*
* $Id: eptotape.F,v 1.1.1.1 1996/03/08 15:21:59 mclareni Exp $
*
* $Log: eptotape.F,v $
* Revision 1.1.1.1  1996/03/08 15:21:59  mclareni
* Epio
*
*
* PROGRAM FOR COPYING EP-FILES FROM DISK TO TAPE
#if defined(CERNLIB_UNIVAC)
#include "sys/CERNLIB_machine.h"
#include "_epio/pilot.h"
C     PROGRAM EPTOTAPE COPIES EP-FORMATTED UNIVAC DISK FILES TO TAPE
C       BLOCK BY BLOCK. IN EACH BLOCK, THE FIRST WORD CONTAINING
C       ('EP',BLOCK LENGTH) IS THUS STRIPPED OFF AND THE REST MAKES ONE
C       TAPEBLOCK.
C     THE PROGRAM WILL, IF RUN IN DEMAND, QUERY FOR THE INPUT FILE NAMES.
C     THE OUTPUT TAPE MUST BE ASSIGNED USING THE NAME EPTAPE.
C
      PARAMETER NBUF=5000
      IMPLICIT INTEGER (A-Z)
      LOGICAL DEMAND,DEM
      CHARACTER*48 INFILE
      CHARACTER*1 INFILC(48)
      DIMENSION BUF(NBUF)
      DATA DFIL/'EP$IN 'F/,TFIL/'EP$TP 'F/,IEOF/'EOFM'/
      DATA EP/O000000105120/
C
C     DUMMY READ FOR ENABLING PROCESSOR CALL
C
      READ(5,17)
C
C     DEMAND RUN ?
C
      DEM=DEMAND(IDUM)
C
C     CHECK TAPE FILE ASSIGNMENT
C
      ISTAT=FACSF2('@USE EP$TP,EPTAPE . ')
      IOD=IODEV('EP$TP')
      IF(IOD.LE.0) THEN
        WRITE(6,*) '  NO TAPE NAMED EPTAPE IS ASSIGNED'
        STOP 'PROGRAM TERMINATED'
       ELSE IF(IOD.GE.16) THEN
        WRITE(6,*) '  EPTAPE IS A DISK FILE, NOT TAPE'
        STOP 'PROGRAM TERMINATED'
       ENDIF
      NFITOT=0
      NBLTOT=0
      IQUE=0
  100 CONTINUE
      IF(DEM) WRITE(6,*) '  ENTER FILENAME OR @EOF'
      READ(5,'(A48)',END=400) INFILE
      DO 110 I=1,48
  110 INFILC(I)=INFILE(I:I)
      IQUE=IQUE+1
      I1=1
      DO 120 I=1,48
      IF(INFILC(I).NE.' ') GOTO 130
  120 I1=I+1
  130 CONTINUE
      I2=48
      DO 140 I=48,1,-1
      IF(INFILC(I).NE.' ') GOTO 150
  140 I2=I-1
  150 CONTINUE
      IF(I1.GT.I2) THEN
        WRITE(6,10) INFILE
        GOTO 180
       ENDIF
      ISTAT=FACSF2('@USE EP$IN.,'//INFILE(I1:I2)//' . ')
      IF(ISTAT.NE.0) THEN
        WRITE(6,11) (INFILC(I),I=I1,I2)
        GOTO 180
       ENDIF
C
C     CHECK DEVICE
C
      IOD=IODEV('EP$IN')
      IF(IOD.LE.0) THEN
        ISTAT=FACSF2('@ASG,A EP$IN . ')
        IOD=IODEV('EP$IN')
       ENDIF
      IF(IOD.LE.0) THEN
        WRITE(6,12) (INFILC(I),I=I1,I2)
        GOTO 180
       ENDIF
      IF(IOD.LT.16) THEN
        WRITE(6,13) (INFILC(I),I=I1,I2)
        GOTO 180
       ENDIF
      GOTO 190
C
C     ERROR. ABORT IF BATCH, OTHERWISE TRY AGAIN BUT AT MOST THREE TIMES
C
  180 IF(.NOT.DEM) CALL FABORT
      IF(IQUE.LT.3) GOTO 100
      STOP 'ABNORMAL TERMINATION'
C
C     ALL CHECKS DONE. START TO COPY.
C
  190 NBLOCK=0
      IADD=0
      IQUE=0
C
C     GET NEW FULL BUFFER
C
  200 CALL FIOR(DFIL,BUF,NBUF,IADD,ISTAT)
      IF(ISTAT.NE.-5.AND.ISTAT.LT.0) THEN
C
C     I/O ERROR
C
        WRITE(6,14) ISTAT,IADD,(INFILC(I),I=I1,I2)
        GOTO 300
       ENDIF
      J1=1
  210 IF(BUF(J1).EQ.IEOF) GOTO 300
      EPR=BITS(BUF(J1),1,18)
      IF(EPR.NE.EP) THEN
C
C     LEFT HALF OF BUF(J1) DOES NOT CONTAIN 'EP'. NO FIXUP POSSIBLE
C
        WRITE(6,19) BUF(J1),NBLOCK,J1,(INFILC(I),I=I1,I2)
        STOP 'ABNORMAL TERMINATION'
      ENDIF
      NW=BITS(BUF(J1),19,18)
      J2=J1+NW
      IF(J2.GT.NBUF) GOTO 200
      CALL TIOW(TFIL,BUF(J1+1),NW,ISTAT)
      IF(ISTAT.NE.NW) THEN
C
C     I/O ERROR ON OUTPUT TAPE
C
        WRITE(6,15) ISTAT,NBLOCK,NFITOT
        IF(DEM) STOP
        CALL FABORT
       ENDIF
      ISEC=(NW+28)/28
      IADD=IADD+ISEC
      J1=J1+ISEC*28
      NBLOCK=NBLOCK+1
      GOTO 210
C
C     WRITE EOF ON OUTPUT TAPE
C
  300 CALL TIOWEF(TFIL,ISTAT)
      CALL TIOWEF(TFIL,ISTAT)
      CALL TIOMVF(TFIL,-1,ISTAT)
      NBLTOT=NBLTOT+NBLOCK
      IF(NBLOCK.GT.0) NFITOT=NFITOT+1
      WRITE(6,16) NBLOCK,NFITOT,(INFILC(I),I=I1,I2)
      GOTO 100
  400 WRITE(6,17) NFITOT,NBLTOT
      WRITE(6,18)
      STOP
   10 FORMAT('  INCORRECT FILENAME READ: ',A48)
   11 FORMAT('  STATUS',O14,' FOR @USE EP$IN.,',48A1)
   12 FORMAT('  FILE IS NOT CATALOGUED OR ASSIGNED: ',48A1)
   13 FORMAT('  INPUT FILE IS A TAPEFILE. COPY BY OTHER MEANS !')
   14 FORMAT('  STATUS',O14,' RETURNED FOR IADD=',I8,' ON FILE ',48A1)
   15 FORMAT('  STATUS',O14,' RETURNED FOR BLOCK ',I4,' , FILE NO ',
     1 I3,' ON OUTPUT TAPE')
   16 FORMAT(I6,' BLOCKS COPIED TO FILE NO',I3,' FROM ',48A1)
   17 FORMAT(I5,' FILES COPIED, TOTALLY ',I8,' BLOCKS')
   18 FORMAT('  NORMAL PROGRAM TERMINATION')
   19 FORMAT('  INCORRECT CONTROL WORD',O14,'. NBLOCK=',I3,' J1=',I5,
     1 /,'  ON FILE ',48A1)
      END
#endif