PROGRAM VAXDRIVEC********************************************************************?C THIS IS A SAMPLE PROGRAM WHICH READS AND DECOMPRESSES VIKING>C IMAGES AND WRITES THEM OUT IN PDS LABELLED FORMAT. IT ALSOBC MODIFIES THE PDS LABELS TO REFLECT THE CONVERSION FROM VARIABLEAC TO FIXED RECORD FORMAT. IT USES THE SUBROUTINES IN DECOMP.FORCC TO PERFORM THE DECOMPRESSION. TWO VERSIONS OF THE DRIVER EXIST,FC ONE WHICH RUNS ON THE IBM PC USING MICROSOFT FORTRAN, VERSION 4.XX,BC 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).CC_HIST-C NOV90 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 VERSIONSC OF THESE ROUTINES.C,C INPUTS - INPUT FILE TO BE DECOMPRESSED.C8C 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.FORC>C TO COMPILE AND LINK USING VAX/VMS FORTRAN USE THE COMMANDS:CC FOR VAXDRIV,DECOMPC LINK VAXDRIV,DECOMPC_ENDC_VARS< CHARACTER NAME*80, INAME*80, LABSTRING*80, OUTSTRING*2408,8 1 IBUF(2048), OBUF(2408),TEMPSTRING*80,* 1 HDRBUF*37324,BUF(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), (OBUF,OUTSTRING) EQUIVALENCE (HDRBUF,BUF)EC********************************************************************CC INITIALIZE SOME CONSTANTSCEC******************************************************************** CR = CHAR(13) LF = CHAR(10) BLANK = CHAR(32) NS = 1204EC********************************************************************C4C GET INPUT AND OUTPUT FILE NAMES AND OPEN THE FILESCEC******************************************************************** WRITE (*,1000)71000 FORMAT(' ENTER NAME OF FILE TO BE DECOMPRESSED: ')1020 FORMAT(A) READ (*,1020) INAME WRITE (*,1010)71010 FORMAT(' ENTER NAME OF UNCOMPRESSED OUTPUT FILE:') READ (*,1020) NAME= OPEN (10,FILE=INAME,FORM='FORMATTED',STATUS='OLD',READONLY)6 OPEN (11,FILE=NAME, FORM='UNFORMATTED',STATUS='NEW',4 1 RECORDTYPE='FIXED',RECORDSIZE=301)EC********************************************************************C.C READ AND PROCESS THE COMPRESSED FILE LABELS.CDC ALL THE LABELS ARE CONCATINATED INTO AN ARRAY, TO ALLOW THE 50-ODDEC LABEL LINES TO BE WRITTEN OUT AS 2-FIXED-LENGTH RECORDS ON THE VAX.CEC******************************************************************** TOTAL_BYTES = 0 101 FORMAT(Q,A)4 100 READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)EC********************************************************************C/C EDIT THE PDS LABELS WHICH HAVE TO BE CHANGED.CEC********************************************************************+C CHANGE THE LENGTH FIELD OF THE SFDU LABELEC********************************************************************+ I = INDEX(LABSTRING,'NJPL1I00PDS1')+ J = INDEX(LABSTRING,'CCSD3ZF00001')( IF (I .EQ. 1 .OR. J .EQ. 1) THEN TEMPSTRING =A 1 'CCSD3ZF0000100000001NJPL3IF0PDS200000001 = SFDU_LABEL'2 OUTSTRING = TEMPSTRING(1:53) // CR // LF( TOTAL_BYTES = TOTAL_BYTES + 55 GOTO 100 ENDIFEC********************************************************************/C CHANGE THE RECORD TYPE FROM VARIABLE TO FIXEDEC********************************************************************* I = INDEX(LABSTRING,'RECORD_TYPE') IF (I .EQ. 1) THEN8 TEMPSTRING = LABSTRING(1:35) // 'FIXED_LENGTH' NLEN = NLEN-3D OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)! 1 // CR // LF. TOTAL_BYTES = TOTAL_BYTES + NLEN + 2 GOTO 100 ENDIFEC********************************************************************DC CHANGE THE RECORD BYTES TO 1204 (some variable length lines are >)EC********************************************************************+ I = INDEX(LABSTRING,'RECORD_BYTES') IF (I .EQ. 1) THEN0 TEMPSTRING = LABSTRING(1:35) // '1204'D OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)! 1 // CR // LF. TOTAL_BYTES = TOTAL_BYTES + NLEN + 2 GOTO 100 ENDIFEC********************************************************************=C CHANGE THE FILE RECORD COUNT TO REFLECT THE FIXED STRUCTUREEC********************************************************************+ I = INDEX(LABSTRING,'FILE_RECORDS') IF (I .EQ. 1) THEN0 TEMPSTRING = LABSTRING(1:35) // '1115'D OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)! 1 // CR // LF. TOTAL_BYTES = TOTAL_BYTES + NLEN + 2 GOTO 100 ENDIFEC********************************************************************(C CHANGE THE COUNT OF LABEL RECORDS TO 2EC********************************************************************, I = INDEX(LABSTRING,'LABEL_RECORDS') IF (I .EQ. 1) THEN- TEMPSTRING = LABSTRING(1:35) // '2' NLEN = NLEN -1D OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)! 1 // CR // LF. TOTAL_BYTES = TOTAL_BYTES + NLEN + 2 GOTO 100 ENDIFEC********************************************************************:C CHANGE THE LOCATION POINTER OF THE HISTOGRAM TO RECORD 3EC********************************************************************/ I = INDEX(LABSTRING,'^IMAGE_HISTOGRAM') IF (I .EQ. 1) THEN- TEMPSTRING = LABSTRING(1:35) // '3' NLEN = NLEN -1D OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)! 1 // CR // LF. TOTAL_BYTES = TOTAL_BYTES + NLEN + 2 GOTO 100 ENDIFEC********************************************************************0C DELETE THE ENCODING HISTOGRAM LOCATION POINTEREC********************************************************************2 I = INDEX(LABSTRING,'^ENCODING_HISTOGRAM') IF (I .EQ. 1) GOTO 100EC********************************************************************BC CHANGE THE LOCATION POINTER OF THE ENGINEERING TABLE TO RECORD 4EC********************************************************************1 I = INDEX(LABSTRING,'^ENGINEERING_TABLE') IF (I .EQ. 1) THEN- TEMPSTRING = LABSTRING(1:35) // '4' NLEN = NLEN -1D OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)! 1 // CR // LF. TOTAL_BYTES = TOTAL_BYTES + NLEN + 2 GOTO 100 ENDIFEC********************************************************************BC CHANGE THE LOCATION POINTER OF THE LINE HEADER TABLE TO RECORD 5EC********************************************************************1 I = INDEX(LABSTRING,'^LINE_HEADER_TABLE') IF (I .EQ. 1) THEN- TEMPSTRING = LABSTRING(1:35) // '5' NLEN = NLEN -1D OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN)! 1 // CR // LF. TOTAL_BYTES = TOTAL_BYTES + NLEN + 2 GOTO 100 ENDIFEC********************************************************************7C CHANGE THE LOCATION POINTER OF THE IMAGE TO RECORD 60EC********************************************************************% I = INDEX(LABSTRING,'^IMAGE') IF (I .EQ. 1) THEN. TEMPSTRING = LABSTRING(1:35) // '60'F OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN-2)! 1 // CR // LF* TOTAL_BYTES = TOTAL_BYTES + NLEN GOTO 100 ENDIFEC********************************************************************1C DELETE THE ENCODING HISTOGRAM OBJECT DEFINITIONEC******************************************************************** I = INDEX(LABSTRING,A 1 'OBJECT = ENCODING_') IF (I .EQ. 1) THEN6 READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)6 READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)6 READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)6 READ(10,101,END=500) NLEN, LABSTRING(1:NLEN) GOTO 100 ENDIFEC********************************************************************AC DELETE THE ENCODING TYPE KEYWORD IN THE IMAGE OBJECT DEFINITIONEC********************************************************************( I = INDEX(LABSTRING,' ENCODING') IF (I .EQ. 1) GOTO 100EC********************************************************************<C DELETE THE CHECKSUM KEYWORD IN THE IMAGE OBJECT DEFINITIONEC********************************************************************( I = INDEX(LABSTRING,' CHECKSUM') IF (I .EQ. 1) GOTO 100EC********************************************************************)C IF WE GET HERE JUST WRITE OUT THE LABELEC********************************************************************A OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // LABSTRING(1:NLEN) 1 // CR // LF, TOTAL_BYTES = TOTAL_BYTES + NLEN + 2! I= INDEX(LABSTRING,'END')0 IF (I .EQ. 1 .AND. NLEN .EQ. 3) GOTO 300 GOTO 100EC********************************************************************$C PAD OUT LABELS TO MULTIPLE OF 1204EC********************************************************************#300 DO 310 I=TOTAL_BYTES+1,2408310 OBUF(I) = BLANKEC********************************************************************.C NOW WRITE OUT THE LABEL RECORDS IN 2-WRITES.EC********************************************************************) WRITE(11) (OBUF(I), I= 1, 1204)) WRITE(11) (OBUF(I), I=1205, 2408)EC********************************************************************CCC READ AND WRITE THE IMAGE HISTOGRAM AS ONE RECORD, FILLING OUT THE#C RECORD TO 1204 BYTES WITH BLANKS.CEC********************************************************************4 READ(10,101,END=500) NLEN, LABSTRING(1:NLEN) DO 330 I=NLEN+1,1204330 IBUF(I) = BLANK& WRITE(11) (IBUF(I), I=1, 1204)EC********************************************************************CAC READ THE ENCODING HISTOGRAM, AND LOAD THE HIST ARRAY FOR USE BY C THE DECOMPRESSION SUBROUTINES.CEC********************************************************************4 READ(10,101,END=500) NLEN, LABSTRING(1:NLEN) DO 340 I=1,301340 HIST(I) = HISTIN(I)4 READ(10,101,END=500) NLEN, LABSTRING(1:NLEN) DO 350 I=1,211!350 HIST(I+301) = HISTIN(I)EC********************************************************************CCC READ AND WRITE THE ENGINEERING SUMMARY AS ONE RECORD, FILLING OUT'C THE RECORD TO 1204 BYTES WITH BLANKS.CEC********************************************************************4 READ(10,101,END=500) NLEN, LABSTRING(1:NLEN) DO 370 I=NLEN+1,1204370 IBUF(I) = BLANK& WRITE(11) (IBUF(I), I=1, 1204)EC********************************************************************C3C 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 VAXCEC********************************************************************DC READ THE FIRST 602 RECORDS (37324 is Least Common Mult of 62,1204) DO 380 J=1,6026 READ(10, 101, END=500) NLEN, LABSTRING(1:NLEN)0 IF (J .EQ. 1) HDRBUF = LABSTRING(1:NLEN)D IF (J .GT. 1) HDRBUF=HDRBUF(1:(J-1)*NLEN)//LABSTRING(1:NLEN)380 CONTINUE DO 382 J=1,310 WRITE(11) (BUF(I),I=1+(J-1)*1204,J*1204)382 CONTINUE C READ THE REMAINING 454 RECORDS DO 384 J=1,4546 READ(10, 101, END=500) NLEN, LABSTRING(1:NLEN)0 IF (J .EQ. 1) HDRBUF = LABSTRING(1:NLEN)D IF (J .GT. 1) HDRBUF=HDRBUF(1:(J-1)*NLEN)//LABSTRING(1:NLEN)384 CONTINUE#C BLANK OUT THE REMAINDER OF HDRBUF DO 386 I=28149, 28896 BUF(I) = BLANK386 CONTINUE DO 390 J=1,240 WRITE(11) (BUF(I),I=1+(J-1)*1204,J*1204)390 CONTINUEEC********************************************************************CC INITIALIZE THE DECOMPRESSION.CEC********************************************************************3 WRITE(*,*) 'INITIALIZING DECOMPRESSION ROUTINE...' CALL DECMPINIT(HIST)EC********************************************************************CC PERFORM THE DECOMPRESSION.CEC********************************************************************# WRITE(*,*) 'DECOMPRESSING DATA...' LINE=00400 READ(10,101,END=500) NLEN, LABSTRING(1:NLEN) LINE = LINE + 1 LEN = NLEN4 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 400EC********************************************************************C)C DONE. CLOSE FILES AND GET OUT OF HERE.CEC******************************************************************** 500 CLOSE(10) CLOSE(11) END