Return to OUT2A.f CVS log

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

Annotation of researchv10dc/cmd/pfort/OUT2A.f, revision 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.