FTN,L,C 
C * 
      SUBROUTINE VVALD (IA,IB,OFSET,LEN,TA,SA,ILNTH,FLAG,IERR)
     & ,92067-1X503 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:   VVALD 
C *     SOURCE: 92067-18503 
C *     RELOC:  92067-16503 
C *     PGMR :  R.D 
C * 
C * 
C * 
C ******************************************************************
C * 
C * 
C * 
C * 
C * 
C 
C THIS SUBROUTINE CHECKS FOR POSSIBLE PROBLEMS UPON READING FROM
C MAG TAPE (INITIATED BY READT) BEFORE THE DATA IS RESTORED TO THE
C DISC AND AFTER WRITING IT TO THE DISC.
C IF END OF TAPE IS FOUND, THE USER WILL BE REQUESTED TO MOUNT THE NEXT 
C TAPE OR ABORT THE PROGRAM.
C 
C THE PARAMETERS ARE: 
C 
C    IA,IB - CONTENTS OF A AND B REGISTER IMMEDIATELY AFTER ATTEMPT 
C            TO READ. 
C    OFSET - FIRST POSITION OF THE BUFFER THAT IS TO BE RESTORED TO 
C            THE DISC.
C            < 0 IF WRITE CHECK, >0 IF READ CHECK 
C    LEN   - NUMBER OF WORDS TO BE RESTORED.
C    TA    - TRACK ADDRESS
C    SA    - SECTOR ADDRESS 
C    ILNTH - WORD/TRACK VALUE OF MAG TAPE 
C    FLAG  - CATCHES FMGR ERROR NUMBER
C    IERR  - ERROR CODE 
C            = 0 NO PROBLEMS
C            = 1 END OF FILE ENCOUNTERED
C            =-1 ABORT MAIN PROGRAM (READT) 
C            =-2 PARITY ERROR FOUND 
C 
C 
      IMPLICIT INTEGER (A-Z)
      DIMENSION JBUF(8192),MRR2(14),MRR8(12),MRR15(32),MRR16(29)
      COMMON/COMRD/ ILU,ITAPE,NDIR,IDISC,MTLU,TSIZE,IBUF(8193)
      EQUIVALENCE (JBUF,IBUF(2))
      DATA MRR2/6412B,2HRE,2HAD,2H 0,2H02,2H  ,2HBA,2HD ,2HTA,2HPE, 
     &         2H F,2HOR,2HMA,2HT / 
      DATA MRR8/6412B,2HRE,2HAD,2H 0,2H08,2H  ,2HEN,2HD ,2HOF,2H T,2HAP,
     &          2HE / 
      DATA MRR15/6412B,2HRE,2HAD,2H 0,2H15,2H B,2HAD,2H T,2HRA,2HNS,
     &          2HMI,2HSS,2HIO,2HN-,2H-M,2HEM,2HOR,2HY ,2HTO,2H D,2HIS, 
     &          2HC ,2HTR,2HK ,2H  ,2H  ,2H  ,2HSE,2HC ,2H  ,2H  ,2H  / 
      DATA MRR16/6412B,2HRE,2HAD,2H 0,2H16,2H B,2HAD,2H T,2HRA,2HNS,
     &    2HMI,2HSS,2HIO,2HN-,2H-M,2HAG,2H T,2HAP,2HE ,2HTO,2H M,2HEM,
     &    2HOR,2HY ,2HRE,2HC ,2H  ,2H  ,2H  / 
C 
C  WHAT KIND OF CHECK - READ FROM TAPE OR WRITE TO DISC?
C 
      IF(OFSET.LT.0) GOTO 500 
C 
C  END OF FILE ENCOUNTERED? 
C 
      IF(IAND(IA,200B).EQ.0) GOTO 480 
      IERR=1
      RETURN
C 
C CHECK TO MAKE SURE TRANSMISSION LENGTH WAS ACCURATE.
C  (IBUF(1)=RECORD NUMBER)
C 
480   IF((IB.EQ.ILNTH+1).OR.(IAND(IA,200B).EQ.200B)) GOTO 481 
      CALL CNUMD(IBUF(1),MRR16(27)) 
      CALL EXEC(2,ILU,MRR16,29) 
      CALL PTERR(MRR16(2),FLAG) 
C 
C CHECK A REGISTER FOR PARITY ERROR.
C 
481   IF((IAND(IA,2B).NE.2)) GOTO 485 
      GOTO 204
C 
C CHECK FOR END OF TAPE. (A REGISTER HAS EQT STATUS WORD FIVE). 
C 
485   IF((IAND(IA,00040B).NE.40B)) RETURN 
C 
C  REWIND MAG TAPE. 
C 
      CALL EXEC(3,MTLU+500B)
C 
C  ASK TO MOUNT ANOTHER TAPE
C 
      CALL EXEC(2,ILU,MRR8,12)
      CALL PTERR(MRR8(2),FLAG)
482   CALL EXEC(2,ILU,28HPLEASE MOUNT SUBSEQUENT TAPE,-28)
483   CALL EXEC(2,ILU,25HAFTER MOUNTING ENTER "GO",-25) 
      CALL REIO(1,ILU,INBF,1) 
      IF(INBF.EQ.2HAB) GOTO 91
      IF(INBF.NE.2HGO) GOTO 483 
C 
C  SET UP TAPE COUNTER
C 
      ITAPE=ITAPE+1 
C 
C  READ FIRST RECORD OF THE FOLLOWING TAPE
C 
      CALL EXEC(1,MTLU,INBUF,1) 
      CALL ABREG(IA,IB) 
C 
C  THE FIRST RECORD SHOULD BE THE TAPE COUNT. IS IT WHAT WAS EXPECTED?
C  IF YES, CONTINUE ON; ELSE ASK TO MOUNT ANOTHER TAPE. 
C 
      IF(INBUF.NE.ITAPE) GOTO 490 
C 
C WRITE BUFFER TO DISC (IT MAY BE REDUNDANT). 
C 
      CALL EXEC(2,IDISC+74000B,JBUF(OFSET),LEN,TA,SA) 
      GOTO 500
C 
C  WRONG TAPE, ASK AGAIN. 
C 
490   CALL EXEC(2,ILU,MRR2,14)
      CALL PTERR(MRR2(2),FLAG)
      ITAPE=ITAPE-1 
      GOTO 482
C 
C  WRITE CHECK - TRANSMISSION LENGTH O.K. AND ERROR BIT CLEAR?
C 
500   IF(IAND(IA,1).NE.1)RETURN 
      CALL CNUMD(TA,MRR15(25))
      CALL CNUMD(SA,MRR15(30))
      CALL EXEC(2,ILU,MRR15,32) 
      CALL PTERR(MRR15(2),FLAG) 
      RETURN
C 
C ABORT REQUESTED.
C 
91    IERR=-1 
      RETURN
C 
C PARITY ERROR. 
C 
204   IERR=-2 
      RETURN
      END 
      END$
                                            