      PROGRAM DBLOADPC_TITLE  DBLOAD  load database files (CHUNKS), display and edit chunk directory.
C_DESCRIPTION>C  DBLOAD:  Load XG database files (chunks) from tape to disk.AC   Options to update the chunk directory, delete database files,AC   (updating chunk directory), initialize, modify or display the8C   chunk directory.  DBLOAD will also load chain files.CC  PROGRAM MODES:(C    1  Display chunk directory entries.2C    2  Change logical unit for a range of chunks.BC    3  Load database file, updating chunk directory entry word 3.5C    4  Load database file, ignoring chunk directory.DC    5  Delete database file, updating chunk directory entry word 3.CJC   This program Assumes 120 word sector size for the chunk directory and JC   for the database file.  The Tape blocksize in the mount command is in CC   bytes and in a data statement (LBLK), the JBUF dimension is in KC   Integer *2 words. (equal to 6000 bytes for the current Database).  The MC   header items for the data file and chunk directory begin with an "m" and OC   are equivalenced into the MH array (data file) or the IH array (chunk dir).C0C   Chunk directory entry is 3 integer *2 words.CC   1 start primary id$C   2 100*tape_number + file_number.4C   3 disk logical unit: >0 file on-line (default 1)C)C                         0 file off-lineFC                        -1 file for this primary range does not existKC                        -2 dummy last entry containing last primary id + 1CCC  More documentation on the chunk directory are in XXCSET routine.GC  tape mount command: $MOUNT/FOREIGN/BLOCKSIZE=6000 MSA0: LABEL TPFILEGC  A Logical assign should be performed for TPFILE, example below shows5C  logical assigns performed when running ALLDEV.COM.C)C   @PDS:[RAD.EXE]ALLDEV 1600 TAPE: 05 12C   ASSIGN TAPE TPFILEC   ASSIGN TAPE TDRIVEC?C  XXCONV subroutine may have to be rewritten for new database.C+C   Current version supports the following:CHC    ID 1: VIKING IRTM db (+ irtm chain files in single file load mode).C    ID 2: VIKING MAWD dbC    ID 3: MARINER 9 IRR dbCAC_CALLS  XXCONV,TPOPEN,TPREAD,TPSKPF,TPCLOS,DSOPEN,DSWRIT,DSCLOS,&C        IABS,ASCII,DATIME,A2AN,ERRMESC?C_HISTORY  82June24  R.Mehlman  UCLA  Single file load version.+C H.Kieffer  84/09/09 Add lun reassignment.OC HHK  84/07/17 use macro for ascoff,b2swap,b4swap and allow "already deleted".1C      03/07/83 Disable default id for modes 3-5.GC      02/10/83 Renamed from xxload   2/11/83 Chain file modifications.KC      01/19/83 Modified tape routines, ds disk I/O rtnes replace xx rtnes."C      01/12/83 Extend mode added..C      11/12/82 type 0 size algorithm changed.GC      10/1/82 Corrections to current file, data file hdr equivalences.9C      9/9/82 Directory update corrected   9/17/82 again.CC      8/19/82 Chunk directory version  9/2/82 File skip corrected.GC      8/6/82  Xxopen changes, return codes, file size comp, key added.OC R.GURULE 10/1/87, USGS FLAGSTAFF, AZ. Convert to a TAE interface.  reorganize$C sequence entries are presented in.C_PAUSE      IMPLICIT INTEGER*2 (M)      CHARACTER*4 IDB      CHARACTER*6 PROGNM      CHARACTER*8 PMODE,PALT(5)      CHARACTER*8 SPCRAFT,PROGM      INTEGER STATUS"      INCLUDE 'RAD$INC:TAEBAS.INC'      REAL*8 TITLE(2))      INTEGER*4 MODE,MQ,IDUM(3),ICHUNK(5)?      INTEGER*2 NAME(3),NAMEDF(3),NAMECD(3),JCD(600),ICD(3,200)G      INTEGER*2 IBUF(120),IH(120),MH(120),ISTR(3),IHINIT(13),JBUF(3000)      INTEGER*2 NAMECF(3)7      INTEGER*2 TPFILE(3) /2HTP,2HFI,2HLE/ , KCF /2HCF/GC-----MH contains data file header, IH contains chunk directory header.      EQUIVALENCE (JCD,ICD)=     1 ,(MFREE,MH(1)),(MCOL,MH(3)),(MRPS,MH(4)),(MTYPE,MH(5));     2 ,(MDHDR,MH(6)),(MRP,MH(9)),(MWP,MH(10)),(MLS,MH(13))'     & ,(MFCSCT,MH(21)),(NAMECF,MH(13))D     3 ,(MDDB,MH(31)),(MDSUB,MH(32)),(MCHUNK,MH(33)),(NAMEDF,MH(61))@     4 ,(MHDR,IH(6)),(MIDDB,IH(21)),(MKERN,IH(22)),(MSUB,IH(23))3     5 ,(MAXCH,IH(24)),(MLEN,IH(25)),(MSECT,IH(26))%      LOGICAL NOUNLD /.FALSE./ , LMOD3      DATA IHINIT /0,0,120,1,0,1,-3,0,0,0,0,16,120/(      DATA TITLE /8HCHUNK DI,8HRECTORY /#      DATA NAMECD /2HDB,2HCD,2H00/ C      DATA IIN,IOUT,LTAPE,LDISK,LCD,LUNCD, LS,LSD,JCDMAX,KFILE,LBLKD     1    /  5,   6,   51,   52, 53,    0,120,120,   600,    1,3000/F      DATA IDDEF /1/,PALT/'DISPLAY ','ENTRIES ','LOFILEUP','LOFILEIG',%     1                    'DELEFILE'/      DATA PROGNM /'DBLOAD'/-      CALL XRINIM(BLOCK,XPRDIM,XABORT,STATUS)(C-----Request program mode, database id.:  10  CALL XRSTR(BLOCK,'_SUBCMD',1,PMODE,ILEN,ICNT,STATUS)            DO I = 1,5,        IF(PMODE(1:8) .EQ. PALT(I)(1:8))THEN           MQ = I           GOTO 21
        ENDIF      ENDDO  7  21  CALL XRSTR(BLOCK,'IDDB',1,IDB,NCHARS,ICNT,STATUS)&      IF (IDB(1:NCHARS).EQ.'IRTM')THEN          IDDB=1*      ELSE IF(IDB(1:NCHARS).EQ.'MAWD')THEN          IDDB=2)      ELSE IF(IDB(1:NCHARS).EQ.'IRR')THEN          IDDB=3      ENDIF C-----Form chunk directory name.      CALL ASCII(IDDB+100,ISTR)      NAMECD(3)=ISTR(3)2C-----If change a range of lun' then next section.      IF(MODE.EQ.4)GOTO 22	=C-----Open chunk directory file, read header...modes 1,2,3,5. /      CALL DSOPEN(LCD,LUNCD,NAMECD,LSD,-1,0,IR)      IF (IR.NE.0) GO TO 74"      CALL DSREAD(LCD,1,IH,LSD,IR)      IF (IR.NE.0) GO TO 74      LMOD=.FALSE.,C-----Request sub-db id, read its directory.  13  IDUM(1) = JZEXT(MSUB)>      CALL XRSTR(BLOCK,'SP_CRAFT',1,SPCRAFT,NCHAR,ICNT,STATUS),      IF(SPCRAFT(1:NCHAR).EQ.'VIKING-1')THEN        IDSUB=12      ELSE IF (SPCRAFT(1:NCHAR).EQ.'VIKING-2')THEN        IDSUB=2      ENDIF# 135  IF (IDSUB.GT.IDUM(1)) GOTO 13	      J=1       ISECT=MHDR+(IDSUB-1)*MSECT      DO 14 K=1,MSECT        ISECT=ISECT+1,        CALL DSREAD(LCD,ISECT,JCD(J),LSD,IR)        IF (IR.NE.0) GO TO 74        J=J+LSD!        IF (J.GT.JCDMAX) GO TO 78 14   CONTINUE       GO TO (18,165,20,22,24),MQN!************* DELETE MODE *************************************************** 24   CONTINUE6      CALL XRINTG(BLOCK,'CHUNKS',5,ICHUNK,ICNT,STATUS)      DO I = 1, ICNT.         CALL ASCII(1000*IDSUB+ICHUNK(I),NAME)         NAME(1) = MKERN         ILUN=ICD(3,ICHUNK(I))*	 CALL DSOPEN(LDISK,ILUN,NAME,LSD,-1,0,IR)	 IF(IR.NE.0)GOTO 75         ICD(3,ICHUNK(I))=0!         CALL DSCLOS(LDISK,-1,IR)	 IF(IR.NE.0) GOTO 75	 ICD(3,ICHUNK(I))=0       ENDDO       GOTO 55;C-----Change a range of luns in chunk directory...mode = 2. 165  IDUM(2) = 0      3      CALL XRINTG(BLOCK,'RANGE',2,IDUM,ICNT,STATUS)      ICHNK1 = IDUM(1)      ICHNK2 = IDUM(2))      IF (ICHNK2.LT.ICHNK1) ICHNK2=ICHNK1C-----Loop on chunks:6      CALL XRINTG(BLOCK,'NEWLUN',1,NEWLUN,ICNT,STATUS)       DO 167 ICHNK=ICHNK1,ICHNK2167	ICD(3,ICHNK) = NEWLUN      GO TO 55#                                   PC-----Display chunk directory. mode 1 ******************************************718    TYPE*, 'Chunk directory for database',IDDB,' and'*      Type*, 'Viking Orbiter number',IDSUBC      TYPE*, 'Chunk   StartId  Tape   File   Logical Unit No./Flag'      TYPE*, ' '      DO ICHNK=1,MAXCH        ISTART=ICD(1,ICHNK)        ILUN=ICD(3,ICHNK)!        IF (ISTART.EQ.0) GO TO 19        ITPFL=ICD(2,ICHNK)        ITAPE=ITPFL/100        IFILE=ITPFL-100*ITAPE>        WRITE (IOUT,919) ICHNK,ISTART,ITAPE,IFILE,ICD(3,ICHNK) 919    FORMAT (I5,I9,I7,I6,I9)!        IF (ILUN.LT.-1) GO TO 195 19   ENDDO 195  GO TO 90OC-----MODE 2 restore chunk from tape,  updating chunk directory.***************DC     Restore mode: request chunk, tape file, disk file, protection.3  20  CALL XRINTG(BLOCK,'DLUNT',1,LUND,ICNT,STATUS)OC------MODE 3...Form tape drive name from tape lun here if necessary. *********5  22  CALL XRINTG(BLOCK,'ICHUNK',1,ICHNK,ICNT,STATUS)4      CALL XRINTG(BLOCK,'TFILE',1,IFILE,ICNT,STATUS)8105    DO JX=1,3	  NAME(JX) = '  '
        ENDDO      IF (IFILE) 25,22,23   ,  23  IF (LUND.LE.0 .AND. MODE.NE.4) LUND=1	      MREAD = 0      MWRIT = 0 248  NSKIP=IFILE-KFILE      IF (NSKIP) 25,28,26C-----Rewind tape.! 25   CALL TPRWND(LUNT,NOUNLD,IR)
      KFILE=1      IFILE=-IFILE      IF (IFILE-1) 22,28,248C-----Skip files.  26   CALL TPSKPF(LUNT,NSKIP,IR)      IF (IR) 70,27,71 27   KFILE=IFILEC-----Open tape file.            / 28   CALL TPOPEN(LTAPE,LUNT,TPFILE,LS,LBLK,IR)      IF (IR.NE.0) GO TO 76      KREC=0$C-----Read logical record from tape. 30   KREC=KREC+1*      CALL TPREAD(LTAPE,IBUF,JBUF,LBLK,IR)      IF (IR) 50,32,72=C-----Swap bytes, convert ascii, etc. as required for record. 32   CALL XXCONV(IBUF,KREC)      IF (KREC.GT.1) GO TO 40CC-----First block: save header sector, check id, compute file size,DC     Create and open disk file.  size estimate will work for type 1DC     Files, or type 0 files with logical record length <= 1 sector.      CALL A2AN(IBUF,MH,LS)      IF (MODE.EQ.4) GO TO 33N      IF (MDDB.EQ.IDDB.AND.MDSUB.EQ.IDSUB.AND.MCHUNK.EQ.ICHNK) GOTO 33        :	TYPE*,'Whoops! This is ID',MDDB,'Spacecraft number',MDSUB'	TYPE*,'CHUNK',MCHUNK,'and File',NAMEDF	TYPE *, ' '      GO TO 22 33   NSECT=MFREE-1&      IF (MTYPE.EQ.1) NSECT=MFREE*MCOL$      IF (NAMECF(1).NE.KCF) GO TO 35NC-----(Special chain file code [hdr word 13 = "cf"]: # sectors in hdr word 21)      NSECT=MFCSCT-13      IF (NAME(1).EQ.2H  ) CALL A2AN(NAMECF,NAME,3) 35   ISIZE=MDHDR+NSECT3      IF (NAME(1).EQ.2H  ) CALL A2AN(NAMEDF,NAME,3)C-----LS=MLS0      CALL DSOPEN(LDISK,LUND,NAME,LS,ISIZE,0,IR)      IF (IR.NE.0) GO TO 77      MRP=MREAD      MWP=MWRIT
      ISECT=0#C-----Write logical record to disk. 40   ISECT=ISECT+1C-----Notification interval.      ISC = JMOD(ISECT,500)      IF(ISC.EQ.0)THEN        WRITE(IOUT,1080)ISECT& 1080   FORMAT('+ Writing sector ',I9)      ENDIF)      CALL DSWRIT(LDISK,ISECT,IBUF,LS,IR)      IF (IR.NE.0) GO TO 73      GO TO 30;C-----End of tape file: release tape unit, close disk file. 50   KFILE=KFILE+1      CALL TPCLOS(LTAPE,IR)      CALL DSCLOS(LDISK,0,IR)      IF (IR.NE.0) GO TO 73      KREC=KREC-1<      TYPE*,'File transferred to disk with', KREC,' records'      TYPE *, ' '      IF ( MQ.EQ.4 ) GO TO 90#C-----Update chunk directory entry.      ICD(3,ICHNK)=LUND.C-----Update subdb sectors of chunk directory. 55   CONTINUE	      J=1       ISECT=MHDR+(IDSUB-1)*MSECT      DO 57 K=1,MSECT        ISECT=ISECT+1,        CALL DSWRIT(LCD,ISECT,JCD(J),LSD,IR)        IF (IR.NE.0) GO TO 74        J=J+LSD 57   CONTINUE      LMOD=.TRUE.7      Type*,'Chunk directory updated for database',IDDB*      Type*,'and spacecraft number', IDSUB      TYPE *, ' '      GO TO 90  60  IF (.NOT.LMOD) GO TO 103C-----Update chunk directory header and close file.      CALL DATIME(IH(81))"      CALL DSWRIT(LCD,1,IH,LSD,IR)      IF (IR.NE.0) GO TO 74      KEOF=0      CALL DSCLOS(LCD,KEOF,IR)      IF (IR.NE.0) GO TO 74>      TYPE*,'Chunk directory header updated for database',IDDB      TYPE *, ' '      GO TO 90C-----ERRORS70    KFILE=KFILE-IR.      WRITE (IOUT,*) 'END OF TAPE ENCOUNTERED'      GO TO 2278	KER = KER + 177	KER = KER + 176	KER = KER + 175	KER = KER + 174	KER = KER + 4	GOTO 80!73	WRITE(IOUT,*)' SECTOR =',ISECT	KER = 3	GOTO 80/72	WRITE(IOUT,*)' FILE AND RECORD =',KFILE,KREC	KER = 2	GOTO 80
71	KER = 1*80	CALL ERRMES('DBLOAD','DBLOAD',KER,'AB')90	STOP        END