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