FTN4
      PROGRAM DBRST(3,80),92069-16126 REV.2013 790413 
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
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18126
C     RELOC:     92069-16126
C 
C 
C****************************************************************:
C 
C 
C************************************************ 
C THIS FILE CONTAINS THE CODE FOR BOTH DBRST AND SETIN. 
C 
C DBRST RESTORES A DATA BASE FROM TAPE TO DISC. THE TAPE
C MUST HAVE BEEN SAVED FROM DISC WITH PROGRAM DBSTR.
C 
C CALLING SEQUENCE: 
C :RU,DBRST,CONSOLE,TAPE,ROOT,LEVEL,ABORT 
C 
C LU1, TAPE, ROOT, LVLWD, AND P5 ARE 6-WORD ARRAYS AS FOLLOWS:
C 1) LU OR FIRST TWO CHARACTERS 
C 2) 0  OR SECOND TWO CHARACTERS IF NAMR. 
C 3) 0 OR THIRD TWO CHARACTERS IF NAMR. 
C 4) 0 IF NULL, 1 IF INTEGER(LU), 3 IF ASCII(NAMR)
C 5) O OR SECURITY CODE IF NAMR.
C 6) 0 OR CARTRIDGE NUMBER IF NAMR. 
C 
C HDR  = TAPE AND REELHEADER WITH INFO ENTERED BY USER. 
C 
C BUFR = BUFFER USED THROUGHOUT PROGRAM FOR EVERYTHING. 
C BUFSZ= SIZE OF ABOVE BUFFER.
C SETNUM= NUMBER OF DATA SETS TO RESTORE, NOT COUNTING ROOT FILE. 
C 
C HDR   = TAPE AND REELHEADER AS DETERMINED BY USER PARAMETERS. 
C TDCB  = DCB USED TO READ FROM THE MAG TAPE DEVICE (TYPE 0 OR TYPE 1)
C TDSZ  = SIZE OF ABOVE DCB.
C 
C FIRST LEVEL SUBRS CALLED ARE: 
C GTPRM = GETS FIVE PARAMETERS AND DOES PRELIMINARY CHECKS. 
C P5STR = STORES ROOT AND P5 AWAY FOR LATER RETRIEVAL.
C TLOCL  = CHECKS IF THE TAPE DRIVE IS LOCAL OR ON-LINE.
C CKTHD = CHECK TAPE HEADER.
C SETIN = WRITES AN ENTIRE DATA SET FROM MAG TAPE TO DISC.
C************************************************** 
C COMMON DECLARATIONS.
C 
      INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) 
      INTEGER HDR(24) 
      COMPLEX HDR1(6) 
      EQUIVALENCE (HDR1,HDR)
      INTEGER TDCB(144),TDSZ
C*******************************************************
      COMMON/TPHDR/HDR,TDCB,TDSZ,P5 
C***************************************************
C LOCAL VARIABLES.
C 
      INTEGER BUFR(2072),BUFSZ
      INTEGER BUF1(256),BUF1SZ
      INTEGER SETNUM
      DATA BUFSZ/2072/
      DATA BUF1SZ/256/
C**************************************************** 
C GET THE PARAMETERS. UNTIL YOU GET LU1, LOG ERRORS ON SCHEDULING LU. 
C 
      LU=LOGLU(IDUMY) 
      CALL STPLU(LU)
      CALL GETST(BUF1,BUF1SZ,LENGTH)
      CALL GTPRM(LU,LU1,TAPE,ROOT,LVLWD,P5,BUF1,LENGTH,IERR)
      IF (IERR .LT. 0) STOP 
C*************************************************************
C CHANGE THE LU FOR STOP MESSAGES TO LU1, CHECK TAPE DEVICE.
C 
      CALL STPLU(LU1) 
      IF (TAPE(4) .EQ. 1) CALL TLOCL(LU1,TAPE,IERR) 
      IF (IERR .LT. 0) STOP 
C********************************************************** 
C SET UP THE HEADER WITH INFO USER ENTERED. 
C 
      HDR1(1)=8HDBSTORE 
      HDR1(2)=8H21XX
C 
      DO 11 J=1,6 
      HDR(J+8)=ROOT(J)
11    CONTINUE
C 
      HDR(17)=LVLWD(1)
      HDR(18)=LVLWD(2)
      HDR(19)=LVLWD(3)
      HDR(21)=1 
      HDR(24)=2H**
C*****************************************************
C OPEN UP THE TYPE 1 OR TYPE 0 FILE TO THE TAPE DEVICE. 
C 
      IOPTN=0 
      ISECU=TAPE(5) 
      ICR=TAPE(6) 
      CALL OPENF(TDCB,IERR,TAPE,IOPTN,ISECU,ICR,TDSZ) 
      IF (IERR .GE. 0) IERR=0 
      CALL DBER2(LU1,IERR,TAPE,6HDBRS2 ,2HAB) 
C****************************************************** 
C CHECK THE TAPEHEADER AGAINST THE INFO ENTERED.
C 
      CALL TAPER(LU1,TAPE,BUFR,BUFSZ,LEN,EOF,IERR)
      IF (IERR .LT. 0) GO TO 9100 
      CALL CKTHD(LU1,HDR,BUFR,IERR) 
      IF (IERR .LT. 0) GO TO 9100 
C***************************************************************
C TRANSFER THE NUMBER OF SETS STORED ON THE TAPE FROM THE TAPE HEADER 
C INTO THE LOCAL HEADER, AND INTO SETNUM. 
C 
      HDR(20)=BUFR(20)
      SETNUM=HDR(20)
C*************************************************************
C WRITE THE ROOT FILE FROM STORAGE DEVICE TO THE DISC.
C IF SETIN ENCOUNTERS A DUPLICATE ROOT FILE THAT IT'S NOT 
C SUPPOSED TO PURGE, DON'T PURGE IT HERE EITHER.
C 
      CALL SETIN(LU1,TAPE,0,BUFR,BUFSZ,P5,IERR) 
      IF (IERR .EQ. -2) GO TO 9100
      IF (IERR .LT. 0) GO TO 9000 
C************************************************************** 
C WRITE ALL THE DATA SETS FROM MAG TAPE TO
C DISC. SETIN ASSUMES THE MAG TAPE IS LOCATED AT THE FILEHEADER 
C FOR THE JTH FILE WHEN ITS CALLED. 
C 
      DO 10 J=1,SETNUM
      CALL SETIN(LU1,TAPE,J,BUFR,BUFSZ,P5,IERR) 
      IF (IERR .LT. 0) GO TO 9000 
10    CONTINUE
C********************************************************** 
C WRITE MESSAGE AND GET OUT.
C 
      CALL REIO(2,LU1,29H DATA BASE RESTORE COMPLETED.,-29) 
      IERR=0
      GO TO 9100
C************************************************************** 
C PURGE ROOT FILE ON ERROR. 
C 
9000  CONTINUE
      CALL PURGE(BUF1,IERR,ROOT,ROOT(5),ROOT(6))
9100  IERR=0
      CALL ECLOS(TDCB)
9999  END 
C 
C 
C 
      SUBROUTINE SETIN(LU1,TAPE,J,BUFR,BUFSZ,P5,IERR) 
     +,92069-16126 REV.2013 790413
C******************************************************** 
C SETIN WRITES THE JTH FILE FROM MAG TAPE TO DISC. IT 
C ASSUMES THAT THE TAPE IS POSITIONED AT THE FILE HEADER
C FOR THE JTH FILE, AND THAT THE DATA FOR THE JTH FILE
C IMMEDIATELY FOLLOWS THE FILE HEADER.
C 
C NAMR = 6-WORD ARRAY HOLDING INFO ON FILE BEING WRITTEN TO DISC
C DCB2 = THE DCB USED TO WRITE THE DATA TO THE FILE.
C DCB2SZ = THE SIZE OF DCB2 
C 
C JBLK= 4-WORD ARRAY USED IN ECREA CALL TO CREATE AN FMP FILE.
C        (=DOUBLE WORD NUMBER OF BLOCKS+2-WORD DUMMY) 
C HDSZ = LENGTH OF DATA HEADER. 
C BLKNO= THE BLOCK NUMBER OF THE BUFR YOU'RE TRANSFERRING.
C EOF = LOGICAL FLAG TAPER SETS WHEN IT HITS EOF. 
C*******************************************************
      INTEGER LU1,TAPE,J,BUFR(1),BUFSZ,P5,IERR
      INTEGER NAMR(6) 
      INTEGER DCB2(272),DCB2SZ
      INTEGER JBLK(4) 
      INTEGER HDSZ
      INTEGER BLKNO 
      LOGICAL EOF 
      DATA DCB2SZ/256/
      DATA HDSZ/24/ 
C*******************************************************
C CALL CKFHD TO DO THE FOLLOWING: 
C 1)READ THE FILE HEADER ON THE TAPE. 
C 2) VERIFY THAT ITS A FILEHEAD.
C 3) RETURN INFO IN NAMR,JBLK,JREC,AND ITYPE. 
C 
      CALL CKFHD(LU1,TAPE,BUFR,BUFSZ,NAMR,JBLK,JREC,ITYPE,IERR) 
      IF (IERR .LT. 0) RETURN 
C****************************************************** 
C CALL NWFIL TO CREATE A NEW FILE (IF P5 .EQ. 'AB', NWFIL RETURNS 
C A NEGATIVE ERROR CODE ON DUPLICATE FILES. IF P5 .NE. 'AB', NWFIL
C PURGES THE OLD FILE AND CREATES A NEW ONE.) 
C JBLK(3) AND JBLK(4) = THE RECORD SIZE FOR A TYPE TWO FILE CREATE. 
C 
      JBLK(3)=0 
      JBLK(4)=JREC
      CALL NWFIL(LU1,IERR,DCB2,DCB2SZ,NAMR,JBLK,ITYPE,P5) 
      IF (IERR .LT. 0) RETURN 
C*******************************************************
C BY HERE, FILE IS CREATED. OPEN IT AS TYPE 1 FILE, 
C EXCLUSIVE USE, BINARY DATA. 
C 
      IOPTN=104B
      ISECU=NAMR(5) 
      ICR=NAMR(6) 
      CALL OPENF(DCB2,IERR,NAMR,IOPTN,ISECU,ICR,DCB2SZ) 
      IF (IERR .GE. 0) IERR=0 
      CALL DBER2(LU1,IERR,NAMR,6HSETIN ,2HXX) 
      IF (IERR .LT. 0) RETURN 
      IERR=0
C************************************************** 
C READ IN DATA RECORD FROM TAPE TO BUFFER.
C 
10    EOF=.FALSE. 
      CALL TAPER(LU1,TAPE,BUFR,BUFSZ,LEN,EOF,IERR)
      IF (IERR .LT. 0) RETURN 
      IF (EOF) GO TO 9000 
      CALL CKDHD(LU1,NAMR,BLKNO,BUFR,IERR)
      IF (IERR .LT. 0) RETURN 
      BLKNO=BLKNO+1 
C*************************************************
C WRITE ALL WORDS PAST DATA HEAD INTO FILE. 
C 
      CALL EWRIT(DCB2,IERR,BUFR(HDSZ+1),LEN-HDSZ,0.0) 
      CALL DBER2(LU1,IERR,NAMR,6HSETIN ,2HXX) 
      IF (IERR .LT. 0) RETURN 
      GO TO 10
C**************************************************** 
C EOF RETURN POINT. 
C 
9000  CONTINUE
      CALL CLOSE(DCB2,IERR) 
      CALL DBER2(LU1,IERR,NAMR,6HSETIN ,2HXX) 
      EOF=.FALSE. 
      IERR=0
      RETURN
      END