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