LC_TITLE CHLUN:  Update the chunk directory performing a directory of XG$DAT.C   OC_Programmer R.MEHLMAN, original version DBLOAD, Robert Gurule, USGS Flagstaff.CPC  09/10/84 FORTRAN ASCII, B2SWAP and B4SWAP dropped - use eliason asm routines.-C  03/07/83 Disable default id for modes 3-5.9C  02/10/83 Renamed from XXLOAD  2/11/83 chain file mods.KC  01/19/83 Modified TP routines, ds disk i/o routines replace xx routines.C  01/12/83 Extend mode added.*C  11/12/82 Type 0 size algorithm changed.CC  10/1/82 Corrections to current file, data file hdr equivalences.5C  9/9/82 Directory update corrected   9/17/82 again.?C  8/19/82 Chunk directory version  9/2/82 file skip corrected.CC  8/6/82  XXOPEN changes, return codes, file size comp, key added.(C@ RMX 6/24/82  Single file load versionC_History  9/20/880C Modified by Robert Gurule, U.S.G.S. Flagstaff.
C_DESCRIPTIONNC Reads a directory listing in XG$DAT.  It will take the filenames specified  MC in XG$DAT and modify the chunk directory to accurately reflect what chunks PC are currently  online.  Written for the Radiometry node of the Planetary Data FC System.  This is the only function this routine performs, all other C functions deleted.C%C    3  Modify chunk directory entry.CNC  Assumes 120 word sector size for chunk directory and for the database file.LC  tape blocksize set in mount command in bytes and in data statement (LBLK)IC  and JBUF dimension in integer*2 words. ( = 6000 bytes for current DBS)HC  header items for data file and chunk directory (int*2) begin with "m"JC  and are equivalenced into MH array (data file) or IH array (chunk dir)."C  see XXFORG.TXT for description.(C  Chunk directory entry (3 INT*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                         0 file off-lineGC                        -1 file for this primary range does not exist.KC                        -2 dummy last entry containing last primary id + 1GC  More documentation on chunk directory in comments to XXCSET routine.@C   XXCONV subroutine may have to be rewritten for new database.,C   current version works for the following:@C_Calls XXCONV,TPOPEN,TPREAD,TPSKPF,TPCLOS,DSOPEN,DSWRIT,DSCLOS,C       IABS,ASCII,DATIME,A2ANGC    ID 1: VIKING IRTM DB (+ IRTM CHAIN FILES IN SINGLE FILE LOAD MODE)C    ID 2: VIKING MAWD DBC    ID 3: MARINER 9 IRR DB      PROGRAM CHLUN      IMPLICIT INTEGER*2 (M)       CHARACTER*32 FNAME,DUM *25      REAL*8 TITLE(2)      INTEGER*4 MODE,MQ,NORM?      INTEGER*2 NAME(3),NAMEDF(3),NAMECD(3),JCD(600),ICD(3,200)?     1 ,IBUF(120),IH(120),MH(120),ISTR(3),IHINIT(13),JBUF(3000)     2 ,NAMECF(3)7      INTEGER*2 TPFILE(3) /2HTP,2HFI,2HLE/ , KCF /2HCF/9      DIMENSION IORB1(200),ORB2(200),ISUB(200),ICHNK(200)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/&      DATA IDDEF /1/,IN2/24/,IOUT2/25/                       AC-----Request mode, database id, old mode was modify chunk dir=3.                 >      OPEN(UNIT=IOUT2,FILE='XG$DAT:ORBITS.LST',STATUS='NEW')        WRITE(IOUT2,1000):1000  FORMAT(' *** The following orbits are online ***',/) 10   MODE = 3      IDDB = 1      LUND = 4      CALL ASCII(IDDB+100,ISTR)      NAMECD(3) = ISTR(3)        -C-----Open chunk directory file, read header./      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.MC-----Open the PDS:[RAD.XG.DAT]DIR.LST file for further decoding of filenamesHC     to be converted into sub database id, and chunk id.  ORB1 = VikingGC     orbiter 1 chunks to be flagged, ORB2 = Viking orbiter 2 chunks toPC     be flagged.  Assume input datafile has n records followed by a blank line.!                                 7      OPEN(UNIT=IN2,FILE='XG$DAT:DIR.LST',STATUS='OLD')      DO I = 1, 200	READ(IN2,2300,END=99)LEN,FNAME2300    FORMAT(Q,A32)D	TYPE*, 'LEN ',LEN!-------DECIPHER THE CHUNK ID.	IF(FNAME(1:2).EQ.' ')GOTO 99	ITS = INDEX(FNAME(1:LEN),'TS')	ISB = ITS + 2	IPT=ITS + 3
	IPT2=ITS + 5D	TYPE*, FNAME(ISB:ISB)&	WRITE (DUM(1:1),'(A1)')FNAME(ISB:ISB)	READ(DUM(1:1),'(I1)')ISUB(I)7	IF(ISUB(I).EQ.1)I1 = I1 + 1		!Cnt number of Viking 1s.7	IF(ISUB(I).EQ.2)I2 = I2 + 1		!Cnt number of Viking 2s.!	WRITE(DUM,'(A4)')FNAME(IPT:IPT2)	READ(DUM,'(I4)')ICHNK(I)%D       TYPE*, ICHNK(I),ISUB(I),I1,I2      ENDDOHC-----Request sub-db id, read its directory.  Start of the loop through ?C     the two sub databases (Viking 1 and 2 chunk directories).&C     Total number of chunks = I1 + I22C     Perform two loops for Viking 1 and Viking 2.  99  DO 200 IDSUB=1,2	      J=1A      ISECT = MHDR + (IDSUB-1) * MSECT     !Calculate the sector.C-----Read the chunk directory.      DO 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      ENDDO$D     TYPE*, ' JCD',(JCD(K),K=1,600)C-----Modify chunk entries.      IF(IDSUB.EQ.1)THEN        NENTRIES = I1
	ISTRT = 1      ELSE IF (IDSUB.EQ.2)THEN        NENTRIES = I2 + I1
	ISTRT=I1 + 1      ENDIF%C-----Initialize the chunk directory.      DO I=1,MAXCH        ICD(3,I)=0&	IF(IDSUB.EQ.1.AND.I.EQ.67)ICD(3,I)=-2&	IF(IDSUB.EQ.2.AND.I.EQ.37)ICD(3,I)=-2      ENDDO	$C------UPDATE CHUNK DIRECTORY ENTRY.      DO I = ISTRT, NENTRIES        ICHUNK =  ICHNK(I)	ICD(3,ICHUNK) = LUND      ENDDO.C----- UPDATE SUBDB SECTORS OF CHUNK DIRECTORY	      J=1       ISECT=MHDR+(IDSUB-1)*MSECT      DO K=1,MSECT        ISECT=ISECT+1,        CALL DSWRIT(LCD,ISECT,JCD(J),LSD,IR)        IF (IR.NE.0) GO TO 74        J=J+LSD      ENDDO      LMOD=.TRUE.      DO ICHUNK=ISTRT,NENTRIESO!-------Is the next chunk in sequence, if so hold off printing range of chunks.K!       don't update first orbit id until print out sequence of consequtive!       orbits.'        IEND=ICD(1,ICHNK(ICHUNK)+1) - 1)	IF(IFLG.EQ.0)ISTART=ICD(1,ICHNK(ICHUNK))%	ITST = ICHNK(ICHUNK+1)-ICHNK(ICHUNK)D	TYPE*, ' ITEST ',ITST	IF(ITST.EQ.1)THEN		  IFLG=1	  GOTO 920    	ENDif	1!-------Reset flag no longer keeping first orbit.		IFLG=0)        WRITE(IOUT2,919)IDSUB,ISTART,IEND5 919    FORMAT(' VIKING ',I2,' Orbits ',I4,' to ',I4) 920  ENDDO	  200 CONTINUE            WRITE(IOUT2,1001)A1001  FORMAT(/' If you need additional orbits, please refer to: '     1 'Menu XHELP-CHUNKS',/,?     1 ' or run XGLOAD and DBLOAD under XGDATA-Loading Chunks',     1 ' to disk')
      GOTO 90	C  ERRORS 73   WRITE (IOUT,973) ISECT,IR? 973  FORMAT (' DISK FILE I/O ERROR IN SECTOR',I6,'  CODE ',I5)      GO TO 801 74   WRITE (IOUT,974) IR                        5 974  FORMAT (' CHUNK DIRECTORY I/O ERROR, CODE ',I5)      GO TO 80 75   WRITE (IOUT,975) IR2 975  FORMAT (' DISK FILE DELETE ERROR, CODE ',I5)      GO TO 80 77   WRITE (IOUT,977) IR0 977  FORMAT (' DISK FILE OPEN ERROR, CODE ',I5)      GO TO 80 78   WRITE (IOUT,978) IR' 978  FORMAT (' NO ROOM FOR DIRECTORY') 80   CONTINUE  90   CALL EXIT	      END