C 3000 GO TO 9400 C%%A-RCB-0077-SL-12 LST -- 31 LOOK FOR END ON PREVIOUS LINE (FOR) C Events: 1 Last line was not END C 2 Last line was END C C ISTRT is increased by 5 to skip over the line number at the start of C the line. C 3100 IEVENT = 1 ISTRT = MOD(NBUF+1,2)*NHALF + 1 ISTOP = ISTRT + NHALF - 1 ISTRT = ISTRT + 5 IPTR = 0 DO 3160 I = ISTRT,ISTOP IF(BUFFER(I).LE.BLANK) GO TO 3160 IPTR = IPTR + 1 IF(IPTR.GT.3) GO TO 10 IF(BUFFER(I).NE.BEND(IPTR)) GO TO 10 3160 CONTINUE IF(IPTR.EQ.3) IEVENT = 2 GO TO 10 C%%A-RCB-0077-SL-12 LST -- 32 LOOK FOR 'STORAGE' (FOR) C Events: 1 STORAGE not found C 2 STORAGE found C 3200 IEVENT = 1 IPTR = IFIRST + IOFFST - 1 DO 3240 I = 1,NMASK IF(BUFFER(IPTR).NE.BMASK(I)) GO TO 10 IPTR = IPTR + 1 3240 CONTINUE IEVENT = 2 GO TO 10 C%%A-RCB-0077-SL-12 LST -- 33 PRINT MAP SUBHEADING FOR 'FOR' C Event: 1 C 3300 IEVENT = 1 WRITE(LUW,3310) 3310 FORMAT(33X,'NAME OFFSET ATTRIBUTES'/) ILINE = ILINE + 2 GO TO 10 C%%A-RCB-0077-SL-12 LST -- 34 MAP PRINTING FOR 'FOR' C Events: 1 Normal C 2 Page full C 3400 IEVENT = 1 IF(BUFFER(IFIRST).LT.BLANK) GO TO 3420 WRITE(LUW,3410) (BUFFER(I), I=IFIRST,ILAST) 3410 FORMAT(33X,100A1) ILINE = ILINE + 1 GO TO 3480 C C Special treatment for COMMON blocks 3420 IFIRST = IFIRST + 1 WRITE(LUW,3430) (BUFFER(I), I=IFIRST,ILAST) 3430 FORMAT('0',32X,100A1) WRITE(LUW,3435) 3435 FORMAT(' ') ILINE = ILINE + 3 C 3480 IF(ILINE.GE.MAXLIN) IEVENT = 2 GO TO 10 C%%A-RCB-0077-SL-12 LST -- 35 INITIALIZE HEADER FOR 'FOR' C Event: 1 C C Notes on FOR listing format C C The compiler shifts the source code by 6 columns. This puts the % C in column 8. Hardware tabs are in columns 1, 9, 17, 25, 33, etc. C Thus, we shift the listing by a further 18 columns to give a 24-column C shift (3 tabs). For symmetry, we leave 18 blanks on the right also, C leaving 94 columns of print (columns 19 to 114). C The map header is identified by 'STORAGE' starting in column 13. The C map has internal tabs, so we shift it to start in column 33 (4 tabs). C 3500 IEVENT = 1 C CALL DATE(BWORK) BWORK(5) = BWORK(5) + 32 BWORK(6) = BWORK(6) + 32 CALL TIME(BWORK(10)) C IPTR = ILAST DO 3520 I = 1,NCHAR IF(BUFFER(IPTR).LE.BLANK) GO TO 3525 IPTR = IPTR - 1 3520 CONTINUE C 3525 IPTR = IPTR + 1 ISTOP = MIN(ILAST,IPTR+49) ENCODE (HD2LNG,3530,BHEAD2) BVERSN,(BWORK(I), I=1,17), 1 (BUFFER(I), I=IPTR,ISTOP) 3530 FORMAT (X,T19,'FORTRAN IV ',16A1,T96,9A1,2X,8A1,T46,50A1) C INDENT = 18 IPERPT = 7 IOFFST = 13 NMASK = 7 ENCODE(NMASK,3570,BMASK) 3570 FORMAT('STORAGE') GO TO 10 C%%A-RCB-0077-SL-12 LST -- 36 INITIALIZE HEADER FOR 'F4P' C Event: 1 C C Notes on F4P listing format C C The compiler shifts the source code by 8 columns (1 tab). This puts C the % in column 10. We shift the listing by a further 24 columns to give C a 32-column shift (3 tabs). For symmetry, we leave 24 blanks on the right C also, leaving 84 columns of print (columns 25 to 108). C The start of the map is identified by 'PR' at the start of the third C line of the page. The map is wide and has internal tabs, so we shift it C by only 8 columns. The map ends with either 'TO' or 'NO' in columns 1 and C 2. C 3600 IEVENT = 1 C CALL DATE(BWORK) BWORK(5) = BWORK(5) + 32 BWORK(6) = BWORK(6) + 32 CALL TIME(BWORK(10)) C ISTOP = MIN(ILAST,IFIRST+34) DO 3620 I = IFIRST,ISTOP IF(BUFFER(I).LT.BLANK) BUFFER(I) = BLANK 3620 CONTINUE C ENCODE (HD2LNG ,3630,BHEAD2) BVERSN,(BWORK(I), I=1,17), 1 (BUFFER(I), I=IFIRST,ISTOP) 3630 FORMAT (X,T25,'FORTRAN IV-PLUS ',16A1,T90,9A1,2X,8A1, 1 T55,35A1) C INDENT = 24 IPERPT = 9 C ENCODE(8,3650,BMASK) 3650 FORMAT('PRTONONU') C GO TO 10 C 3700 GO TO 9400 C%%A-RCB-0077-SL-12 LST -- 38 LOOK FOR START OF F4P MAP C Events: 1 Normal C 2 Start of map C 3800 IEVENT = 1 IF(BUFFER(IFIRST).NE.BMASK(1)) GO TO 10 IF(BUFFER(IFIRST+1).NE.BMASK(2)) GO TO 10 IEVENT = 2 GO TO 10 C%%A-RCB-0077-SL-12 LST -- 39 PRINT F4P MAP LINE C Events: 1 Normal C 2 Page full C C The map has internal tabs (headers use spaces) and its width is 119 C columns. We shift it by 8 columns (1 tab), so data appear in columns C 9 to 127 and there are 5 blanks at the end. C 3900 IEVENT = 1 WRITE(LUW,3910) (BUFFER(I), I = IFIRST,ILAST) 3910 FORMAT(9X,124A1) ILINE = ILINE + 1 IF(ILINE.GE.MAXLIN) IEVENT = 2 GO TO 10