Return to OUT2A.f CVS log

Up to [Research Unix] / researchv10no / cmd / pfort

Annotation of researchv10no/cmd/pfort/OUT2A.f, revision 1.1.1.1

1.1       root        1:       SUBROUTINE OUT2A( IT, JJ, N, ISW )
                      2: C
                      3: C     IT CONTINAS TITLE FOR FIRST LINE OF OUTPUT
                      4: C     JJ CONTAINS NUMBER OF CHARS IN TITLE, J<=25
                      5: C     N CONTAINS NUMBER OF ELEMENTS TO BE PRINTED
                      6: C     ISW TELLS IF THESE ARE COMMON NAMES OR PROC NAMES
                      7: C
                      8:       INTEGER IT(25), II(25), BL, PLAT, PCOM, COM, STACK, OUTUT, S
                      9:       INTEGER BUF(54)
                     10:       COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
                     11:       COMMON /PARAMS/ II1, OUTUT, II2, II3, II4, II5, II6
                     12:       COMMON /CEXPRS/ LSTACK, STACK(620)
                     13:       COMMON /COMS/ LCOM, PCOM, COM(300)
                     14:       DATA BL/1H /,S/1HS/
                     15: C
                     16: C     UNPACK TITLE
                     17: C
                     18:       NN = JJ
                     19:       IF(JJ.GT.25) NN=25
                     20:       CALL S5UNPK( IT(1), II(1), NN)
                     21:       K1 = NN + 1
                     22:       IF(K1.GT.25) GOTO 15
                     23:       DO 10 K =K1, 25
                     24:         II(K) = BL
                     25:  10   CONTINUE
                     26: C
                     27: C     SETUP FIRST LINE OF ELEMENTS
                     28: C
                     29:  15   K = 6
                     30:       IF (K.GT.N) K = N
                     31:       IB = 1
                     32:       DO 50 I = 1, K
                     33:         IL = STACK(I)
                     34:         GOTO (20, 30),ISW
                     35: C       FOR PARE OR DESC LISTS
                     36:  20     CALL S5UNPK( LAT(IL), BUF(IB), 6 )
                     37:         BUF(IB + 7) = BL
                     38:         GOTO 40
                     39: C       FOR COMMON LISTS- INDEX TO ELEMENTS IS NEGATIVE
                     40: C       IF COMMON IS SET BY PGM UNIT
                     41:  30     BUF(IB + 7) = BL
                     42:         IF(IL.LT.0) BUF(IB + 7) = S
                     43:         IL = IABS(IL)
                     44:         CALL S5UNPK( COM(IL), BUF(IB), 6 )
                     45:  40     BUF(IB + 6) = BL
                     46:         BUF(IB + 8) = BL
                     47:         IB = IB + 9
                     48:  50   CONTINUE
                     49:       IB = IB - 1
                     50:       WRITE(OUTUT,99999) (II(L),L=1,25), (BUF(I),I=1,IB)
                     51: 99999 FORMAT(80A1)
                     52:       IF(K.EQ.N) GOTO 110
                     53: C       WRITE SUBSEQUENT LINES
                     54:  60   IB = 1
                     55:       K1 = K + 1
                     56:       K = K + 6
                     57:       IF (K.GT.N) K = N
                     58:       DO 100 I = K1, K
                     59:         IL = STACK(I)
                     60:         GOTO (70, 80), ISW
                     61: C       FOR PAR OR DESC LISTS
                     62:  70     CALL S5UNPK( LAT(IL), BUF(IB), 6 )
                     63:         BUF(IB + 7) = BL
                     64:         GOTO 90
                     65: C     FOR   COMMON LISTS
                     66:  80     BUF(IB + 7) = BL
                     67:         IF(IL.LT.0) BUF(IB + 7) = S
                     68:         IL = IABS(IL)
                     69:         CALL S5UNPK( COM(IL), BUF(IB), 6 )
                     70:  90     BUF(IB + 6) = BL
                     71:         BUF(IB +8) = BL
                     72:         IB = IB + 9
                     73:  100  CONTINUE
                     74:       IB = IB - 1
                     75:       WRITE(OUTUT,99998) (BUF(I),I =1,IB)
                     76: 99998 FORMAT(25X,55A1)
                     77:       IF(K.LT.N) GOTO 60
                     78:  110  RETURN
                     79:       END

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.