*
* $Id: epdump.F,v 1.1.1.1 1996/03/08 15:22:01 mclareni Exp $
*
* $Log: epdump.F,v $
* Revision 1.1.1.1  1996/03/08 15:22:01  mclareni
* Epio
*
*
C     PROGRAM EPTEST(TAPE10,TAPE5,OUTPUT)
*  EPIO dump program
*  Inputs are     LUN  Logical input unit for epio file
*       Words/record and no. of records to print but the whole file is
*         always read
*       No. of blocks to skip before starting to dump (normally 0)
*
      LOGICAL LHEAD, INTRAC
      DIMENSION IBUF(8190),IREC(16000)
#include "epio/epiocom.inc"
      DATA LBUF/16380/, LREC/32000/
      DATA MINDAT/999999/, MINHEA/999999/, MAXDAT/0/, MAXHEA/0/
      DATA NREC/0/, LHEAD/.FALSE./, MAXERR/5  /, NERR/0/,
     1 LUN/1/,  MAXNW/100/, MAXLOG/10/, NSKIPB/0/
C       READ DATA CARDS
      IF(INTRAC(D))THEN
      PRINT *,' TYPE LUN, WORDS/REC, NO. OF RECORDS, BLOCKS TO SKIP,
     1   EG 1 10 5 0'
      READ (5,*,END=5)LUN,MAXNW,MAXLOG,NSKIPB
      ENDIF
  5   PRINT 901
 901  FORMAT(' +++ EP DUMP REQUESTED')
      IF(MAXNW.GT.LREC )THEN
      PRINT 902
 902  FORMAT(' ',22X,'OF ALL WORDS')
      MAXNW=LREC
      ELSE
      PRINT 903,MAXNW
 903  FORMAT(' ',22X,'OF THE FIRST',I6,' WORDS')
      END IF
      PRINT 904,MAXLOG
 904  FORMAT(23X,'OF THE FIRST',I6,' LOGICAL RECORDS')
      IF(NSKIPB.GT.0)PRINT 905,NSKIPB
 905  FORMAT(23X,'AFTER SKIPPING',I6,' BLOCKS')
C--     INITIALISE
      CALL EPIOT(6)
      CALL EPINIT
      CALL EPSETW(LUN,1,LBUF,IERR)
      CALL EPSETW(LUN,2,LREC,IERR)
      CALL EPSETW(LUN,27,1,IERR)
C     CALL EPSETW(LUN,25,1,IERR)
      CALL EPSTAT
C--      SKIP BLOCKS
      DO 10 I=1,NSKIPB
      CALL EPREAD(LUN,30,NW,IREC,IBUF,IERR)
      PRINT*, ' BLOCK NO ', I, ' SKIPPED'
      IF(IERR.EQ.0)GOTO 10
      IF(IERR.EQ.3)GOTO 500
      NERR=NERR+1
      CALL EPSTAT
      IF(NERR.GT.MAXERR)THEN
      PRINT 910
      GOTO 500
      ENDIF
 10   CONTINUE
       IF(NSKIPB.GT.0)THEN
      PRINT 906,NSKIPB,NW
 906  FORMAT(/,' +++ PHYSICAL HEADER OF BLOCK NUMBER',I6,'  LENGTH=',I6,
     1 ' 16-BIT WORDS')
      WRITE(*,'(6Z10)')(IBUF(I),I=1,24)
      CALL PRTDMP(NW,IREC)
CDEB  CALL EPSTAT
        ENDIF
      MAXBLS=LIST(ISTART+14)
      MINBLS=LIST(ISTART+14)
 100  CONTINUE
      IF(LIST(ISTART+17).EQ.1)THEN
         MODE=2
         LHEAD=.FALSE.
      ELSE
      LHEAD=.NOT.LHEAD
      IF(LHEAD)MODE=20
      IF(.NOT.LHEAD)MODE=12
      IF(NREC.GT.MAXLOG)MODE=2
      ENDIF
      CALL EPREAD(LUN,MODE,NW,IREC,IBUF,IERR)
      IF(IERR.NE.0) THEN
         IF(IERR.EQ.3)GOTO 500
         NERR=NERR+1
         CALL EPSTAT
          WRITE(*,'(6Z10)')(IBUF(I),I=1,24)
         IF(NERR.GT.MAXERR)THEN
            PRINT 910
            GOTO 500
         ENDIF
      GOTO 100
      ENDIF
      IF(MODE.NE.12)NREC=NREC+1
      MINHEA=MIN(MINHEA,LIST(ISTART+21))
      MAXHEA=MAX(MAXHEA,LIST(ISTART+21))
      MINDAT=MIN(MINDAT,LIST(ISTART+20),NW)
      MAXDAT=MAX(MAXDAT,LIST(ISTART+20))
      IF(LIST(ISTART+14).GT.0)MINBLS=MIN(MINBLS,LIST(ISTART+14))
      MAXBLS=MAX(MAXBLS,LIST(ISTART+14))
CDEB  PRINT*,MAXBLS,MINBLS,LIST(ISTART+14)
      IF(NREC.LE.MAXLOG)THEN
      IF(LHEAD)PRINT 907,NREC,NW
 907  FORMAT(/,' +++ HEADER OF LOGICAL RECORD NO.',I6,'  LENGTH=',I6,/)
      IF(.NOT.LHEAD)PRINT 908,NREC,NW
 908  FORMAT(/,' +++ DATA OF LOGICAL RECORD NO.  ',I6,'  LENGTH=',I6,/)
      NW=MIN(NW,MAXNW)
      IF(NW.GT.0 .AND. NREC.LE.MAXLOG)CALL PRTDMP(NW,IREC)
      ENDIF
      GOTO 100
 500  CONTINUE
      NBLK=LIST(ISTART+11)-NSKIPB +1
      CALL EPSTAT
      PRINT 909,NREC,NBLK,MINHEA,MAXHEA,MINDAT,MAXDAT,MINBLS,MAXBLS
 909  FORMAT(/,' +++ NO. OF LOGICAL RECORDS      =',I7,
     1       /,' +++ NO. OF BLOCKS               =',I7,
     1       /,' +++ MINIMUM LOGICAL HEADER LENGTH        =',I7,
     1       /,' +++ MAXIMUM LOGICAL HEADER LENGTH        =',I7,
     1       /,' +++ MINIMUM LOGICAL DATA LENGTH          =',I7,
     1       /,' +++ MAXIMUM LOGICAL DATA LENGTH          =',I7,
     1       /,' +++ MINIMUM BLOCK LENGTH (SAMPLE)        =',I7,
     1       /,' +++ MAXIMUM BLOCK LENGTH (SAMPLE)        =',I7)
  910 FORMAT(/,' +++ MAXIMUM NUMBER OF ERROR MESSAGES EXCEEDED')
      STOP
      END
      SUBROUTINE PRTDMP(NW,IREC)
      DIMENSION IREC(1)
      DATA NWPERL/10/
 901  FORMAT(1X,I5,'- ',5I7,2X,5I7)
 902  FORMAT(/,28X,'DUMP IN 16-BIT INTEGERS',/)
      IF(NW.LE.0)RETURN
      PRINT 902
      J=1
      IW=0
      NLINES=NW/NWPERL
      DO 10 II=1,NLINES
      K=J+NWPERL-1
      PRINT 901,IW,(IREC(I),I=J,K)
      J=J+NWPERL
      IW=IW+NWPERL
 10   CONTINUE
      NLEFT=NW-NLINES*NWPERL
      K=J+NLEFT-1
      IF(NLEFT.GT.0)PRINT 901,IW,(IREC(I),I=J,K)
      RETURN
      END