home *** CD-ROM | disk | FTP | other *** search
/ Voyagers to the Outer Planets 8: Jupiter / VoyagerstotheOuterPlanetsVol8.cdr / software / vaxdriv.for < prev   
Text File  |  1989-09-19  |  11KB  |  273 lines
  1.     PROGRAM VAXDRIV
  2. C********************************************************************
  3. C  THIS IS A SAMPLE PROGRAM WHICH READS AND DECOMPRESSES VOYAGER
  4. C  IMAGES AND WRITES THEM OUT IN PDS LABELLED FORMAT.  IT ALSO
  5. C  MODIFIES THE PDS LABELS TO REFLECT THE CONVERSION FROM VARIABLE
  6. C  TO FIXED RECORD FORMAT.  IT USES THE SUBROUTINES IN DECOMP.FOR
  7. C  TO PERFORM THE DECOMPRESSION.  TWO VERSIONS OF THE DRIVER EXIST, 
  8. C  ONE WHICH RUNS ON THE IBM PC USING MICROSOFT FORTRAN, VERSION 4.XX,
  9. C  AND ONE WHICH RUNS UNDER VAX/VMS FORTRAN.  THE TWO VERSIONS ARE 
  10. C  IDENTICAL EXCEPT FOR THE FILE OPEN STATEMENTS AND VARIABLE
  11. C  LENGTH RECORD I/O (READ STATEMENTS).
  12. C
  13. C_HIST
  14. C  AUG89 FIXED LENGTH OF OUTPUT SFDU.
  15. C  JUL88 PC AND VAX VERSIONS BY MIKE MARTIN 1988/07/30, WITH 
  16. C  ASSISTANCE FROM ROGER BOWEN, WHO CODED THE FIRST PC VERSIONS
  17. C  OF THESE ROUTINES.
  18. C
  19. C  INPUTS   - INPUT FILE TO BE DECOMPRESSED.
  20. C
  21. C  OUTPUTS  - OUTPUT FILE CONTAINING DECOMPRESSED IMAGE.
  22. C
  23. C  TO COMPILE AND LINK UNDER MICROSOFT FORTRAN USE THE COMMAND:
  24. C
  25. C    FL /FPi PCDRIV.FOR DECOMP.FOR
  26. C
  27. C  TO COMPILE AND LINK USING VAX/VMS FORTRAN USE THE COMMANDS:
  28. C
  29. C    FOR  VAXDRIV,DECOMP
  30. C    LINK VAXDRIV,DECOMP  
  31. C_END
  32. C_VARS
  33.     CHARACTER  NAME*80, INAME*80, LABSTRING*80, OUTSTRING*2508,
  34.      1           IBUF(2048), OBUF(2508),TEMPSTRING*80
  35.         CHARACTER CR,LF,BLANK
  36.         INTEGER*2 TOTAL_BYTES,LINE,I,J,NLEN
  37.     INTEGER*4 HIST(512),HISTIN(209)
  38.         INTEGER*4 LEN,NS
  39.     EQUIVALENCE (IBUF,LABSTRING,HISTIN), (OBUF,OUTSTRING)
  40. C********************************************************************
  41. C
  42. C INITIALIZE SOME CONSTANTS
  43. C
  44. C********************************************************************
  45.         CR    = CHAR(13)
  46.         LF    = CHAR(10)
  47.         BLANK = CHAR(32)
  48.         NS    = 836
  49. C********************************************************************
  50. C
  51. C GET INPUT AND OUTPUT FILE NAMES AND OPEN THE FILES
  52. C
  53. C********************************************************************
  54.     WRITE (*,1000)
  55. 1000    FORMAT(' ENTER NAME OF FILE TO BE DECOMPRESSED: ')
  56. 1020    FORMAT(A)
  57.     READ  (*,1020) INAME
  58.         WRITE (*,1010)
  59. 1010    FORMAT(' ENTER NAME OF UNCOMPRESSED OUTPUT FILE:')
  60.         READ  (*,1020) NAME
  61.     OPEN  (10,FILE=INAME,FORM='FORMATTED',STATUS='OLD',READONLY)
  62.     OPEN  (11,FILE=NAME, FORM='UNFORMATTED',STATUS='NEW',
  63.      1            RECORDTYPE='FIXED',RECORDSIZE=209)
  64. C********************************************************************
  65. C
  66. C READ AND PROCESS THE COMPRESSED FILE LABELS.  
  67. C 
  68. C ALL THE LABELS ARE CONCATINATED INTO AN ARRAY, TO ALLOW THE 50-ODD 
  69. C LABEL LINES TO BE WRITTEN OUT AS 3-FIXED-LENGTH RECORDS ON THE VAX.
  70. C
  71. C********************************************************************
  72.         TOTAL_BYTES = 0
  73.   101   FORMAT(Q,A)
  74.   100   READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)
  75. C********************************************************************
  76. C
  77. C EDIT THE PDS LABELS WHICH HAVE TO BE CHANGED.
  78. C
  79. C********************************************************************
  80. C CHANGE THE LENGTH FIELD OF THE SFDU LABEL
  81. C********************************************************************
  82.         I = INDEX(LABSTRING,'NJPL1I00PDS1')
  83.         IF (I .EQ. 1) THEN 
  84.           TEMPSTRING = LABSTRING(1:12) // '00673796' // 
  85.      1                 LABSTRING(21:NLEN)
  86.           OUTSTRING = TEMPSTRING(1:NLEN) // CR // LF
  87.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  88.           GOTO 100
  89.         ENDIF
  90. C********************************************************************
  91. C CHANGE THE RECORD TYPE FROM VARIABLE TO FIXED
  92. C********************************************************************
  93.         I = INDEX(LABSTRING,'RECORD_TYPE')
  94.         IF (I .EQ. 1) THEN 
  95.           TEMPSTRING = LABSTRING(1:35) // 'FIXED_LENGTH'
  96.           NLEN = NLEN-3
  97.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  98.      1                // CR // LF
  99.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  100.           GOTO 100
  101.         ENDIF
  102. C********************************************************************
  103. C CHANGE THE FILE RECORD COUNT TO REFLECT THE FIXED STRUCTURE
  104. C********************************************************************
  105.         I = INDEX(LABSTRING,'FILE_RECORDS')
  106.         IF (I .EQ. 1) THEN 
  107.           TEMPSTRING = LABSTRING(1:35) // '806'
  108.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  109.      1                // CR // LF
  110.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  111.           GOTO 100
  112.         ENDIF
  113. C********************************************************************
  114. C CHANGE THE COUNT OF LABEL RECORDS TO 3
  115. C********************************************************************
  116.         I = INDEX(LABSTRING,'LABEL_RECORDS')
  117.         IF (I .EQ. 1) THEN 
  118.           TEMPSTRING = LABSTRING(1:35) // '3'
  119.           NLEN = NLEN -1
  120.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  121.      1                // CR // LF
  122.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  123.           GOTO 100
  124.         ENDIF
  125. C********************************************************************
  126. C CHANGE THE LOCATION POINTER OF THE HISTOGRAM TO RECORD 4
  127. C********************************************************************
  128.         I = INDEX(LABSTRING,'^IMAGE_HISTOGRAM')
  129.         IF (I .EQ. 1) THEN 
  130.           TEMPSTRING = LABSTRING(1:35) // '4'
  131.           NLEN = NLEN -1
  132.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  133.      1                // CR // LF
  134.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  135.           GOTO 100
  136.         ENDIF
  137. C********************************************************************
  138. C DELETE THE ENCODING HISTOGRAM LOCATION POINTER
  139. C********************************************************************
  140.         I = INDEX(LABSTRING,'^ENCODING_HISTOGRAM')
  141.         IF (I .EQ. 1) GOTO 100
  142. C********************************************************************
  143. C CHANGE THE LOCATION POINTER OF THE ENGINEERING TABLE TO RECORD 6
  144. C********************************************************************
  145.         I = INDEX(LABSTRING,'^ENGINEERING_TABLE')
  146.         IF (I .EQ. 1) THEN 
  147.           TEMPSTRING = LABSTRING(1:35) // '6'
  148.           NLEN = NLEN -1
  149.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  150.      1                // CR // LF
  151.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  152.           GOTO 100
  153.         ENDIF
  154. C********************************************************************
  155. C CHANGE THE LOCATION POINTER OF THE IMAGE TO RECORD 7
  156. C********************************************************************
  157.         I = INDEX(LABSTRING,'^IMAGE')
  158.         IF (I .EQ. 1) THEN 
  159.           TEMPSTRING = LABSTRING(1:35) // '7'
  160.           NLEN = NLEN -1
  161.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  162.      1                // CR // LF
  163.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  164.           GOTO 100
  165.         ENDIF
  166. C********************************************************************
  167. C DELETE THE ENCODING HISTOGRAM OBJECT DEFINITION
  168. C********************************************************************
  169.         I = INDEX(LABSTRING,
  170.      1            'OBJECT                           = ENCODING_')
  171.         IF (I .EQ. 1) THEN 
  172.           READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)
  173.           READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)
  174.           READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)
  175.           READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)
  176.           GOTO 100
  177.         ENDIF
  178. C********************************************************************
  179. C DELETE THE ENCODING TYPE KEYWORD IN THE IMAGE OBJECT DEFINITION
  180. C********************************************************************
  181.         I = INDEX(LABSTRING,' ENCODING')
  182.         IF (I .EQ. 1) GOTO 100
  183. C********************************************************************
  184. C IF WE GET HERE JUST WRITE OUT THE LABEL
  185. C********************************************************************
  186.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // LABSTRING(1:NLEN) 
  187.      1                // CR // LF
  188.         TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  189.         I= INDEX(LABSTRING,'END') 
  190.         IF (I .EQ. 1 .AND. NLEN .EQ. 3) GOTO 300
  191.         GOTO 100
  192. C********************************************************************
  193. C PAD OUT LABELS TO MULTIPLE OF 836
  194. C********************************************************************
  195. 300     DO 310 I=TOTAL_BYTES+1,2508
  196. 310     OBUF(I) =  BLANK
  197. C********************************************************************
  198. C NOW WRITE OUT THE LABEL RECORDS IN 3-WRITES, FILLING OUT THE THIRD
  199. C RECORD TO 836 BYTES WITH BLANKS.
  200. C********************************************************************
  201.         WRITE(11) (OBUF(I), I=   1,  836)
  202.         WRITE(11) (OBUF(I), I= 837, 1672)
  203.         WRITE(11) (OBUF(I), I=1673, 2508)
  204. C********************************************************************
  205. C
  206. C READ AND WRITE THE IMAGE HISTOGRAM AS TWO RECORDS, FILLING OUT THE
  207. C SECOND RECORD TO 836 BYTES WITH BLANKS.
  208. C
  209. C********************************************************************
  210.         DO 320 J=1,2
  211.         READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)
  212.         IF (NLEN .EQ. 836) WRITE(11) (IBUF(I), I=1, NLEN)
  213. 320     CONTINUE
  214.         DO 330 I=NLEN+1,836
  215. 330     IBUF(I) =  BLANK
  216.         WRITE(11) (IBUF(I), I=1, 836)
  217. C********************************************************************
  218. C
  219. C READ THE ENCODING HISTOGRAM, AND LOAD THE HIST ARRAY FOR USE BY
  220. C THE DECOMPRESSION SUBROUTINES.
  221. C
  222. C********************************************************************
  223.         READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)
  224.         DO 340 I=1,209
  225. 340       HIST(I) = HISTIN(I)
  226.         READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)
  227.         DO 350 I=1,209
  228. 350       HIST(I+209) = HISTIN(I)
  229.         READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)
  230.         DO 360 I=1,93
  231. 360       HIST(I+418) = HISTIN(I)
  232. C********************************************************************
  233. C
  234. C READ AND WRITE THE ENGINEERING SUMMARY AS ONE RECORD, FILLING OUT 
  235. C THE RECORD TO 836 BYTES WITH BLANKS.
  236. C
  237. C********************************************************************
  238.         READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)
  239.         DO 370 I=NLEN+1,836
  240. 370     IBUF(I) = BLANK
  241.         WRITE(11) (IBUF(I), I=1, 836)
  242. C********************************************************************
  243. C
  244. C INITIALIZE THE DECOMPRESSION.
  245. C
  246. C********************************************************************
  247.     WRITE(*,*) 'INITIALIZING DECOMPRESSION ROUTINE...'
  248.     CALL DECMPINIT(HIST)
  249. C********************************************************************
  250. C
  251. C PERFORM THE DECOMPRESSION.
  252. C
  253. C********************************************************************
  254.     WRITE(*,*) 'DECOMPRESSING DATA...'
  255.         LINE=0
  256. 400    READ(10,101,END=500) NLEN, LABSTRING(1:NLEN)
  257.         LINE = LINE + 1
  258.                 LEN = NLEN
  259.                 CALL DECOMPRESS(IBUF, OBUF, LEN, NS)
  260.         WRITE(11) (OBUF(I), I=1, NS)
  261.                 J = MOD(LINE,100)
  262.                 IF (J .EQ. 0) WRITE (*,'(I5,A6)') LINE,' LINES'
  263.                 IF (LINE .EQ. 800) GOTO 500
  264.                 GO TO 400
  265. C********************************************************************
  266. C
  267. C DONE.  CLOSE FILES AND GET OUT OF HERE.
  268. C
  269. C********************************************************************
  270. 500    CLOSE(10)
  271.     CLOSE(11)
  272.     END
  273.