Return to OUT2C.f CVS log

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

researchv10 Norman

      SUBROUTINE OUT2C
      INTEGER COM, PCOM, STACK, BL, SYMLEN, OUTUT, S, PLAT
      EXTERNAL EXCH
      COMMON /PARAMS/ INUT, OUTUT, NOCHAR, SYMLEN, I1, I2, I3
      COMMON /COMS/ LCOM, PCOM, COM(300)
      COMMON /CEXPRS/ LSTACK, STACK(620)
      COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
      COMMON /SCR2/ LICOM, ICOM(500)
      DATA BL /1H /, S /1HS/
C
C     PRINTS COM ARRAY
C
      IF (PCOM-1) 80, 80, 10
   10 K1 = SYMLEN + 5
      K = 1
      LCOMS = (PCOM-1)/(SYMLEN+5)
      DO 20 I=1,LCOMS
        ICOM(I) = K
        K = K + K1
   20 CONTINUE
      CALL SSORT(EXCH, COM, LCOM, ICOM, LCOMS, 0)
      WRITE (OUTUT,99999)
99999 FORMAT (///14H1COMMON BLOCKS///1X, 4HNAME, 3X, 3HSET, 1X,
     *    18H DP,COM INT,RL,LOG//)
      DO 70 IBR=1,LCOMS
        I = ICOM(IBR)
        CALL S5UNPK(COM(I), STACK(1), 6)
        DO 30 L=1,3
          II = I + SYMLEN + L
          KK = 7 + L
          STACK(KK) = COM(II)
   30   CONTINUE
        IF (STACK(8)) 40, 40, 50
   40   STACK(8) = BL
        GO TO 60
   50   STACK(8) = S
   60   WRITE (OUTUT,99998) (STACK(II),II=1,6), STACK(8),
     *      (STACK(II),II=9,10)
99998   FORMAT (1X, 6A1, 3X, A1, I8, 3X, I8)
   70 CONTINUE
   80 RETURN
      END

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