FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00001 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00001 00000 C;+ 00002 00000 C.ENTRY STRING 00003 00000 C - S T R I N G 00004 00000 C IDENT: /850207/ 00005 00000 C FILE: cluster::[MP1Q.FLEALECOM]STRING.FLX 00006 00000 C SYSTEM: RSX-11M V4.1, VMS V4.0 00007 00000 C LANGUAGE: FLECS/F77 00008 00000 C AUTHOR: G. T. Anderson 00009 00000 C DATE: 1980 00010 00000 C;- 00011 00000 C 00012 00000 C REFERENCES: 00013 00000 C 00014 00000 C;+ 00015 00000 C 00016 00000 C****PURPOSE: String handling subroutines for FLECS and ALECS. 00017 00000 C;- FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00002 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00018 00000 .PAGE 00019 00000 C;+ 00020 00000 C - C A T S U B 00021 00000 C****NAME: SUBROUTINE CATSUB 00022 00000 C FILE: STRING.FLX 00023 00000 C 00024 00000 C****PURPOSE: CONCATENATE A PORTION OF ONE STRING TO ANOTHER. 00025 00000 C 00026 00000 C****RESTRICTIONS: 00027 00000 C 00028 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00029 00000 C LANGUAGE: FLECS/F77 00030 00000 C AUTHOR: CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON 00031 00000 C DATE: 25-OCT-74 00032 00000 C REVISIONS: 00033 00000 C 1980 (GTA) CONVERT FROM MACRO TO FORTRAN 00034 00000 C 850207mao Add documentation; handle strings >127 char right; 00035 00000 C handle 0 length strings right. 00036 00000 C 00037 00000 C****CALLING SEQUENCE: CALL CATSUB(A,B,START,LEN) 00038 00000 C 00039 00000 C INPUT: 00040 00000 C 00041 00000 C A =STRING TO BE APPENDED TO 00042 00000 C B =STRING FROM WHICH A SUBSTRING IS EXTRACTED AND APPENDED TO A 00043 00000 C START =(I*2) FIRST CHARACTER IN B TO EXTRACT 00044 00000 C LEN =(I*2) NUMBER OF CHARACTERS TO EXTRACT (IF=0, A IS NOT MODIFIED) 00045 00000 C 00046 00000 C OUTPUT: 00047 00000 C 00048 00000 C A =ORIGINAL STRING + LEN CHARACTERS FROM B 00049 00000 C 00050 00000 C CMN BLOCK I/O: NONE 00051 00000 C 00052 00000 C RESOURCES: 00053 00000 C LIBRARIES: NONE 00054 00000 C OTHER SUBR: NONE 00055 00000 C DISK FILES: NONE 00056 00000 C DEVICES: NONE 00057 00000 C SGAS: NONE 00058 00000 C EVENT FLAGS: NONE 00059 00000 C SYSTEM DIR: NONE 00060 00000 C 00061 00000 C****NOTES: 00062 00000 C;- FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00003 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00063 00000 .PAGE 00064 00001 SUBROUTINE CATSUB(A,B,BSTART,LENGTH) 00065 00002 BYTE A(1), B(1), NXTB(2) 00066 00003 INTEGER*2 BSTART, LENGTH, NXT 00067 00004 EQUIVALENCE (NXT,NXTB(1)) 00068 00004 00069 00005 IF (LENGTH.GT.0) !850207mao 00070 00005 C . 00071 00005 C . NEED OFFSET OF 2 TO GET BEYOND STRING LENGTH SPECIFICATION 00072 00005 C . 00073 00006 . NXTB(1)=A(1) !Get length into I*2 format!850207mao 00074 00007 . NXTB(2)=A(2) !850207mao 00075 00008 . NXT = NXT+3 !850207mao 00076 00008 . 00077 00009 . DO(I = BSTART,BSTART+LENGTH-1) !transfer 00078 00010 . . A(NXT) = B(I+2) 00079 00011 . . NXT = NXT + 1 00080 00011 . ...FIN 00081 00012 . 00082 00013 . NXT=NXT-3 !# of char in A !850207mao 00083 00014 . A(1)=NXTB(1) !put into string !850207mao 00084 00015 . A(2)=NXTB(2) !850207mao 00085 00015 C . 00086 00015 C . IF ODD # OF CHARACTERS, PAD WITH A BLANK CHARACTER 00087 00015 C . 00088 00016 . IF(NXT/2*2.NE.NXT)A(NXT+3) = (1H ) !850207mao 00089 00016 . 00090 00016 ...FIN!if !850207mao 00091 00018 RETURN 00092 00019 END (FLECS VERSION 22.38) FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00004 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00093 00000 .PAGE 00094 00000 C;+ 00095 00000 C - C H T Y P 00096 00000 C****NAME: FUNCTION CHTYP 00097 00000 C FILE: STRING.FLX 00098 00000 C 00099 00000 C****PURPOSE: RETURN CODE FOR CHARACTER TYPE 00100 00000 C 00101 00000 C****RESTRICTIONS: 00102 00000 C 00103 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00104 00000 C LANGUAGE: FLECS/F77 00105 00000 C AUTHOR: CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON 00106 00000 C DATE: 25-OCT-74 00107 00000 C REVISIONS: 00108 00000 C 1980 (GTA) CONVERT MACRO TO FORTRAN 00109 00000 C 850207mao Add documentation; replace octal values with hollerith. 00110 00000 C 00111 00000 C****CALLING SEQUENCE: I=CHTYP(CH) 00112 00000 C 00113 00000 C INPUT: 00114 00000 C 00115 00000 C CH =(I*2) INTEGER REPRESENTING CHARACTER CODE FOR THE CHARACTER 00116 00000 C 00117 00000 C OUTPUT: 00118 00000 C 00119 00000 C CHTYP =(I*2) SYNTACTIC CATEGORY FOR THE CHARACTER 00120 00000 C =1, LETTER, A-Z OR LOWER CASE A-Z 00121 00000 C =2, DIGIT, 0-9 00122 00000 C =3, HYPHEN OR MINUS SIGN 00123 00000 C =4, LEFT PARENTHESIS 00124 00000 C =5, RIGHT PARENTHESIS 00125 00000 C =6, BLANK 00126 00000 C =7, ANY OTHER CHARACTER 00127 00000 C 00128 00000 C CMN BLOCK I/O: NONE 00129 00000 C 00130 00000 C RESOURCES: 00131 00000 C LIBRARIES: NONE 00132 00000 C OTHER SUBR: NONE 00133 00000 C DISK FILES: NONE 00134 00000 C DEVICES: NONE 00135 00000 C SGAS: NONE 00136 00000 C EVENT FLAGS: NONE 00137 00000 C SYSTEM DIR: NONE 00138 00000 C 00139 00000 C****NOTES: 00140 00000 C;- FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00005 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00141 00000 .PAGE 00142 00001 INTEGER FUNCTION CHTYP(CHAR) 00143 00002 BYTE CHAR(2) 00144 00003 INTEGER*2 TYP 00145 00003 00146 00003 CONDITIONAL 00147 00005 . ((CHAR(1).GE.1HA).AND.(CHAR(1).LE.1HZ)) TYP = 1 00148 00007 . ((CHAR(1).GE.1Ha).AND.(CHAR(1).LE.1Hz)) TYP = 1 !850207mao 00149 00009 . ((CHAR(1).GE.1H0).AND.(CHAR(1).LE.1H9)) TYP = 2 00150 00011 . (CHAR(1).EQ.1H-) TYP = 3 00151 00013 . (CHAR(1).EQ."50) TYP = 4 !( 00152 00015 . (CHAR(1).EQ."51) TYP = 5 !) 00153 00017 . (CHAR(1).EQ.(1H )) TYP = 6 !space 00154 00019 . (CHAR(1).EQ."11) TYP = 6 !tab 00155 00021 . (OTHERWISE) TYP = 7 00156 00022 ...FIN 00157 00023 CHTYP = TYP 00158 00023 00159 00024 RETURN 00160 00025 END (FLECS VERSION 22.38) FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00006 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00161 00000 .PAGE 00162 00000 C;+ 00163 00000 C - G E T C H 00164 00000 C****NAME: SUBROUTINE GETCH 00165 00000 C FILE: STRING.FLX 00166 00000 C 00167 00000 C****PURPOSE: RETRIEVE INDIVIDUAL CHARACTER FROM A STRING 00168 00000 C 00169 00000 C****RESTRICTIONS: 00170 00000 C 00171 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00172 00000 C LANGUAGE: FLECS/F77 00173 00000 C AUTHOR: CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON 00174 00000 C DATE: 25-OCT-74 00175 00000 C REVISIONS: 00176 00000 C 1980 (GTA) CONVERT MACRO TO FORTRAN 00177 00000 C 850207mao Add documentation; zero high byte of VALUE. 00178 00000 C 00179 00000 C****CALLING SEQUENCE: CALL GETCH(WD,POS,CH) 00180 00000 C 00181 00000 C INPUT: 00182 00000 C 00183 00000 C WD =(I*2) LOCATION IN STRING CONTAINING CHARACTER 00184 00000 C POS =(I*2) WHICH CHARACTER IN WD TO RETRIEVE (1-NCHPWD) 00185 00000 C 00186 00000 C OUTPUT: 00187 00000 C 00188 00000 C CH =(I*2) INTEGER VALUE OF CHARACTER AT SPECIFIED LOCATION 00189 00000 C 00190 00000 C CMN BLOCK I/O: NONE 00191 00000 C 00192 00000 C RESOURCES: 00193 00000 C LIBRARIES: NONE 00194 00000 C OTHER SUBR: NONE 00195 00000 C DISK FILES: NONE 00196 00000 C DEVICES: NONE 00197 00000 C SGAS: NONE 00198 00000 C EVENT FLAGS: NONE 00199 00000 C SYSTEM DIR: NONE 00200 00000 C 00201 00000 C****NOTES: 00202 00000 C;- FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00007 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00203 00000 .PAGE 00204 00001 SUBROUTINE GETCH(WORD,POS,VALUE) 00205 00002 INTEGER*2 POS 00206 00003 BYTE WORD(2), VALUE(2) 00207 00003 00208 00004 VALUE(1) = WORD(POS) 00209 00005 VALUE(2) = 0 !850207mao 00210 00005 00211 00006 RETURN 00212 00007 END (FLECS VERSION 22.38) FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00008 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00213 00000 .PAGE 00214 00000 C;+ 00215 00000 C - P U T C H 00216 00000 C****NAME: SUBROUTINE PUTCH 00217 00000 C FILE: STRING.FLX 00218 00000 C 00219 00000 C****PURPOSE: PUT A CHARACTER INTO A STRING 00220 00000 C 00221 00000 C****RESTRICTIONS: 00222 00000 C 00223 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00224 00000 C LANGUAGE: FLECS/F77 00225 00000 C AUTHOR: CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON 00226 00000 C DATE: 25-OCT-74 00227 00000 C REVISIONS: 00228 00000 C 1980 (GTA) CONVERT MACRO TO FORTRAN 00229 00000 C 850207mao Add documentation. 00230 00000 C 00231 00000 C****CALLING SEQUENCE: CALL PUTCH(WD,POS,CH) 00232 00000 C 00233 00000 C INPUT: 00234 00000 C 00235 00000 C POS =(I*2) LOCATION IN WD TO REPLACE (1-NCHPWD) 00236 00000 C CH =(I*2) INTEGER VALUE OF CHARACTER TO PUT IN STRING 00237 00000 C 00238 00000 C OUTPUT: 00239 00000 C 00240 00000 C WD =(I*2) WORD IN STRING TO HAVE A CHARACTER REPLACED 00241 00000 C 00242 00000 C CMN BLOCK I/O: NONE 00243 00000 C 00244 00000 C RESOURCES: 00245 00000 C LIBRARIES: NONE 00246 00000 C OTHER SUBR: NONE 00247 00000 C DISK FILES: NONE 00248 00000 C DEVICES: NONE 00249 00000 C SGAS: NONE 00250 00000 C EVENT FLAGS: NONE 00251 00000 C SYSTEM DIR: NONE 00252 00000 C 00253 00000 C****NOTES: 00254 00000 C;- FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00009 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00255 00000 .PAGE 00256 00001 SUBROUTINE PUTCH(WORD,POS,VALUE) 00257 00002 INTEGER*2 POS 00258 00003 BYTE WORD(2), VALUE(2) 00259 00003 00260 00004 WORD(POS) = VALUE(1) 00261 00004 00262 00005 RETURN 00263 00006 END (FLECS VERSION 22.38) FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00010 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00264 00000 .PAGE 00265 00000 C;+ 00266 00000 C - S T R E Q 00267 00000 C****NAME: FUNCTION STREQ 00268 00000 C FILE: STRING.FLX 00269 00000 C 00270 00000 C****PURPOSE: TEST FOR STRING EQUALITY 00271 00000 C 00272 00000 C****RESTRICTIONS: 00273 00000 C 00274 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00275 00000 C LANGUAGE: FLECS/F77 00276 00000 C AUTHOR: CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON 00277 00000 C DATE: 25-OCT-74 00278 00000 C REVISIONS: 00279 00000 C 1980 (GTA) CONVERT FROM MACRO TO F77 00280 00000 C 850207mao Add documentation; handle strings >127 char right. 00281 00000 C 00282 00000 C****CALLING SEQUENCE: L=STREQ(A,B) 00283 00000 C 00284 00000 C INPUT: 00285 00000 C 00286 00000 C A =STRING OF NON-ZERO LENGTH 00287 00000 C B =STRING OF NON-ZERO LENGTH 00288 00000 C 00289 00000 C OUTPUT: 00290 00000 C 00291 00000 C STREQ =(L*2) .T. IF STRINGS ARE IDENTICAL IN LENGTH AND CONTENTS, 00292 00000 C .F. IF OTHERWISE. 00293 00000 C 00294 00000 C CMN BLOCK I/O: NONE 00295 00000 C 00296 00000 C RESOURCES: 00297 00000 C LIBRARIES: NONE 00298 00000 C OTHER SUBR: NONE 00299 00000 C DISK FILES: NONE 00300 00000 C DEVICES: NONE 00301 00000 C SGAS: NONE 00302 00000 C EVENT FLAGS: NONE 00303 00000 C SYSTEM DIR: NONE 00304 00000 C 00305 00000 C****NOTES: 00306 00000 C;- FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00011 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00307 00000 .PAGE 00308 00001 LOGICAL FUNCTION STREQ(A,B) 00309 00001 00310 00002 INTEGER*2 LENG !850207mao 00311 00003 LOGICAL*2 EQUAL 00312 00004 BYTE A(1), B(1), LENGB(2) !850207mao 00313 00005 EQUIVALENCE (LENG,LENGB(1)) !850207mao 00314 00005 00315 00005 C IF A & B NOT THE SAME LENGTH, THEY ARE NOT EQUAL 00316 00005 00317 00006 EQUAL = A(1).EQ.B(1) .AND. A(2).EQ.B(2) !850207mao 00318 00007 IF (EQUAL) !850207mao 00319 00007 . 00320 00008 . LENGB(1) = A(1) !string len as I*2 !850207mao 00321 00009 . LENGB(2) = A(2) 00322 00010 . LENG = LENG+2 !last used array elem !850207mao 00323 00010 . 00324 00011 . I = 3 00325 00012 . WHILE (EQUAL.AND.(I.LE.LENG)) !850207mao 00326 00013 . . IF (A(I).NE.B(I)) EQUAL = .FALSE. 00327 00014 . . I = I+1 00328 00014 . ...FIN 00329 00015 ...FIN!if !850207mao 00330 00016 00331 00017 STREQ = EQUAL 00332 00017 00333 00018 RETURN 00334 00019 END (FLECS VERSION 22.38) FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00012 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00335 00000 .PAGE 00336 00000 C;+ 00337 00000 C - S T R L T 00338 00000 C****NAME: FUNCTION STRLT 00339 00000 C FILE: STRING.FLX 00340 00000 C 00341 00000 C****PURPOSE: DETERMINE WHETHER ONE STRING IS LEXICOGRAPHICALLY 00342 00000 C LESS THAN ANOTHER. 00343 00000 C 00344 00000 C****RESTRICTIONS: 00345 00000 C 00346 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00347 00000 C LANGUAGE: FLECS/F77 00348 00000 C AUTHOR: CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON 00349 00000 C DATE: 25-OCT-74 00350 00000 C REVISIONS: 00351 00000 C 1980 (GTA) CONVERT MACRO TO FORTRAN 00352 00000 C 850207mao Add documentation; handle strings >127 char right 00353 00000 C 00354 00000 C****CALLING SEQUENCE: L=STRLT(A,B) 00355 00000 C 00356 00000 C INPUT: 00357 00000 C 00358 00000 C A =STRING OF NON-ZERO LENGTH 00359 00000 C B =STRING OF NON-ZERO LENGTH 00360 00000 C 00361 00000 C OUTPUT: 00362 00000 C 00363 00000 C STRLT =(L*2) SET .TRUE. IF THE STRING A IS LEXICOGRAPHICALLY STRICTLY 00364 00000 C LESS THAN STRING B. 00365 00000 C 00366 00000 C CMN BLOCK I/O: NONE 00367 00000 C 00368 00000 C RESOURCES: 00369 00000 C LIBRARIES: NONE 00370 00000 C OTHER SUBR: NONE 00371 00000 C DISK FILES: NONE 00372 00000 C DEVICES: NONE 00373 00000 C SGAS: NONE 00374 00000 C EVENT FLAGS: NONE 00375 00000 C SYSTEM DIR: NONE 00376 00000 C 00377 00000 C****NOTES: 00378 00000 C;- FLECS VERSION 860214 2-DEC-87 06:41:45 PAGE 00013 STRING,STRING/-SP=[MP1Q.FLEALECOM]STRING 00379 00000 .PAGE 00380 00001 LOGICAL FUNCTION STRLT(A,B) 00381 00002 INTEGER*2 ALENG,BLENG !850207mao 00382 00003 LOGICAL*2 ALESS, MORE 00383 00004 BYTE A(1), B(1), ALENGB(2), BLENGB(2) !850207mao 00384 00005 EQUIVALENCE (ALENG,ALENGB(1)) !850207mao 00385 00006 EQUIVALENCE (BLENG,BLENGB(1)) !850207mao 00386 00006 00387 00007 DO (I=1,2) !string lengths as I*2 !850207mao 00388 00008 . ALENGB(I) = A(I) !850207mao 00389 00009 . BLENGB(I) = B(I) !850207mao 00390 00009 ...FIN!do !850207mao 00391 00010 00392 00010 C SET MLENG TO LENGTH OF SHORTEST STRING + LENGTH OF HEADER 00393 00010 00394 00011 MLENG = MIN (ALENG,BLENG) + 2 !850207mao 00395 00011 00396 00012 I = 3 00397 00013 MORE = .TRUE. 00398 00014 WHILE (MORE.AND.(I.LE.MLENG)) 00399 00014 . CONDITIONAL 00400 00015 . . (A(I).GT.B(I)) !works because no neg ASCII characters 00401 00016 . . . MORE = .FALSE. 00402 00017 . . . ALESS = .FALSE. 00403 00017 . . ...FIN 00404 00018 . . (A(I).LT.B(I)) 00405 00019 . . . MORE = .FALSE. 00406 00020 . . . ALESS = .TRUE. 00407 00020 . . ...FIN 00408 00021 . . (OTHERWISE) CONTINUE 00409 00022 . ...FIN 00410 00023 . I = I+1 00411 00023 ...FIN 00412 00024 C 00413 00024 C IF A=B THROUGH MLENG AND A IS SHORTER, THEN A < B 00414 00024 C 00415 00025 IF (MORE) ALESS = ALENG.LT.BLENG !850207mao 00416 00025 00417 00026 STRLT = ALESS 00418 00026 00419 00027 RETURN 00420 00028 END (FLECS VERSION 22.38)