SUBROUTINE ANALYZ 00064 INTEGER NUMLIN !830307 MAO 00118 LOGICAL CNTALL !830307 MAO 00119 COMMON/FLINE/CNTALL,NUMLIN !830307 MAO 00120 INTEGER DTYPE !22-JUN-81 00122 COMMON/DIR/DTYPE !22-JUN-81 00123 LOGICAL PASFLG !30JUN81MAO 00125 INTEGER CNDLVL !30JUN81MAO 00126 INTEGER OFFLVL !30JUN81MAO 00127 INTEGER COND !30JUN81MAO 00128 INTEGER CNDVAL !30JUN81MAO 00129 COMMON/COND/PASFLG,CNDLVL,OFFLVL,COND,CNDVAL(4,10) !30JUN81MAO 00130 LOGICAL*2 ALECS,LSTFUL !14-FEB-80 00133 INTEGER*2 TYPIN,TYPLST,TYPOUT,CHCMNT !14-FEB-80 00134 COMMON/MACVAL/ALECS,TYPIN,TYPLST,TYPOUT,CHCMNT,LSTFUL !14-FEB-80 00135 INTEGER SAEND 00137 INTEGER ERR1,ERR2 !821129MAO 00140 COMMON/IOERR/ERR1,ERR2 !821129MAO 00141 INTEGER FORMFD !MAO15-SEP-80 00148 INTEGER DIRCH !MAO22-JUN-81 00149 INTEGER KPAGE !MAO22-JUN-81 00150 INTEGER KPIF,KPUNL,KPEND !30JUN81MAO 00151 INTEGER KNAME !30JUN81MAO 00152 INTEGER TDIR !MAO22-JUN-81 00153 INTEGER TOFF !30JUN81MAO 00154 INTEGER DPAGE !MAO22-JUN-81 00155 INTEGER KINCL,DINCL,UDIR !29-JUN-81MAO 00156 INTEGER DPIF,DPUNL,DPEND !30JUN81MAO 00157 INTEGER DNAME !30JUN81MAO 00158 INTEGER DIMP,KIMP,KNONE !840307MAO 00159 INTEGER BLN , CH , CHC , CHSPAC, CHTYP , CHTYPE 00160 INTEGER CINLIN !25-JAN-80 00161 INTEGER CHZERO, CLASS , CPOS , CSAVE , CURSOR, CWD 00162 INTEGER ERRCL , ERROR , ERRSTK, ERSTOP 00163 INTEGER EXTYPE, FLXNO , FORTCL, HOLDNO, I , KCOND 00164 INTEGER KDO , KELSE , KEND , KFIN , KIF , KREPT 00165 INTEGER KSELCT, KTO , KUNLES, KUNTIL, KWHEN , KWHILE 00166 INTEGER LEN , LEVEL , LINENO, LISTCL, LSTLEV, MAJCNT 00167 INTEGER MINCNT, MLINE , NCHPWD, NUNITS, PCNT , PTABLE, QP 00168 INTEGER READ , REFNO ,RETRY , SB , SB5 , SB6 00169 INTEGER SB7 , SDASH , SDUM , SEND , SETUP , SFLX 00170 INTEGER SFSPCR, SHOLD , SLIST , SLP , SOURCE, SOWSE 00171 INTEGER SPINV , SPUTGO, SRP , SSPACR, SST 00172 INTEGER SSTMAX, STACK , START , TBLANK, TCEXP , TCOND 00173 INTEGER TDIGIT, TDO , TELSE , TEND , TEOL , TEXEC 00174 INTEGER TFIN , TFORT , THYPHN, TIF , TINVOK, TLETTR 00175 INTEGER TLP , TOP , TOTHER, TRP , TRUNTL, TRWHIL 00176 INTEGER TSELCT, TTO , TUNLES, TUNTIL, TWHEN , TWHILE 00177 INTEGER UDO , UEXP , UFORT , ULEN , UOWSE , UPINV 00178 INTEGER USTART, UTYPE , WWIDTH 00179 LOGICAL DRCTV !22-JUN-81 MAO 00187 LOGICAL BADCH , CONT , DONE ,ENDFIL, ENDPGM, ERLST , FIRST 00188 LOGICAL FOUND , INDENT, INVOKE, NOPGM , PASS , SAVED , STREQ 00189 DIMENSION UTYPE(3), USTART(3), ULEN(3) 00197 DIMENSION STACK(2000) 00200 DIMENSION ERRSTK(5) 00203 COMMON BLN , CLASS , DONE , ENDFIL, ENDPGM, ERLST 00212 COMMON ERROR , ERRSTK, ERSTOP, EXTYPE, FIRST , FLXNO 00213 COMMON FOUND , HOLDNO, LEVEL , LINENO, LSTLEV, MAJCNT 00214 COMMON MINCNT, MLINE , NOPGM , NUNITS, PASS , PTABLE, QP 00215 COMMON REFNO , SAVED , SFLX , SHOLD , SLIST , SOURCE 00216 COMMON SPINV , SPUTGO, SST , STACK , TOP , ULEN 00217 COMMON USTART, UTYPE , WWIDTH 00218 COMMON /PARAM/ NCHPWD, CHZERO, CHSPAC, CHC, CINLIN !25-JAN-80 00269 DIMENSION SFLX (51) 00282 DIMENSION SHOLD (51) 00284 DIMENSION SLIST (101) 00286 DIMENSION SPINV (41) 00288 DIMENSION SPUTGO (11) 00290 DIMENSION SST (101) 00292 DIMENSION SB (2) 00298 DIMENSION SB5 (4) 00301 DIMENSION SB6 (4) 00304 DIMENSION SB7 (5) 00307 DIMENSION SDASH (21) 00310 DIMENSION SDUM (9) 00315 DIMENSION SEND (6) 00318 DIMENSION SFSPCR (3) 00321 DIMENSION SLP (2) 00324 DIMENSION SOWSE (7) 00327 DIMENSION SRP (2) 00330 DIMENSION SSPACR (3) 00333 DIMENSION KCOND (7) 00339 DIMENSION KDO (2) 00342 DIMENSION KELSE (3) 00345 DIMENSION KEND (3) 00348 DIMENSION KFIN (3) 00351 DIMENSION KIF (2) 00354 DIMENSION KNAME(3) !30JUN81MAO 00357 DIMENSION KINCL(5) !29JUN81 MAO 00360 DIMENSION KIMP(5) !840307MAO 00363 DIMENSION KNONE(3) !840307MAO 00366 DIMENSION KPAGE(3) !22-JUN-81 (MAO) 00369 DIMENSION KPEND(5) !30JUN81MAO 00372 DIMENSION KPIF (4) !30JUN81MAO 00375 DIMENSION KPUNL(6) !30JUN81MAO 00378 DIMENSION KREPT (4) 00381 DIMENSION KSELCT (4) 00384 DIMENSION KTO (2) 00387 DIMENSION KUNLES (4) 00390 DIMENSION KUNTIL (4) 00393 DIMENSION KWHEN (3) 00396 DIMENSION KWHILE (4) 00399 DIMENSION SAEND(6) 00405 DATA FORMFD/"14/ !MAO15-SEP-80 00415 DATA DIRCH /"56/ !DIRECTIVE FLAG CHARACTER !22-JUN-81 MAO 00416 DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ 00417 DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ 00418 DATA UDIR/6/ !29JUN81 MAO 00419 DATA TLETTR/1/, TDIGIT/2/, THYPHN/3/, TLP/4/, TRP/5/ 00420 DATA TBLANK/6/, TOTHER/7/, TEOL/8/ 00421 DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 00422 DATA TDIR/7/ !22-JUN-81 00423 DATA TOFF/8/ !30JUN81MAO 00424 DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ 00425 DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ 00426 DATA TWHILE/12/ 00427 DATA DPAGE/1/ !22-JUN-81 00428 DATA DINCL/2/ !29JUN81MAO 00429 DATA DPIF /3/, DPUNL /4/, DPEND /5/ !30JUN81MAO 00430 DATA DNAME /6/ !30JUN81MAO 00431 DATA DIMP /7/ !840307MAO 00432 DATA SETUP /1/, RETRY /2/, READ /3/ 00433 DATA SSTMAX /200/ 00434 DATA SB / 1, 1H / 00435 DATA SB5 / 5, 2H , 2H , 1H / 00436 DATA SB6 / 6, 2H , 2H , 2H / 00437 DATA SB7 / 7, 2H , 2H , 2H , 1H / 00438 DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00439 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00440 1 , 2H--, 2H--, 2H--, 2H--/ 00441 DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ 00442 DATA SEND / 9, 2H , 2H , 2H , 2HEN, 1HD/ 00443 DATA SFSPCR / 3, 2H.., 1H./ 00444 DATA SLP / 1, 1H(/ 00445 DATA SOWSE / 11, 2H(O, 2HTH, 2HER, 2HWI, 2HSE, 1H)/ 00446 DATA SRP / 1, 1H)/ 00447 DATA SSPACR / 3, 2H. , 1H / 00448 DATA KCOND / 11, 2HCO, 2HND, 2HIT, 2HIO, 2HNA, 1HL/ 00449 DATA KDO / 2, 2HDO/ 00450 DATA KELSE / 4, 2HEL, 2HSE/ 00451 DATA KEND / 3, 2HEN, 1HD/ 00452 DATA KFIN / 3, 2HFI, 1HN/ 00453 DATA KIF / 2, 2HIF/ 00454 DATA KINCL /7, 2HIN, 2HCL, 2HUD, 1HE/ !29JUN81 MAO 00455 DATA KIMP /8, 2HIM, 2HPL, 2HIC, 2HIT/ !840307MAO 00456 DATA KNAME / 4, 2HNA, 2HME/ !30JUN81MAO 00457 DATA KNONE /4, 2HNO, 2HNE/ !840307MAO 00458 DATA KPEND / 7, 2HPA, 2HSS, 2HEN, 1HD/ !30JUN81MAO 00459 DATA KPIF /6, 2HPA, 2HSS, 2HIF/ !30JUN81MAO 00460 DATA KPUNL / 10, 2HPA, 2HSS, 2HUN, 2HLE, 2HSS/ !30JUN81MAO 00461 DATA KPAGE/ 4, 2HPA, 2HGE/ !22-JUN-81 MAO 00462 DATA KREPT / 6, 2HRE, 2HPE, 2HAT/ 00463 DATA KSELCT / 6, 2HSE, 2HLE, 2HCT/ 00464 DATA KTO / 2, 2HTO/ 00465 DATA KUNLES / 6, 2HUN, 2HLE, 2HSS/ 00466 DATA KUNTIL / 5, 2HUN, 2HTI, 1HL/ 00467 DATA KWHEN / 4, 2HWH, 2HEN/ 00468 DATA KWHILE / 5, 2HWH, 2HIL, 1HE/ 00469 DATA SAEND /10, 2H ,2H ,2H ,2H.E,2HND/ 00473 IF((READ).NE.(SOURCE)) GO TO 32757 00491 ASSIGN 32755 TO I32756 00491 GO TO 32756 00491 32755 GO TO 32758 00492 32757 IF((SETUP).NE.(SOURCE)) GO TO 32754 00492 GO TO 32758 00493 32754 IF((RETRY).NE.(SOURCE)) GO TO 32753 00493 LINENO=HOLDNO 00494 CALL CPYSTR(SFLX,SHOLD) 00495 32753 CONTINUE 00497 32758 ERROR=0 00498 SAVED=.FALSE. !HAVE NOT YET SAVED AN OLD LINE 00499 NUNITS=0 !# OF UNITS OF INFO IN LINE 00500 ERSTOP=0 !# OF ERRORS FOUND FOR THIS LINE 00501 CURSOR=0 !POSITION IN LINE OF CHARACTER SCAN 00502 CWD=2 !WORD IN LINE BEING LOOKED AT (WORD 1=CHARACTER COUNT) 00503 CPOS=0 !POSITION IN CWD OF CHARACTER 00504 CLASS=0 !TYPE OF STATEMENT FOUND 00505 ASSIGN 32751 TO I32752 00506 GO TO 32752 00506 32751 ASSIGN 32749 TO I32750 00507 GO TO 32750 00507 32749 IF(.NOT.(CONT.OR.PASS)) GO TO 32747 00508 CLASS=TEXEC !EXECUTABLE 00512 EXTYPE=TFORT !PURE FORTRAN 00513 GO TO 32748 00514 32747 ASSIGN 32745 TO I32746 00515 GO TO 32746 00515 32745 CONTINUE 00515 32748 IF(.NOT.(.NOT.PASFLG)) GO TO 32743 00517 IF(.NOT.(CLASS.EQ.TEND)) GO TO 32741 00523 ERROR=404 !OOPS, HIT END WITH MISSING .PASSENDS! 00524 CLASS=0 00525 GO TO 32742 00527 32741 IF(.NOT.(CLASS.EQ.TDIR)) GO TO 32740 00527 IF((DPIF).NE.(DTYPE)) GO TO 32738 00529 ASSIGN 32736 TO I32737 00530 GO TO 32737 00530 32736 ASSIGN 32734 TO I32735 00531 GO TO 32735 00531 32734 GO TO 32739 00533 32738 IF((DPUNL).NE.(DTYPE)) GO TO 32733 00533 ASSIGN 32732 TO I32737 00534 GO TO 32737 00534 32732 ASSIGN 32731 TO I32735 00535 GO TO 32735 00535 32731 GO TO 32739 00537 32733 IF((DPEND).NE.(DTYPE)) GO TO 32730 00537 ASSIGN 32729 TO I32735 00537 GO TO 32735 00537 32729 GO TO 32739 00538 32730 CLASS=TOFF 00538 32739 GO TO 32742 00541 32740 CLASS=TOFF 00541 32742 GO TO 32744 00543 32743 IF((TEXEC).NE.(CLASS)) GO TO 32727 00546 IF((TFORT).NE.(EXTYPE)) GO TO 32725 00548 CONTINUE !PURE FORTRAN, NOTHING MORE TO DO 00548 GO TO 32726 00549 32725 IF((TINVOK).NE.(EXTYPE)) GO TO 32724 00549 ASSIGN 32723 TO I32735 00549 GO TO 32735 00549 32723 GO TO 32726 00550 32724 IF((TCOND).NE.(EXTYPE)) GO TO 32722 00550 ASSIGN 32721 TO I32735 00550 GO TO 32735 00550 32721 GO TO 32726 00551 32722 IF((TSELCT).NE.(EXTYPE)) GO TO 32720 00551 ASSIGN 32718 TO I32719 00552 GO TO 32719 00552 32718 IF(.NOT.(NUNITS.GT.1)) GO TO 32717 00553 NUNITS=1 00554 CURSOR=USTART(2) 00555 ASSIGN 32715 TO I32716 00556 GO TO 32716 00556 32715 ASSIGN 32714 TO I32735 00557 GO TO 32735 00557 32714 CONTINUE 00558 32717 GO TO 32726 00560 32720 ASSIGN 32713 TO I32719 00560 GO TO 32719 00560 32713 CONTINUE 00561 32726 GO TO 32728 00563 32727 IF((TFIN).NE.(CLASS)) GO TO 32712 00563 ASSIGN 32711 TO I32735 00563 GO TO 32735 00563 32711 GO TO 32728 00564 32712 IF((TEND).NE.(CLASS)) GO TO 32710 00564 CONTINUE !END HIT 00564 GO TO 32728 00565 32710 IF((TELSE).NE.(CLASS)) GO TO 32709 00565 ASSIGN 32707 TO I32708 00565 GO TO 32708 00565 32707 GO TO 32728 00566 32709 IF((TTO).NE.(CLASS)) GO TO 32706 00566 CSAVE=CURSOR 00567 ASSIGN 32704 TO I32705 00568 GO TO 32705 00568 32704 IF(.NOT.(FOUND)) GO TO 32702 00569 ASSIGN 32701 TO I32708 00569 GO TO 32708 00569 32701 GO TO 32703 00569 32702 ERSTOP=ERSTOP+1 00571 ERRSTK(ERSTOP)=5 00572 ASSIGN 32699 TO I32700 00573 GO TO 32700 00573 32699 SFLX(1)=CSAVE 00574 CALL CATSTR(SFLX,SDUM) 00575 CURSOR=CSAVE 00576 ASSIGN 32698 TO I32716 00577 GO TO 32716 00577 32698 ASSIGN 32697 TO I32705 00578 GO TO 32705 00578 32697 CONTINUE 00579 32703 GO TO 32728 00581 32706 IF((TCEXP).NE.(CLASS)) GO TO 32696 00581 ASSIGN 32695 TO I32719 00581 GO TO 32719 00581 32695 GO TO 32728 00582 32696 IF((TDIR).NE.(CLASS)) GO TO 32694 00582 IF((DPAGE).NE.(DTYPE)) GO TO 32692 00584 ASSIGN 32691 TO I32735 00584 GO TO 32735 00584 32691 GO TO 32693 00585 32692 IF((DINCL).NE.(DTYPE)) GO TO 32690 00585 ASSIGN 32689 TO I32737 00586 GO TO 32737 00586 32689 ASSIGN 32688 TO I32735 00587 GO TO 32735 00587 32688 GO TO 32693 00589 32690 IF((DPIF).NE.(DTYPE)) GO TO 32687 00589 ASSIGN 32686 TO I32737 00590 GO TO 32737 00590 32686 ASSIGN 32685 TO I32735 00591 GO TO 32735 00591 32685 GO TO 32693 00593 32687 IF((DPUNL).NE.(DTYPE)) GO TO 32684 00593 ASSIGN 32683 TO I32737 00594 GO TO 32737 00594 32683 ASSIGN 32682 TO I32735 00595 GO TO 32735 00595 32682 GO TO 32693 00597 32684 IF((DPEND).NE.(DTYPE)) GO TO 32681 00597 ASSIGN 32680 TO I32735 00597 GO TO 32735 00597 32680 GO TO 32693 00598 32681 IF((DNAME).NE.(DTYPE)) GO TO 32679 00598 ASSIGN 32678 TO I32737 00599 GO TO 32737 00599 32678 ASSIGN 32677 TO I32735 00600 GO TO 32735 00600 32677 GO TO 32693 00602 32679 IF((DIMP).NE.(DTYPE)) GO TO 32676 00602 ASSIGN 32675 TO I32735 00602 GO TO 32735 00602 32675 CONTINUE 00603 32676 CONTINUE 00603 32693 CONTINUE 00605 32694 CONTINUE 00605 32728 CONTINUE 00606 32744 IF(ERSTOP.GT.0) CLASS=0 00607 LSTLEV=LEVEL 00608 IF(.NOT.(LSTFUL)) GO TO 32674 00613 IF(.NOT.(CLASS.NE.TEXEC.OR.EXTYPE.NE.TFORT)) GO TO 32673 00614 CALL CPYSTR(SLIST,SFLX) !PUT FLX LINE IN LIST STRING 00615 CALL PUTCH(SLIST(2),1,CHC) !PUT COMMENT CHAR IN COL 1 00616 CALL PUT(LINENO,SLIST,FORTCL) !PUT IT OUT 00617 IF(.NOT.(CNTALL)) NUMLIN=NUMLIN-1 !USUALLY DON'T COUNT !830307 00618 32673 CONTINUE 00620 32674 RETURN 00622 32672 CONTINUE 00623 CURSOR=CURSOR+1 00624 CPOS=CPOS+1 00625 IF(.NOT.(CPOS.GT.NCHPWD)) GO TO 32671 00626 CWD=CWD+1 00627 CPOS=1 00628 32671 IF(.NOT.(CURSOR.GT.SFLX(1))) GO TO 32669 00630 CHTYPE=TEOL 00630 GO TO 32670 00630 32669 CALL GETCH(SFLX(CWD),CPOS,CH) 00632 CHTYPE=CHTYP(CH) 00633 32670 GO TO I32672 00635 32668 CONTINUE 00636 LSTLEV=LEVEL 00637 IF(.NOT.(LSTLEV.EQ.0)) GO TO 32666 00638 CALL PUT(BLN,SB,LISTCL) 00638 GO TO 32667 00638 32666 CALL CPYSTR(SLIST,SB6) 00640 DO 32665 I=1,LSTLEV 00641 CALL CATSTR(SLIST,SSPACR) 00641 32665 CONTINUE 00641 IF(.NOT.(SLIST(1).GT.WWIDTH)) GO TO 32663 00642 CALL PUT(BLN,SB,LISTCL) 00642 GO TO 32664 00642 32663 CALL PUT(BLN,SLIST,LISTCL) 00643 32664 CONTINUE 00644 32667 BLN=0 00645 GO TO I32668 00646 32662 CONTINUE 00647 IF(.NOT.(LSTFUL)) GO TO 32661 00654 CALL PUT(LINENO,SFLX,FORTCL) 00655 IF(.NOT.(CNTALL)) NUMLIN=NUMLIN-1 !USUALLY DONT COUNT !830307 00656 32661 CURSOR=1 00659 ASSIGN 32660 TO I32716 00660 GO TO 32716 00660 32660 INDENT=.TRUE. 00661 I=2 00662 GO TO 32658 00663 32659 IF(.NOT.(I.LE.6.AND.INDENT)) GO TO 32657 00663 32658 ASSIGN 32656 TO I32672 00664 GO TO 32672 00664 32656 IF ((CHTYPE.NE.TBLANK).AND.(CHTYPE.NE.TEOL)) INDENT=.FALSE. 00665 I=I+1 00666 GO TO 32659 00667 32657 IF(.NOT.(INDENT)) GO TO 32654 00668 LSTLEV=LEVEL 00669 CLASS=0 00670 ASSIGN 32652 TO I32653 00671 GO TO 32653 00671 32652 GO TO 32655 00672 32654 CALL PUT(LINENO,SFLX,LISTCL) 00673 32655 GO TO I32662 00674 32651 CONTINUE 00675 CALL PUT(0,SB,LISTCL) 00676 CALL PUT(0,SDASH,LISTCL) 00677 CALL PUT(0,SB,LISTCL) 00678 GO TO I32651 00679 32653 CONTINUE 00680 IF(.NOT.(CLASS.EQ.TTO)) GO TO 32650 00681 ASSIGN 32649 TO I32651 00681 GO TO 32651 00681 32649 CONTINUE 00681 32650 IF (SFLX(1).LT.7) CALL CATSTR(SFLX,SB7) 00682 CALL CPYSUB(SLIST,SFLX,1,6) 00683 IF(LSTLEV.EQ.0) GO TO 32648 00684 DO 32647 I=1,LSTLEV 00685 CALL CATSTR(SLIST,SSPACR) 00685 32647 CONTINUE 00685 32648 IF(.NOT.(CLASS.EQ.TFIN)) GO TO 32646 00687 SLIST(1)=SLIST(1)-SSPACR(1) 00688 CALL CATSTR(SLIST,SFSPCR) 00689 32646 CALL CATSUB(SLIST,SFLX,7,SFLX(1)-6) 00691 IF (SLIST(1).GT.WWIDTH) CALL CPYSTR(SLIST,SFLX) 00692 IF(.NOT.(ERLST)) GO TO 32644 00693 CALL PUT(LINENO,SLIST,ERRCL) 00694 ERLST=.FALSE. 00695 GO TO 32645 00696 32644 CALL PUT(LINENO,SLIST,LISTCL) 00697 32645 GO TO I32653 00698 32756 CONTINUE 00699 GO TO 32642 00704 32643 IF(FOUND) GO TO 32641 00704 32642 CALL GET(LINENO,SFLX,ENDFIL,ERR1,ERR2) !821129MAO 00705 IF(.NOT.(FIRST)) GO TO 32640 00706 32639 IF(SFLX(1).GT.0.OR.ENDFIL) GO TO 32638 00707 CALL GET(LINENO,SFLX,ENDFIL,ERR1,ERR2) !821129MAO 00708 GO TO 32639 00709 32638 FIRST=.FALSE. 00710 IF(ENDFIL) NOPGM=.TRUE. 00711 32640 IF(.NOT.(ENDFIL)) GO TO 32637 00713 CALL CPYSTR(SFLX,SEND) 00718 LINENO=0 00720 32637 CALL GETCH(SFLX(2),1,CH) 00722 IF(.NOT.(SFLX(1).EQ.0)) GO TO 32635 00724 BLN=LINENO 00725 IF(.NOT.(PASFLG)) GO TO 32634 00726 ASSIGN 32633 TO I32668 00726 GO TO 32668 00726 32633 CONTINUE 00726 32634 FOUND=.FALSE. 00727 GO TO 32636 00729 32635 IF(.NOT.(CH.EQ.CHC.OR.CH.EQ.FORMFD)) GO TO 32632 00729 IF(.NOT.(PASFLG)) GO TO 32631 00730 ASSIGN 32630 TO I32662 00730 GO TO 32662 00730 32630 CONTINUE 00730 32631 FOUND=.FALSE. 00731 GO TO 32636 00733 32632 FOUND=.TRUE. 00733 32636 GO TO 32643 00735 32641 GO TO I32756 00736 32716 CONTINUE 00737 CURSOR=CURSOR-1 00741 CWD=(CURSOR-1)/NCHPWD+2 00742 CPOS=CURSOR-(CWD-2)*NCHPWD 00743 ASSIGN 32629 TO I32672 00744 GO TO 32672 00744 32629 GO TO I32716 00745 32700 CONTINUE 00746 IF(SAVED) GO TO 32628 00750 SAVED=.TRUE. 00751 HOLDNO=LINENO 00752 CALL CPYSTR(SHOLD,SFLX) 00753 32628 GO TO I32700 00755 32750 CONTINUE 00756 ASSIGN 32627 TO I32672 00761 GO TO 32672 00761 32627 IF(.NOT.(CHTYPE.EQ.TEOL)) GO TO 32625 00763 CONT=.FALSE. 00763 GO TO 32626 00764 32625 IF(.NOT.(CH.EQ.CHZERO.OR.CH.EQ.CHSPAC)) GO TO 32624 00764 CONT=.FALSE. 00764 GO TO 32626 00765 32624 CONT=.TRUE. 00766 IF(.NOT.(CNTALL)) NUMLIN=NUMLIN-1 !USUALLY DONT COUNT !830307 00767 32626 GO TO I32750 00770 32719 CONTINUE 00771 32623 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32622 00775 ASSIGN 32621 TO I32672 00775 GO TO 32672 00775 32621 GO TO 32623 00775 32622 START=CURSOR 00776 IF(.NOT.(CHTYPE.NE.TLP)) GO TO 32620 00777 ERSTOP=ERSTOP+1 00778 ERRSTK(ERSTOP)=3 00779 ASSIGN 32619 TO I32700 00780 GO TO 32700 00780 32619 CALL CPYSTR(SST,SFLX) 00781 SFLX(1)=START-1 00782 CALL CATSTR(SFLX,SLP) 00783 CALL CATSUB(SFLX,SST,START,SST(1)-START-1) 00784 32620 PCNT=1 !COUNT OF # OF ( 00786 FOUND=.TRUE. 00787 GO TO 32617 00788 32618 IF(PCNT.EQ.0.OR..NOT.FOUND) GO TO 32616 00788 32617 ASSIGN 32615 TO I32672 00789 GO TO 32672 00789 32615 IF((TRP).NE.(CHTYPE)) GO TO 32613 00791 PCNT=PCNT-1 00791 GO TO 32614 00792 32613 IF((TLP).NE.(CHTYPE)) GO TO 32612 00792 PCNT=PCNT+1 00792 GO TO 32614 00793 32612 IF((TEOL).NE.(CHTYPE)) GO TO 32611 00793 FOUND=.FALSE. 00793 32611 CONTINUE 00794 32614 GO TO 32618 00795 32616 IF(FOUND) GO TO 32610 00796 ERSTOP=ERSTOP+1 00800 ERRSTK(ERSTOP)=4 00801 ASSIGN 32609 TO I32700 00802 GO TO 32700 00802 32609 DO 32608 I=1,PCNT 00803 CALL CATSTR(SFLX,SRP) 00803 32608 CONTINUE 00803 CURSOR=SFLX(1) 00804 ASSIGN 32607 TO I32716 00805 GO TO 32716 00805 32607 CONTINUE 00806 32610 ASSIGN 32606 TO I32672 00807 GO TO 32672 00807 32606 NUNITS=NUNITS+1 00808 UTYPE(NUNITS)=UEXP !ASSUME (LOGICAL) 00809 USTART(NUNITS)=START 00810 ULEN(NUNITS)=CURSOR-START 00811 CALL CPYSUB(SST,SFLX,START,CURSOR-START) 00812 IF(STREQ(SST,SOWSE)) UTYPE(NUNITS)=UOWSE !OOPS, IS (OTHERWISE) 00813 ASSIGN 32605 TO I32708 00814 GO TO 32708 00814 32605 GO TO I32719 00815 32735 CONTINUE 00816 32604 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32603 00817 ASSIGN 32602 TO I32672 00817 GO TO 32672 00817 32602 GO TO 32604 00817 32603 IF(.NOT.(CHTYPE.NE.TEOL.AND.CH.NE.CINLIN)) GO TO 32601 00818 ERSTOP=ERSTOP+1 !BAD STUFF ON THE LINE 00819 ERRSTK(ERSTOP)=2 00820 ASSIGN 32600 TO I32700 00821 GO TO 32700 00821 32600 SFLX(1)=CURSOR-1 00822 32601 GO TO I32735 00824 32746 CONTINUE 00825 ASSIGN 32599 TO I32672 00830 GO TO 32672 00830 32599 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32598 00831 ASSIGN 32597 TO I32672 00831 GO TO 32672 00831 32597 GO TO 32599 00831 32598 IF(.NOT.(CH.NE.DIRCH)) GO TO 32595 00832 DRCTV=.FALSE. !not a directive !22-JUN-81 MAO 00832 GO TO 32596 00832 32595 DRCTV=.TRUE. !is a directive !22-JUN-81 00834 ASSIGN 32594 TO I32672 00835 GO TO 32672 00835 32594 CONTINUE 00836 32596 IF((TLETTR).NE.(CHTYPE)) GO TO 32592 00838 START=CURSOR 00839 INVOKE=.FALSE. 00840 BADCH=.FALSE. 00841 GO TO 32590 00842 32591 IF(BADCH) GO TO 32589 00842 32590 ASSIGN 32588 TO I32672 00843 GO TO 32672 00843 32588 IF(.NOT.(CHTYPE.LE.TDIGIT)) GO TO 32586 00845 CONTINUE !0-9 AND A-Z ONLY (NOT BLANK) 00845 GO TO 32587 00846 32586 IF(.NOT.(CHTYPE.EQ.THYPHN)) GO TO 32585 00846 INVOKE=.TRUE. !A PROCEDURE INVOCATION 00846 GO TO 32587 00847 32585 BADCH=.TRUE. !END OF SCAN 00847 32587 GO TO 32591 00849 32589 LEN=CURSOR-START 00850 IF(.NOT.(INVOKE)) GO TO 32583 00851 CLASS=TEXEC 00852 EXTYPE=TINVOK 00853 NUNITS=1 00854 UTYPE(1)=UPINV 00855 USTART(1)=START 00856 ULEN(1)=LEN 00857 GO TO 32584 00858 32583 CALL CPYSUB(SST,SFLX,START,LEN) !PUT "KEYWORD" IN SST 00860 CLASS=TEXEC !BUT ASSUME PURE FORTRAN 00861 EXTYPE=TFORT 00862 IF((2).NE.(SST(1))) GO TO 32581 00864 IF(.NOT.(STREQ(SST,KIF).AND..NOT.DRCTV)) GO TO 32579 00866 EXTYPE=TIF !17AUG81 MAO 00866 GO TO 32580 00867 32579 IF(.NOT.(STREQ(SST,KTO))) GO TO 32578 00867 CLASS=TTO 00867 GO TO 32580 00868 32578 IF(.NOT.(STREQ(SST,KDO))) GO TO 32577 00868 32576 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32575 00869 ASSIGN 32574 TO I32672 00869 GO TO 32672 00869 32574 GO TO 32576 00869 32575 IF(.NOT.(CHTYPE.EQ.TDIGIT)) GO TO 32572 00870 EXTYPE=TFORT !OOPS, REALLY FORT DO 00870 GO TO 32573 00870 32572 EXTYPE=TDO 00871 32573 CONTINUE 00873 32577 CONTINUE 00873 32580 GO TO 32582 00875 32581 IF((3).NE.(SST(1))) GO TO 32571 00875 IF(.NOT.(STREQ(SST,KFIN))) GO TO 32569 00877 CLASS=TFIN 00877 GO TO 32570 00878 32569 IF(.NOT.(STREQ(SST,KEND))) GO TO 32568 00878 IF (CHTYPE.EQ.TEOL) CLASS=TEND 00879 DRCTV=.FALSE. !previously set .T. for .END !29JUN81MAO 00888 32568 CONTINUE 00890 32570 GO TO 32582 00892 32571 IF((4).NE.(SST(1))) GO TO 32567 00892 IF(.NOT.(STREQ(SST,KWHEN))) GO TO 32565 00894 EXTYPE=TWHEN 00894 GO TO 32566 00895 32565 IF(.NOT.(STREQ(SST,KELSE))) GO TO 32564 00895 CLASS=TELSE 00895 GO TO 32566 00896 32564 IF(.NOT.(STREQ(SST,KPAGE) .AND. DRCTV)) GO TO 32563 00896 CLASS=TDIR !22-JUN-81 00897 DTYPE=DPAGE !22-JUN-81 00898 GO TO 32566 00900 32563 IF(.NOT.(STREQ(SST,KNAME) .AND. DRCTV)) GO TO 32562 00900 CLASS=TDIR 00901 DTYPE=DNAME 00902 32562 CONTINUE 00904 32566 GO TO 32582 00906 32567 IF((5).NE.(SST(1))) GO TO 32561 00906 IF(.NOT.(STREQ(SST,KWHILE))) GO TO 32559 00908 EXTYPE=TWHILE 00908 GO TO 32560 00909 32559 IF(.NOT.(STREQ(SST,KUNTIL))) GO TO 32558 00909 EXTYPE=TUNTIL 00909 32558 CONTINUE 00910 32560 GO TO 32582 00912 32561 IF((6).NE.(SST(1))) GO TO 32557 00912 IF(.NOT.(STREQ(SST,KREPT))) GO TO 32555 00914 32554 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32553 00915 ASSIGN 32552 TO I32672 00915 GO TO 32672 00915 32552 GO TO 32554 00915 32553 START=CURSOR 00916 32551 IF(.NOT.(CHTYPE.EQ.TLETTR)) GO TO 32550 00917 ASSIGN 32549 TO I32672 00917 GO TO 32672 00917 32549 GO TO 32551 00917 32550 LEN=CURSOR-START 00918 CALL CPYSUB(SST,SFLX,START,LEN) 00919 IF(.NOT.(STREQ(SST,KWHILE))) GO TO 32547 00921 EXTYPE=TRWHIL 00921 GO TO 32548 00922 32547 IF(.NOT.(STREQ(SST,KUNTIL))) GO TO 32546 00922 EXTYPE=TRUNTL 00922 32546 CONTINUE 00923 32548 GO TO 32556 00925 32555 IF(.NOT.(STREQ(SST,KSELCT))) GO TO 32545 00925 EXTYPE=TSELCT 00925 GO TO 32556 00926 32545 IF(.NOT.(STREQ(SST,KUNLES))) GO TO 32544 00926 EXTYPE=TUNLES 00926 GO TO 32556 00927 32544 IF(.NOT.(STREQ(SST,KPIF) .AND. DRCTV)) GO TO 32543 00927 CLASS=TDIR 00928 DTYPE=DPIF 00929 32543 CONTINUE 00931 32556 GO TO 32582 00933 32557 IF((7).NE.(SST(1))) GO TO 32542 00933 IF(.NOT.(STREQ(SST,KINCL) .AND. DRCTV)) GO TO 32541 00934 CLASS=TDIR 00935 DTYPE=DINCL 00936 32541 IF(.NOT.(STREQ(SST,KPEND) .AND. DRCTV)) GO TO 32540 00938 CLASS=TDIR 00939 DTYPE=DPEND 00940 32540 CONTINUE 00943 GO TO 32582 00944 32542 IF((8).NE.(SST(1))) GO TO 32539 00944 IF(.NOT.(STREQ(SST,KIMP) .AND. DRCTV)) GO TO 32538 00945 32537 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32536 00946 ASSIGN 32535 TO I32672 00946 GO TO 32672 00946 32535 GO TO 32537 00946 32536 START=CURSOR !840307MAO 00947 32534 IF(.NOT.(CHTYPE.EQ.TLETTR)) GO TO 32533 00948 ASSIGN 32532 TO I32672 00948 GO TO 32672 00948 32532 GO TO 32534 00948 32533 LEN=CURSOR-START !840307MAO 00949 CALL CPYSUB (SST,SFLX,START,LEN) !840307MAO 00950 IF(.NOT.(STREQ(SST,KNONE))) GO TO 32531 00951 CLASS=TDIR !840307MAO 00952 DTYPE=DIMP !840307MAO 00953 32531 CONTINUE 00955 32538 CONTINUE 00957 GO TO 32582 00958 32539 IF((10).NE.(SST(1))) GO TO 32530 00958 IF(.NOT.(STREQ(SST,KPUNL) .AND. DRCTV)) GO TO 32529 00959 CLASS=TDIR 00960 DTYPE=DPUNL 00961 32529 GO TO 32582 00964 32530 IF((11).NE.(SST(1))) GO TO 32528 00964 IF (STREQ(SST,KCOND)) EXTYPE=TCOND 00965 32528 CONTINUE 00967 32582 CONTINUE 00968 32584 GO TO 32593 00970 32592 IF((TLP).NE.(CHTYPE)) GO TO 32527 00970 CLASS=TCEXP !MUST BE COND OR SELECT SUBCLAUSE 00970 GO TO 32593 00971 32527 CLASS=TEXEC 00975 EXTYPE=TFORT 00976 32593 GO TO I32746 00979 32737 CONTINUE 00980 32526 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32525 00984 ASSIGN 32524 TO I32672 00984 GO TO 32672 00984 32524 GO TO 32526 00984 32525 NUNITS=1 00985 UTYPE(1)=UDIR 00986 USTART(1)=CURSOR 00987 32523 IF(.NOT.(CHTYPE.NE.TEOL.AND.CH.NE.CINLIN)) GO TO 32522 00989 ASSIGN 32521 TO I32672 00989 GO TO 32672 00989 32521 GO TO 32523 00989 32522 ULEN(1)=CURSOR-USTART(1) 00990 GO TO I32737 00991 32705 CONTINUE 00992 32520 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32519 00993 ASSIGN 32518 TO I32672 00993 GO TO 32672 00993 32518 GO TO 32520 00993 32519 FOUND=.FALSE. 00994 IF(.NOT.(CHTYPE.EQ.TLETTR)) GO TO 32517 00995 START=CURSOR 00996 GO TO 32515 00997 32516 IF(CHTYPE.GT.THYPHN) GO TO 32514 00997 32515 ASSIGN 32513 TO I32672 00998 GO TO 32672 00998 32513 IF(CHTYPE.EQ.THYPHN) FOUND=.TRUE. 00999 GO TO 32516 01000 32514 CONTINUE 01001 32517 IF(.NOT.(FOUND)) GO TO 32512 01002 NUNITS=NUNITS+1 01003 UTYPE(NUNITS)=UPINV 01004 USTART(NUNITS)=START 01005 ULEN(NUNITS)=CURSOR-START 01006 32512 GO TO I32705 01008 32708 CONTINUE 01009 32511 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32510 01014 ASSIGN 32509 TO I32672 01014 GO TO 32672 01014 32509 GO TO 32511 01014 32510 IF(CHTYPE.EQ.TEOL.OR.CH.EQ.CINLIN) GO TO 32508 01015 CSAVE=CURSOR 01016 ASSIGN 32507 TO I32705 01017 GO TO 32705 01017 32507 IF(.NOT.(FOUND)) GO TO 32505 01018 ASSIGN 32504 TO I32735 01018 GO TO 32735 01018 32504 GO TO 32506 01018 32505 NUNITS=NUNITS+1 01023 UTYPE(NUNITS)=UFORT 01024 USTART(NUNITS)=CSAVE 01025 ULEN(NUNITS)=SFLX(1)+1-CSAVE 01026 32506 CONTINUE 01028 32508 GO TO I32708 01029 32752 CONTINUE 01030 FLXNO=0 01037 PASS=.FALSE. 01038 DO 32503 I=1,5 01039 ASSIGN 32502 TO I32672 01040 GO TO 32672 01040 32502 IF((TBLANK).NE.(CHTYPE)) GO TO 32500 01042 GO TO 32501 01043 32500 IF((TDIGIT).NE.(CHTYPE)) GO TO 32499 01043 FLXNO=FLXNO*10+CH-CHZERO 01043 GO TO 32501 01044 32499 IF((TEOL).NE.(CHTYPE)) GO TO 32498 01044 GO TO 32501 01045 32498 PASS=.TRUE. !ILLEGAL CHAR IN COL 1-5 01045 32501 CONTINUE 01047 32503 CONTINUE 01047 GO TO I32752 01048 END 01049