SUBROUTINE ANALYZ 00051 INTEGER FORMFD !15-SEP-80 00100 INTEGER BLN , CH , CHC , CHSPAC, CHTYP , CHTYPE 00101 INTEGER CINLIN !25-JAN-80 00102 INTEGER CHZERO, CLASS , CPOS , CSAVE , CURSOR, CWD 00103 INTEGER ERRCL , ERROR , ERRSTK, ERSTOP 00104 INTEGER EXTYPE, FLXNO , FORTCL, HOLDNO, I , KCOND 00105 INTEGER KDO , KELSE , KEND , KFIN , KIF , KREPT 00106 INTEGER KSELCT, KTO , KUNLES, KUNTIL, KWHEN , KWHILE 00107 INTEGER LEN , LEVEL , LINENO, LISTCL, LSTLEV, MAJCNT 00108 INTEGER MINCNT, MLINE , NCHPWD, NUNITS, PCNT , PTABLE, QP 00109 INTEGER READ , REFNO ,RETRY , SB , SB5 , SB6 00110 INTEGER SB7 , SDASH , SDUM , SEND , SETUP , SFLX 00111 INTEGER SFSPCR, SHOLD , SLIST , SLP , SOURCE, SOWSE 00112 INTEGER SP , SPINV , SPUTGO, SRP , SSPACR, SST 00113 INTEGER SSTMAX, STACK , START , TBLANK, TCEXP , TCOND 00114 INTEGER TDIGIT, TDO , TELSE , TEND , TEOL , TEXEC 00115 INTEGER TFIN , TFORT , THYPHN, TIF , TINVOK, TLETTR 00116 INTEGER TLP , TOP , TOTHER, TRP , TRUNTL, TRWHIL 00117 INTEGER TSELCT, TTO , TUNLES, TUNTIL, TWHEN , TWHILE 00118 INTEGER UDO , UEXP , UFORT , ULEN , UOWSE , UPINV 00119 INTEGER USTART, UTYPE , WWIDTH 00120 LOGICAL BADCH , CONT , DONE ,ENDFIL, ENDPGM, ERLST , FIRST 00128 LOGICAL FOUND , INDENT, INVOKE, NOPGM , PASS , SAVED , STREQ 00129 LOGICAL LSTFUL !14-FEB-80 00130 DIMENSION UTYPE(3), USTART(3), ULEN(3) 00138 DIMENSION STACK(2000) 00141 DIMENSION ERRSTK(5) 00144 COMMON BLN , CLASS , DONE , ENDFIL, ENDPGM, ERLST 00153 COMMON ERROR , ERRSTK, ERSTOP, EXTYPE, FIRST , FLXNO 00154 COMMON FOUND , HOLDNO, LEVEL , LINENO, LSTLEV, MAJCNT 00155 COMMON MINCNT, MLINE , NOPGM , NUNITS, PASS , PTABLE, QP 00156 COMMON REFNO , SAVED , SFLX , SHOLD , SLIST , SOURCE 00157 COMMON SPINV , SPUTGO, SST , STACK , TOP , ULEN 00158 COMMON USTART, UTYPE , WWIDTH 00159 COMMON /PARAM/ NCHPWD, CHZERO, CHSPAC, CHC, CINLIN !25-JAN-80 00200 COMMON/MACVAL/LSTFUL !14-FEB-80 00206 DIMENSION SFLX (51) 00219 DIMENSION SHOLD (51) 00221 DIMENSION SLIST (101) 00223 DIMENSION SPINV (41) 00225 DIMENSION SPUTGO (11) 00227 DIMENSION SST (101) 00229 DIMENSION SB (2) 00235 DIMENSION SB5 (4) 00238 DIMENSION SB6 (4) 00241 DIMENSION SB7 (5) 00244 DIMENSION SDASH (21) 00247 DIMENSION SDUM (9) 00252 DIMENSION SEND (6) 00255 DIMENSION SFSPCR (3) 00258 DIMENSION SLP (2) 00261 DIMENSION SOWSE (7) 00264 DIMENSION SRP (2) 00267 DIMENSION SSPACR (3) 00270 DIMENSION KCOND (7) 00276 DIMENSION KDO (2) 00279 DIMENSION KELSE (3) 00282 DIMENSION KEND (3) 00285 DIMENSION KFIN (3) 00288 DIMENSION KIF (2) 00291 DIMENSION KREPT (4) 00294 DIMENSION KSELCT (4) 00297 DIMENSION KTO (2) 00300 DIMENSION KUNLES (4) 00303 DIMENSION KUNTIL (4) 00306 DIMENSION KWHEN (3) 00309 DIMENSION KWHILE (4) 00312 DATA FORMFD/"14/ !15-SEP-80 00320 DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ 00321 DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ 00322 DATA TLETTR/1/, TDIGIT/2/, THYPHN/3/, TLP/4/, TRP/5/ 00323 DATA TBLANK/6/, TOTHER/7/, TEOL/8/ 00324 DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 00325 DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ 00326 DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ 00327 DATA TWHILE/12/ 00328 DATA SETUP /1/, RETRY /2/, READ /3/ 00329 DATA SSTMAX /200/ 00330 DATA SB / 1, 1H / 00331 DATA SB5 / 5, 2H , 2H , 1H / 00332 DATA SB6 / 6, 2H , 2H , 2H / 00333 DATA SB7 / 7, 2H , 2H , 2H , 1H / 00334 DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00335 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00336 1 , 2H--, 2H--, 2H--, 2H--/ 00337 DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ 00338 DATA SEND / 9, 2H , 2H , 2H , 2HEN, 1HD/ 00339 DATA SFSPCR / 3, 2H.., 1H./ 00340 DATA SLP / 1, 1H(/ 00341 DATA SOWSE / 11, 2H(O, 2HTH, 2HER, 2HWI, 2HSE, 1H)/ 00342 DATA SRP / 1, 1H)/ 00343 DATA SSPACR / 3, 2H. , 1H / 00344 DATA KCOND / 11, 2HCO, 2HND, 2HIT, 2HIO, 2HNA, 1HL/ 00345 DATA KDO / 2, 2HDO/ 00346 DATA KELSE / 4, 2HEL, 2HSE/ 00347 DATA KEND / 3, 2HEN, 1HD/ 00348 DATA KFIN / 3, 2HFI, 1HN/ 00349 DATA KIF / 2, 2HIF/ 00350 DATA KREPT / 6, 2HRE, 2HPE, 2HAT/ 00351 DATA KSELCT / 6, 2HSE, 2HLE, 2HCT/ 00352 DATA KTO / 2, 2HTO/ 00353 DATA KUNLES / 6, 2HUN, 2HLE, 2HSS/ 00354 DATA KUNTIL / 5, 2HUN, 2HTI, 1HL/ 00355 DATA KWHEN / 4, 2HWH, 2HEN/ 00356 DATA KWHILE / 5, 2HWH, 2HIL, 1HE/ 00357 IF((READ).NE.(SOURCE)) GO TO 32757 00373 ASSIGN 32755 TO I32756 00373 GO TO 32756 00373 32755 GO TO 32758 00374 32757 IF((SETUP).NE.(SOURCE)) GO TO 32754 00374 GO TO 32758 00375 32754 IF((RETRY).NE.(SOURCE)) GO TO 32753 00375 LINENO=HOLDNO 00376 CALL CPYSTR(SFLX,SHOLD) 00377 32753 CONTINUE 00379 32758 ERROR=0 00380 SAVED=.FALSE. !HAVE NOT YET SAVE AN OLD LINE 00381 NUNITS=0 !# OF UNITS OF INFO IN LINE 00382 ERSTOP=0 !# OF ERRORS FOUND FOR THIS LINE 00383 CURSOR=0 !POSITION IN LINE OF CHARACTER SCAN 00384 CWD=2 !WORD IN LINE BEING LOOKED AT (WORD 1=CHARACTER COUNT) 00385 CPOS=0 !POSITION IN CWD OF CHARACTER 00386 CLASS=0 !TYPE OF STATEMENT FOUND 00387 ASSIGN 32751 TO I32752 00388 GO TO 32752 00388 32751 ASSIGN 32749 TO I32750 00389 GO TO 32750 00389 32749 IF(.NOT.(CONT.OR.PASS)) GO TO 32747 00390 CLASS=TEXEC !EXECUTABLE 00394 EXTYPE=TFORT !PURE FORTRAN 00395 GO TO 32748 00396 32747 ASSIGN 32745 TO I32746 00397 GO TO 32746 00397 32745 CONTINUE 00397 32748 IF((TEXEC).NE.(CLASS)) GO TO 32743 00399 IF((TFORT).NE.(EXTYPE)) GO TO 32741 00401 CONTINUE !PURE FORTRAN, NOTHING MORE TO DO 00401 GO TO 32742 00402 32741 IF((TINVOK).NE.(EXTYPE)) GO TO 32740 00402 ASSIGN 32738 TO I32739 00402 GO TO 32739 00402 32738 GO TO 32742 00403 32740 IF((TCOND).NE.(EXTYPE)) GO TO 32737 00403 ASSIGN 32736 TO I32739 00403 GO TO 32739 00403 32736 GO TO 32742 00404 32737 IF((TSELCT).NE.(EXTYPE)) GO TO 32735 00404 ASSIGN 32733 TO I32734 00405 GO TO 32734 00405 32733 IF(.NOT.(NUNITS.GT.1)) GO TO 32732 00406 NUNITS=1 00407 CURSOR=USTART(2) 00408 ASSIGN 32730 TO I32731 00409 GO TO 32731 00409 32730 ASSIGN 32729 TO I32739 00410 GO TO 32739 00410 32729 CONTINUE 00411 32732 GO TO 32742 00413 32735 ASSIGN 32728 TO I32734 00413 GO TO 32734 00413 32728 CONTINUE 00414 32742 GO TO 32744 00416 32743 IF((TFIN).NE.(CLASS)) GO TO 32727 00416 ASSIGN 32726 TO I32739 00416 GO TO 32739 00416 32726 GO TO 32744 00417 32727 IF((TEND).NE.(CLASS)) GO TO 32725 00417 CONTINUE !END HIT 00417 GO TO 32744 00418 32725 IF((TELSE).NE.(CLASS)) GO TO 32724 00418 ASSIGN 32722 TO I32723 00418 GO TO 32723 00418 32722 GO TO 32744 00419 32724 IF((TTO).NE.(CLASS)) GO TO 32721 00419 CSAVE=CURSOR 00420 ASSIGN 32719 TO I32720 00421 GO TO 32720 00421 32719 IF(.NOT.(FOUND)) GO TO 32717 00422 ASSIGN 32716 TO I32723 00422 GO TO 32723 00422 32716 GO TO 32718 00422 32717 ERSTOP=ERSTOP+1 00424 ERRSTK(ERSTOP)=5 00425 ASSIGN 32714 TO I32715 00426 GO TO 32715 00426 32714 SFLX(1)=CSAVE 00427 CALL CATSTR(SFLX,SDUM) 00428 CURSOR=CSAVE 00429 ASSIGN 32713 TO I32731 00430 GO TO 32731 00430 32713 ASSIGN 32712 TO I32720 00431 GO TO 32720 00431 32712 CONTINUE 00432 32718 GO TO 32744 00434 32721 IF((TCEXP).NE.(CLASS)) GO TO 32711 00434 ASSIGN 32710 TO I32734 00434 GO TO 32734 00434 32710 CONTINUE 00435 32711 CONTINUE 00435 32744 IF(ERSTOP.GT.0) CLASS=0 00436 LSTLEV=LEVEL 00437 IF(.NOT.(LSTFUL.AND.(CLASS.NE.TEXEC.OR.EXTYPE.NE.TFORT))) GO TO 32 00442 1709 00442 CALL CPYSTR(SLIST,SFLX) !PUT FLX LINE IN LIST STRING 00443 CALL PUTCH(SLIST(2),1,CHC) !PUT COMMENT CHAR IN COL 1 00444 CALL PUT(LINENO,SLIST,FORTCL) !PUT IT OUT 00445 32709 RETURN 00448 32708 CONTINUE 00449 CURSOR=CURSOR+1 00450 CPOS=CPOS+1 00451 IF(.NOT.(CPOS.GT.NCHPWD)) GO TO 32707 00452 CWD=CWD+1 00453 CPOS=1 00454 32707 IF(.NOT.(CURSOR.GT.SFLX(1))) GO TO 32705 00456 CHTYPE=TEOL 00456 GO TO 32706 00456 32705 CALL GETCH(SFLX(CWD),CPOS,CH) 00458 CHTYPE=CHTYP(CH) 00459 32706 GO TO I32708 00461 32704 CONTINUE 00462 LSTLEV=LEVEL 00463 IF(.NOT.(LSTLEV.EQ.0)) GO TO 32702 00464 CALL PUT(BLN,SB,LISTCL) 00464 GO TO 32703 00464 32702 CALL CPYSTR(SLIST,SB6) 00466 DO 32701 I=1,LSTLEV 00467 CALL CATSTR(SLIST,SSPACR) 00467 32701 CONTINUE 00467 IF(.NOT.(SLIST(1).GT.WWIDTH)) GO TO 32699 00468 CALL PUT(BLN,SP,LISTCL) 00468 GO TO 32700 00468 32699 CALL PUT(BLN,SLIST,LISTCL) 00469 32700 CONTINUE 00470 32703 BLN=0 00471 GO TO I32704 00472 32698 CONTINUE 00473 CURSOR=1 00478 ASSIGN 32697 TO I32731 00479 GO TO 32731 00479 32697 INDENT=.TRUE. 00480 I=2 00481 GO TO 32695 00482 32696 IF(.NOT.(I.LE.6.AND.INDENT)) GO TO 32694 00482 32695 ASSIGN 32693 TO I32708 00483 GO TO 32708 00483 32693 IF ((CHTYPE.NE.TBLANK).AND.(CHTYPE.NE.TEOL)) INDENT=.FALSE. 00484 I=I+1 00485 GO TO 32696 00486 32694 IF(.NOT.(INDENT)) GO TO 32691 00487 LSTLEV=LEVEL 00488 CLASS=0 00489 ASSIGN 32689 TO I32690 00490 GO TO 32690 00490 32689 GO TO 32692 00491 32691 CALL PUT(LINENO,SFLX,LISTCL) 00492 32692 IF(LSTFUL)CALL PUT(LINENO,SFLX,FORTCL) 00496 GO TO I32698 00498 32688 CONTINUE 00499 CALL PUT(0,SB,LISTCL) 00500 CALL PUT(0,SDASH,LISTCL) 00501 CALL PUT(0,SB,LISTCL) 00502 GO TO I32688 00503 32690 CONTINUE 00504 IF(.NOT.(CLASS.EQ.TTO)) GO TO 32687 00505 ASSIGN 32686 TO I32688 00505 GO TO 32688 00505 32686 CONTINUE 00505 32687 IF (SFLX(1).LT.7) CALL CATSTR(SFLX,SB7) 00506 CALL CPYSUB(SLIST,SFLX,1,6) 00507 IF(LSTLEV.EQ.0) GO TO 32685 00508 DO 32684 I=1,LSTLEV 00509 CALL CATSTR(SLIST,SSPACR) 00509 32684 CONTINUE 00509 32685 IF(.NOT.(CLASS.EQ.TFIN)) GO TO 32683 00511 SLIST(1)=SLIST(1)-SSPACR(1) 00512 CALL CATSTR(SLIST,SFSPCR) 00513 32683 CALL CATSUB(SLIST,SFLX,7,SFLX(1)-6) 00515 IF (SLIST(1).GT.WWIDTH) CALL CPYSTR(SLIST,SFLX) 00516 IF(.NOT.(ERLST)) GO TO 32681 00517 CALL PUT(LINENO,SLIST,ERRCL) 00518 ERLST=.FALSE. 00519 GO TO 32682 00520 32681 CALL PUT(LINENO,SLIST,LISTCL) 00521 32682 GO TO I32690 00522 32756 CONTINUE 00523 GO TO 32679 00528 32680 IF(FOUND) GO TO 32678 00528 32679 CALL GET(LINENO,SFLX,ENDFIL) 00529 IF(.NOT.(FIRST)) GO TO 32677 00530 32676 IF(SFLX(1).GT.0.OR.ENDFIL) GO TO 32675 00531 CALL GET(LINENO,SFLX,ENDFIL) 00531 GO TO 32676 00531 32675 FIRST=.FALSE. 00532 IF(ENDFIL) NOPGM=.TRUE. 00533 32677 IF(.NOT.(ENDFIL)) GO TO 32674 00535 CALL CPYSTR(SFLX,SEND) 00536 LINENO=0 00537 32674 CALL GETCH(SFLX(2),1,CH) 00539 IF(.NOT.(SFLX(1).EQ.0)) GO TO 32672 00541 BLN=LINENO 00542 ASSIGN 32671 TO I32704 00543 GO TO 32704 00543 32671 FOUND=.FALSE. 00544 GO TO 32673 00546 32672 IF(.NOT.(CH.EQ.CHC.OR.CH.EQ.FORMFD)) GO TO 32670 00546 ASSIGN 32669 TO I32698 00547 GO TO 32698 00547 32669 FOUND=.FALSE. 00548 GO TO 32673 00550 32670 FOUND=.TRUE. 00550 32673 GO TO 32680 00552 32678 GO TO I32756 00553 32731 CONTINUE 00554 CURSOR=CURSOR-1 00558 CWD=(CURSOR-1)/NCHPWD+2 00559 CPOS=CURSOR-(CWD-2)*NCHPWD 00560 ASSIGN 32668 TO I32708 00561 GO TO 32708 00561 32668 GO TO I32731 00562 32715 CONTINUE 00563 IF(SAVED) GO TO 32667 00567 SAVED=.TRUE. 00568 HOLDNO=LINENO 00569 CALL CPYSTR(SHOLD,SFLX) 00570 32667 GO TO I32715 00572 32750 CONTINUE 00573 ASSIGN 32666 TO I32708 00578 GO TO 32708 00578 32666 IF(.NOT.(CHTYPE.EQ.TEOL)) GO TO 32664 00580 CONT=.FALSE. 00580 GO TO 32665 00581 32664 IF(.NOT.(CH.EQ.CHZERO.OR.CH.EQ.CHSPAC)) GO TO 32663 00581 CONT=.FALSE. 00581 GO TO 32665 00582 32663 CONT=.TRUE. 00582 32665 GO TO I32750 00584 32734 CONTINUE 00585 32662 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32661 00589 ASSIGN 32660 TO I32708 00589 GO TO 32708 00589 32660 GO TO 32662 00589 32661 START=CURSOR 00590 IF(.NOT.(CHTYPE.NE.TLP)) GO TO 32659 00591 ERSTOP=ERSTOP+1 00592 ERRSTK(ERSTOP)=3 00593 ASSIGN 32658 TO I32715 00594 GO TO 32715 00594 32658 CALL CPYSTR(SST,SFLX) 00595 SFLX(1)=START-1 00596 CALL CATSTR(SFLX,SLP) 00597 CALL CATSUB(SFLX,SST,START,SST(1)-START-1) 00598 32659 PCNT=1 !COUNT OF # OF ( 00600 FOUND=.TRUE. 00601 GO TO 32656 00602 32657 IF(PCNT.EQ.0.OR..NOT.FOUND) GO TO 32655 00602 32656 ASSIGN 32654 TO I32708 00603 GO TO 32708 00603 32654 IF((TRP).NE.(CHTYPE)) GO TO 32652 00605 PCNT=PCNT-1 00605 GO TO 32653 00606 32652 IF((TLP).NE.(CHTYPE)) GO TO 32651 00606 PCNT=PCNT+1 00606 GO TO 32653 00607 32651 IF((TEOL).NE.(CHTYPE)) GO TO 32650 00607 FOUND=.FALSE. 00607 32650 CONTINUE 00608 32653 GO TO 32657 00609 32655 IF(FOUND) GO TO 32649 00610 ERSTOP=ERSTOP+1 00614 ERRSTK(ERSTOP)=4 00615 ASSIGN 32648 TO I32715 00616 GO TO 32715 00616 32648 DO 32647 I=1,PCNT 00617 CALL CATSTR(SFLX,SRP) 00617 32647 CONTINUE 00617 CURSOR=SFLX(1) 00618 ASSIGN 32646 TO I32731 00619 GO TO 32731 00619 32646 CONTINUE 00620 32649 ASSIGN 32645 TO I32708 00621 GO TO 32708 00621 32645 NUNITS=NUNITS+1 00622 UTYPE(NUNITS)=UEXP !ASSUME (LOGICAL) 00623 USTART(NUNITS)=START 00624 ULEN(NUNITS)=CURSOR-START 00625 CALL CPYSUB(SST,SFLX,START,CURSOR-START) 00626 IF(STREQ(SST,SOWSE)) UTYPE(NUNITS)=UOWSE !OOPS, REALLY (OTHERWISE 00627 ASSIGN 32644 TO I32723 00628 GO TO 32723 00628 32644 GO TO I32734 00629 32739 CONTINUE 00630 32643 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32642 00631 ASSIGN 32641 TO I32708 00631 GO TO 32708 00631 32641 GO TO 32643 00631 32642 IF(.NOT.(CHTYPE.NE.TEOL.AND.CH.NE.CINLIN)) GO TO 32640 00632 ERSTOP=ERSTOP+1 !BAD STUFF ON THE LINE 00633 ERRSTK(ERSTOP)=2 00634 ASSIGN 32639 TO I32715 00635 GO TO 32715 00635 32639 SFLX(1)=CURSOR-1 00636 32640 GO TO I32739 00638 32746 CONTINUE 00639 ASSIGN 32638 TO I32708 00644 GO TO 32708 00644 32638 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32637 00645 ASSIGN 32636 TO I32708 00645 GO TO 32708 00645 32636 GO TO 32638 00645 32637 IF((TLETTR).NE.(CHTYPE)) GO TO 32634 00647 START=CURSOR 00648 INVOKE=.FALSE. 00649 BADCH=.FALSE. 00650 GO TO 32632 00651 32633 IF(BADCH) GO TO 32631 00651 32632 ASSIGN 32630 TO I32708 00652 GO TO 32708 00652 32630 IF(.NOT.(CHTYPE.LE.TDIGIT)) GO TO 32628 00654 CONTINUE !0-9 AND A-Z ONLY (BLANKS EXCLUD 00654 GO TO 32629 00655 32628 IF(.NOT.(CHTYPE.EQ.THYPHN)) GO TO 32627 00655 INVOKE=.TRUE. !A PROCEDURE INVOCATION 00655 GO TO 32629 00656 32627 BADCH=.TRUE. !END OF SCAN 00656 32629 GO TO 32633 00658 32631 LEN=CURSOR-START 00659 IF(.NOT.(INVOKE)) GO TO 32625 00660 CLASS=TEXEC 00661 EXTYPE=TINVOK 00662 NUNITS=1 00663 UTYPE(1)=UPINV 00664 USTART(1)=START 00665 ULEN(1)=LEN 00666 GO TO 32626 00667 32625 CALL CPYSUB(SST,SFLX,START,LEN) !PUT "KEYWORD" IN SST 00669 CLASS=TEXEC !BUT ASSUME PURE FORTRAN 00670 EXTYPE=TFORT 00671 IF((2).NE.(SST(1))) GO TO 32623 00673 IF(.NOT.(STREQ(SST,KIF))) GO TO 32621 00675 EXTYPE=TIF 00675 GO TO 32622 00676 32621 IF(.NOT.(STREQ(SST,KTO))) GO TO 32620 00676 CLASS=TTO 00676 GO TO 32622 00677 32620 IF(.NOT.(STREQ(SST,KDO))) GO TO 32619 00677 32618 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32617 00678 ASSIGN 32616 TO I32708 00678 GO TO 32708 00678 32616 GO TO 32618 00678 32617 IF(.NOT.(CHTYPE.EQ.TDIGIT)) GO TO 32614 00679 EXTYPE=TFORT !OOPS, REALLY FORT DO 00679 GO TO 32615 00679 32614 EXTYPE=TDO 00680 32615 CONTINUE 00682 32619 CONTINUE 00682 32622 GO TO 32624 00684 32623 IF((3).NE.(SST(1))) GO TO 32613 00684 IF(.NOT.(STREQ(SST,KFIN))) GO TO 32611 00686 CLASS=TFIN 00686 GO TO 32612 00687 32611 IF(.NOT.(STREQ(SST,KEND))) GO TO 32610 00687 IF (CHTYPE.EQ.TEOL) CLASS=TEND 00688 32610 CONTINUE 00690 32612 GO TO 32624 00692 32613 IF((4).NE.(SST(1))) GO TO 32609 00692 IF(.NOT.(STREQ(SST,KWHEN))) GO TO 32607 00694 EXTYPE=TWHEN 00694 GO TO 32608 00695 32607 IF(.NOT.(STREQ(SST,KELSE))) GO TO 32606 00695 CLASS=TELSE 00695 32606 CONTINUE 00696 32608 GO TO 32624 00698 32609 IF((5).NE.(SST(1))) GO TO 32605 00698 IF(.NOT.(STREQ(SST,KWHILE))) GO TO 32603 00700 EXTYPE=TWHILE 00700 GO TO 32604 00701 32603 IF(.NOT.(STREQ(SST,KUNTIL))) GO TO 32602 00701 EXTYPE=TUNTIL 00701 32602 CONTINUE 00702 32604 GO TO 32624 00704 32605 IF((6).NE.(SST(1))) GO TO 32601 00704 IF(.NOT.(STREQ(SST,KREPT))) GO TO 32599 00706 32598 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32597 00707 ASSIGN 32596 TO I32708 00707 GO TO 32708 00707 32596 GO TO 32598 00707 32597 START=CURSOR 00708 32595 IF(.NOT.(CHTYPE.EQ.TLETTR)) GO TO 32594 00709 ASSIGN 32593 TO I32708 00709 GO TO 32708 00709 32593 GO TO 32595 00709 32594 LEN=CURSOR-START 00710 CALL CPYSUB(SST,SFLX,START,LEN) 00711 IF(.NOT.(STREQ(SST,KWHILE))) GO TO 32591 00713 EXTYPE=TRWHIL 00713 GO TO 32592 00714 32591 IF(.NOT.(STREQ(SST,KUNTIL))) GO TO 32590 00714 EXTYPE=TRUNTL 00714 32590 CONTINUE 00715 32592 GO TO 32600 00717 32599 IF(.NOT.(STREQ(SST,KSELCT))) GO TO 32589 00717 EXTYPE=TSELCT 00717 GO TO 32600 00718 32589 IF(.NOT.(STREQ(SST,KUNLES))) GO TO 32588 00718 EXTYPE=TUNLES 00718 32588 CONTINUE 00719 32600 GO TO 32624 00721 32601 IF((11).NE.(SST(1))) GO TO 32587 00721 IF (STREQ(SST,KCOND)) EXTYPE=TCOND 00722 32587 CONTINUE 00724 32624 CONTINUE 00725 32626 GO TO 32635 00727 32634 IF((TLP).NE.(CHTYPE)) GO TO 32586 00727 CLASS=TCEXP !MUST BE COND OR SELECT SUBCLAUSE 00727 GO TO 32635 00728 32586 CLASS=TEXEC 00732 EXTYPE=TFORT 00733 32635 GO TO I32746 00736 32720 CONTINUE 00737 32585 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32584 00738 ASSIGN 32583 TO I32708 00738 GO TO 32708 00738 32583 GO TO 32585 00738 32584 FOUND=.FALSE. 00739 IF(.NOT.(CHTYPE.EQ.TLETTR)) GO TO 32582 00740 START=CURSOR 00741 GO TO 32580 00742 32581 IF(CHTYPE.GT.THYPHN) GO TO 32579 00742 32580 ASSIGN 32578 TO I32708 00743 GO TO 32708 00743 32578 IF(CHTYPE.EQ.THYPHN) FOUND=.TRUE. 00744 GO TO 32581 00745 32579 CONTINUE 00746 32582 IF(.NOT.(FOUND)) GO TO 32577 00747 NUNITS=NUNITS+1 00748 UTYPE(NUNITS)=UPINV 00749 USTART(NUNITS)=START 00750 ULEN(NUNITS)=CURSOR-START 00751 32577 GO TO I32720 00753 32723 CONTINUE 00754 32576 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32575 00759 ASSIGN 32574 TO I32708 00759 GO TO 32708 00759 32574 GO TO 32576 00759 32575 IF(CHTYPE.EQ.TEOL.OR.CH.EQ.CINLIN) GO TO 32573 00760 CSAVE=CURSOR 00761 ASSIGN 32572 TO I32720 00762 GO TO 32720 00762 32572 IF(.NOT.(FOUND)) GO TO 32570 00763 ASSIGN 32569 TO I32739 00763 GO TO 32739 00763 32569 GO TO 32571 00763 32570 NUNITS=NUNITS+1 00768 UTYPE(NUNITS)=UFORT 00769 USTART(NUNITS)=CSAVE 00770 ULEN(NUNITS)=SFLX(1)+1-CSAVE 00771 32571 CONTINUE 00773 32573 GO TO I32723 00774 32752 CONTINUE 00775 FLXNO=0 00782 PASS=.FALSE. 00783 DO 32568 I=1,5 00784 ASSIGN 32567 TO I32708 00785 GO TO 32708 00785 32567 IF((TBLANK).NE.(CHTYPE)) GO TO 32565 00787 GO TO 32566 00788 32565 IF((TDIGIT).NE.(CHTYPE)) GO TO 32564 00788 FLXNO=FLXNO*10+CH-CHZERO 00788 GO TO 32566 00789 32564 IF((TEOL).NE.(CHTYPE)) GO TO 32563 00789 GO TO 32566 00790 32563 PASS=.TRUE. !ILLEGAL CHAR IN COL 1-5 00790 32566 CONTINUE 00792 32568 CONTINUE 00792 GO TO I32752 00793 END 00794