Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50212/dump.f4
There are no other files named dump.f4 in the archive.
C DUMPS RECORD ON LPT IN FREE FORMAT
SUBROUTINE DUMP(IB)
DIMENSION IB(1), IPAR(10), IFRMAT(3,1), IFORM(50)
COMMON IDF,LFR,NAVR,MAXR,NSPR,LSR,LFMT,NCPR,C1,C2,IFRMAT
EQUIVALENCE (IPAR(1),IDF)
LOGICAL ALPHA
C DUMP THE RECORD
C
LIMIT = NSPR*10
LINE = 1
C PRINT HEADING
WRITE(3,100)
100 FORMAT(/13X'1*'9X'2*'9X'3*'9X'4*'9X'5*'9X'6*'
19X'7*'9X'8*'9X'9*'9X'10*')
MIN = 1
C
1 CONTINUE
C
DO 2 I=1,35
2 IFORM(I)=' '
C
NSPAC=0
ALPHA=.FALSE.
MAX=MIN+9
K=3
IFORM(K-2)='(1XI3'
IFORM(K-1)=',1H*'
IFORM( K)='2X'
C
C
DO 10 I=MIN,MAX
IF(IABS(IB(I)).GT.9 999 999 999) GO TO 5
K=K+2
IFORM(K-1)='I11'
IFORM( K)=','
ALPHA=.FALSE.
GO TO 10
C
5 CONTINUE
NSPAC=NSPAC+6
IF(ALPHA) GO TO 7
K=K+1
NREM=K
7 CONTINUE
ALPHA=.TRUE.
K=K+2
IFORM(K-1)='A5'
IFORM( K)=','
IF(NSPAC.EQ.0) GO TO 10
IF((I.NE.MAX).AND.(IABS(IB(I+1)).GT.9 999 999 999)) GO TO 10
NSPAC=NSPAC/2
IFORM(NREM)=ISHIFT(INCODE(NSPAC),7)+"260
K=K+1
IFORM(K) = IFORM(NREM)
NSPAC=0
10 C O N T I N U E
C
IF(IFORM(K).NE.',')K=K+1
IFORM(K)=')'
C
WRITE(3,IFORM) LINE,(IB(I),I=MIN,MAX)
LINE = LINE+10
IF(MAX.EQ.LIMIT) R E T U R N
MIN=MAX+1
G O T O 1
END