SUBROUTINE ANALYZ 00067 INTEGER NUMLIN !830307 MAO 00163 LOGICAL CNTALL !830307 MAO 00164 COMMON/FLINE/CNTALL,NUMLIN !830307 MAO 00165 INTEGER DTYPE !22-JUN-81 00167 COMMON/DIR/DTYPE !22-JUN-81 00168 LOGICAL PASFLG !30JUN81MAO 00170 INTEGER CNDLVL !30JUN81MAO 00171 INTEGER OFFLVL !30JUN81MAO 00172 INTEGER COND !30JUN81MAO 00173 INTEGER CNDVAL !30JUN81MAO 00174 COMMON/COND/PASFLG,CNDLVL,OFFLVL,COND,CNDVAL(4,10) !30JUN81MAO 00175 LOGICAL*2 ALECS,LSTFUL !14-FEB-80 00178 INTEGER*2 TYPIN,TYPLST,TYPOUT,CHCMNT !14-FEB-80 00179 COMMON/MACVAL/ALECS,TYPIN,TYPLST,TYPOUT,CHCMNT,LSTFUL !14-FEB-80 00180 INTEGER SAEND 00182 INTEGER ERR1,ERR2 !821129MAO 00185 COMMON/IOERR/ERR1,ERR2 !821129MAO 00186 INTEGER FORMFD !MAO15-SEP-80 00193 INTEGER DIRCH !MAO22-JUN-81 00194 INTEGER KPAGE !MAO22-JUN-81 00195 INTEGER KPIF,KPUNL,KPEND !30JUN81MAO 00196 INTEGER KNAME !30JUN81MAO 00197 INTEGER TDIR !MAO22-JUN-81 00198 INTEGER TOFF !30JUN81MAO 00199 INTEGER DPAGE !MAO22-JUN-81 00200 INTEGER KINCL,DINCL,UDIR !29-JUN-81MAO 00201 INTEGER DPIF,DPUNL,DPEND !30JUN81MAO 00202 INTEGER DNAME !30JUN81MAO 00203 INTEGER DIMP,KIMP,KNONE !840307MAO 00204 INTEGER BLN , CH , CHC , CHSPAC, CHTYP , CHTYPE 00205 INTEGER CINLIN !25-JAN-80 00206 INTEGER CHZERO, CLASS , CPOS , CSAVE , CURSOR, CWD 00207 INTEGER ERRCL , ERROR , ERRSTK, ERSTOP 00208 INTEGER EXTYPE, FLXNO , FORTCL, HOLDNO, I , KCOND 00209 INTEGER KDO , KELSE , KEND , KFIN , KIF , KREPT 00210 INTEGER KDOW , KENDDO !860214 00211 INTEGER KSELCT, KTO , KUNLES, KUNTIL, KWHEN , KWHILE 00212 INTEGER KELSIF, KTHEN , KENDIF !860214 00213 INTEGER LEN , LEVEL , LINENO, LISTCL, LSTLEV, MAJCNT 00214 INTEGER MINCNT, MLINE , NCHPWD, NUNITS, PCNT , PTABLE, QP 00215 INTEGER READ , REFNO ,RETRY , SB , SB5 , SB6 00216 INTEGER SB7 , SDASH , SDUM , SEND , SETUP , SFLX 00217 INTEGER SFSPCR, SHOLD , SLIST , SLP , SOURCE, SOWSE 00218 INTEGER SPINV , SPUTGO, SRP , SSPACR, SST 00219 INTEGER SSTMAX, STACK , START , TBLANK, TCEXP , TCOND 00220 INTEGER TDIGIT, TDO , TELSE , TEND , TEOL , TEXEC 00221 INTEGER TDO77 , TENDDO, TELSIF, TENDIF, TIFTHN !860214 00222 INTEGER TFIN , TFORT , THYPHN, TIF , TINVOK, TLETTR 00223 INTEGER TLP , TOP , TOTHER, TRP , TRUNTL, TRWHIL 00224 INTEGER TSELCT, TTO , TUNLES, TUNTIL, TWHEN , TWHILE 00225 INTEGER UDO , UEXP , UFORT , ULEN , UOWSE , UPINV 00226 INTEGER USTART, UTYPE , WWIDTH 00227 LOGICAL DRCTV !22-JUN-81 MAO 00235 LOGICAL BADCH , CONT , DONE ,ENDFIL, ENDPGM, ERLST , FIRST 00236 LOGICAL FOUND , INDENT, INVOKE, NOPGM , PASS , SAVED , STREQ 00237 DIMENSION UTYPE(3), USTART(3), ULEN(3) 00245 DIMENSION STACK(2000) 00248 DIMENSION ERRSTK(5) 00251 COMMON BLN , CLASS , DONE , ENDFIL, ENDPGM, ERLST 00260 COMMON ERROR , ERRSTK, ERSTOP, EXTYPE, FIRST , FLXNO 00261 COMMON FOUND , HOLDNO, LEVEL , LINENO, LSTLEV, MAJCNT 00262 COMMON MINCNT, MLINE , NOPGM , NUNITS, PASS , PTABLE, QP 00263 COMMON REFNO , SAVED , SFLX , SHOLD , SLIST , SOURCE 00264 COMMON SPINV , SPUTGO, SST , STACK , TOP , ULEN 00265 COMMON USTART, UTYPE , WWIDTH 00266 COMMON /PARAM/ NCHPWD, CHZERO, CHSPAC, CHC, CINLIN !25-JAN-80 00321 DIMENSION SFLX (51) 00334 DIMENSION SHOLD (51) 00336 DIMENSION SLIST (101) 00338 DIMENSION SPINV (41) 00340 DIMENSION SPUTGO (11) 00342 DIMENSION SST (101) 00344 BYTE SSTB(202) 00345 EQUIVALENCE(SSTB,SST) 00346 DIMENSION SB (2) 00352 DIMENSION SB5 (4) 00355 DIMENSION SB6 (4) 00358 DIMENSION SB7 (5) 00361 DIMENSION SDASH (21) 00364 DIMENSION SDUM (9) 00369 DIMENSION SEND (6) 00372 DIMENSION SFSPCR (3) 00375 DIMENSION SLP (2) 00378 DIMENSION SOWSE (7) 00381 DIMENSION SRP (2) 00384 DIMENSION SSPACR (3) 00387 DIMENSION KCOND (7) 00393 DIMENSION KDO (2) 00396 DIMENSION KDOW (5) !860214 00399 DIMENSION KELSE (3) 00402 DIMENSION KELSIF (4) !860214 00405 DIMENSION KEND (3) 00408 DIMENSION KENDDO (4) !860214 00411 DIMENSION KENDIF (4) !860214 00414 DIMENSION KFIN (3) 00417 DIMENSION KIF (2) 00420 DIMENSION KNAME(3) !30JUN81MAO 00423 DIMENSION KINCL(5) !29JUN81 MAO 00426 DIMENSION KIMP(5) !840307MAO 00429 DIMENSION KNONE(3) !840307MAO 00432 DIMENSION KPAGE(3) !22-JUN-81 (MAO) 00435 DIMENSION KPEND(5) !30JUN81MAO 00438 DIMENSION KPIF (4) !30JUN81MAO 00441 DIMENSION KPUNL(6) !30JUN81MAO 00444 DIMENSION KREPT (4) 00447 DIMENSION KSELCT (4) 00450 DIMENSION KTHEN (3) !860214 00453 DIMENSION KTO (2) 00456 DIMENSION KUNLES (4) 00459 DIMENSION KUNTIL (4) 00462 DIMENSION KWHEN (3) 00465 DIMENSION KWHILE (4) 00468 DIMENSION SAEND(6) 00474 DATA FORMFD/"14/ !MAO15-SEP-80 00484 DATA DIRCH /"56/ !DIRECTIVE FLAG CHARACTER !22-JUN-81 MAO 00485 DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ 00486 DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ 00487 DATA UDIR/6/ !29JUN81 MAO 00488 DATA TLETTR/1/, TDIGIT/2/, THYPHN/3/, TLP/4/, TRP/5/ 00489 DATA TBLANK/6/, TOTHER/7/, TEOL/8/ 00490 DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 00491 DATA TDIR/7/ !22-JUN-81 00492 DATA TOFF/8/ !30JUN81MAO 00493 DATA TENDDO/9/ !860214 00494 DATA TELSIF/10/, TENDIF/11/ !860214 00495 DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ 00496 DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ 00497 DATA TWHILE/12/ 00498 DATA TDO77/13/ !860214 00499 DATA TIFTHN/14/ !860214 00500 DATA DPAGE/1/ !22-JUN-81 00501 DATA DINCL/2/ !29JUN81MAO 00502 DATA DPIF /3/, DPUNL /4/, DPEND /5/ !30JUN81MAO 00503 DATA DNAME /6/ !30JUN81MAO 00504 DATA DIMP /7/ !840307MAO 00505 DATA SETUP /1/, RETRY /2/, READ /3/ 00506 DATA SSTMAX /200/ 00507 DATA SB / 1, 1H / 00508 DATA SB5 / 5, 2H , 2H , 1H / 00509 DATA SB6 / 6, 2H , 2H , 2H / 00510 DATA SB7 / 7, 2H , 2H , 2H , 1H / 00511 DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00512 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00513 1 , 2H--, 2H--, 2H--, 2H--/ 00514 DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ 00515 DATA SEND / 9, 2H , 2H , 2H , 2HEN, 1HD/ 00516 DATA SFSPCR / 3, 2H.., 1H./ 00517 DATA SLP / 1, 1H(/ 00518 DATA SOWSE / 11, 2H(O, 2HTH, 2HER, 2HWI, 2HSE, 1H)/ 00519 DATA SRP / 1, 1H)/ 00520 DATA SSPACR / 3, 2H. , 1H / 00521 DATA KCOND / 11, 2HCO, 2HND, 2HIT, 2HIO, 2HNA, 1HL/ 00522 DATA KDO / 2, 2HDO/ 00523 DATA KDOW / 7, 2HDO, 2HWH, 2HIL, 1HE/ !860214 00524 DATA KELSE / 4, 2HEL, 2HSE/ 00525 DATA KEND / 3, 2HEN, 1HD/ 00526 DATA KENDDO / 5, 2HEN, 2HDD, 1HO/ !860214 00527 DATA KELSIF / 6, 2HEL, 2HSE, 2HIF/ !860214 00528 DATA KENDIF / 5, 2HEN, 2HDI, 1HF/ !860214 00529 DATA KTHEN / 4, 2HTH, 2HEN/ !860214 00530 DATA KFIN / 3, 2HFI, 1HN/ 00531 DATA KIF / 2, 2HIF/ 00532 DATA KINCL /7, 2HIN, 2HCL, 2HUD, 1HE/ !29JUN81 MAO 00533 DATA KIMP /8, 2HIM, 2HPL, 2HIC, 2HIT/ !840307MAO 00534 DATA KNAME / 4, 2HNA, 2HME/ !30JUN81MAO 00535 DATA KNONE /4, 2HNO, 2HNE/ !840307MAO 00536 DATA KPEND / 7, 2HPA, 2HSS, 2HEN, 1HD/ !30JUN81MAO 00537 DATA KPIF /6, 2HPA, 2HSS, 2HIF/ !30JUN81MAO 00538 DATA KPUNL / 10, 2HPA, 2HSS, 2HUN, 2HLE, 2HSS/ !30JUN81MAO 00539 DATA KPAGE/ 4, 2HPA, 2HGE/ !22-JUN-81 MAO 00540 DATA KREPT / 6, 2HRE, 2HPE, 2HAT/ 00541 DATA KSELCT / 6, 2HSE, 2HLE, 2HCT/ 00542 DATA KTO / 2, 2HTO/ 00543 DATA KUNLES / 6, 2HUN, 2HLE, 2HSS/ 00544 DATA KUNTIL / 5, 2HUN, 2HTI, 1HL/ 00545 DATA KWHEN / 4, 2HWH, 2HEN/ 00546 DATA KWHILE / 5, 2HWH, 2HIL, 1HE/ 00547 DATA SAEND /10, 2H ,2H ,2H ,2H.E,2HND/ 00551 IF((READ).EQ.(SOURCE))THEN 00569 ASSIGN 32757 TO I32758 00569 GO TO 32758 00569 32757 CONTINUE 00570 ELSEIF((SETUP).EQ.(SOURCE))THEN 00570 ELSEIF((RETRY).EQ.(SOURCE))THEN 00571 LINENO=HOLDNO 00572 CALL CPYSTR(SFLX,SHOLD) 00573 ENDIF 00575 ERROR=0 00576 SAVED=.FALSE. !HAVE NOT YET SAVED AN OLD LINE 00577 NUNITS=0 !# OF UNITS OF INFO IN LINE 00578 ERSTOP=0 !# OF ERRORS FOUND FOR THIS LINE 00579 CURSOR=0 !POSITION IN LINE OF CHARACTER SCAN 00580 CWD=2 !WORD IN LINE BEING LOOKED AT (WORD 1=CHARACTER COUNT) 00581 CPOS=0 !POSITION IN CWD OF CHARACTER 00582 CLASS=0 !TYPE OF STATEMENT FOUND 00583 ASSIGN 32755 TO I32756 00584 GO TO 32756 00584 32755 ASSIGN 32753 TO I32754 00585 GO TO 32754 00585 32753 IF(CONT.OR.PASS)THEN 00586 CLASS=TEXEC !EXECUTABLE 00590 EXTYPE=TFORT !PURE FORTRAN 00591 ELSE 00593 ASSIGN 32751 TO I32752 00593 GO TO 32752 00593 32751 CONTINUE 00593 ENDIF 00593 IF(.NOT.PASFLG)THEN 00595 IF(CLASS.EQ.TEND)THEN 00601 ERROR=404 !OOPS, HIT END WITH MISSING .PASSENDS! 00602 CLASS=0 00603 ELSEIF(CLASS.EQ.TDIR)THEN 00605 IF((DPIF).EQ.(DTYPE))THEN 00607 ASSIGN 32749 TO I32750 00608 GO TO 32750 00608 32749 ASSIGN 32747 TO I32748 00609 GO TO 32748 00609 32747 CONTINUE 00611 ELSEIF((DPUNL).EQ.(DTYPE))THEN 00611 ASSIGN 32746 TO I32750 00612 GO TO 32750 00612 32746 ASSIGN 32745 TO I32748 00613 GO TO 32748 00613 32745 CONTINUE 00615 ELSEIF((DPEND).EQ.(DTYPE))THEN 00615 ASSIGN 32744 TO I32748 00615 GO TO 32748 00615 32744 CONTINUE 00616 ELSE 00616 CLASS=TOFF 00616 ENDIF 00617 ELSE 00619 CLASS=TOFF 00619 ENDIF 00620 ELSE 00622 IF((TEXEC).EQ.(CLASS))THEN 00624 IF((TFORT).EQ.(EXTYPE))THEN 00626 CONTINUE !PURE FORTRAN, NOTHING MORE TO DO 00626 ELSEIF((TDO77).EQ.(EXTYPE))THEN 00627 CONTINUE !DOWHILE or DO/ENDDO !860214 00627 ELSEIF((TINVOK).EQ.(EXTYPE))THEN 00628 ASSIGN 32743 TO I32748 00628 GO TO 32748 00628 32743 CONTINUE 00629 ELSEIF((TCOND).EQ.(EXTYPE))THEN 00629 ASSIGN 32742 TO I32748 00629 GO TO 32748 00629 32742 CONTINUE 00630 ELSEIF((TSELCT).EQ.(EXTYPE))THEN 00630 ASSIGN 32740 TO I32741 00631 GO TO 32741 00631 32740 IF(NUNITS.GT.1)THEN 00632 NUNITS=1 00633 CURSOR=USTART(2) 00634 ASSIGN 32738 TO I32739 00635 GO TO 32739 00635 32738 ASSIGN 32737 TO I32748 00636 GO TO 32748 00636 32737 CONTINUE 00637 ENDIF 00637 ELSE 00639 ASSIGN 32736 TO I32741 00639 GO TO 32741 00639 32736 CONTINUE 00640 ENDIF 00640 ELSEIF((TFIN).EQ.(CLASS))THEN 00642 ASSIGN 32735 TO I32748 00642 GO TO 32748 00642 32735 CONTINUE 00643 ELSEIF((TENDDO).EQ.(CLASS))THEN 00643 CONTINUE !860214 00643 ELSEIF((TEND).EQ.(CLASS))THEN 00644 CONTINUE !END HIT 00644 ELSEIF((TELSE).EQ.(CLASS))THEN 00645 ASSIGN 32733 TO I32734 00645 GO TO 32734 00645 32733 CONTINUE 00646 ELSEIF((TELSIF).EQ.(CLASS))THEN 00646 CONTINUE !860214 00646 ELSEIF((TTO).EQ.(CLASS))THEN 00647 CSAVE=CURSOR 00648 ASSIGN 32731 TO I32732 00649 GO TO 32732 00649 32731 IF(FOUND)THEN 00650 ASSIGN 32730 TO I32734 00650 GO TO 32734 00650 32730 CONTINUE 00651 ELSE 00651 ERSTOP=ERSTOP+1 00652 ERRSTK(ERSTOP)=5 00653 ASSIGN 32728 TO I32729 00654 GO TO 32729 00654 32728 SFLX(1)=CSAVE 00655 CALL CATSTR(SFLX,SDUM) 00656 CURSOR=CSAVE 00657 ASSIGN 32727 TO I32739 00658 GO TO 32739 00658 32727 ASSIGN 32726 TO I32732 00659 GO TO 32732 00659 32726 CONTINUE 00660 ENDIF 00660 ELSEIF((TCEXP).EQ.(CLASS))THEN 00662 ASSIGN 32725 TO I32741 00662 GO TO 32741 00662 32725 CONTINUE 00663 ELSEIF((TDIR).EQ.(CLASS))THEN 00663 IF((DPAGE).EQ.(DTYPE))THEN 00665 ASSIGN 32724 TO I32748 00665 GO TO 32748 00665 32724 CONTINUE 00666 ELSEIF((DINCL).EQ.(DTYPE))THEN 00666 ASSIGN 32723 TO I32750 00667 GO TO 32750 00667 32723 ASSIGN 32722 TO I32748 00668 GO TO 32748 00668 32722 CONTINUE 00670 ELSEIF((DPIF).EQ.(DTYPE))THEN 00670 ASSIGN 32721 TO I32750 00671 GO TO 32750 00671 32721 ASSIGN 32720 TO I32748 00672 GO TO 32748 00672 32720 CONTINUE 00674 ELSEIF((DPUNL).EQ.(DTYPE))THEN 00674 ASSIGN 32719 TO I32750 00675 GO TO 32750 00675 32719 ASSIGN 32718 TO I32748 00676 GO TO 32748 00676 32718 CONTINUE 00678 ELSEIF((DPEND).EQ.(DTYPE))THEN 00678 ASSIGN 32717 TO I32748 00678 GO TO 32748 00678 32717 CONTINUE 00679 ELSEIF((DNAME).EQ.(DTYPE))THEN 00679 ASSIGN 32716 TO I32750 00680 GO TO 32750 00680 32716 ASSIGN 32715 TO I32748 00681 GO TO 32748 00681 32715 CONTINUE 00683 ELSEIF((DIMP).EQ.(DTYPE))THEN 00683 ASSIGN 32714 TO I32748 00683 GO TO 32748 00683 32714 CONTINUE 00684 ENDIF 00684 ENDIF 00686 ENDIF 00687 IF(ERSTOP.GT.0) CLASS=0 00688 LSTLEV=LEVEL 00689 IF(LSTFUL)THEN 00694 IF(CLASS.NE.TEXEC.OR.EXTYPE.NE.TFORT)THEN 00695 CALL CPYSTR(SLIST,SFLX) !PUT FLX LINE IN LIST STRING 00696 CALL PUTCH(SLIST(2),1,CHC) !PUT COMMENT CHAR IN COL 1 00697 CALL PUT(LINENO,SLIST,FORTCL) !PUT IT OUT 00698 IF(.NOT.(CNTALL)) NUMLIN=NUMLIN-1 !USUALLY DON'T COUNT !830307 00699 ENDIF 00700 ENDIF 00701 RETURN 00703 32713 CONTINUE 00704 CURSOR=CURSOR+1 00705 CPOS=CPOS+1 00706 IF(CPOS.GT.NCHPWD)THEN 00707 CWD=CWD+1 00708 CPOS=1 00709 ENDIF 00710 IF(CURSOR.GT.SFLX(1))THEN 00711 CHTYPE=TEOL 00711 ELSE 00712 CALL GETCH(SFLX(CWD),CPOS,CH) 00713 CHTYPE=CHTYP(CH) 00714 ENDIF 00715 GO TO I32713 00716 32712 CONTINUE 00717 LSTLEV=LEVEL 00718 IF(LSTLEV.EQ.0)THEN 00719 CALL PUT(BLN,SB,LISTCL) 00719 ELSE 00720 CALL CPYSTR(SLIST,SB6) 00721 DO I=1,LSTLEV 00722 CALL CATSTR(SLIST,SSPACR) 00722 ENDDO 00722 IF(SLIST(1).GT.WWIDTH)THEN 00723 CALL PUT(BLN,SB,LISTCL) 00723 ELSE 00724 CALL PUT(BLN,SLIST,LISTCL) 00724 ENDIF 00724 ENDIF 00725 BLN=0 00726 GO TO I32712 00727 32711 CONTINUE 00728 IF(LSTFUL)THEN 00735 CALL PUT(LINENO,SFLX,FORTCL) 00736 IF(.NOT.(CNTALL)) NUMLIN=NUMLIN-1 !USUALLY DONT COUNT !830307 00737 ENDIF 00738 CURSOR=1 00740 ASSIGN 32710 TO I32739 00741 GO TO 32739 00741 32710 INDENT=.TRUE. 00742 I=2 00743 I32709=.TRUE. 00744 DOWHILE(((I32709)).OR.(I.LE.6.AND.INDENT)) 00744 I32709=.FALSE. 00744 ASSIGN 32708 TO I32713 00745 GO TO 32713 00745 32708 IF ((CHTYPE.NE.TBLANK).AND.(CHTYPE.NE.TEOL)) INDENT=.FALSE. 00746 I=I+1 00747 ENDDO 00748 IF(INDENT)THEN 00749 LSTLEV=LEVEL 00750 CLASS=0 00751 ASSIGN 32706 TO I32707 00752 GO TO 32707 00752 32706 CONTINUE 00754 ELSE 00754 CALL PUT(LINENO,SFLX,LISTCL) 00754 ENDIF 00754 GO TO I32711 00755 32705 CONTINUE 00756 CALL PUT(0,SB,LISTCL) 00757 CALL PUT(0,SDASH,LISTCL) 00758 CALL PUT(0,SB,LISTCL) 00759 GO TO I32705 00760 32707 CONTINUE 00761 IF(CLASS.EQ.TTO)THEN 00762 ASSIGN 32704 TO I32705 00762 GO TO 32705 00762 32704 CONTINUE 00762 ENDIF 00762 IF (SFLX(1).LT.7) CALL CATSTR(SFLX,SB7) 00763 CALL CPYSUB(SLIST,SFLX,1,6) 00764 IF(.NOT.(LSTLEV.EQ.0))THEN 00765 DO I=1,LSTLEV 00766 CALL CATSTR(SLIST,SSPACR) 00766 ENDDO 00766 ENDIF 00767 IF(CLASS.EQ.TFIN)THEN 00768 SLIST(1)=SLIST(1)-SSPACR(1) 00769 CALL CATSTR(SLIST,SFSPCR) 00770 ENDIF 00771 CALL CATSUB(SLIST,SFLX,7,SFLX(1)-6) 00772 IF (SLIST(1).GT.WWIDTH) CALL CPYSTR(SLIST,SFLX) 00773 IF(ERLST)THEN 00774 CALL PUT(LINENO,SLIST,ERRCL) 00775 ERLST=.FALSE. 00776 ELSE 00778 CALL PUT(LINENO,SLIST,LISTCL) 00778 ENDIF 00778 GO TO I32707 00779 32758 CONTINUE 00780 I32703=.TRUE. 00785 DOWHILE(((I32703)).OR.(.NOT.(FOUND))) 00785 I32703=.FALSE. 00785 CALL GET(LINENO,SFLX,ENDFIL,ERR1,ERR2) !821129MAO 00786 IF(FIRST)THEN 00787 DOWHILE(.NOT.(SFLX(1).GT.0.OR.ENDFIL)) 00788 CALL GET(LINENO,SFLX,ENDFIL,ERR1,ERR2) !821129MAO 00789 ENDDO 00790 FIRST=.FALSE. 00791 IF(ENDFIL) NOPGM=.TRUE. 00792 ENDIF 00793 IF(ENDFIL)THEN 00794 CALL CPYSTR(SFLX,SEND) 00799 LINENO=0 00801 ENDIF 00802 CALL GETCH(SFLX(2),1,CH) 00803 IF(SFLX(1).EQ.0)THEN 00805 BLN=LINENO 00806 IF(PASFLG)THEN 00807 ASSIGN 32702 TO I32712 00807 GO TO 32712 00807 32702 CONTINUE 00807 ENDIF 00807 FOUND=.FALSE. 00808 ELSEIF(CH.EQ.CHC.OR.CH.EQ.FORMFD)THEN 00810 IF(PASFLG)THEN 00811 ASSIGN 32701 TO I32711 00811 GO TO 32711 00811 32701 CONTINUE 00811 ENDIF 00811 FOUND=.FALSE. 00812 ELSE 00814 FOUND=.TRUE. 00814 ENDIF 00815 ENDDO 00816 GO TO I32758 00817 32739 CONTINUE 00818 CURSOR=CURSOR-1 00822 CWD=(CURSOR-1)/NCHPWD+2 00823 CPOS=CURSOR-(CWD-2)*NCHPWD 00824 ASSIGN 32700 TO I32713 00825 GO TO 32713 00825 32700 GO TO I32739 00826 32729 CONTINUE 00827 IF(.NOT.(SAVED))THEN 00831 SAVED=.TRUE. 00832 HOLDNO=LINENO 00833 CALL CPYSTR(SHOLD,SFLX) 00834 ENDIF 00835 GO TO I32729 00836 32754 CONTINUE 00837 ASSIGN 32699 TO I32713 00842 GO TO 32713 00842 32699 IF(CHTYPE.EQ.TEOL)THEN 00844 CONT=.FALSE. 00844 ELSEIF(CH.EQ.CHZERO.OR.CH.EQ.CHSPAC)THEN 00845 CONT=.FALSE. 00845 ELSE 00846 CONT=.TRUE. 00847 IF(.NOT.(CNTALL)) NUMLIN=NUMLIN-1 !USUALLY DONT COUNT !830307 00848 ENDIF 00850 GO TO I32754 00851 32741 CONTINUE 00852 DOWHILE(CHTYPE.EQ.TBLANK) 00856 ASSIGN 32698 TO I32713 00856 GO TO 32713 00856 32698 CONTINUE 00856 ENDDO 00856 START=CURSOR 00857 IF(CHTYPE.NE.TLP)THEN 00858 ERSTOP=ERSTOP+1 00859 ERRSTK(ERSTOP)=3 00860 ASSIGN 32697 TO I32729 00861 GO TO 32729 00861 32697 CALL CPYSTR(SST,SFLX) 00862 SFLX(1)=START-1 00863 CALL CATSTR(SFLX,SLP) 00864 CALL CATSUB(SFLX,SST,START,SST(1)-START-1) 00865 ENDIF 00866 PCNT=1 !COUNT OF # OF ( 00867 FOUND=.TRUE. 00868 I32696=.TRUE. 00869 DOWHILE(((I32696)).OR.(.NOT.(PCNT.EQ.0.OR..NOT.FOUND))) 00869 I32696=.FALSE. 00869 ASSIGN 32695 TO I32713 00870 GO TO 32713 00870 32695 IF((TRP).EQ.(CHTYPE))THEN 00872 PCNT=PCNT-1 00872 ELSEIF((TLP).EQ.(CHTYPE))THEN 00873 PCNT=PCNT+1 00873 ELSEIF((TEOL).EQ.(CHTYPE))THEN 00874 FOUND=.FALSE. 00874 ENDIF 00875 ENDDO 00876 IF(.NOT.(FOUND))THEN 00877 ERSTOP=ERSTOP+1 00881 ERRSTK(ERSTOP)=4 00882 ASSIGN 32694 TO I32729 00883 GO TO 32729 00883 32694 DO I=1,PCNT 00884 CALL CATSTR(SFLX,SRP) 00884 ENDDO 00884 CURSOR=SFLX(1) 00885 ASSIGN 32693 TO I32739 00886 GO TO 32739 00886 32693 CONTINUE 00887 ENDIF 00887 ASSIGN 32692 TO I32713 00888 GO TO 32713 00888 32692 NUNITS=NUNITS+1 00889 UTYPE(NUNITS)=UEXP !ASSUME (LOGICAL) 00890 USTART(NUNITS)=START 00891 ULEN(NUNITS)=CURSOR-START 00892 CALL CPYSUB(SST,SFLX,START,CURSOR-START) 00893 IF(STREQ(SST,SOWSE)) UTYPE(NUNITS)=UOWSE !OOPS, IS (OTHERWISE) 00894 ASSIGN 32691 TO I32734 00895 GO TO 32734 00895 32691 CONTINUE 00897 IF(EXTYPE.EQ.TIF .AND. NUNITS.EQ.2)THEN 00898 CURSOR=USTART(NUNITS) !860214 00900 ASSIGN 32690 TO I32739 00901 GO TO 32739 00901 32690 DOWHILE(CHTYPE.EQ.TBLANK) 00902 ASSIGN 32689 TO I32713 00902 GO TO 32713 00902 32689 CONTINUE 00902 ENDDO 00902 START=CURSOR !860214 00903 DOWHILE(CHTYPE.LE.THYPHN) 00904 ASSIGN 32688 TO I32713 00904 GO TO 32713 00904 32688 CONTINUE 00904 ENDDO 00904 LEN = CURSOR-START !860214 00905 CALL CPYSUB(SST,SFLX,START,LEN) !860214 00906 IF (STREQ(SST,KTHEN))EXTYPE=TIFTHN !860214 00907 ENDIF 00908 GO TO I32741 00910 32748 CONTINUE 00911 DOWHILE(CHTYPE.EQ.TBLANK) 00912 ASSIGN 32687 TO I32713 00912 GO TO 32713 00912 32687 CONTINUE 00912 ENDDO 00912 IF(CHTYPE.NE.TEOL.AND.CH.NE.CINLIN)THEN 00913 ERSTOP=ERSTOP+1 !BAD STUFF ON THE LINE 00914 ERRSTK(ERSTOP)=2 00915 ASSIGN 32686 TO I32729 00916 GO TO 32729 00916 32686 SFLX(1)=CURSOR-1 00917 ENDIF 00918 GO TO I32748 00919 32752 CONTINUE 00920 ASSIGN 32685 TO I32713 00925 GO TO 32713 00925 32685 DOWHILE(CHTYPE.EQ.TBLANK) 00926 ASSIGN 32684 TO I32713 00926 GO TO 32713 00926 32684 CONTINUE 00926 ENDDO 00926 IF(CH.NE.DIRCH)THEN 00927 DRCTV=.FALSE. !not a directive !22-JUN-81 MAO 00927 ELSE 00928 DRCTV=.TRUE. !is a directive !22-JUN-81 00929 ASSIGN 32683 TO I32713 00930 GO TO 32713 00930 32683 CONTINUE 00931 ENDIF 00931 IF((TLETTR).EQ.(CHTYPE))THEN 00933 START=CURSOR 00934 INVOKE=.FALSE. 00935 BADCH=.FALSE. 00936 I32682=.TRUE. 00937 DOWHILE(((I32682)).OR.(.NOT.(BADCH))) 00937 I32682=.FALSE. 00937 ASSIGN 32681 TO I32713 00938 GO TO 32713 00938 32681 IF(CHTYPE.LE.TDIGIT)THEN 00940 CONTINUE !0-9 AND A-Z ONLY (NOT BLANK) 00940 ELSEIF(CHTYPE.EQ.THYPHN)THEN 00941 INVOKE=.TRUE. !A PROCEDURE INVOCATION 00941 ELSE 00942 BADCH=.TRUE. !END OF SCAN 00942 ENDIF 00943 ENDDO 00944 LEN=CURSOR-START 00945 IF(INVOKE)THEN 00946 CLASS=TEXEC 00947 EXTYPE=TINVOK 00948 NUNITS=1 00949 UTYPE(1)=UPINV 00950 USTART(1)=START 00951 ULEN(1)=LEN 00952 ELSE 00954 CALL CPYSUB(SST,SFLX,START,LEN) !PUT "KEYWORD" IN SST 00955 CLASS=TEXEC !BUT ASSUME PURE FORTRAN 00956 EXTYPE=TFORT 00957 IF((2).EQ.(SST(1)))THEN 00959 IF(STREQ(SST,KIF).AND..NOT.DRCTV)THEN 00961 EXTYPE=TIF !17AUG81 MAO 00961 ELSEIF(STREQ(SST,KTO))THEN 00962 CLASS=TTO 00962 ELSEIF(STREQ(SST,KDO))THEN 00963 DOWHILE(CHTYPE.EQ.TBLANK) 00964 ASSIGN 32680 TO I32713 00964 GO TO 32713 00964 32680 CONTINUE 00964 ENDDO 00964 IF(CHTYPE.EQ.TDIGIT)THEN 00966 EXTYPE=TFORT !OOPS, REALLY FORT DO 00966 ELSEIF(CHTYPE.EQ.TLP)THEN 00967 EXTYPE=TDO !860214 00967 ENDIF 00971 ENDIF 00973 ELSEIF((3).EQ.(SST(1)))THEN 00975 IF(STREQ(SST,KFIN))THEN 00977 CLASS=TFIN 00977 ELSEIF(STREQ(SST,KEND))THEN 00978 IF(CHTYPE.EQ.TEOL)THEN 00979 CLASS=TEND 00979 ELSE 00980 DOWHILE(CHTYPE.EQ.TBLANK) 00983 ASSIGN 32679 TO I32713 00983 GO TO 32713 00983 32679 CONTINUE 00983 ENDDO 00983 START=CURSOR !860214 00984 DOWHILE(CHTYPE.EQ.TLETTR) 00985 ASSIGN 32678 TO I32713 00985 GO TO 32713 00985 32678 CONTINUE 00985 ENDDO 00985 LEN=CURSOR-START !860214 00986 CALL CPYSUB(SST,SFLX,START,LEN) !860214 00987 IF (STREQ(SST,KIF)) CLASS=TENDIF !860214 00991 ENDIF 00994 DRCTV=.FALSE. !previously set .T. for .END !29JUN81MAO 01003 ENDIF 01005 ELSEIF((4).EQ.(SST(1)))THEN 01007 IF(STREQ(SST,KWHEN))THEN 01009 EXTYPE=TWHEN 01009 ELSEIF(STREQ(SST,KELSE))THEN 01010 CLASS=TELSE 01010 ELSEIF(STREQ(SST,KPAGE) .AND. DRCTV)THEN 01011 CLASS=TDIR !22-JUN-81 01012 DTYPE=DPAGE !22-JUN-81 01013 ELSEIF(STREQ(SST,KNAME) .AND. DRCTV)THEN 01015 CLASS=TDIR 01016 DTYPE=DNAME 01017 ENDIF 01019 ELSEIF((5).EQ.(SST(1)))THEN 01021 IF(STREQ(SST,KWHILE))THEN 01023 EXTYPE=TWHILE 01023 ELSEIF(STREQ(SST,KUNTIL))THEN 01024 EXTYPE=TUNTIL 01024 ELSEIF(STREQ(SST,KENDIF))THEN 01029 CLASS=TENDIF !860214 01029 ENDIF 01031 ELSEIF((6).EQ.(SST(1)))THEN 01033 IF(STREQ(SST,KREPT))THEN 01035 DOWHILE(CHTYPE.EQ.TBLANK) 01036 ASSIGN 32677 TO I32713 01036 GO TO 32713 01036 32677 CONTINUE 01036 ENDDO 01036 START=CURSOR 01037 DOWHILE(CHTYPE.EQ.TLETTR) 01038 ASSIGN 32676 TO I32713 01038 GO TO 32713 01038 32676 CONTINUE 01038 ENDDO 01038 LEN=CURSOR-START 01039 CALL CPYSUB(SST,SFLX,START,LEN) 01040 IF(STREQ(SST,KWHILE))THEN 01042 EXTYPE=TRWHIL 01042 ELSEIF(STREQ(SST,KUNTIL))THEN 01043 EXTYPE=TRUNTL 01043 ENDIF 01044 ELSEIF(STREQ(SST,KELSIF))THEN 01047 CLASS=TELSIF !860214 01047 ELSEIF(STREQ(SST,KSELCT))THEN 01049 EXTYPE=TSELCT 01049 ELSEIF(STREQ(SST,KUNLES))THEN 01050 EXTYPE=TUNLES 01050 ELSEIF(STREQ(SST,KPIF) .AND. DRCTV)THEN 01051 CLASS=TDIR 01052 DTYPE=DPIF 01053 ENDIF 01055 ELSEIF((7).EQ.(SST(1)))THEN 01057 IF(STREQ(SST,KINCL) .AND. DRCTV)THEN 01058 CLASS=TDIR 01059 DTYPE=DINCL 01060 ENDIF 01061 IF(STREQ(SST,KPEND) .AND. DRCTV)THEN 01062 CLASS=TDIR 01063 DTYPE=DPEND 01064 ENDIF 01065 ELSEIF((8).EQ.(SST(1)))THEN 01071 IF(STREQ(SST,KIMP) .AND. DRCTV)THEN 01072 DOWHILE(CHTYPE.EQ.TBLANK) 01073 ASSIGN 32675 TO I32713 01073 GO TO 32713 01073 32675 CONTINUE 01073 ENDDO 01073 START=CURSOR !840307MAO 01074 DOWHILE(CHTYPE.EQ.TLETTR) 01075 ASSIGN 32674 TO I32713 01075 GO TO 32713 01075 32674 CONTINUE 01075 ENDDO 01075 LEN=CURSOR-START !840307MAO 01076 CALL CPYSUB (SST,SFLX,START,LEN) !840307MAO 01077 IF(STREQ(SST,KNONE))THEN 01078 CLASS=TDIR !840307MAO 01079 DTYPE=DIMP !840307MAO 01080 ENDIF 01081 ENDIF 01082 ELSEIF((10).EQ.(SST(1)))THEN 01085 IF(STREQ(SST,KPUNL) .AND. DRCTV)THEN 01086 CLASS=TDIR 01087 DTYPE=DPUNL 01088 ENDIF 01089 ELSEIF((11).EQ.(SST(1)))THEN 01091 IF (STREQ(SST,KCOND)) EXTYPE=TCOND 01092 ENDIF 01094 ENDIF 01095 ELSEIF((TLP).EQ.(CHTYPE))THEN 01097 CLASS=TCEXP !MUST BE COND OR SELECT SUBCLAUSE 01097 ELSE 01098 CLASS=TEXEC 01102 EXTYPE=TFORT 01103 ENDIF 01105 GO TO I32752 01106 32750 CONTINUE 01107 DOWHILE(CHTYPE.EQ.TBLANK) 01111 ASSIGN 32673 TO I32713 01111 GO TO 32713 01111 32673 CONTINUE 01111 ENDDO 01111 NUNITS=1 01112 UTYPE(1)=UDIR 01113 USTART(1)=CURSOR 01114 DOWHILE(CHTYPE.NE.TEOL.AND.CH.NE.CINLIN) 01116 ASSIGN 32672 TO I32713 01116 GO TO 32713 01116 32672 CONTINUE 01116 ENDDO 01116 ULEN(1)=CURSOR-USTART(1) 01117 GO TO I32750 01118 32732 CONTINUE 01119 DOWHILE(CHTYPE.EQ.TBLANK) 01120 ASSIGN 32671 TO I32713 01120 GO TO 32713 01120 32671 CONTINUE 01120 ENDDO 01120 FOUND=.FALSE. 01121 IF(CHTYPE.EQ.TLETTR)THEN 01122 START=CURSOR 01123 I32670=.TRUE. 01124 DOWHILE(((I32670)).OR.(.NOT.(CHTYPE.GT.THYPHN))) 01124 I32670=.FALSE. 01124 ASSIGN 32669 TO I32713 01125 GO TO 32713 01125 32669 IF(CHTYPE.EQ.THYPHN) FOUND=.TRUE. 01126 ENDDO 01127 ENDIF 01128 IF(FOUND)THEN 01129 NUNITS=NUNITS+1 01130 UTYPE(NUNITS)=UPINV 01131 USTART(NUNITS)=START 01132 ULEN(NUNITS)=CURSOR-START 01133 ENDIF 01134 GO TO I32732 01135 32734 CONTINUE 01136 DOWHILE(CHTYPE.EQ.TBLANK) 01141 ASSIGN 32668 TO I32713 01141 GO TO 32713 01141 32668 CONTINUE 01141 ENDDO 01141 IF(.NOT.(CHTYPE.EQ.TEOL.OR.CH.EQ.CINLIN))THEN 01142 CSAVE=CURSOR 01143 ASSIGN 32667 TO I32732 01144 GO TO 32732 01144 32667 IF(FOUND)THEN 01145 ASSIGN 32666 TO I32748 01145 GO TO 32748 01145 32666 CONTINUE 01146 ELSE 01146 NUNITS=NUNITS+1 01150 UTYPE(NUNITS)=UFORT 01151 USTART(NUNITS)=CSAVE 01152 ULEN(NUNITS)=SFLX(1)+1-CSAVE 01153 ENDIF 01154 ENDIF 01155 GO TO I32734 01156 32756 CONTINUE 01157 FLXNO=0 01164 PASS=.FALSE. 01165 DO I=1,5 01166 ASSIGN 32665 TO I32713 01167 GO TO 32713 01167 32665 IF((TBLANK).EQ.(CHTYPE))THEN 01169 ELSEIF((TDIGIT).EQ.(CHTYPE))THEN 01170 FLXNO=FLXNO*10+CH-CHZERO 01170 ELSEIF((TEOL).EQ.(CHTYPE))THEN 01171 ELSE 01172 PASS=.TRUE. !ILLEGAL CHAR IN COL 1-5 01172 ENDIF 01173 ENDDO 01174 GO TO I32756 01175 END 01176