Return to OUT2C.f CVS log

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

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

1.1       root        1:       SUBROUTINE OUT2C
                      2:       INTEGER COM, PCOM, STACK, BL, SYMLEN, OUTUT, S, PLAT
                      3:       EXTERNAL EXCH
                      4:       COMMON /PARAMS/ INUT, OUTUT, NOCHAR, SYMLEN, I1, I2, I3
                      5:       COMMON /COMS/ LCOM, PCOM, COM(300)
                      6:       COMMON /CEXPRS/ LSTACK, STACK(620)
                      7:       COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
                      8:       COMMON /SCR2/ LICOM, ICOM(500)
                      9:       DATA BL /1H /, S /1HS/
                     10: C
                     11: C     PRINTS COM ARRAY
                     12: C
                     13:       IF (PCOM-1) 80, 80, 10
                     14:    10 K1 = SYMLEN + 5
                     15:       K = 1
                     16:       LCOMS = (PCOM-1)/(SYMLEN+5)
                     17:       DO 20 I=1,LCOMS
                     18:         ICOM(I) = K
                     19:         K = K + K1
                     20:    20 CONTINUE
                     21:       CALL SSORT(EXCH, COM, LCOM, ICOM, LCOMS, 0)
                     22:       WRITE (OUTUT,99999)
                     23: 99999 FORMAT (///14H1COMMON BLOCKS///1X, 4HNAME, 3X, 3HSET, 1X,
                     24:      *    18H DP,COM INT,RL,LOG//)
                     25:       DO 70 IBR=1,LCOMS
                     26:         I = ICOM(IBR)
                     27:         CALL S5UNPK(COM(I), STACK(1), 6)
                     28:         DO 30 L=1,3
                     29:           II = I + SYMLEN + L
                     30:           KK = 7 + L
                     31:           STACK(KK) = COM(II)
                     32:    30   CONTINUE
                     33:         IF (STACK(8)) 40, 40, 50
                     34:    40   STACK(8) = BL
                     35:         GO TO 60
                     36:    50   STACK(8) = S
                     37:    60   WRITE (OUTUT,99998) (STACK(II),II=1,6), STACK(8),
                     38:      *      (STACK(II),II=9,10)
                     39: 99998   FORMAT (1X, 6A1, 3X, A1, I8, 3X, I8)
                     40:    70 CONTINUE
                     41:    80 RETURN
                     42:       END

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