SUBROUTINE PUTFOR (LEFT, RIGHT, ENNTRY) C C PUTFOR writes card images from array LST to LUN OUTFIL. C Images are formed beginning at LEFT of LST and ending at C RIGHT of LST. If the statement is too long to fit on one C line, PUTFOR divides it up and inserts continuation characters C in column 6. C IMPLICIT INTEGER (A - Z) LOGICAL*1 LIST, CONLBL, LABEL, PLUS, BLANK, LST, LHEAD LOGICAL*1 WORK COMMON /FORCOM/ ERRS, ITYPE, L, KIND, IP, INFILE, OUTFIL, LOUT, + LISTNG, PLINES, LPPAGE, LABEL(66), LHEAD(6), LIST(1320), CONLBL(6) DIMENSION WORK(5), LST(1326) EQUIVALENCE (LST(1), LHEAD(1)) DATA BLANK, PLUS /' ', '+'/ C C **************************************************************** C GO TO (31700, 31800, 31900), ENNTRY 31700 LABEL(6) = BLANK LL = LEFT R = RIGHT + 6 32098 IF (LL .GT. R) RETURN K = LL + 65 IF (K .GT. R) K = R IF (CONLBL(5) .NE. BLANK) GO TO 32095 WRITE (OUTFIL, 1) (LABEL(Z), Z = 1,6), (LST(Z), Z = LL,K) 1 FORMAT (80A1) GO TO 32096 C 32095 IF (LABEL(5) .NE. BLANK) GO TO 32094 WRITE (OUTFIL, 1) (CONLBL(Z), Z=1,6), (LST(Z), Z = LL,K) CONLBL(5) = BLANK GO TO 32096 C 32094 WRITE (OUTFIL, 2) (CONLBL(Z), Z=1,6) 2 FORMAT (6A1, 'CONTINUE') WRITE (OUTFIL, 1) (LABEL(Z), Z = 1,6), (LST(Z), Z = LL,K) CONLBL(5) = BLANK C Put blanks in LABEL 32096 DO 20 I = 1,5 LABEL(I) = BLANK 20 CONTINUE LABEL(6) = PLUS LL = K + 1 GO TO 32098 C C Convert stmt number in RIGHT to alpha and put it in WORK 31800 CALL INTALP (RIGHT, WORK) IF (CONLBL(5) .NE. BLANK) GO TO 32092 WRITE (OUTFIL, 3) (WORK(Z), Z=1,5) 3 FORMAT (' GO TO ', 6A1) RETURN C 32092 WRITE (OUTFIL, 4) (CONLBL(Z), Z=1,6), (WORK(Z), Z=1,5) 4 FORMAT (6A1, 'GO TO ', 5A1) CONLBL(5) = BLANK RETURN C 31900 IF (LEFT .LT. 0) RETURN IF (CONLBL(5) .NE. BLANK) WRITE (OUTFIL,2) (CONLBL(Z), Z=1,6) IF (LEFT .LE. 0) GO TO 32090 C Convert stmt number in LEFT to alpha and put it in CONLBL CALL INTALP (LEFT, CONLBL) RETURN C 32090 CALL COPY (5, LABEL, CONLBL) RETURN END