FTN4,L,C
      SUBROUTINE REFMT (ISCTR,IDUM,FLAG,IERR,TEMP2) 
     & ,92067-1X505 REV.2026 800522 
C 
C * 
C * 
C ******************************************************************* 
C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED.
C * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
C * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN
C * CONSENT OF HEWLETT-PACKARD COMPANY. 
C ******************************************************************* 
C * 
C * 
C *     NAME  : REFMT 
C *     SOURCE: 92067-18505 
C *     RELOC:  92067-16505 
C *     PGMR :  R.D 
C * 
C * 
C * 
C ******************************************************************* 
C * 
C * 
C * 
C * 
C 
C 
C  THIS SUBROUTINE RE-FORMATS DATA TRACKS STORED ON A MAG TAPE
C  (VIA WRITT) BEFORE RESTORING IT TO A DISC CARTRIDGE (AS INITIATED
C  BY READT) WHICH HAS A DIFFERENT SEC/TRK VALUE. 
C  THE FULL TRACK (RECORD) IS READ FROM THE MAG TAPE EACH TIME AND THE
C  LARGEST PORTION OF THAT RECORD IS WRITTEN TO THE DISC EACH TIME. 
C 
C  THE PARAMETERS ARE:
C 
C    ISCTR - SEC/TRK OF MAG TAPE
C    IDUM  - SEC/TRK OF DISC
C    FLAG  - CATCHES FMGR ERROR FOR USE IN CALLS TO SUB. VVALD
C    IERR - ERROR CODE  (AS GAINED FROM SUBROUTINE VVALD) 
C           = 1  END OF FILE ENCOUNTERED  (NORMAL TERMINATION)
C           =-1  ABORT MAIN PROGRAM  (READT)
C           =-2  PARITY ERROR 
C    TEMP2 - THE STARTING FMP TRACK 
C 
C 
C 
C  LOCAL VARIABLES USED:
C 
C    ILNTH,JLNTH - WORD/TRK OF MAG TAPE AND DISC
C    TRK   - TRACK ADDRESS
C    SEC   - SECTOR ADDRESS 
C    TOTL  - TOTAL # WORDS WRITTEN TO DISC
C    FILL,FILL2 - SUBPORTIONS (IN WORDS) OF THE MAG TAPE RECORD 
C 
C 
      IMPLICIT INTEGER (A-Z)
      DIMENSION JBUF(8192)
      COMMON/COMRD/ ILU,ITAPE,NDIR,IDISC,MTLU,TSIZE,IBUF(8193)
      EQUIVALENCE (JBUF,IBUF(2))
C 
C  INITIALIZE FOR THE DATA TRANSFER 
C 
      TRK=TEMP2 
      SEC=0 
      TOTL=0
      FILL2=0 
      ILNTH=ISCTR*64
      JLNTH=IDUM*64 
C 
C  GET NEXT RECORD (TRACK) FROM MAG TAPE
C 
300   CALL EXEC(1,MTLU,IBUF,ILNTH+1)
      CALL ABREG(IA,IB) 
C 
C  CALCULATE THE 1ST PORTION OF THE RECORD TO BE RESTORED 
C 
      FILL=JLNTH-TOTL 
C 
C  MAKE SURE IT'S NOT TOO BIG 
C 
      IF(FILL.GT.ILNTH) FILL=ILNTH
C 
C  MAKE SURE THAT READ WAS VALID
C 
      IERR=0
      CALL VVALD(IA,IB,1,FILL,TRK,SEC,ILNTH,FLAG,IERR)
      IF(IERR.NE.0) RETURN
C 
C  EVERYTHING'S O.K. RESTORE THAT PORTION 
C 
      CALL EXEC(2,IDISC+74000B,JBUF,FILL,TRK,SEC) 
C 
C  MAKE SURE WRITE WAS O.K. 
C 
      CALL ABREG(IA,IB) 
      CALL VVALD(IA,IB,-1,FILL,TRK,SEC,0,FLAG,0)
C 
C  CALCULATE THE NEXT SECTOR
C 
      SEC=SEC+FILL/64 
      TOTL=TOTL+FILL
C 
C  TRACK FULL?
C 
      IF(SEC.LT.IDUM) GOTO 300
C 
C  FULL. RESET SECTOR POINTER AND INCREMENT TRACK POINTER 
C 
      TRK=TRK+1 
      SEC=0 
      TOTL=0
C 
C  ANYMORE OF THAT RECORD LEFT? IF YES, GO RESTORE IT. IF NOT, GET
C  NEXT ONE.
C 
      IF(TOTL.EQ.ILNTH) GOTO 300
C 
C  CALCULATE THE REMAINING PORTION OF THE RECORD
C 
400   FILL2=ILNTH-FILL
C 
C  MAKE SURE IT'S NOT BIGGER THAN IT'S SUPPOSED TO BE 
C 
      IF(FILL2.GT.JLNTH) FILL2=JLNTH
      IF(FILL2.EQ.0) GOTO 300 
C 
C  NOW RESTORE THE SECOND PORTION.
C 
      CALL EXEC(2,IDISC+74000B,JBUF(FILL+1),FILL2,TRK,SEC)
C 
C  MAKE SURE WRITE WAS O.K. 
C 
      CALL ABREG(IA,IB) 
      CALL VVALD(IA,IB,-1,FILL2,TRK,SEC,0,FLAG,0) 
C 
C  UPDATE THE SECTOR POINTER
C 
      SEC=SEC+FILL2/64
      TOTL=TOTL+FILL2 
C 
C  TRACK FULL?
C 
      IF(SEC.LT.IDUM) GOTO 460
C 
C  FULL. INCREMENT THE TRACK POINTER AND RESET THE SECTOR POINTER 
C 
      TRK=TRK+1 
      SEC=0 
      TOTL=0
C 
C  KEEP GOING UNTIL DONE
C 
460   IF((FILL+FILL2).EQ.ILNTH) GOTO 300
      FILL=FILL+FILL2 
      GOTO 400
  
      END 
      END$
                                                                                                                                                                                      