FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00001 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00001 00000 C;+ 00002 00000 C - A N A L Y Z 00003 00000 C****NAME: SUBROUTINE ANALYZ 00004 00000 C IDENT: /860407/ 00005 00000 C FILE: A.FLX 00006 00000 C 00007 00000 C****PURPOSE: OBTAIN AND ANALYZE NEXT FLECS STATEMENT 00008 00000 C 00009 00000 C****RESTRICTIONS: 00010 00000 C 00011 00000 C SYSTEM: RSX11M V4.0 00012 00000 C LANGUAGE: FLECS/FORTRAN 00013 00000 C AUTHOR: TERRY BEYER 00014 00000 C DATE: 20-NOV-74 00015 00000 C REVISIONS: 00016 00000 C 25-JAN-80 (MAO) MAKE COMMENTS ON FLECS LINES LEGAL IF PRECEEDED 00017 00000 C BY AN EXCLAIMATION POINT. 00018 00000 C 26-JAN-80 (MAO) COMMENT CODE 00019 00000 C 14-FEB-80 (MAO) ALLOW COMMENTS IN FTN OUTPUT, ADD /MACVAL/ 00020 00000 C 20-FEB-80 (MAO) ADD ALECS CODE; NOTE ALL ALECS CODE IS DELIMITED BY 00021 00000 C C 00022 00000 C C ALECS VVVVV 00023 00000 C ALECS CODE 00024 00000 C C ALECS ^^^^^ 00025 00000 C C 00026 00000 C IF YOU DO NOT WANT ALECS, SIMPLY COMMENT OUT THE DELIMITED LINES. 00027 00000 C 15-SEP-80 (MAO) TREAT FORMFEED AS A COMMENT LINE 00028 00000 C 22-JUN-81 (MAO) ENABLE FLECS DIRECTIVES 00029 00000 C 22-JUN-81 (MAO) ADD .PAGE DIRECTIVE 00030 00000 C 22-JUN-81 (MAO) TREATE ALECS .END PROCESSING AS A DIRECTIVE 00031 00000 C 29-JUN-81 (MAO) ADD .INCLUDE PROCESSING 00032 00000 C 30-JUN-81 (MAO) ADD .PASSx DIRECTIVES 00033 00000 C 30-JUN-81 (MAO) ADD .NAME DIRECTIVE 00034 00000 C 17-AUG-81 (MAO) MAKE SURE MACRO-11 .IF IS NOT TREATED AS FLECS CMD 00035 00000 C 29-NOV-82 (MAO) ADD COMMON IOERR AND NEW CALL TO SUBR GET 00036 00000 C 07-MAR-83 (MAO) CODE FOR FORT LINE # IN FLL FILE 00037 00000 C 07-MAR-84 (MAO) ADD CODE FOR .IMPLICIT NONE 00038 00000 C 13-AUG-84 (MAO) CONVERT WHEN(ALECS) ELSE TO .PASSIF ALECS/FLECS 00039 00000 C 860214mao Add .IMP NONE; add code for DOWHILE, DO/ENDDO as input. 00040 00000 C Add code for IF-THEN-ELSE. 00041 00000 C 860407mao Remove .IMP NONE so .FTN file can be exported w/o .FID file. 00042 00000 C 00043 00000 C****CALLING SEQUENCE: CALL ANALYZ 00044 00000 C 00045 00000 C INPUT: NONE 00046 00000 C 00047 00000 C OUTPUT: NONE 00048 00000 C 00049 00000 C CMN BLOCK I/O: BLANK COMMON, /PARAM/, /MACVAL/, /IOERR/ 00050 00000 C 00051 00000 C RESOURCES: 00052 00000 C LIBRARIES: NONE 00053 00000 C OTHER SUBR: [201,13]CATSTR,CATSUB,CHTYP,CPYSTR,CPYSUB,GET,GETCH,PUT, 00054 00000 C PUTCH,STREQ 00055 00000 C DISK FILES: NONE FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00002 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 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 1. NONSTANDARD FEATURE: A COMMENT MAY BE PUT ON A FLECS LINE 00063 00000 C IF IT IS PRECEDED BY AN EXCLAIMATION POINT, EG. 00064 00000 C 00065 00000 C WHEN(I.GT.J) !WILL ONLY HAPPEN FOR ABNORMAL DATA 00066 00000 C;- 00067 00001 SUBROUTINE ANALYZ 00068 00001 00069 00001 CCCCC .IMPLICIT NONE !860214 00070 00001 00071 00001 C Conditionals 00072 00001 00073 00001 C ALECS==>generate ALECS assembly language output 00074 00001 C FLECS==>generate FLECS F77 output 00075 00001 C F77FUL==>generate code using full F77, ie. DOWHILE & DO-ENDDO 00076 00001 C F77SUB==>generate code compatible with F77 subset 00077 00001 00078 00001 C ALECS & FLECS are mutually exclusive. 00079 00001 C If FLECS is given, either F77FUL or F77SUB must be given. 00080 00001 00081 00001 .PASSUNLESS ALECS 00082 00001 .PASSUNLESS FLECS 00084 00001 .PASSEND 00085 00001 .PASSEND 00086 00001 00087 00001 .PASSIF ALECS 00088 00001 .PASSIF FLECS 00090 00001 .PASSEND 00091 00001 .PASSEND 00092 00001 00093 00001 .PASSIF ALECS 00094 00001 .PASSIF F77FUL 00096 00001 .PASSEND 00097 00001 .PASSIF F77SUB 00099 00001 .PASSEND 00100 00001 .PASSEND 00101 00001 00102 00001 .PASSIF FLECS 00103 00001 .PASSUNLESS F77FUL 00104 00001 .PASSUNLESS F77SUB 00106 00001 .PASSEND 00107 00001 .PASSEND 00108 00001 .PASSEND 00109 00001 00110 00001 .PASSIF F77FUL 00111 00001 .PASSIF F77SUB 00113 00001 .PASSEND 00114 00001 .PASSEND 00115 00001 00116 00001 C FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00003 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00117 00001 C SUBROUTINE TO OBTAIN AND ANALYZE NEXT FLECS STATEMENT 00118 00001 C 00119 00001 C 00120 00001 C--------------------------------------- 00121 00001 C 00122 00001 C FLECS TRANSLATOR (PRELIMINARY VERSION 22) 00123 00001 C (FOR A MORE PRECISE VERSION NUMBER, SEE THE STRING SVER) 00124 00001 C 00125 00001 C AUTHOR -- TERRY BEYER 00126 00001 C 00127 00001 C ADDRESS -- COMPUTING CENTER 00128 00001 C UNIVERSITY OF OREGON 00129 00001 C EUGENE, OREGON 97405 00130 00001 C 00131 00001 C TELEPHONE -- (503) 686-4416 00132 00001 C 00133 00001 C DATE -- NOVEMBER 20, 1974 00134 00001 C 00135 00001 C--------------------------------------- 00136 00001 C 00137 00001 C DISCLAIMER 00138 00001 C 00139 00001 C NEITHER THE AUTHOR NOR THE UNIVERSITY OF OREGON SHALL BE 00140 00001 C LIBAL FOR ANY DIRECT OR INDIRECT, INCIDENTAL, CONSEQUENTIAL, 00141 00001 C OR SPECIFIC DAMAGES OF ANY KIND OR FROM ANY CAUSE WHATSOEVER 00142 00001 C ARISING OUT OF OR IN ANY WAY CONNECTED WITH THE USE OR 00143 00001 C PERFORMANCE OF THIS PROGRAM. 00144 00001 C 00145 00001 C--------------------------------------- 00146 00001 C 00147 00001 C SPECIAL NOTES FOR THE PDP-11 00148 00001 C 00149 00001 C 00150 00001 C 1. DUE TO A RESTRICTION IN THE DOS FORTRAN COMPILER, 00151 00001 C ALL DATA STATEMENTS HAVE BEEN COMMENTED OUT IN THEIR 00152 00001 C ORIGINAL LOCATIONS AND HAVE BEEN REPRODUCED IN A BLOCK 00153 00001 C AT THE END OF THE OTHER DECLARATIONS. 00154 00001 C 00155 00001 C 2. DUE TO THE INABILITY OF THE DOS FORTRAN COMPILER TO 00156 00001 C CORRECTLY INTERPRET THE STATEMENT CALLNO=CALLNO+1 00157 00001 C THE VARIABLE CALLNO HAS BEEN RENAMED TO NOCALL 00158 00001 C 00159 00001 C--------------------------------------- 00160 00001 C 00161 00001 C FOLLOWING FOR LAMPF VERSION OF FLECS--14-FEB-80 00162 00001 C 00163 00002 INTEGER NUMLIN !830307 MAO 00164 00003 LOGICAL CNTALL !830307 MAO 00165 00004 COMMON/FLINE/CNTALL,NUMLIN !830307 MAO 00166 00004 C 00167 00005 INTEGER DTYPE !22-JUN-81 00168 00006 COMMON/DIR/DTYPE !22-JUN-81 00169 00006 C 00170 00007 LOGICAL PASFLG !30JUN81MAO 00171 00008 INTEGER CNDLVL !30JUN81MAO FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00004 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00172 00009 INTEGER OFFLVL !30JUN81MAO 00173 00010 INTEGER COND !30JUN81MAO 00174 00011 INTEGER CNDVAL !30JUN81MAO 00175 00012 COMMON/COND/PASFLG,CNDLVL,OFFLVL,COND,CNDVAL(4,10) !30JUN81MAO 00176 00012 C 00177 00012 C ALECS VVVVV 00178 00013 LOGICAL*2 ALECS,LSTFUL !14-FEB-80 00179 00014 INTEGER*2 TYPIN,TYPLST,TYPOUT,CHCMNT !14-FEB-80 00180 00015 COMMON/MACVAL/ALECS,TYPIN,TYPLST,TYPOUT,CHCMNT,LSTFUL !14-FEB-80 00181 00015 C 00182 00016 INTEGER SAEND 00183 00016 C ALECS ^^^^^ 00184 00016 C 00185 00017 INTEGER ERR1,ERR2 !821129MAO 00186 00018 COMMON/IOERR/ERR1,ERR2 !821129MAO 00187 00018 C 00188 00018 C--------------------------------------- 00189 00018 C 00190 00018 C INTEGER DECLARATIONS 00191 00018 C 00192 00018 C 00193 00019 INTEGER FORMFD !MAO15-SEP-80 00194 00020 INTEGER DIRCH !MAO22-JUN-81 00195 00021 INTEGER KPAGE !MAO22-JUN-81 00196 00022 INTEGER KPIF,KPUNL,KPEND !30JUN81MAO 00197 00023 INTEGER KNAME !30JUN81MAO 00198 00024 INTEGER TDIR !MAO22-JUN-81 00199 00025 INTEGER TOFF !30JUN81MAO 00200 00026 INTEGER DPAGE !MAO22-JUN-81 00201 00027 INTEGER KINCL,DINCL,UDIR !29-JUN-81MAO 00202 00028 INTEGER DPIF,DPUNL,DPEND !30JUN81MAO 00203 00029 INTEGER DNAME !30JUN81MAO 00204 00030 INTEGER DIMP,KIMP,KNONE !840307MAO 00205 00031 INTEGER BLN , CH , CHC , CHSPAC, CHTYP , CHTYPE 00206 00032 INTEGER CINLIN !25-JAN-80 00207 00033 INTEGER CHZERO, CLASS , CPOS , CSAVE , CURSOR, CWD 00208 00034 INTEGER ERRCL , ERROR , ERRSTK, ERSTOP 00209 00035 INTEGER EXTYPE, FLXNO , FORTCL, HOLDNO, I , KCOND 00210 00036 INTEGER KDO , KELSE , KEND , KFIN , KIF , KREPT 00211 00037 INTEGER KDOW , KENDDO !860214 00212 00038 INTEGER KSELCT, KTO , KUNLES, KUNTIL, KWHEN , KWHILE 00213 00039 INTEGER KELSIF, KTHEN , KENDIF !860214 00214 00040 INTEGER LEN , LEVEL , LINENO, LISTCL, LSTLEV, MAJCNT 00215 00041 INTEGER MINCNT, MLINE , NCHPWD, NUNITS, PCNT , PTABLE, QP 00216 00042 INTEGER READ , REFNO ,RETRY , SB , SB5 , SB6 00217 00043 INTEGER SB7 , SDASH , SDUM , SEND , SETUP , SFLX 00218 00044 INTEGER SFSPCR, SHOLD , SLIST , SLP , SOURCE, SOWSE 00219 00045 INTEGER SPINV , SPUTGO, SRP , SSPACR, SST 00220 00046 INTEGER SSTMAX, STACK , START , TBLANK, TCEXP , TCOND 00221 00047 INTEGER TDIGIT, TDO , TELSE , TEND , TEOL , TEXEC 00222 00048 INTEGER TDO77 , TENDDO, TELSIF, TENDIF, TIFTHN !860214 00223 00049 INTEGER TFIN , TFORT , THYPHN, TIF , TINVOK, TLETTR 00224 00050 INTEGER TLP , TOP , TOTHER, TRP , TRUNTL, TRWHIL 00225 00051 INTEGER TSELCT, TTO , TUNLES, TUNTIL, TWHEN , TWHILE 00226 00052 INTEGER UDO , UEXP , UFORT , ULEN , UOWSE , UPINV FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00005 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00227 00053 INTEGER USTART, UTYPE , WWIDTH 00228 00053 C 00229 00053 C 00230 00053 C--------------------------------------- 00231 00053 C 00232 00053 C LOGICAL DECLARATIONS 00233 00053 C 00234 00053 C 00235 00054 LOGICAL DRCTV !22-JUN-81 MAO 00236 00055 LOGICAL BADCH , CONT , DONE ,ENDFIL, ENDPGM, ERLST , FIRST 00237 00056 LOGICAL FOUND , INDENT, INVOKE, NOPGM , PASS , SAVED , STREQ 00238 00056 C 00239 00056 C--------------------------------------- 00240 00056 C 00241 00056 C ARRAY DECLARATIONS 00242 00056 C 00243 00056 C 00244 00056 C ARRAYS WHICH HOLD RESULTS OF SCANNERS ANALYSIS 00245 00057 DIMENSION UTYPE(3), USTART(3), ULEN(3) 00246 00057 C 00247 00057 C STACK/TABLE AREA AND POINTER TO TOP OF STACK 00248 00058 DIMENSION STACK(2000) 00249 00058 C 00250 00058 C SYNTAX ERROR STACK AND TOP POINTER 00251 00059 DIMENSION ERRSTK(5) 00252 00059 C 00253 00059 C--------------------------------------- 00254 00059 C 00255 00059 C COMMON DECLARATIONS 00256 00059 C (SEE ALSO PARAMETERS BELOW) 00257 00059 C 00258 00059 C 00259 00059 C THE FOLLOWING VARIABLES ARE COMMON TO TWO OR MORE SUBPROGRAMS 00260 00060 COMMON BLN , CLASS , DONE , ENDFIL, ENDPGM, ERLST 00261 00061 COMMON ERROR , ERRSTK, ERSTOP, EXTYPE, FIRST , FLXNO 00262 00062 COMMON FOUND , HOLDNO, LEVEL , LINENO, LSTLEV, MAJCNT 00263 00063 COMMON MINCNT, MLINE , NOPGM , NUNITS, PASS , PTABLE, QP 00264 00064 COMMON REFNO , SAVED , SFLX , SHOLD , SLIST , SOURCE 00265 00065 COMMON SPINV , SPUTGO, SST , STACK , TOP , ULEN 00266 00066 COMMON USTART, UTYPE , WWIDTH 00267 00066 C 00268 00066 C--------------------------------------- 00269 00066 C 00270 00066 C MNEMONIC DECLARATIONS 00271 00066 C 00272 00066 C 00273 00066 C I/O CLASS CODES FOR USE WITH SUBROUTINE PUT 00274 00066 C DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ 00275 00066 C 00276 00066 C TYPE CODES USED BY SCANNERS 00277 00066 C DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ 00278 00066 C DATA UDIR/6/ !29-JUN- 00279 00066 C 00280 00066 C TYPE CODES OF CHARACTERS (SUPPLIED BY CHTYPE) 00281 00066 C WARNING - LOGIC IS SENSITIVE TO THE ORDER OF THESE VALUES. FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00006 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00282 00066 C DATA TLETTR/1/, TDIGIT/2/, THYPHN/3/, TLP/4/, TRP/5/ 00283 00066 C DATA TBLANK/6/, TOTHER/7/, TEOL/8/ 00284 00066 C 00285 00066 C TYPE CODES ASSIGNED TO THE VARIABLE CLASS 00286 00066 C DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 00287 00066 C DATA TDIR /7/ !22-JUN- 00288 00066 C DATA TOFF /8/ !30JUN81 00289 00066 C DATA TENDDO /9/ !860214 00290 00066 C DATA TELSIF /10/, TENDIF /11/ !860214 00291 00066 C 00292 00066 C TYPE CODES ASSIGNED TO THE VARIABLE EXTYPE 00293 00066 C DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ 00294 00066 C DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ 00295 00066 C DATA TWHILE/12/ 00296 00066 C DATA TDO77 /13/ !860214 00297 00066 C DATA TIFTHN/14/ !860214 00298 00066 C 00299 00066 C TYPE CODES ASSIGNED TO THE VARIABLE DTYPE 00300 00066 C 00301 00066 C DATA DPAGE /1/, DINCL /2/ !29-JUN- 00302 00066 C DATA DPIF /3/, DPUNL /4/, DPEND /5/ !30JUN81 00303 00066 C DATA DNAME /6/ !30JUN81 00304 00066 C DATA DIMP /7/ !840307M 00305 00066 C 00306 00066 C CODES INDICATING SOURCE OF NEXT STATEMENT 00307 00066 C IN ANALYZE-NEXT-STATEMENT 00308 00066 C DATA SETUP /1/, RETRY /2/, READ /3/ 00309 00066 C 00310 00066 C--------------------------------------- 00311 00066 C 00312 00066 C 00313 00066 C PARAMETERS 00314 00066 C 00315 00066 C THE FOLLOWING VARIABLES ARE PARAMETERS FOR THE PROGRAM. 00316 00066 C THE MEANING OF EACH IS GIVEN BRIEFLY BELOW. FOR MORE INFORMATION 00317 00066 C ON THE EFFECT OF THESE PARAMETERS, CONSULT THE SYSTEM MODIFICATION 00318 00066 C GUIDE. 00319 00066 C THE PARAMETERS NCHPWD, CHZERO, CHSPAC, AND CHC ARE SUPPLIED 00320 00066 C BY THE MAIN PROGRAM VIA THE FOLLOWING COMMON 00321 00067 COMMON /PARAM/ NCHPWD, CHZERO, CHSPAC, CHC, CINLIN !25-JAN-80 00322 00067 C 00323 00067 C--------------------------------------- 00324 00067 C 00325 00067 C STRING DECLARATIONS 00326 00067 C 00327 00067 C 00328 00067 C THE FOLLOWING ARRAYS ARE USED FOR STORAGE OF WORKING STRINGS 00329 00067 C AND CORRESPOND TO STRINGS OF THE LENGTHS INDICATED. 00330 00067 C THE SIZES GIVEN BELOW ARE EXCESSIVE AND SHOULD BE 00331 00067 C BE REDUCED AFTER CAREFUL ANALYSIS (NO TIME NOW). 00332 00067 C 00333 00067 C SFLX 100 CHARACTERS 00334 00068 DIMENSION SFLX (51) 00335 00068 C SHOLD 100 CHARACTERS 00336 00069 DIMENSION SHOLD (51) FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00007 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00337 00069 C SLIST 200 CHARACTERS 00338 00070 DIMENSION SLIST (101) 00339 00070 C SPINV 80 CHARACTERS 00340 00071 DIMENSION SPINV (41) 00341 00071 C SPUTGO 20 CHARACTERS 00342 00072 DIMENSION SPUTGO (11) 00343 00072 C SST 200 CHARACTERS 00344 00073 DIMENSION SST (101) 00345 00074 BYTE SSTB(202) 00346 00075 EQUIVALENCE(SSTB,SST) 00347 00075 C DATA SSTMAX /200/ 00348 00075 C 00349 00075 C THE FOLLOWING STRINGS REPRESENT CONSTANTS 00350 00075 C 00351 00075 C SB // // 00352 00076 DIMENSION SB (2) 00353 00076 C DATA SB / 1, 1H / 00354 00076 C SB5 // // 00355 00077 DIMENSION SB5 (4) 00356 00077 C DATA SB5 / 5, 2H , 2H , 1H / 00357 00077 C SB6 // // 00358 00078 DIMENSION SB6 (4) 00359 00078 C DATA SB6 / 6, 2H , 2H , 2H / 00360 00078 C SB7 // // 00361 00079 DIMENSION SB7 (5) 00362 00079 C DATA SB7 / 7, 2H , 2H , 2H , 1H / 00363 00079 C SDASH //----------------------------------------// 00364 00080 DIMENSION SDASH (21) 00365 00080 C DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00366 00080 C 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00367 00080 C 1 , 2H--, 2H--, 2H--, 2H--/ 00368 00080 C SDUM //DUMMY-PROCEDURE// 00369 00081 DIMENSION SDUM (9) 00370 00081 C DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ 00371 00081 C SEND // END// 00372 00082 DIMENSION SEND (6) 00373 00082 C DATA SEND / 9, 2H , 2H , 2H , 2HEN, 1HD/ 00374 00082 C SFSPCR //...// 00375 00083 DIMENSION SFSPCR (3) 00376 00083 C DATA SFSPCR / 3, 2H.., 1H./ 00377 00083 C SLP //(// 00378 00084 DIMENSION SLP (2) 00379 00084 C DATA SLP / 1, 1H(/ 00380 00084 C SOWSE //(OTHERWISE)// 00381 00085 DIMENSION SOWSE (7) 00382 00085 C DATA SOWSE / 11, 2H(O, 2HTH, 2HER, 2HWI, 2HSE, 1H)/ 00383 00085 C SRP //)// 00384 00086 DIMENSION SRP (2) 00385 00086 C DATA SRP / 1, 1H)/ 00386 00086 C SSPACR //. // 00387 00087 DIMENSION SSPACR (3) 00388 00087 C DATA SSPACR / 3, 2H. , 1H / 00389 00087 C 00390 00087 C THE FOLLWING ARRAYS HOLD STRINGS USED BY THE KEYWORD SCANNER 00391 00087 C FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00008 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00392 00087 C KCOND //CONDITIONAL// 00393 00088 DIMENSION KCOND (7) 00394 00088 C DATA KCOND / 11, 2HCO, 2HND, 2HIT, 2HIO, 2HNA, 1HL/ 00395 00088 C KDO //DO// 00396 00089 DIMENSION KDO (2) 00397 00089 C DATA KDO / 2, 2HDO/ 00398 00089 C KDOW //DOWHILE// 00399 00090 DIMENSION KDOW (5) !860214 00400 00090 C DATA KDOW / 7, 2HDO, 2HWH, 2HIL, 1HE/ 00401 00090 C KELSE //ELSE// 00402 00091 DIMENSION KELSE (3) 00403 00091 C DATA KELSE / 4, 2HEL, 2HSE/ 00404 00091 C KELSIF //ELSEIF// 00405 00092 DIMENSION KELSIF (4) !860214 00406 00092 C DATA KELSIF / 6, 2HEL, 2HSE, 2HIF/ 00407 00092 C KEND //END// 00408 00093 DIMENSION KEND (3) 00409 00093 C DATA KEND / 3, 2HEN, 1HD/ 00410 00093 C KENDDO //ENDDO// 00411 00094 DIMENSION KENDDO (4) !860214 00412 00094 C DATA KENDDO / 5, 2HEN, 2HDD, 1HO/ 00413 00094 C KENDIF //ENDIF// 00414 00095 DIMENSION KENDIF (4) !860214 00415 00095 C DATA KENDIF / 5, 2HEN, 2HDI, 1HF/ 00416 00095 C KFIN //FIN// 00417 00096 DIMENSION KFIN (3) 00418 00096 C DATA KFIN / 3, 2HFI, 1HN/ 00419 00096 C KIF //IF// 00420 00097 DIMENSION KIF (2) 00421 00097 C DATA KIF / 2, 2HIF/ 00422 00097 C KNAME //NAME// 00423 00098 DIMENSION KNAME(3) !30JUN81MAO 00424 00098 C DATA KNAME / 4, 2HNA, 2HME/ 00425 00098 C KINCL //INCLUDE// 00426 00099 DIMENSION KINCL(5) !29JUN81 MAO 00427 00099 C DATA KINCL /7, 2HIN, 2HCL, 2HUD, 1HE/ 00428 00099 C KIMP //IMPLICIT// !840307MAO 00429 00100 DIMENSION KIMP(5) !840307MAO 00430 00100 C DATA KIMP /8, 2HIM, 2HPL, 2HIC, 2HIT/ !840307MAO 00431 00100 C KNONE //NONE// !840307MAO 00432 00101 DIMENSION KNONE(3) !840307MAO 00433 00101 C DATA KNONE /4, 2HNO, 2HNE/ !840307MAO 00434 00101 C KPAGE //PAGE// 00435 00102 DIMENSION KPAGE(3) !22-JUN-81 (MAO) 00436 00102 C DATA KPAGE / 4, 2HPA, 2HGE/ 00437 00102 C KPEND //PASSEND// 00438 00103 DIMENSION KPEND(5) !30JUN81MAO 00439 00103 C DATA KPEND / 7, 2HPA, 2HSS, 2HEN, 1HD/ 00440 00103 C KPIF //PASSIF// 00441 00104 DIMENSION KPIF (4) !30JUN81MAO 00442 00104 C DATA KPIF /6, 2HPA, 2HSS, 2HIF/ 00443 00104 C KPUNL //PASSUNLESS// 00444 00105 DIMENSION KPUNL(6) !30JUN81MAO 00445 00105 C DATA KPUNL / 10, 2HPA, 2HSS, 2HUN, 2HLE, 2HSS/ 00446 00105 C KREPT //REPEAT// FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00009 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00447 00106 DIMENSION KREPT (4) 00448 00106 C DATA KREPT / 6, 2HRE, 2HPE, 2HAT/ 00449 00106 C KSELCT //SELECT// 00450 00107 DIMENSION KSELCT (4) 00451 00107 C DATA KSELCT / 6, 2HSE, 2HLE, 2HCT/ 00452 00107 C KTHEN //THEN// 00453 00108 DIMENSION KTHEN (3) !860214 00454 00108 C DATA KTHEN / 4, 2HTH, 2HEN/ 00455 00108 C KTO //TO// 00456 00109 DIMENSION KTO (2) 00457 00109 C DATA KTO / 2, 2HTO/ 00458 00109 C KUNLES //UNLESS// 00459 00110 DIMENSION KUNLES (4) 00460 00110 C DATA KUNLES / 6, 2HUN, 2HLE, 2HSS/ 00461 00110 C KUNTIL //UNTIL// 00462 00111 DIMENSION KUNTIL (4) 00463 00111 C DATA KUNTIL / 5, 2HUN, 2HTI, 1HL/ 00464 00111 C KWHEN //WHEN// 00465 00112 DIMENSION KWHEN (3) 00466 00112 C DATA KWHEN / 4, 2HWH, 2HEN/ 00467 00112 C KWHILE //WHILE// 00468 00113 DIMENSION KWHILE (4) 00469 00113 C DATA KWHILE / 5, 2HWH, 2HIL, 1HE/ 00470 00113 C 00471 00113 C 00472 00113 C ALECS VVVVV 00473 00113 C SAEND // .END// 00474 00114 DIMENSION SAEND(6) 00475 00114 C DATA SAEND /10, 2H ,2H ,2H ,2H.E,2HND/ 00476 00114 C ALECS ^^^^^ 00477 00114 C 00478 00114 C 00479 00114 C--------------------------------------- 00480 00114 C 00481 00114 C THE DATA DECLARATIONS FOLLOW 00482 00114 C 00483 00114 C 00484 00115 DATA FORMFD/"14/ !MAO15-SEP-80 00485 00116 DATA DIRCH /"56/ !DIRECTIVE FLAG CHARACTER !22-JUN-81 MAO 00486 00117 DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ 00487 00118 DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ 00488 00119 DATA UDIR/6/ !29JUN81 MAO 00489 00120 DATA TLETTR/1/, TDIGIT/2/, THYPHN/3/, TLP/4/, TRP/5/ 00490 00121 DATA TBLANK/6/, TOTHER/7/, TEOL/8/ 00491 00122 DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 00492 00123 DATA TDIR/7/ !22-JUN-81 00493 00124 DATA TOFF/8/ !30JUN81MAO 00494 00125 DATA TENDDO/9/ !860214 00495 00126 DATA TELSIF/10/, TENDIF/11/ !860214 00496 00127 DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ 00497 00128 DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ 00498 00129 DATA TWHILE/12/ 00499 00130 DATA TDO77/13/ !860214 00500 00131 DATA TIFTHN/14/ !860214 00501 00132 DATA DPAGE/1/ !22-JUN-81 FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00010 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00502 00133 DATA DINCL/2/ !29JUN81MAO 00503 00134 DATA DPIF /3/, DPUNL /4/, DPEND /5/ !30JUN81MAO 00504 00135 DATA DNAME /6/ !30JUN81MAO 00505 00136 DATA DIMP /7/ !840307MAO 00506 00137 DATA SETUP /1/, RETRY /2/, READ /3/ 00507 00138 DATA SSTMAX /200/ 00508 00139 DATA SB / 1, 1H / 00509 00140 DATA SB5 / 5, 2H , 2H , 1H / 00510 00141 DATA SB6 / 6, 2H , 2H , 2H / 00511 00142 DATA SB7 / 7, 2H , 2H , 2H , 1H / 00512 00143 DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00513 00144 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00514 00145 1 , 2H--, 2H--, 2H--, 2H--/ 00515 00146 DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ 00516 00147 DATA SEND / 9, 2H , 2H , 2H , 2HEN, 1HD/ 00517 00148 DATA SFSPCR / 3, 2H.., 1H./ 00518 00149 DATA SLP / 1, 1H(/ 00519 00150 DATA SOWSE / 11, 2H(O, 2HTH, 2HER, 2HWI, 2HSE, 1H)/ 00520 00151 DATA SRP / 1, 1H)/ 00521 00152 DATA SSPACR / 3, 2H. , 1H / 00522 00153 DATA KCOND / 11, 2HCO, 2HND, 2HIT, 2HIO, 2HNA, 1HL/ 00523 00154 DATA KDO / 2, 2HDO/ 00524 00155 DATA KDOW / 7, 2HDO, 2HWH, 2HIL, 1HE/ !860214 00525 00156 DATA KELSE / 4, 2HEL, 2HSE/ 00526 00157 DATA KEND / 3, 2HEN, 1HD/ 00527 00158 DATA KENDDO / 5, 2HEN, 2HDD, 1HO/ !860214 00528 00159 DATA KELSIF / 6, 2HEL, 2HSE, 2HIF/ !860214 00529 00160 DATA KENDIF / 5, 2HEN, 2HDI, 1HF/ !860214 00530 00161 DATA KTHEN / 4, 2HTH, 2HEN/ !860214 00531 00162 DATA KFIN / 3, 2HFI, 1HN/ 00532 00163 DATA KIF / 2, 2HIF/ 00533 00164 DATA KINCL /7, 2HIN, 2HCL, 2HUD, 1HE/ !29JUN81 MAO 00534 00165 DATA KIMP /8, 2HIM, 2HPL, 2HIC, 2HIT/ !840307MAO 00535 00166 DATA KNAME / 4, 2HNA, 2HME/ !30JUN81MAO 00536 00167 DATA KNONE /4, 2HNO, 2HNE/ !840307MAO 00537 00168 DATA KPEND / 7, 2HPA, 2HSS, 2HEN, 1HD/ !30JUN81MAO 00538 00169 DATA KPIF /6, 2HPA, 2HSS, 2HIF/ !30JUN81MAO 00539 00170 DATA KPUNL / 10, 2HPA, 2HSS, 2HUN, 2HLE, 2HSS/ !30JUN81MAO 00540 00171 DATA KPAGE/ 4, 2HPA, 2HGE/ !22-JUN-81 MAO 00541 00172 DATA KREPT / 6, 2HRE, 2HPE, 2HAT/ 00542 00173 DATA KSELCT / 6, 2HSE, 2HLE, 2HCT/ 00543 00174 DATA KTO / 2, 2HTO/ 00544 00175 DATA KUNLES / 6, 2HUN, 2HLE, 2HSS/ 00545 00176 DATA KUNTIL / 5, 2HUN, 2HTI, 1HL/ 00546 00177 DATA KWHEN / 4, 2HWH, 2HEN/ 00547 00178 DATA KWHILE / 5, 2HWH, 2HIL, 1HE/ 00548 00178 C 00549 00178 C 00550 00178 C ALECS VVVVV 00551 00179 DATA SAEND /10, 2H ,2H ,2H ,2H.E,2HND/ 00552 00179 C ALECS ^^^^^ 00553 00179 C 00554 00179 C 00555 00179 C--------------------------------------- 00556 00179 C FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00011 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00557 00179 C BODY OF SUBROUTINE FOLLOWS 00558 00179 C 00559 00179 SELECT (SOURCE) 00560 00179 C . 00561 00179 C . VALUES FOR SOURCE ARE SET IN MAIN OR LIST: 00562 00179 C . =READ IN MAIN AT INITIALIZATION 00563 00179 C . =READ IN LIST IF NO ERRORS OR IF RECOVERABLE ERROR SUCH AS 00564 00179 C . GENERATING MISSING FIN, BUT THREW OUT INPUT LINE 00565 00179 C . =SETUP IN LIST IF MISSING SELECT, ETC BEING INSERTED NOW 00566 00179 C . AND OLD LINE BEING HELD FOR LATER TRANSLATION. 00567 00179 C . =RETRY IN LIST IF SETUP ON LAST PASS 00568 00179 C . 00569 00182 . (READ) READ-NEXT-STATEMENT !GET FROM FLX FILE 00570 00184 . (SETUP) CONTINUE 00571 00185 . (RETRY) !REDO OLD LINE 00572 00186 . . LINENO=HOLDNO 00573 00187 . . CALL CPYSTR(SFLX,SHOLD) 00574 00187 . ...FIN 00575 00188 ...FIN 00576 00189 ERROR=0 00577 00190 SAVED=.FALSE. !HAVE NOT YET SAVED AN OLD LINE 00578 00191 NUNITS=0 !# OF UNITS OF INFO IN LINE 00579 00192 ERSTOP=0 !# OF ERRORS FOUND FOR THIS LINE 00580 00193 CURSOR=0 !POSITION IN LINE OF CHARACTER SCAN 00581 00194 CWD=2 !WORD IN LINE BEING LOOKED AT (WORD 1=CHARACTER COUNT) 00582 00195 CPOS=0 !POSITION IN CWD OF CHARACTER 00583 00196 CLASS=0 !TYPE OF STATEMENT FOUND 00584 00198 SCAN-STATEMENT-NUMBER !CHECK COL 1-5 00585 00200 SCAN-CONTINUATION !CHECK COL 6 00586 00201 WHEN (CONT.OR.PASS) 00587 00201 C . 00588 00201 C . NON-NUMBER IN COL 1-5 OR NON-(ZERO OR BLANK) IN COL 6 00589 00201 C . 00590 00202 . CLASS=TEXEC !EXECUTABLE 00591 00203 . EXTYPE=TFORT !PURE FORTRAN 00592 00203 ...FIN 00593 00208 ELSE SCAN-KEYWORD !IS THERE A FLECS KEYWORD IN THE LINE? 00594 00208 00595 00209 WHEN (.NOT.PASFLG) !30JUN81MAO 00596 00209 C . 00597 00209 C . .PASSIF/UNLESS HAS TURNED OFF TRANSLATION. THEREFORE 00598 00209 C . IGNORE EVERYTHING BUT END, .PASSIF, .PASSUNLESS OR .PASSEND 00599 00209 C . 00600 00209 . CONDITIONAL 00601 00210 . . (CLASS.EQ.TEND) 00602 00211 . . . ERROR=404 !OOPS, HIT END WITH MISSING .PASSENDS! 00603 00212 . . . CLASS=0 00604 00212 . . ...FIN 00605 00213 . . (CLASS.EQ.TDIR) 00606 00213 . . . SELECT (DTYPE) 00607 00214 . . . . (DPIF) 00608 00216 . . . . . SCAN-NAME 00609 00218 . . . . . SCAN-GARBAGE 00610 00218 . . . . ...FIN 00611 00220 . . . . (DPUNL) FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00012 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00612 00222 . . . . . SCAN-NAME 00613 00224 . . . . . SCAN-GARBAGE 00614 00224 . . . . ...FIN 00615 00228 . . . . (DPEND) SCAN-GARBAGE 00616 00231 . . . . (OTHERWISE)CLASS=TOFF 00617 00232 . . . ...FIN!select 00618 00232 . . ...FIN 00619 00234 . . (OTHERWISE) CLASS=TOFF 00620 00235 . ...FIN!conditional 00621 00235 ...FIN!when 00622 00236 ELSE 00623 00236 . SELECT (CLASS) 00624 00237 . . (TEXEC) 00625 00237 . . . SELECT (EXTYPE) 00626 00239 . . . . (TFORT) CONTINUE !PURE FORTRAN, NOTHING MORE TO DO 00627 00241 . . . . (TDO77) CONTINUE !DOWHILE or DO/ENDDO !860214 00628 00244 . . . . (TINVOK) SCAN-GARBAGE !PROCEDURE INVOCATION 00629 00248 . . . . (TCOND) SCAN-GARBAGE !CONDITIONAL 00630 00250 . . . . (TSELCT) !SELECT 00631 00252 . . . . . SCAN-CONTROL 00632 00253 . . . . . IF(NUNITS.GT.1) !CAN HAVE NOTHING TO RIGHT OF () ON A SELECT 00633 00254 . . . . . . NUNITS=1 00634 00255 . . . . . . CURSOR=USTART(2) 00635 00257 . . . . . . RESET-GET-CHARACTER 00636 00259 . . . . . . SCAN-GARBAGE 00637 00259 . . . . . ...FIN 00638 00261 . . . . ...FIN 00639 00264 . . . . (OTHERWISE) SCAN-CONTROL 00640 00266 . . . ...FIN 00641 00266 . . ...FIN 00642 00269 . . (TFIN) SCAN-GARBAGE !FIN 00643 00272 . . (TENDDO) CONTINUE !860214 00644 00274 . . (TEND) CONTINUE !END HIT 00645 00277 . . (TELSE) SCAN-PINV-OR-FORT !ELSE HIT 00646 00280 . . (TELSIF) CONTINUE !860214 00647 00281 . . (TTO) !PROCEDURE DFN HIT 00648 00282 . . . CSAVE=CURSOR 00649 00284 . . . SCAN-PINV !GET THE PROCEDURE NAME 00650 00287 . . . WHEN(FOUND) SCAN-PINV-OR-FORT 00651 00289 . . . ELSE !NO NAME GIVE WITH TO! 00652 00290 . . . . ERSTOP=ERSTOP+1 00653 00291 . . . . ERRSTK(ERSTOP)=5 00654 00293 . . . . SAVE-ORIGINAL-STATEMENT 00655 00294 . . . . SFLX(1)=CSAVE 00656 00295 . . . . CALL CATSTR(SFLX,SDUM) 00657 00296 . . . . CURSOR=CSAVE 00658 00298 . . . . RESET-GET-CHARACTER 00659 00300 . . . . SCAN-PINV 00660 00300 . . . ...FIN 00661 00302 . . ...FIN 00662 00305 . . (TCEXP) SCAN-CONTROL !LINE OF FORM (..) 00663 00307 . . (TDIR) !29JUN81 MAO 00664 00307 . . . SELECT (DTYPE) 00665 00310 . . . . (DPAGE) SCAN-GARBAGE 00666 00312 . . . . (DINCL) FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00013 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00667 00314 . . . . . SCAN-NAME 00668 00316 . . . . . SCAN-GARBAGE 00669 00316 . . . . ...FIN 00670 00318 . . . . (DPIF) !30JUN81MAO 00671 00320 . . . . . SCAN-NAME 00672 00322 . . . . . SCAN-GARBAGE 00673 00322 . . . . ...FIN 00674 00324 . . . . (DPUNL) !30JUN81MAO 00675 00326 . . . . . SCAN-NAME 00676 00328 . . . . . SCAN-GARBAGE 00677 00328 . . . . ...FIN 00678 00332 . . . . (DPEND) SCAN-GARBAGE !30JUN81MAO 00679 00334 . . . . (DNAME) !30JUN81MAO 00680 00336 . . . . . SCAN-NAME 00681 00338 . . . . . SCAN-GARBAGE 00682 00338 . . . . ...FIN 00683 00342 . . . . (DIMP) SCAN-GARBAGE !840307MAO 00684 00344 . . . ...FIN!select 00685 00344 . . ...FIN 00686 00345 . ...FIN 00687 00345 ...FIN!else 00688 00347 IF(ERSTOP.GT.0) CLASS=0 00689 00348 LSTLEV=LEVEL 00690 00348 C 00691 00348 C IF WANT FULL OUTPUT TO FTN FILE, PUT OUT FLX LINE AS COMMENT 00692 00348 C 14-FEB-80 00693 00348 C 00694 00349 IF(LSTFUL) 00695 00350 . IF(CLASS.NE.TEXEC.OR.EXTYPE.NE.TFORT) 00696 00351 . . CALL CPYSTR(SLIST,SFLX) !PUT FLX LINE IN LIST STRING 00697 00352 . . CALL PUTCH(SLIST(2),1,CHC) !PUT COMMENT CHAR IN COL 1 00698 00353 . . CALL PUT(LINENO,SLIST,FORTCL) !PUT IT OUT 00699 00354 . . UNLESS (CNTALL) NUMLIN=NUMLIN-1 !USUALLY DON'T COUNT !830307 00700 00354 . ...FIN 00701 00355 ...FIN 00702 00356 C 00703 00357 RETURN ---------------------------------------- 00704 00358 TO GET-CHARACTER !GET NEXT CHARACTER IN STRING 00705 00359 . CURSOR=CURSOR+1 00706 00360 . CPOS=CPOS+1 00707 00361 . IF (CPOS.GT.NCHPWD) 00708 00362 . . CWD=CWD+1 00709 00363 . . CPOS=1 00710 00363 . ...FIN 00711 00366 . WHEN(CURSOR.GT.SFLX(1)) CHTYPE=TEOL 00712 00367 . ELSE 00713 00368 . . CALL GETCH(SFLX(CWD),CPOS,CH) 00714 00369 . . CHTYPE=CHTYP(CH) 00715 00369 . ...FIN 00716 00370 ...FIN ---------------------------------------- FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00014 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00717 00372 TO LIST-BLANK-LINE !PUT OUT BLANK LINE WITH PROPER INDENT 00718 00373 . LSTLEV=LEVEL 00719 00375 . WHEN (LSTLEV.EQ.0) CALL PUT(BLN,SB,LISTCL) 00720 00376 . ELSE 00721 00377 . . CALL CPYSTR(SLIST,SB6) 00722 00380 . . DO (I=1,LSTLEV) CALL CATSTR(SLIST,SSPACR) 00723 00382 . . WHEN (SLIST(1).GT.WWIDTH) CALL PUT(BLN,SB,LISTCL) 00724 00385 . . ELSE CALL PUT(BLN,SLIST,LISTCL) 00725 00385 . ...FIN 00726 00387 . BLN=0 00727 00387 ...FIN ---------------------------------------- 00728 00389 TO LIST-COMMENT-LINE 00729 00389 C . 00730 00389 C . WHEN COMMENT LINE IS A C FOLLOWED BY 6 BLANKS LIST AS NORMAL 00731 00389 C . FLECS LINE; OTHERWISE LIST EXACTLY AS IS IN FLX FILE. 00732 00389 C . 00733 00389 C . IF WANT FULL OUTPUT TO FTN FILE, PUT OUT COMMENT--14-FEB-80 00734 00389 C . 00735 00390 . IF(LSTFUL) 00736 00391 . . CALL PUT(LINENO,SFLX,FORTCL) 00737 00392 . . UNLESS (CNTALL) NUMLIN=NUMLIN-1 !USUALLY DONT COUNT !830307 00738 00392 . ...FIN!if 00739 00393 C . 00740 00394 . CURSOR=1 00741 00396 . RESET-GET-CHARACTER 00742 00397 . INDENT=.TRUE. 00743 00398 . I=2 00744 00401 . REPEAT WHILE (I.LE.6.AND.INDENT) 00745 00403 . . GET-CHARACTER 00746 00404 . . IF ((CHTYPE.NE.TBLANK).AND.(CHTYPE.NE.TEOL)) INDENT=.FALSE. 00747 00405 . . I=I+1 00748 00405 . ...FIN 00749 00407 . WHEN (INDENT) 00750 00408 . . LSTLEV=LEVEL 00751 00409 . . CLASS=0 00752 00411 . . LIST-FLEX !OUTPUT LINE WITH INDENTATION 00753 00411 . ...FIN 00754 00415 . ELSE CALL PUT(LINENO,SFLX,LISTCL) 00755 00415 ...FIN ---------------------------------------- 00756 00417 TO LIST-DASHES 00757 00418 . CALL PUT(0,SB,LISTCL) 00758 00419 . CALL PUT(0,SDASH,LISTCL) 00759 00420 . CALL PUT(0,SB,LISTCL) 00760 00420 ...FIN ---------------------------------------- 00761 00422 TO LIST-FLEX FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00015 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00762 00427 . IF (CLASS.EQ.TTO) LIST-DASHES 00763 00428 . IF (SFLX(1).LT.7) CALL CATSTR(SFLX,SB7) 00764 00429 . CALL CPYSUB(SLIST,SFLX,1,6) 00765 00430 . UNLESS(LSTLEV.EQ.0) 00766 00433 . . DO (I=1,LSTLEV) CALL CATSTR(SLIST,SSPACR) 00767 00433 . ...FIN 00768 00435 . IF(CLASS.EQ.TFIN) 00769 00436 . . SLIST(1)=SLIST(1)-SSPACR(1) 00770 00437 . . CALL CATSTR(SLIST,SFSPCR) 00771 00437 . ...FIN 00772 00439 . CALL CATSUB(SLIST,SFLX,7,SFLX(1)-6) 00773 00440 . IF (SLIST(1).GT.WWIDTH) CALL CPYSTR(SLIST,SFLX) 00774 00441 . WHEN (ERLST) 00775 00442 . . CALL PUT(LINENO,SLIST,ERRCL) 00776 00443 . . ERLST=.FALSE. 00777 00443 . ...FIN 00778 00446 . ELSE CALL PUT(LINENO,SLIST,LISTCL) 00779 00446 ...FIN ---------------------------------------- 00780 00448 TO READ-NEXT-STATEMENT 00781 00448 C . 00782 00448 C . READ THROUGH FLX FILE UNTIL FIND A NONBLANK, NONCOMMENT LINE 00783 00448 C . (BLANK AND COMMENT LINES PUT OUT INTO FLL FILE) 00784 00448 C . 00785 00451 . REPEAT UNTIL (FOUND) 00786 00452 . . CALL GET(LINENO,SFLX,ENDFIL,ERR1,ERR2) !821129MAO 00787 00453 . . IF (FIRST) !FIRST READ ON THE FILE? 00788 00454 . . . UNTIL (SFLX(1).GT.0.OR.ENDFIL) 00789 00455 . . . . CALL GET(LINENO,SFLX,ENDFIL,ERR1,ERR2) !821129MAO 00790 00455 . . . ...FIN 00791 00457 . . . FIRST=.FALSE. 00792 00458 . . . IF(ENDFIL) NOPGM=.TRUE. 00793 00458 . . ...FIN 00794 00460 . . IF (ENDFIL) !IF HIT EOF, PRETEND READ AN END 00795 00460 . . . .PASSIF ALECS 00797 00460 . . . .PASSEND 00798 00460 . . . .PASSIF FLECS 00799 00461 . . . CALL CPYSTR(SFLX,SEND) 00800 00461 . . . .PASSEND 00801 00462 . . . LINENO=0 00802 00462 . . ...FIN 00803 00464 . . CALL GETCH(SFLX(2),1,CH) 00804 00464 . . CONDITIONAL 00805 00465 . . . (SFLX(1).EQ.0) !BLANK LINE 00806 00466 . . . . BLN=LINENO 00807 00471 . . . . IF(PASFLG) LIST-BLANK-LINE !30JUN81MAO 00808 00472 . . . . FOUND=.FALSE. 00809 00472 . . . ...FIN 00810 00473 . . . (CH.EQ.CHC.OR.CH.EQ.FORMFD) !COMMENT LINE !MAO15-SEP-80 00811 00478 . . . . IF(PASFLG) LIST-COMMENT-LINE !30JUN81MAO 00812 00479 . . . . FOUND=.FALSE. 00813 00479 . . . ...FIN 00814 00481 . . . (OTHERWISE) FOUND=.TRUE. FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00016 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00815 00482 . . ...FIN 00816 00482 . ...FIN 00817 00483 ...FIN ---------------------------------------- 00818 00485 TO RESET-GET-CHARACTER 00819 00485 C . 00820 00485 C . GET LAST CHARACTER AGAIN 00821 00485 C . 00822 00486 . CURSOR=CURSOR-1 00823 00487 . CWD=(CURSOR-1)/NCHPWD+2 00824 00488 . CPOS=CURSOR-(CWD-2)*NCHPWD 00825 00490 . GET-CHARACTER 00826 00490 ...FIN ---------------------------------------- 00827 00492 TO SAVE-ORIGINAL-STATEMENT 00828 00492 C . 00829 00492 C . SAVE STATEMENT FROM FLX FILE FOR LATER REFERENCE 00830 00492 C . 00831 00493 . UNLESS (SAVED) 00832 00494 . . SAVED=.TRUE. 00833 00495 . . HOLDNO=LINENO 00834 00496 . . CALL CPYSTR(SHOLD,SFLX) 00835 00496 . ...FIN 00836 00497 ...FIN ---------------------------------------- 00837 00499 TO SCAN-CONTINUATION 00838 00499 C . 00839 00499 C . IS THIS A CONTINUATION LINE? IE. IS THERE SOMETHING IN COL 6 00840 00499 C . BESIDES A BLANK OR ZERO? 00841 00499 C . 00842 00501 . GET-CHARACTER 00843 00501 . CONDITIONAL 00844 00503 . . (CHTYPE.EQ.TEOL) CONT=.FALSE. 00845 00505 . . (CH.EQ.CHZERO.OR.CH.EQ.CHSPAC) CONT=.FALSE. 00846 00506 . . (OTHERWISE) 00847 00507 . . . CONT=.TRUE. 00848 00508 . . . UNLESS (CNTALL) NUMLIN=NUMLIN-1 !USUALLY DONT COUNT !830307 00849 00508 . . ...FIN!otherwise 00850 00509 . ...FIN 00851 00509 ...FIN ---------------------------------------- 00852 00511 TO SCAN-CONTROL 00853 00511 C . 00854 00511 C . CHECK THE (..) AFTER A KEYWORD, EG. WHEN(..) 00855 00511 C . 00856 00516 . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER 00857 00517 . START=CURSOR FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00017 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00858 00518 . IF (CHTYPE.NE.TLP) !IF NO ( FOUND, INSERT ONE AFTER BLANKS 00859 00519 . . ERSTOP=ERSTOP+1 00860 00520 . . ERRSTK(ERSTOP)=3 00861 00522 . . SAVE-ORIGINAL-STATEMENT 00862 00523 . . CALL CPYSTR(SST,SFLX) 00863 00524 . . SFLX(1)=START-1 00864 00525 . . CALL CATSTR(SFLX,SLP) 00865 00526 . . CALL CATSUB(SFLX,SST,START,SST(1)-START-1) 00866 00526 . ...FIN 00867 00528 . PCNT=1 !COUNT OF # OF ( 00868 00529 . FOUND=.TRUE. 00869 00532 . REPEAT UNTIL (PCNT.EQ.0.OR..NOT.FOUND) !SCAN TO MATCHING ) 00870 00534 . . GET-CHARACTER 00871 00534 . . SELECT (CHTYPE) 00872 00536 . . . (TRP) PCNT=PCNT-1 00873 00538 . . . (TLP) PCNT=PCNT+1 00874 00540 . . . (TEOL) FOUND=.FALSE. 00875 00541 . . ...FIN 00876 00541 . ...FIN 00877 00543 . UNLESS (FOUND) 00878 00543 C . . 00879 00543 C . . DIDNOT FIND MATCHING RIGHT PAREN, APPEND ENOUGH TO BALANCE LINE 00880 00543 C . . 00881 00544 . . ERSTOP=ERSTOP+1 00882 00545 . . ERRSTK(ERSTOP)=4 00883 00547 . . SAVE-ORIGINAL-STATEMENT 00884 00550 . . DO (I=1,PCNT) CALL CATSTR(SFLX,SRP) 00885 00551 . . CURSOR=SFLX(1) 00886 00553 . . RESET-GET-CHARACTER 00887 00553 . ...FIN 00888 00557 . GET-CHARACTER 00889 00558 . NUNITS=NUNITS+1 00890 00559 . UTYPE(NUNITS)=UEXP !ASSUME (LOGICAL) 00891 00560 . USTART(NUNITS)=START 00892 00561 . ULEN(NUNITS)=CURSOR-START 00893 00562 . CALL CPYSUB(SST,SFLX,START,CURSOR-START) 00894 00563 . IF(STREQ(SST,SOWSE)) UTYPE(NUNITS)=UOWSE !OOPS, IS (OTHERWISE) 00895 00565 . SCAN-PINV-OR-FORT !CHECK FOR TRAILING FORT OR C-O-A 00896 00565 . 00897 00566 . .PASSIF FLECS 00898 00567 . IF (EXTYPE.EQ.TIF .AND. NUNITS.EQ.2) !860214 00899 00567 C . . Check for IF()THEN 00900 00568 . . CURSOR=USTART(NUNITS) !860214 00901 00570 . . RESET-GET-CHARACTER !860214 00902 00575 . . WHILE(CHTYPE.EQ.TBLANK)GET-CHARACTER !860214 00903 00576 . . START=CURSOR !860214 00904 00581 . . WHILE (CHTYPE.LE.THYPHN)GET-CHARACTER !860214 00905 00582 . . LEN = CURSOR-START !860214 00906 00583 . . CALL CPYSUB(SST,SFLX,START,LEN) !860214 00907 00584 . . IF (STREQ(SST,KTHEN))EXTYPE=TIFTHN !860214 00908 00584 . ...FIN!if 00909 00585 . .PASSEND 00910 00585 ...FIN ---------------------------------------- FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00018 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00911 00587 TO SCAN-GARBAGE !MAKE SURE NOTHING BEYOND END OF STMNT 00912 00592 . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER 00913 00593 . IF(CHTYPE.NE.TEOL.AND.CH.NE.CINLIN) !25-JAN-80 (MAO) 00914 00594 . . ERSTOP=ERSTOP+1 !BAD STUFF ON THE LINE 00915 00595 . . ERRSTK(ERSTOP)=2 00916 00597 . . SAVE-ORIGINAL-STATEMENT 00917 00598 . . SFLX(1)=CURSOR-1 00918 00598 . ...FIN 00919 00599 ...FIN ---------------------------------------- 00920 00601 TO SCAN-KEYWORD 00921 00601 C . 00922 00601 C . DETERMINE IF LINE STARTS WITH A FLECS KEYWORD OR A PROCEDURE 00923 00601 C . INVOKATION. NOTE ON ENTRY HERE WE ARE AT COL 6. 00924 00601 C . 00925 00603 . GET-CHARACTER 00926 00608 . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER 00927 00610 . WHEN (CH.NE.DIRCH) DRCTV=.FALSE. !not a directive !22-JUN-81 MAO 00928 00611 . ELSE 00929 00612 . . DRCTV=.TRUE. !is a directive !22-JUN-81 00930 00614 . . GET-CHARACTER !skip over directive character !22-JUN-81 00931 00614 . ...FIN!else 00932 00616 . SELECT (CHTYPE) 00933 00617 . . (TLETTR) !LETTER IN COL 7 00934 00618 . . . START=CURSOR 00935 00619 . . . INVOKE=.FALSE. 00936 00620 . . . BADCH=.FALSE. 00937 00623 . . . REPEAT UNTIL (BADCH) !FIND LENGTH OF ENTRY 00938 00625 . . . . GET-CHARACTER 00939 00625 . . . . CONDITIONAL 00940 00627 . . . . . (CHTYPE.LE.TDIGIT) CONTINUE !0-9 AND A-Z ONLY (NOT BLANK) 00941 00629 . . . . . (CHTYPE.EQ.THYPHN) INVOKE=.TRUE. !A PROCEDURE INVOCATION 00942 00631 . . . . . (OTHERWISE) BADCH=.TRUE. !END OF SCAN 00943 00632 . . . . ...FIN 00944 00632 . . . ...FIN 00945 00634 . . . LEN=CURSOR-START 00946 00635 . . . WHEN (INVOKE) !WAS A PROCEDURE INVOCATION 00947 00636 . . . . CLASS=TEXEC 00948 00637 . . . . EXTYPE=TINVOK 00949 00638 . . . . NUNITS=1 00950 00639 . . . . UTYPE(1)=UPINV 00951 00640 . . . . USTART(1)=START 00952 00641 . . . . ULEN(1)=LEN 00953 00641 . . . ...FIN 00954 00642 . . . ELSE 00955 00643 . . . . CALL CPYSUB(SST,SFLX,START,LEN) !PUT "KEYWORD" IN SST 00956 00644 . . . . CLASS=TEXEC !BUT ASSUME PURE FORTRAN 00957 00645 . . . . EXTYPE=TFORT 00958 00645 . . . . SELECT (SST(1)) !SST(1)=LENGTH OF STRING 00959 00646 . . . . . (2) 00960 00646 . . . . . . CONDITIONAL 00961 00648 . . . . . . . (STREQ(SST,KIF).AND..NOT.DRCTV) EXTYPE=TIF !17AUG81 MAO FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00019 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 00962 00650 . . . . . . . (STREQ(SST,KTO)) CLASS=TTO 00963 00651 . . . . . . . (STREQ(SST,KDO)) 00964 00656 . . . . . . . . WHILE(CHTYPE.EQ.TBLANK) GET-CHARACTER 00965 00656 . . . . . . . . CONDITIONAL !860214 00966 00658 . . . . . . . . . (CHTYPE.EQ.TDIGIT) EXTYPE=TFORT !OOPS, REALLY FORT DO 00967 00660 . . . . . . . . . (CHTYPE.EQ.TLP) EXTYPE=TDO !860214 00968 00660 . . . . . . . . . .PASSIF F77FUL 00969 00662 . . . . . . . . . (OTHERWISE) EXTYPE=TDO77 !DOWHILE or DO/ENDDO !860214 00970 00662 . . . . . . . . . .PASSEND 00971 00663 . . . . . . . . ...FIN!conditional !860214 00972 00663 . . . . . . . ...FIN 00973 00664 . . . . . . ...FIN 00974 00664 . . . . . ...FIN 00975 00665 . . . . . (3) 00976 00665 . . . . . . CONDITIONAL 00977 00667 . . . . . . . (STREQ(SST,KFIN)) CLASS=TFIN 00978 00668 . . . . . . . (STREQ(SST,KEND)) 00979 00670 . . . . . . . . WHEN (CHTYPE.EQ.TEOL) CLASS=TEND 00980 00671 . . . . . . . . ELSE !860214 00981 00671 . . . . . . . . . .PASSIF FLECS 00982 00671 C . . . . . . . . . Check if END DO, or ENDIF 00983 00676 . . . . . . . . . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER !860214 00984 00677 . . . . . . . . . START=CURSOR !860214 00985 00682 . . . . . . . . . WHILE (CHTYPE.EQ.TLETTR) GET-CHARACTER !860214 00986 00683 . . . . . . . . . LEN=CURSOR-START !860214 00987 00684 . . . . . . . . . CALL CPYSUB(SST,SFLX,START,LEN) !860214 00988 00684 . . . . . . . . . .PASSIF F77FUL 00989 00685 . . . . . . . . . IF (STREQ(SST,KDO)) CLASS=TENDDO !860214 00990 00685 . . . . . . . . . .PASSEND 00991 00686 . . . . . . . . . IF (STREQ(SST,KIF)) CLASS=TENDIF !860214 00992 00686 . . . . . . . . . .PASSEND 00993 00686 . . . . . . . . . 00994 00686 . . . . . . . . ...FIN!else !860214 00995 00687 . . . . . . . . .PASSIF ALECS 01002 00687 . . . . . . . . .PASSEND 01003 00688 . . . . . . . . DRCTV=.FALSE. !previously set .T. for .END !29JUN81MAO 01004 00688 . . . . . . . ...FIN 01005 00689 . . . . . . ...FIN 01006 00689 . . . . . ...FIN 01007 00690 . . . . . (4) 01008 00690 . . . . . . CONDITIONAL 01009 00692 . . . . . . . (STREQ(SST,KWHEN)) EXTYPE=TWHEN 01010 00694 . . . . . . . (STREQ(SST,KELSE)) CLASS=TELSE 01011 00695 . . . . . . . (STREQ(SST,KPAGE) .AND. DRCTV) !22-JUN-81 01012 00696 . . . . . . . . CLASS=TDIR !22-JUN-81 01013 00697 . . . . . . . . DTYPE=DPAGE !22-JUN-81 01014 00697 . . . . . . . ...FIN 01015 00698 . . . . . . . (STREQ(SST,KNAME) .AND. DRCTV) !30JUN81MAO 01016 00699 . . . . . . . . CLASS=TDIR 01017 00700 . . . . . . . . DTYPE=DNAME 01018 00700 . . . . . . . ...FIN 01019 00701 . . . . . . ...FIN 01020 00701 . . . . . ...FIN 01021 00702 . . . . . (5) 01022 00702 . . . . . . CONDITIONAL FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00020 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 01023 00704 . . . . . . . (STREQ(SST,KWHILE)) EXTYPE=TWHILE 01024 00706 . . . . . . . (STREQ(SST,KUNTIL)) EXTYPE=TUNTIL 01025 00706 . . . . . . . .PASSIF F77FUL 01026 00708 . . . . . . . (STREQ(SST,KENDDO)) CLASS=TENDDO !860214 01027 00708 . . . . . . . .PASSEND 01028 00708 . . . . . . . .PASSIF FLECS 01029 00710 . . . . . . . (STREQ(SST,KENDIF)) CLASS=TENDIF !860214 01030 00710 . . . . . . . .PASSEND 01031 00711 . . . . . . ...FIN 01032 00711 . . . . . ...FIN 01033 00712 . . . . . (6) 01034 00712 . . . . . . CONDITIONAL 01035 00713 . . . . . . . (STREQ(SST,KREPT)) 01036 00718 . . . . . . . . WHILE(CHTYPE.EQ.TBLANK) GET-CHARACTER 01037 00719 . . . . . . . . START=CURSOR 01038 00724 . . . . . . . . WHILE(CHTYPE.EQ.TLETTR) GET-CHARACTER 01039 00725 . . . . . . . . LEN=CURSOR-START 01040 00726 . . . . . . . . CALL CPYSUB(SST,SFLX,START,LEN) 01041 00726 . . . . . . . . CONDITIONAL 01042 00728 . . . . . . . . . (STREQ(SST,KWHILE)) EXTYPE=TRWHIL 01043 00730 . . . . . . . . . (STREQ(SST,KUNTIL)) EXTYPE=TRUNTL 01044 00731 . . . . . . . . ...FIN 01045 00731 . . . . . . . ...FIN 01046 00731 . . . . . . . .PASSIF FLECS 01047 00733 . . . . . . . (STREQ(SST,KELSIF)) CLASS=TELSIF !860214 01048 00733 . . . . . . . .PASSEND 01049 00735 . . . . . . . (STREQ(SST,KSELCT)) EXTYPE=TSELCT 01050 00737 . . . . . . . (STREQ(SST,KUNLES)) EXTYPE=TUNLES 01051 00738 . . . . . . . (STREQ(SST,KPIF) .AND. DRCTV) !30JUN81MAO 01052 00739 . . . . . . . . CLASS=TDIR 01053 00740 . . . . . . . . DTYPE=DPIF 01054 00740 . . . . . . . ...FIN 01055 00741 . . . . . . ...FIN 01056 00741 . . . . . ...FIN 01057 00742 . . . . . (7) !29JUN81 MAO 01058 00743 . . . . . . IF (STREQ(SST,KINCL) .AND. DRCTV) 01059 00744 . . . . . . . CLASS=TDIR 01060 00745 . . . . . . . DTYPE=DINCL 01061 00745 . . . . . . ...FIN!if 01062 00747 . . . . . . IF (STREQ(SST,KPEND) .AND. DRCTV) !30JUN81MAO 01063 00748 . . . . . . . CLASS=TDIR 01064 00749 . . . . . . . DTYPE=DPEND 01065 00749 . . . . . . ...FIN!if 01066 00750 . . . . . . .PASSIF F77FUL 01067 00751 . . . . . . IF (STREQ(SST,KDOW)) EXTYPE=TDO77 !860214 01068 00751 . . . . . . .PASSEND 01069 00751 . . . . . ...FIN 01070 00751 . . . . . .PASSIF FLECS 01071 00752 . . . . . (8) !840307MAO 01072 00753 . . . . . . IF (STREQ(SST,KIMP) .AND. DRCTV) !840307MAO 01073 00758 . . . . . . . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER !840307MAO 01074 00759 . . . . . . . START=CURSOR !840307MAO 01075 00764 . . . . . . . WHILE (CHTYPE.EQ.TLETTR) GET-CHARACTER !840307MAO 01076 00765 . . . . . . . LEN=CURSOR-START !840307MAO 01077 00766 . . . . . . . CALL CPYSUB (SST,SFLX,START,LEN) !840307MAO FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00021 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 01078 00767 . . . . . . . IF (STREQ(SST,KNONE)) !84O307MAO 01079 00768 . . . . . . . . CLASS=TDIR !840307MAO 01080 00769 . . . . . . . . DTYPE=DIMP !840307MAO 01081 00769 . . . . . . . ...FIN!if !840307MAO 01082 00770 . . . . . . ...FIN!if !840307MAO 01083 00771 . . . . . ...FIN!(8) !84O307MAO 01084 00771 . . . . . .PASSEND 01085 00772 . . . . . (10) !30JUN81MAO 01086 00773 . . . . . . IF (STREQ(SST,KPUNL) .AND. DRCTV) 01087 00774 . . . . . . . CLASS=TDIR 01088 00775 . . . . . . . DTYPE=DPUNL 01089 00775 . . . . . . ...FIN!if 01090 00776 . . . . . ...FIN!(10) 01091 00777 . . . . . (11) 01092 00778 . . . . . . IF (STREQ(SST,KCOND)) EXTYPE=TCOND 01093 00778 . . . . . ...FIN 01094 00779 . . . . ...FIN 01095 00779 . . . ...FIN 01096 00780 . . ...FIN 01097 00782 . . (TLP) CLASS=TCEXP !MUST BE COND OR SELECT SUBCLAUSE 01098 00783 . . (OTHERWISE) 01099 00783 C . . . 01100 00783 C . . . NOT A LETTER OR LEFT PAREN. MUST BE PURE FORTRAN LINE 01101 00783 C . . . 01102 00784 . . . CLASS=TEXEC 01103 00785 . . . EXTYPE=TFORT 01104 00785 . . ...FIN 01105 00786 . ...FIN 01106 00786 ...FIN ---------------------------------------- 01107 00788 TO SCAN-NAME !29JUN81MAO 01108 00788 C . 01109 00788 C . SCAN THE NAME GIVEN WITH A DIRECTIVE 01110 00788 C . 01111 00793 . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER 01112 00794 . NUNITS=1 01113 00795 . UTYPE(1)=UDIR 01114 00796 . USTART(1)=CURSOR 01115 00796 C . 01116 00801 . WHILE (CHTYPE.NE.TEOL.AND.CH.NE.CINLIN) GET-CHARACTER 01117 00802 . ULEN(1)=CURSOR-USTART(1) 01118 00802 ...FIN!to scan-name ---------------------------------------- 01119 00804 TO SCAN-PINV !IS THERE A PROCEDURE INVOCATION? 01120 00809 . WHILE(CHTYPE.EQ.TBLANK) GET-CHARACTER 01121 00810 . FOUND=.FALSE. 01122 00811 . IF(CHTYPE.EQ.TLETTR) 01123 00812 . . START=CURSOR 01124 00815 . . REPEAT UNTIL (CHTYPE.GT.THYPHN) 01125 00817 . . . GET-CHARACTER 01126 00818 . . . IF(CHTYPE.EQ.THYPHN) FOUND=.TRUE. FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00022 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 01127 00818 . . ...FIN 01128 00819 . ...FIN 01129 00821 . IF (FOUND) !IT IS A PROCEDURE INVOCATION! 01130 00822 . . NUNITS=NUNITS+1 01131 00823 . . UTYPE(NUNITS)=UPINV 01132 00824 . . USTART(NUNITS)=START 01133 00825 . . ULEN(NUNITS)=CURSOR-START 01134 00825 . ...FIN 01135 00826 ...FIN ---------------------------------------- 01136 00828 TO SCAN-PINV-OR-FORT 01137 00828 C . 01138 00828 C . CHECK FOR PROCEDURE INVOCATION OR A FORTRAN UNIT 01139 00828 C . EG. WHEN()I=J VS. WHEN()C-O-A VS. WHEN() 01140 00828 C . 01141 00833 . WHILE (CHTYPE.EQ.TBLANK) GET-CHARACTER 01142 00834 . UNLESS (CHTYPE.EQ.TEOL.OR.CH.EQ.CINLIN) !25-JAN-80 (MAO) 01143 00835 . . CSAVE=CURSOR 01144 00837 . . SCAN-PINV 01145 00840 . . WHEN(FOUND) SCAN-GARBAGE !WAS PROC INVOC 01146 00842 . . ELSE 01147 00842 C . . . 01148 00842 C . . . NOT A PROCEDURE INVOCATION, SO MUST BE A FORTRAN LINE 01149 00842 C . . . 01150 00843 . . . NUNITS=NUNITS+1 01151 00844 . . . UTYPE(NUNITS)=UFORT 01152 00845 . . . USTART(NUNITS)=CSAVE 01153 00846 . . . ULEN(NUNITS)=SFLX(1)+1-CSAVE 01154 00846 . . ...FIN 01155 00847 . ...FIN 01156 00848 ...FIN ---------------------------------------- 01157 00850 TO SCAN-STATEMENT-NUMBER 01158 00850 C . 01159 00850 C . CHECK CONTENTS OF COL 1-5 FOR LEGAL (IN FORTRAN SENSE) 01160 00850 C . STATEMENT #, IE ONLY DIGITS OR BLANKS. STORE # (IF THERE) 01161 00850 C . IN FLXNO. SET PASS=.T. IF ILLEGAL CHARACTER, TO INDICATE 01162 00850 C . LINE IS TO BE PASSED DIRECTLY TO FTN FILE. 01163 00850 C . 01164 00851 . FLXNO=0 01165 00852 . PASS=.FALSE. 01166 00853 . DO (I=1,5) 01167 00855 . . GET-CHARACTER 01168 00855 . . SELECT (CHTYPE) 01169 00856 . . . (TBLANK) CONTINUE 01170 00858 . . . (TDIGIT) FLXNO=FLXNO*10+CH-CHZERO 01171 00859 . . . (TEOL) CONTINUE 01172 00861 . . . (OTHERWISE) PASS=.TRUE. !ILLEGAL CHAR IN COL 1-5 01173 00862 . . ...FIN 01174 00862 . ...FIN 01175 00863 ...FIN FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00023 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL 01176 00865 END ---------------------------------------- PROCEDURE CROSS-REFERENCE TABLE 00704 GET-CHARACTER 00745 00825 00842 00856 00870 00888 00902 00904 00912 00925 00926 00930 00938 00964 00983 00985 01036 01038 01073 01075 01111 01116 01120 01125 01141 01167 00717 LIST-BLANK-LINE 00807 00728 LIST-COMMENT-LINE 00811 00756 LIST-DASHES 00762 00761 LIST-FLEX 00752 00780 READ-NEXT-STATEMENT 00569 00818 RESET-GET-CHARACTER 00635 00658 00741 00886 00901 00827 SAVE-ORIGINAL-STATEMENT 00654 00861 00883 00916 00837 SCAN-CONTINUATION 00585 00852 SCAN-CONTROL 00631 00639 00662 00911 SCAN-GARBAGE 00609 00613 00615 00628 00629 00636 00642 00665 00668 00672 00676 00678 00681 00683 01145 00920 SCAN-KEYWORD 00593 01107 SCAN-NAME 00608 00612 00667 00671 00675 00680 01119 SCAN-PINV 00649 00659 01144 01136 SCAN-PINV-OR-FORT 00645 00650 00895 01157 SCAN-STATEMENT-NUMBER 00584 FLECS VERSION 860214 2-DEC-87 06:40:58 PAGE 00024 A,A/-SP=[MP1Q.FLEALECOM]A/CO:FLECS:F77FUL (FLECS VERSION 22.38)