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