home *** CD-ROM | disk | FTP | other *** search
/ Voyagers to the Outer Planets 3: Uranus / VoyagestotheOuterPlanetsVol3.cdr / software / pcdriv.for < prev    next >
Text File  |  1988-09-14  |  11KB  |  271 lines

  1.     PROGRAM PCDRIV
  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='BINARY',BLOCKSIZE=51200)
  61.     OPEN  (11, FILE=NAME, STATUS='NEW', FORM='BINARY')
  62.  
  63. C********************************************************************
  64. C
  65. C READ AND PROCESS THE COMPRESSED FILE LABELS.  
  66. C ALL THE LABELS ARE CONCATINATED INTO AN ARRAY, TO ALLOW THE 50-ODD 
  67. C LABEL LINES TO BE WRITTEN OUT AS 3-FIXED-LENGTH RECORDS ON THE VAX.
  68. C
  69. C********************************************************************
  70.         TOTAL_BYTES = 0
  71. 100    READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  72. C********************************************************************
  73. C
  74. C EDIT THE PDS LABELS WHICH HAVE TO BE CHANGED.
  75. C
  76. C********************************************************************
  77. C CHANGE THE LENGTH FIELD OF THE SFDU LABEL
  78. C********************************************************************
  79.         I = INDEX(LABSTRING,'NJPL1I00PDS1')
  80.         IF (I .EQ. 1) THEN 
  81.           TEMPSTRING = LABSTRING(1:12) // '00673816' // 
  82.      1                 LABSTRING(21:NLEN)
  83.           OUTSTRING = TEMPSTRING(1:NLEN) // CR // LF
  84.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  85.           GOTO 100
  86.         ENDIF
  87. C********************************************************************
  88. C CHANGE THE RECORD TYPE FROM VARIABLE TO FIXED
  89. C********************************************************************
  90.         I = INDEX(LABSTRING,'RECORD_TYPE')
  91.         IF (I .EQ. 1) THEN 
  92.           TEMPSTRING = LABSTRING(1:35) // 'FIXED_LENGTH'
  93.           NLEN = NLEN-3
  94.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  95.      1                // CR // LF
  96.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  97.           GOTO 100
  98.         ENDIF
  99. C********************************************************************
  100. C CHANGE THE FILE RECORD COUNT TO REFLECT THE FIXED STRUCTURE
  101. C********************************************************************
  102.         I = INDEX(LABSTRING,'FILE_RECORDS')
  103.         IF (I .EQ. 1) THEN 
  104.           TEMPSTRING = LABSTRING(1:35) // '806'
  105.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  106.      1                // CR // LF
  107.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  108.           GOTO 100
  109.         ENDIF
  110. C********************************************************************
  111. C CHANGE THE COUNT OF LABEL RECORDS TO 3
  112. C********************************************************************
  113.         I = INDEX(LABSTRING,'LABEL_RECORDS')
  114.         IF (I .EQ. 1) THEN 
  115.           TEMPSTRING = LABSTRING(1:35) // '3'
  116.           NLEN = NLEN -1
  117.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  118.      1                // CR // LF
  119.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  120.           GOTO 100
  121.         ENDIF
  122. C********************************************************************
  123. C CHANGE THE LOCATION POINTER OF THE HISTOGRAM TO RECORD 4
  124. C********************************************************************
  125.         I = INDEX(LABSTRING,'^IMAGE_HISTOGRAM')
  126.         IF (I .EQ. 1) THEN 
  127.           TEMPSTRING = LABSTRING(1:35) // '4'
  128.           NLEN = NLEN -1
  129.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  130.      1                // CR // LF
  131.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  132.           GOTO 100
  133.         ENDIF
  134. C********************************************************************
  135. C DELETE THE ENCODING HISTOGRAM LOCATION POINTER
  136. C********************************************************************
  137.         I = INDEX(LABSTRING,'^ENCODING_HISTOGRAM')
  138.         IF (I .EQ. 1) GOTO 100
  139. C********************************************************************
  140. C CHANGE THE LOCATION POINTER OF THE ENGINEERING TABLE TO RECORD 6
  141. C********************************************************************
  142.         I = INDEX(LABSTRING,'^ENGINEERING_TABLE')
  143.         IF (I .EQ. 1) THEN 
  144.           TEMPSTRING = LABSTRING(1:35) // '6'
  145.           NLEN = NLEN -1
  146.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  147.      1                // CR // LF
  148.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  149.           GOTO 100
  150.         ENDIF
  151. C********************************************************************
  152. C CHANGE THE LOCATION POINTER OF THE IMAGE TO RECORD 7
  153. C********************************************************************
  154.         I = INDEX(LABSTRING,'^IMAGE')
  155.         IF (I .EQ. 1) THEN 
  156.           TEMPSTRING = LABSTRING(1:35) // '7'
  157.           NLEN = NLEN -1
  158.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  159.      1                // CR // LF
  160.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  161.           GOTO 100
  162.         ENDIF
  163. C********************************************************************
  164. C DELETE THE ENCODING HISTOGRAM OBJECT DEFINITION
  165. C********************************************************************
  166.         I = INDEX(LABSTRING,
  167.      1            'OBJECT                           = ENCODING_')
  168.         IF (I .EQ. 1) THEN 
  169.           READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  170.           READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  171.           READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  172.       READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  173.           GOTO 100
  174.         ENDIF
  175. C********************************************************************
  176. C DELETE THE ENCODING TYPE KEYWORD IN THE IMAGE OBJECT DEFINITION
  177. C********************************************************************
  178.         I = INDEX(LABSTRING,' ENCODING')
  179.         IF (I .EQ. 1) GOTO 100
  180. C********************************************************************
  181. C IF WE GET HERE JUST WRITE OUT THE LABEL
  182. C********************************************************************
  183.         OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // LABSTRING(1:NLEN) 
  184.      1              // CR // LF
  185.         TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  186.         I= INDEX(LABSTRING,'END') 
  187.         IF (I .EQ. 1 .AND. NLEN .EQ. 3) GOTO 300
  188.         GOTO 100
  189. C********************************************************************
  190. C PAD OUT LABELS TO MULTIPLE OF 836
  191. C********************************************************************
  192. 300     DO 310 I=TOTAL_BYTES+1,2508
  193. 310     OBUF(I) =  BLANK
  194. C********************************************************************
  195. C NOW WRITE OUT THE LABEL RECORDS IN 3-WRITES, FILLING OUT THE THIRD
  196. C RECORD TO 836 BYTES WITH BLANKS.
  197. C********************************************************************
  198.         WRITE(11) (OBUF(I), I=   1,  836)
  199.         WRITE(11) (OBUF(I), I= 837, 1672)
  200.         WRITE(11) (OBUF(I), I=1673, 2508)
  201. C********************************************************************
  202. C
  203. C READ AND WRITE THE IMAGE HISTOGRAM AS TWO RECORDS, FILLING OUT THE
  204. C SECOND RECORD TO 836 BYTES WITH BLANKS.
  205. C
  206. C********************************************************************
  207.         DO 320 J=1,2
  208.     READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  209.         IF (NLEN .EQ. 836) WRITE(11) (IBUF(I), I=1, NLEN)
  210. 320     CONTINUE
  211.         DO 330 I=NLEN+1,836
  212. 330     IBUF(I) =  BLANK
  213.         WRITE(11) (IBUF(I), I=1, 836)
  214. C********************************************************************
  215. C
  216. C READ THE ENCODING HISTOGRAM, AND LOAD THE HIST ARRAY FOR USE BY
  217. C THE DECOMPRESSION SUBROUTINES.
  218. C
  219. C********************************************************************
  220.     READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  221.         DO 340 I=1,209
  222. 340       HIST(I) = HISTIN(I)
  223.     READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  224.         DO 350 I=1,209
  225. 350       HIST(I+209) = HISTIN(I)
  226.     READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  227.         DO 360 I=1,93
  228. 360       HIST(I+418) = HISTIN(I)
  229. C********************************************************************
  230. C
  231. C READ AND WRITE THE ENGINEERING SUMMARY AS ONE RECORD, FILLING OUT 
  232. C THE RECORD TO 836 BYTES WITH BLANKS.
  233. C
  234. C********************************************************************
  235.     READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  236.         DO 370 I=NLEN+1,836
  237. 370     IBUF(I) = BLANK
  238.         WRITE(11) (IBUF(I), I=1, 836)
  239. C********************************************************************
  240. C
  241. C INITIALIZE THE DECOMPRESSION.
  242. C
  243. C********************************************************************
  244.     WRITE(*,*) 'INITIALIZING DECOMPRESSION ROUTINE...'
  245.     CALL DECMPINIT(HIST)
  246. C********************************************************************
  247. C
  248. C PERFORM THE DECOMPRESSION.
  249. C
  250. C********************************************************************
  251.     WRITE(*,*) 'DECOMPRESSING DATA...'
  252.         LINE=0
  253. 400    READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  254.         LINE = LINE + 1
  255.                 LEN = NLEN
  256.                 CALL DECOMPRESS(IBUF, OBUF, LEN, NS)
  257.         WRITE(11) (OBUF(I), I=1, NS)
  258.                 J = MOD(LINE,100)
  259.                 IF (J .EQ. 0) WRITE (*,'(I5,A6)') LINE,' LINES'
  260.                 IF (LINE .EQ. 800) GOTO 500
  261.                 GO TO 400
  262. C********************************************************************
  263. C
  264. C DONE.  CLOSE FILES AND GET OUT OF HERE.
  265. C
  266. C********************************************************************
  267. 500    CLOSE(10)
  268.     CLOSE(11)
  269.     END
  270.