SUBROUTINE LDSRCE INTEGER GCHAR INTEGER QUOTEX INTEGER CONTF INTEGER CONTRL INTEGER HEAD INTEGER EJECT INTEGER BLANK INTEGER SLASH INTEGER CARDC INTEGER FLINCT (8) INTEGER EOCC INTEGER ENDCRD (3) INTEGER RECORD (66) INTEGER RECPTR INTEGER SOURCE (150) INTEGER SRCEND INTEGER SLEN INTEGER TF (3) COMMON /SRCE/ QUOTEX COMMON /SRCE/ CONTF COMMON /SRCE/ CONTRL COMMON /SRCE/ HEAD COMMON /SRCE/ EJECT COMMON /SRCE/ BLANK COMMON /SRCE/ SLASH COMMON /SRCE/ CARDC COMMON /SRCE/ FLINCT COMMON /SRCE/ EOCC COMMON /SRCE/ ENDCRD COMMON /SRCE/ RECORD COMMON /SRCE/ RECPTR COMMON /SRCE/ SOURCE COMMON /SRCE/ SRCEND COMMON /SRCE/ SLEN COMMON /SRCE/ TF INTEGER FCHRTS INTEGER SCFLAG INTEGER QMODE INTEGER LBIAS INTEGER SCOUNT INTEGER QINDEX LOGICAL NOTINQ COMMON /SRCEX/ FCHRTS COMMON /SRCEX/ SCFLAG COMMON /SRCEX/ QMODE COMMON /SRCEX/ LBIAS COMMON /SRCEX/ SCOUNT COMMON /SRCEX/ QINDEX COMMON /SRCEX/ NOTINQ INTEGER ADDR, ADRFLG, CUROP, NEXTOP, CFLAG INTEGER PI, XBBL, XA, XF, XZERO, DPVFLG INTEGER LC, LCI, LODLCI, LODLCV, LDLCVO, MAXLCV INTEGER NEXT, NUMBER, I, IOTYPE INTEGER J, K, L, LABNLX, M, N INTEGER PSYMB, SYMBOL, TOP, VALFLG, QVALUE INTEGER OPTOPX, OPNXTX, TOPX, NEXTX INTEGER DUMMY, OVCHN, PEEKS INTEGER LO, CI, CO, LOGICF, LOCSUP INTEGER VAREF, INPUTJ, LCTS, CRUCNT, FLTCNT INTEGER ICLP05 LOGICAL ENDOK,CONEND COMMON /LOGOS/ ADDR, ADRFLG, CUROP, NEXTOP, CFLAG COMMON /LOGOS/ PI, XBBL, XA, XF, XZERO, DPVFLG COMMON /LOGOS/ LC, LCI, LODLCI, LODLCV, LDLCVO, MAXLCV COMMON /LOGOS/ NEXT, NUMBER, I, IOTYPE COMMON /LOGOS/ J, K, L, LABNLX, M, N COMMON /LOGOS/ PSYMB, SYMBOL, TOP, VALFLG, QVALUE COMMON /LOGOS/ OPTOPX, OPNXTX, TOPX, NEXTX COMMON /LOGOS/ DUMMY, OVCHN, PEEKS COMMON /LOGOS/ LO, CI, CO, LOGICF, LOCSUP COMMON /LOGOS/ VAREF, INPUTJ, LCTS, CRUCNT, FLTCNT COMMON /LOGOS/ ICLP05 COMMON /LOGOS/ ENDOK,CONEND INTEGER LISTF, SNLPRT, SUMPRT, SYMFLG INTEGER PRINTF, SKIP, COMPFL (2) INTEGER LOCPRT, USFLGS, NEGFLG, SKNAME (8) INTEGER ORGFLG, CTLUSE, CTLERR, TTL (8) INTEGER DUMFLG INTEGER ICLP01 COMMON /CTLCOM/ LISTF, SNLPRT, SUMPRT, SYMFLG COMMON /CTLCOM/ PRINTF, SKIP, COMPFL COMMON /CTLCOM/ LOCPRT, USFLGS, NEGFLG, SKNAME COMMON /CTLCOM/ ORGFLG, CTLUSE, CTLERR, TTL COMMON /CTLCOM/ DUMFLG COMMON /CTLCOM/ ICLP01 INTEGER LBUF (66) INTEGER LCOUNT INTEGER PGECNT INTEGER UHEAD (15) INTEGER CHEAD (8) INTEGER ICLP09 COMMON /PRT/ LBUF COMMON /PRT/ LCOUNT COMMON /PRT/ PGECNT COMMON /PRT/ UHEAD COMMON /PRT/ CHEAD COMMON /PRT/ ICLP09 INTEGER PLEVEL, STOPS (20) INTEGER CNLSID (9), CNLTLI (9), CNLEND (9) INTEGER CLX, CPLOC (30) INTEGER NESTX, PNESTX INTEGER RELLEV, RELCNT, TRUEF LOGICAL RELPAS INTEGER CMPFLG INTEGER ILB INTEGER BRCT, BROK, TNESTX COMMON /COMP/ PLEVEL, STOPS COMMON /COMP/ CNLSID, CNLTLI, CNLEND COMMON /COMP/ CLX, CPLOC COMMON /COMP/ NESTX, PNESTX COMMON /COMP/ RELLEV, RELCNT, TRUEF COMMON /COMP/ RELPAS COMMON /COMP/ CMPFLG COMMON /COMP/ ILB COMMON /COMP/ BRCT, BROK, TNESTX INTEGER ESMSG (4), NCMSG (4), TS, TS1, IERR DATA ESMSG / '**','*E','S*','**' / DATA NCMSG / '**','*N','C*','**' / 1 CALL SET (XBBL, RECORD, 66) CALL RDLIN (PI, RECORD, SLEN, IERR) IF (.NOT. (IERR .EQ. 9))GO TO 13000 IF (.NOT. (PI .GT. 4))GO TO 13002 CALL CLOSF (PI, IERR) PI = PI - 1 PRINTF = IAND (USFLGS, 1) USFLGS = ISHFT (USFLGS, -1) GO TO 1 13002 CONTINUE CALL FAULTP (82) SKIP = 6 CALL SET (XBBL, RECORD, 66) CALL MOVE (ENDCRD, RECORD, 3) 13000 CONTINUE IF (GCHAR (RECORD, 1) .EQ. 12) GO TO 1 RECPTR = 1 CARDC = CARDC + 1 FLINCT (PI) = FLINCT (PI) + 1 CALL SETCF IF (.NOT. (CONTF .EQ. CONTRL))GO TO 13004 TS = RECORD (2) IF (.NOT. (TS .EQ. HEAD .OR. TS .EQ. EJECT))GO TO 13006 IF (.NOT. (CARDC .LT. 2))GO TO 13008 LCOUNT = 3 13008 CONTINUE SKIP = SKIP + 1 RETURN 13006 CONTINUE 13004 CONTINUE IF (.NOT. (FCHRTS .NE. 0))GO TO 13010 FCHRTS = 0 IF (LCOUNT .NE. 1) CALL NPAGE 13010 CONTINUE IF (.NOT. (PRINTF .NE. 0))GO TO 13012 CALL SET (XBBL, LBUF, 66) CALL ESP (FLINCT (PI), LBUF, 1, 4) CALL LCVSET IF (.NOT. (PNESTX .NE. 1))GO TO 13014 N = 6 DO 13016 TS = 2, PNESTX TS1 = CNLSID (TS - 1) + 1 CALL EST (TF (TS1), LBUF, N, N) N = N + 1 13016 CONTINUE 13014 CONTINUE CALL EST (RECORD, LBUF, 19, 98) IF (SCFLAG .NE. 0) CALL EST (ESMSG, LBUF, 6, 13) 13012 CONTINUE TS = GCHAR (RECORD, RECPTR) - XA IF (.NOT. (TS .GE. 0))GO TO 13018 IF (.NOT. (QMODE .EQ. 0))GO TO 13020 IF (.NOT. (TS .GE. 16))GO TO 13022 TS = ISHFT (COMPFL (2), 16 - TS) GO TO 13023 13022 CONTINUE TS = ISHFT (COMPFL (1), -TS) 13023 CONTINUE IF (.NOT. (IAND (TS, 1) .EQ. 0))GO TO 13024 SKIP = SKIP + 1 CALL EST (NCMSG, LBUF, 6, 13) CALL SGLPRT GO TO 1 13024 CONTINUE CALL PCHAR (RECORD, RECPTR, BLANK) RECPTR = RECPTR + 1 CALL SETCF RECPTR = RECPTR - 1 13020 CONTINUE 13018 CONTINUE SKIP = SKIP + 1 IF (SKIP .LT. 0) CALL EST (NCMSG, LBUF, 6, 13) CALL SGLPRT RETURN END