PROGRAM PCDRIV
C********************************************************************
C  THIS IS A SAMPLE PROGRAM WHICH READS AND DECOMPRESSES VIKING
C  IMAGES AND WRITES THEM OUT IN PDS LABELLED FORMAT.  IT ALSO
C  MODIFIES THE PDS LABELS TO REFLECT THE CONVERSION FROM VARIABLE
C  TO FIXED RECORD FORMAT.  IT USES THE SUBROUTINES IN DECOMP.FOR
C  TO PERFORM THE DECOMPRESSION.  TWO VERSIONS OF THE DRIVER EXIST,
C  ONE WHICH RUNS ON THE IBM PC USING MICROSOFT FORTRAN, VERSION 4.XX,
C  AND ONE WHICH RUNS UNDER VAX/VMS FORTRAN.  THE TWO VERSIONS ARE
C  IDENTICAL EXCEPT FOR THE FILE OPEN STATEMENTS AND VARIABLE
C  LENGTH RECORD I/O (READ STATEMENTS).
C
C_HIST
C  FEB90 REVISED TO DECOMPRESS VIKING IMAGES.
C  JUL88 PC AND VAX VERSIONS BY MIKE MARTIN 1988/07/30, WITH
C  ASSISTANCE FROM ROGER BOWEN, WHO CODED THE FIRST PC VERSIONS
C  OF THESE ROUTINES.
C
C  INPUTS   - INPUT FILE TO BE DECOMPRESSED.
C
C  OUTPUTS  - OUTPUT FILE CONTAINING DECOMPRESSED IMAGE.
C
C  TO COMPILE AND LINK UNDER MICROSOFT FORTRAN USE THE COMMAND:
C
C    FL /FPi PCDRIV.FOR DECOMP.FOR
C
C  TO COMPILE AND LINK USING VAX/VMS FORTRAN USE THE COMMANDS:
C
C    FOR  VAXDRIV,DECOMP
C    LINK VAXDRIV,DECOMP
C_END
C_VARS
	CHARACTER  NAME*80, INAME*80, LABSTRING*80, OUTSTRING*2408,
     1             IBUF(2048), OBUF(2408),TEMPSTRING*80,
     1             HDRBUF(37324)
        CHARACTER  CR,LF,BLANK
        INTEGER*2  TOTAL_BYTES,LINE,NLEN
	INTEGER*4  HIST(512),HISTIN(301)
        INTEGER*4  LEN,NS,I,J
        EQUIVALENCE (IBUF,LABSTRING,HISTIN,HDRBUF), (OBUF,OUTSTRING)
C********************************************************************
C
C INITIALIZE SOME CONSTANTS
C
C********************************************************************
        CR    = CHAR(13)
        LF    = CHAR(10)
        BLANK = CHAR(32)
        NS    = 1204
C********************************************************************
C
C GET INPUT AND OUTPUT FILE NAMES AND OPEN THE FILES
C
C********************************************************************
	WRITE (*,1000)
1000	FORMAT(' ENTER NAME OF FILE TO BE DECOMPRESSED: ')
1020	FORMAT(A)
	READ  (*,1020) INAME
        WRITE (*,1010)
1010	FORMAT(' ENTER NAME OF UNCOMPRESSED OUTPUT FILE:')
        READ  (*,1020) NAME
	OPEN  (10, FILE=INAME, FORM='BINARY',BLOCKSIZE=51200)
	OPEN  (11, FILE=NAME, STATUS='NEW', FORM='BINARY')

C********************************************************************
C
C READ AND PROCESS THE COMPRESSED FILE LABELS.
C
C ALL THE LABELS ARE CONCATINATED INTO AN ARRAY, TO ALLOW THE 50-ODD
C LABEL LINES TO BE WRITTEN OUT AS 2-FIXED-LENGTH RECORDS ON THE VAX.
C
C********************************************************************
        TOTAL_BYTES = 0
100	READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
C********************************************************************
C
C EDIT THE PDS LABELS WHICH HAVE TO BE CHANGED.
C
C********************************************************************
C CHANGE THE LENGTH FIELD OF THE SFDU LABEL
C********************************************************************
        I = INDEX(LABSTRING,'NJPL1I00PDS1')
        J = INDEX(LABSTRING,'CCSD3ZF00001')
        IF (I .EQ. 1 .OR. J .EQ. 1) THEN
          TEMPSTRING =
     1    'CCSD3ZF0000100000001NJPL3IF0PDS200000001 = SFDU_LABEL'
          OUTSTRING = TEMPSTRING(1:53) // CR // LF
          TOTAL_BYTES = TOTAL_BYTES + 55
          GOTO 100
        ENDIF
C********************************************************************
C CHANGE THE RECORD TYPE FROM VARIABLE TO FIXED
C********************************************************************
        I = INDEX(LABSTRING,'RECORD_TYPE')
        IF (I .EQ. 1) THEN
          TEMPSTRING = LABSTRING(1:35) // 'FIXED_LENGTH'
          NLEN = NLEN-3
          OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)
     1                // CR // LF
          TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
          GOTO 100
        ENDIF
C********************************************************************
C CHANGE THE RECORD BYTES TO 1204 (some variable length lines are >)
C********************************************************************
        I = INDEX(LABSTRING,'RECORD_BYTES')
        IF (I .EQ. 1) THEN
          TEMPSTRING = LABSTRING(1:35) // '1204'
          OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)
     1                // CR // LF
          TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
          GOTO 100
        ENDIF
C********************************************************************
C CHANGE THE FILE RECORD COUNT TO REFLECT THE FIXED STRUCTURE
C********************************************************************
        I = INDEX(LABSTRING,'FILE_RECORDS')
        IF (I .EQ. 1) THEN
          TEMPSTRING = LABSTRING(1:35) // '1115'
          OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)
     1                // CR // LF
          TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
          GOTO 100
        ENDIF
C********************************************************************
C CHANGE THE COUNT OF LABEL RECORDS TO 2
C********************************************************************
        I = INDEX(LABSTRING,'LABEL_RECORDS')
        IF (I .EQ. 1) THEN
          TEMPSTRING = LABSTRING(1:35) // '2'
          NLEN = NLEN -1
          OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)
     1                // CR // LF
          TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
          GOTO 100
        ENDIF
C********************************************************************
C CHANGE THE LOCATION POINTER OF THE HISTOGRAM TO RECORD 3
C********************************************************************
        I = INDEX(LABSTRING,'^IMAGE_HISTOGRAM')
        IF (I .EQ. 1) THEN
          TEMPSTRING = LABSTRING(1:35) // '3'
          NLEN = NLEN -1
          OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)
     1                // CR // LF
          TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
          GOTO 100
        ENDIF
C********************************************************************
C DELETE THE ENCODING HISTOGRAM LOCATION POINTER
C********************************************************************
        I = INDEX(LABSTRING,'^ENCODING_HISTOGRAM')
        IF (I .EQ. 1) GOTO 100
C********************************************************************
C CHANGE THE LOCATION POINTER OF THE ENGINEERING TABLE TO RECORD 4
C********************************************************************
        I = INDEX(LABSTRING,'^ENGINEERING_TABLE')
        IF (I .EQ. 1) THEN
          TEMPSTRING = LABSTRING(1:35) // '4'
          NLEN = NLEN -1
          OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)
     1                // CR // LF
          TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
          GOTO 100
        ENDIF
C********************************************************************
C CHANGE THE LOCATION POINTER OF THE LINE HEADER TABLE TO RECORD 5
C********************************************************************
        I = INDEX(LABSTRING,'^LINE_HEADER_TABLE')
        IF (I .EQ. 1) THEN
          TEMPSTRING = LABSTRING(1:35) // '5'
          NLEN = NLEN -1
          OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)
     1                // CR // LF
          TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
          GOTO 100
        ENDIF

C********************************************************************
C CHANGE THE LOCATION POINTER OF THE IMAGE TO RECORD 60
C********************************************************************
        I = INDEX(LABSTRING,'^IMAGE')
        IF (I .EQ. 1) THEN
          TEMPSTRING = LABSTRING(1:35) // '60'
          OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN-2)
     1                // CR // LF
          TOTAL_BYTES = TOTAL_BYTES + NLEN
          GOTO 100
        ENDIF
C********************************************************************
C DELETE THE ENCODING HISTOGRAM OBJECT DEFINITION
C********************************************************************
        I = INDEX(LABSTRING,
     1            'OBJECT                           = ENCODING_')
        IF (I .EQ. 1) THEN
          READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
    	  READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
    	  READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
	  READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
          GOTO 100
        ENDIF
C********************************************************************
C DELETE THE ENCODING TYPE KEYWORD IN THE IMAGE OBJECT DEFINITION
C********************************************************************
        I = INDEX(LABSTRING,' ENCODING')
        IF (I .EQ. 1) GOTO 100
C********************************************************************
C DELETE THE CHECKSUM KEYWORD IN THE IMAGE OBJECT DEFINITION
C********************************************************************
        I = INDEX(LABSTRING,' CHECKSUM')
        IF (I .EQ. 1) GOTO 100
C********************************************************************
C IF WE GET HERE JUST WRITE OUT THE LABEL
C********************************************************************
        OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // LABSTRING(1:NLEN)
     1              // CR // LF
        TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
        I= INDEX(LABSTRING,'END')
        IF (I .EQ. 1 .AND. NLEN .EQ. 3) GOTO 300
        GOTO 100
C********************************************************************
C PAD OUT LABELS TO MULTIPLE OF 1204
C********************************************************************
300     DO 310 I=TOTAL_BYTES+1,2408
310     OBUF(I) =  BLANK
C********************************************************************
C NOW WRITE OUT THE LABEL RECORDS IN 2-WRITES.
C********************************************************************
        WRITE(11) (OBUF(I), I=   1, 1204)
        WRITE(11) (OBUF(I), I=1205, 2408)
C********************************************************************
C
C READ AND WRITE THE IMAGE HISTOGRAM AS TWO RECORDS, FILLING OUT THE
C SECOND RECORD TO 1204 BYTES WITH BLANKS.
C
C********************************************************************
	READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
        DO 330 I=NLEN+1,1204
330     IBUF(I) =  BLANK
        WRITE(11) (IBUF(I), I=1, 1204)
C********************************************************************
C
C READ THE ENCODING HISTOGRAM, AND LOAD THE HIST ARRAY FOR USE BY
C THE DECOMPRESSION SUBROUTINES.
C
C********************************************************************
	READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
        DO 340 I=1,301
340       HIST(I) = HISTIN(I)
	READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
        DO 350 I=1,211
350       HIST(I+301) = HISTIN(I)
C********************************************************************
C
C READ AND WRITE THE ENGINEERING SUMMARY AS ONE RECORD, FILLING OUT
C THE RECORD TO 1204 BYTES WITH BLANKS.
C
C********************************************************************
	READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
        DO 370 I=NLEN+1,1204
370     IBUF(I) = BLANK
        WRITE(11) (IBUF(I), I=1, 1204)
C********************************************************************
C
C READ AND WRITE THE LINE HEADER TABLE, FILLING OUT
C THE LAST RECORD TO A MULTIPLE OF 1204 BYTES WITH BLANKS.
C RECORDS ARE READ INTO A BUFFER IN TWO LARGE CHUNKS SO THAT
C THE OUTPUT CAN BE WRITTEN IN 1204 BYTE RECORDS ON THE VAX
C
C********************************************************************
C READ THE FIRST 602 RECORDS (37324 is Least Common Mult of 62,1204)
        DO 380 J=1,602
        READ(10, END=500) NLEN, (HDRBUF(I),I=1+(J-1)*62,J*NLEN)
380     CONTINUE
        DO 382 J=1,31
        WRITE(11) (HDRBUF(I),I=1+(J-1)*1204,J*1204)
382     CONTINUE
C READ THE REMAINING 454 RECORDS
        DO 384 J=1,454
        READ(10,END=500) NLEN,(HDRBUF(I),I=1+(J-1)*62,J*NLEN)
384     CONTINUE
C BLANK OUT THE REMAINDER OF HDRBUF
        DO 386 I=28149, 28896
        HDRBUF(I) = BLANK
386     CONTINUE
        DO 390 J=1,24
        WRITE(11) (HDRBUF(I),I=1+(J-1)*1204,J*1204)
390     CONTINUE

C********************************************************************
C
C INITIALIZE THE DECOMPRESSION.
C
C********************************************************************
	WRITE(*,*) 'INITIALIZING DECOMPRESSION ROUTINE...'
	CALL DECMPINIT(HIST)
C********************************************************************
C
C PERFORM THE DECOMPRESSION.
C
C********************************************************************
	WRITE(*,*) 'DECOMPRESSING DATA...'
        LINE=0
400	READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
		LINE = LINE + 1
                LEN = NLEN
                CALL DECOMPRESS(IBUF, OBUF, LEN, NS)
		WRITE(11) (OBUF(I), I=1, NS)
                J = MOD(LINE,100)
                IF (J .EQ. 0) WRITE (*,'(I5,A6)') LINE,' LINES'
                IF (LINE .EQ. 1056) GOTO 500
                GO TO 400
C********************************************************************
C
C DONE.  CLOSE FILES AND GET OUT OF HERE.
C
C********************************************************************
500	CLOSE(10)
	CLOSE(11)
	END