C     PROGRAM NAME:   COPYMT.FOR   V03.02   SBK   12/06/76   DOS V 9.20C
C
C FOR COPYMT/NOSN,LP=COPYMT
C TKB
C TKB>COPYMT/CP,LP=COPYMT,LB[1,1]SYSLIB/LB:$SHORT
C TKB>DEVLIB/LB(FOR MAKBUF)
C TKB>/
C TKB>UNITS=3
C TKB>ACTFIL=1
C TKB>MAXBUF=80
C TKB>ASG=TI:3
C TKB>//
C
      PROGRAM COPYMT
C
      BYTE IBM(18)
C
      INTEGER INPUT,OUTPUT,RECD
C
      REAL DAT(3),TIM(2)
C
      DATA LOOP/0/
C
      CALL DATE(DAT)
      CALL TIME(TIM)
C
      WRITE(3,120) DAT,TIM
      READ(3,130,END=100) IRS
      WRITE(3,210)
      READ(3,130,END=100) IOR
      GO TO 20
C
10    IF (IFLG.EQ.0) GO TO 30
20    WRITE(3,140)
      READ(3,130,END=100) IBS
      IF (LOOP.EQ.0) GO TO 40
C
30    IF (JFLG.EQ.0) GO TO 50
40    WRITE(3,150)
      READ(3,130,END=100) IOS
C
      WRITE(3,220)
      CALL ANSWER (NIT)
C
      WRITE(3,230)
      CALL ANSWER (NOT)
C
      WRITE(3,290)
      CALL ANSWER(LIT)
      WRITE(3,300)
      CALL ANSWER(LOT)
      IF(LOT.LE.0)GO TO 45
C
      WRITE(3,310)
      READ(3,320)IBM
C
45    WRITE(3,260)
      READ(3,130,END=100)IDENS,INFILE
      IF(IDENS.NE.1600)IDENS=800
C
      WRITE(3,270)
      READ(3,130,END=100)IODENS,IOFILE
      IF(IODENS.NE.1600)IODENS=800
C
50    R=IRS
      RR=IOR
      RI=IBS
      RO=IOS
      LOOP=1
      IFLG=0
      JFLG=0
C
      IF (AMOD(RI,R).EQ.0.0) GO TO 60
      WRITE(3,190)
      IFLG=1
C
60    IF (AMOD(RO,RR).EQ.0.0) GO TO 70
      WRITE(3,200)
      JFLG=1
70    IF (IFLG.EQ.1.OR.JFLG.EQ.1) GO TO 10
C
      IFACI=IBS/IRS
      IFACO=IOS/IOR
C
      WRITE(3,160) IFACI,IDENS,IFACO,IODENS
C
      WRITE(3,170)
      READ(3,240,END=100) DUMMY
C
      WRITE(3,250)
      READ(3,240,END=100) DUMMY
C
      RICNT=0.0
      ROCNT=0.0
C
C
C ALLOCATE DYNAMIC STORAGE FOR TREAD, TWRITE BUFFERS
C
      N=MAX0(IRS,IOR)
      CALL MAKBUF(RECD,(N+1)/2,IER3)
      CALL MAKBUF(INPUT,(IBS+1)/2,IER)
      CALL MAKBUF(OUTPUT,(IOS+1)/2,IER2)
      IF(IER+IER2+IER3.NE.0)GO TO 110
C
C     NOW OPEN TREAD/TWRITE INPUT, OUTPUT TAPES.
C
      CALL TPTT(3)
      CALL TRINIT (1,INPUT,-1*IBS,RECD,-1*IRS,ISTAT,NIT,IDENS,INFILE,
     1 LIT)
      CALL TWINIT (2,OUTPUT,-1*IOS,RECD,-1*IOR,NSTAT,NOT,IODENS,IOFILE
     1 ,LOT,,,IBM,LENGTH(IBM,18))
C
80    CALL TREAD(1)
      IF (ISTAT.EQ.1) GO TO 90
C
      RICNT=RICNT+1.0
C
      CALL TWRITE(2)
      ROCNT=ROCNT+1.0
C
      GO TO 80
C
90    CALL WCLOSE(2)
C
      FACI=RICNT/IFACI
      FACO=ROCNT/IFACO
C
      WRITE(3,180) RICNT,FACI,ROCNT,FACO
C
100   STOP
C
110   WRITE(3,280)
      STOP
C
120   FORMAT ('0[COPYMT V03.02]',//,T5,'DATE: ',2A4,A1,/,
     1T5,'TIME: ',2A4,///,' ENTER SPECIFICATIONS',//,'$',T5,'INPUT ',
     2'RECORD SIZE (BYTES):   ')
130   FORMAT (2I6)
140   FORMAT (/'$',T5,'INPUT BLOCK SIZE (BYTES):    ')
150   FORMAT (/'$',T5,'OUTPUT BLOCK SIZE (BYTES):   ')
160   FORMAT ('0INPUT:  ',I5,' RECORDS PER BLOCK AT ',I4,' BPI'/
     1' OUTPUT: ',I5,' RECORDS PER BLOCK AT ',I4,' BPI'//)
170   FORMAT (/'$INPUT REEL(S):  ')
180   FORMAT (' SUMMARY',//,T5,F8.0,' INPUT RECORDS READ     [',
     1F9.1,' BLOCKS]',/,T5,F8.0,' OUTPUT RECORDS WRITTEN [',F9.1,
     2' BLOCKS]',//)
190   FORMAT ('0ERROR:  INPUT BLOCK SIZE NOT INTEGER MULTIPLE OF ',
     1'INPUT RECORD SIZE',/)
200   FORMAT ('0ERROR:  OUTPUT BLOCK SIZE NOT INTEGER MULTIPLE OF',
     1' OUTPUT RECORD SIZE',/)
210   FORMAT (/'$',T5,'OUTPUT RECORD SIZE (BYTES):  ')
220   FORMAT (/'$',T5,'INPUT TRANSLATION [EBCDIC TO ASCII] ?  ')
230   FORMAT (/'$',T5,'OUTPUT TRANSLATION [ASCII TO EBCDIC] ?  ')
240   FORMAT (A4)
250   FORMAT (/'$OUTPUT REEL(S):  ')
260   FORMAT(/'$',T5,'INPUT DENSITY,FILE NUMBER ? :   ')
270    FORMAT(/'$',T5,'OUTPUT DENSITY,FILE NUMBER ? :   ')
280   FORMAT(' SORRY, UNABLE TO ALLOCATE BUFFER SPACE'/
     1 ' DECREASE YOUR BUFFER SIZES')
290   FORMAT(/'$',T5,'DO THE INPUT TAPES HAVE LABELS OR LEADING',
     1 ' TAPEMARKS ?:  ')
300   FORMAT(/'$',T5,'SHOULD THE OUTPUT TAPES CONTAIN IBM STANDARD',
     1 ' LABELS ?:  ')
310   FORMAT(/'$',T5,'ENTER THE IBM OUTPUT FILENAME :  ')
320   FORMAT(18A1)
C
      END
      SUBROUTINE ANSWER(IYES)
C
C RETURNS A 1 IF ANSWER IS YES, 0 IF ANSWER IS NO
C
      INTEGER ANS(2),YES(2),NO(2)
C
      DATA YES,NO/'YE','S ','NO','  '/
C
10    READ(3,30,END=20)ANS
      IYES=-1
      IF(ANS(1).EQ.NO(1).AND.ANS(2).EQ.NO(2))IYES=0
      IF(ANS(1).EQ.YES(1).AND.ANS(2).EQ.YES(2))IYES=1
      IF(IYES.GE.0)RETURN
      WRITE(3,40)
      GO TO 10
C
20    STOP
C
30    FORMAT(2A2)
40    FORMAT(/'$',T5,'REENTER RESPONSE: ''YES'' OR ''NO''   ')
C
      END
      INTEGER FUNCTION LENGTH(STR,MAX)
C
C RETURNS THE POSITION OF THE LAST PRINTING CHARACTER
C IN STR
C
      BYTE STR(MAX)
C
      LENGTH=0
      IF(MAX.LE.0)RETURN
      DO 10 I=MAX,1,-1
      IF(STR(I).LE.' ')GO TO 10
      LENGTH=I
      RETURN
10    CONTINUE
      RETURN
      END