*S~ SUBROUTINE PUTFOR (LEFT, RIGHT, IARG) C C PUTFOR writes to LUN OUTFIL the card images from LST. Images C are formed beginning in column LEFT of LST and ending in column C RIGHT of LIST. If the statement is too long to fit on one line, C PUTFOR divides it up and inserts continuation characters in C column 6. C Revision History: C 19-JAN-81 Character variables changed to type BYTE C 19-JAN-81 IFTCOM common rearranged C 26-JAN-81 Removed ENTRY calls and substituted IARG switch C 31-MAR-81 Changed continuation char to + (ASCII 43) IMPLICIT INTEGER (A - Z) BYTE WORK, LST, ICONT, BLANK BYTE LABEL, LHEAD, LIST, CONLBL LOGICAL*1 LISTNG, PASCOM ; Listing, pass comments flag COMMON /IFTCOM/ DONE, INFILE, IP, KIND, L, LNUM, LOUT, OUTFIL, + ERRCNT, LISTNG, PASCOM, CONLBL(6), LABEL(66), LHEAD(6), LIST(1320) DIMENSION WORK(5), LST(1326) EQUIVALENCE (ICONT, LABEL(6)), (LST(1), LHEAD(1)) DATA BLANK /' '/ GO TO (100, 200, 300), IARG ; Change code done on switch 100 ICONT = BLANK ; Original PUTFOR code LL = LEFT R = RIGHT + 6 WHILE (LL .LE. R) K = LL + 65 IF (K .GT. R) K = R IF (CONLBL(5) .EQ. BLANK) WRITE (OUTFIL, 1) (LABEL(Z), Z = 1, 6), (LST(Z), Z = LL, K) 1 FORMAT (80A1) OR IF (LABEL(5) .EQ. BLANK) WRITE (OUTFIL, 1) CONLBL, (LST(Z), Z = LL, K) CONLBL(5) = BLANK ELSE WRITE (OUTFIL, 2) CONLBL 2 FORMAT (6A1, 'CONTINUE') WRITE (OUTFIL, 1) (LABEL(Z), Z = 1, 6), (LST(Z), Z = LL, K) CONLBL(5) = BLANK END IF FOR I = 1, 5 LABEL(I) = BLANK END FOR ICONT = 43 ; Use + for continuation indicator LL = K + 1 END WHILE RETURN 200 CALL INTALP (RIGHT, WORK) ; Used to be PUTGT IF (CONLBL(5) .EQ. BLANK) WRITE (OUTFIL, 3) WORK 3 FORMAT (6X, 'GO TO ', 6A1) ELSE WRITE (OUTFIL, 4) CONLBL, WORK 4 FORMAT (6A1, 'GO TO ', 5A1) CONLBL(5) = BLANK END IF RETURN 300 IF (LEFT .LT. 0) RETURN ; Used to be PUTCON IF (CONLBL(5) .NE. BLANK) WRITE (OUTFIL, 2) CONLBL IF (LEFT .GT. 0) CALL INTALP (LEFT, CONLBL) ELSE CALL COPY (5, LABEL, CONLBL) END IF RETURN END