source: trunk/fsource/pack_f.for

Last change on this file was 3144, checked in by vondreele, 6 years ago

fix MAR345 & CBF importers to work for python 3.6 as well as python 2.7; revised importers & new fortran decompression routines for py3.
File size: 7.4 KB
Line 
1      SUBROUTINE PACK_F(N,CMPR,MX,MY,IMG)
2
3Cf2py intent(in) N
4Cf2py intent(in) CMPR
5Cf2py depend(N) CMPR
6Cf2py intent(in) MX
7Cf2py intent(in) MY
8Cf2py intent(in,out) IMG
9Cf2py depend(MX,MY) IMG
10
11      IMPLICIT NONE
12      INTEGER*4 BITDECODE(0:7),SETBITS(0:16),IN,N,MX,MY,BITNUM
13      INTEGER*4 PIXEL,SPILLBITS,USEDBITS,VALIDS,WINDOW,TOTAL
14      INTEGER*4 IMG(0:MX-1,0:MY-1),NEXTINT
15      INTEGER*4 SPILL,ROW,COL,PIXNUM,MM1
16      INTEGER*2 TMP
17      CHARACTER*1 CMPR(0:N-1)
18      DATA BITDECODE /0,4,5,6,7,8,16,32/
19      DATA SETBITS /Z'0000',Z'0001',Z'0003',Z'0007',
20     1  Z'000F',Z'001F',Z'003F',Z'007F',Z'00FF',
21     1  Z'01FF',Z'03FF',Z'07FF',Z'0FFF',Z'1FFF',
22     1  Z'3FFF',Z'7FFF',Z'FFFF'/
23
24      PIXEL = 0
25      SPILLBITS = 0
26      SPILL = 0
27      USEDBITS = 0
28      VALIDS = 0
29      WINDOW = 0
30      ROW = 0
31      COL = 0
32      TOTAL = MX*MY
33      MM1 = MX-1
34      IN = 0
35      DO WHILE (PIXEL .LT. TOTAL)
36        IF (VALIDS .LT. 6) THEN
37          IF (SPILLBITS .GT. 0) THEN
38            WINDOW = IOR(WINDOW,ISHFT(SPILL,VALIDS))
39            VALIDS = VALIDS + SPILLBITS
40            SPILLBITS = 0
41          ELSE
42            SPILL = ICHAR(CMPR(IN))
43            IN = IN+1
44            SPILLBITS = 8
45          END IF
46        ELSE
47          PIXNUM = ISHFT(1,IAND(WINDOW,SETBITS(3)))
48          WINDOW = ISHFT(WINDOW,-3)
49          BITNUM = BITDECODE(IAND(WINDOW,SETBITS(3)))
50          WINDOW = ISHFT(WINDOW,-3)
51          VALIDS = VALIDS-6
52          DO WHILE ( (PIXNUM .GT. 0) .AND. (PIXEL .LT. TOTAL) )
53            IF ( VALIDS .LT. BITNUM ) THEN
54              IF ( SPILLBITS .GT. 0 ) THEN
55                WINDOW = IOR(WINDOW,ISHFT(SPILL,VALIDS))
56                IF ( (32-VALIDS) .GT. SPILLBITS ) THEN
57                  VALIDS = VALIDS + SPILLBITS
58                  SPILLBITS = 0
59                ELSE
60                  USEDBITS = 32-VALIDS
61                  SPILL = ISHFT(SPILL,-USEDBITS)
62                  SPILLBITS = SPILLBITS-USEDBITS
63                  VALIDS = 32
64                END IF
65              ELSE
66                SPILL = ICHAR(CMPR(IN))
67                IN = IN+1
68                SPILLBITS = 8
69              END IF               
70            ELSE
71              PIXNUM = PIXNUM-1
72              IF ( BITNUM .EQ. 0 ) THEN
73                NEXTINT = 0
74              ELSE
75                NEXTINT = IAND(WINDOW,SETBITS(BITNUM))
76                VALIDS = VALIDS-BITNUM
77                WINDOW = ISHFT(WINDOW,-BITNUM)
78                IF ( BTEST(NEXTINT,BITNUM-1) ) 
79     1            NEXTINT = IOR(NEXTINT,NOT(SETBITS(BITNUM)))
80              END IF
81
82              ROW = PIXEL/MX
83              COL = MOD(PIXEL,MX)
84              IF ( PIXEL .GT. MX ) THEN
85                IF ( COL .EQ. 0 ) THEN
86                  TMP = NEXTINT +
87     1              (IMG(MM1,ROW-1)+IMG(COL+1,ROW-1)+
88     1              IMG(COL,ROW-1)+IMG(MM1,ROW-2) +2)/4
89                ELSE IF ( COL.EQ.MM1 ) THEN
90                  TMP = NEXTINT +
91     1              (IMG(COL-1,ROW)+IMG(0,ROW)+
92     1              IMG(MM1,ROW-1)+IMG(MM1-1,ROW-1) +2)/4
93                ELSE
94                  TMP = NEXTINT + 
95     1              (IMG(COL-1,ROW)+IMG(COL+1,ROW-1)+
96     1              IMG(COL,ROW-1)+IMG(COL-1,ROW-1) +2)/4
97                END IF
98              ELSE IF (PIXEL .NE. 0) THEN
99                TMP = IMG(COL-1,ROW)+NEXTINT
100              ELSE
101                TMP = NEXTINT
102              END IF
103              IMG(COL,ROW) = TMP
104              PIXEL = PIXEL+1
105            END IF
106          END DO
107        END IF     
108      END DO
109      DO ROW=0,MM1
110        DO COL=0,MM1
111            IF ( IMG(COL,ROW).LT.0 ) IMG(COL,ROW) = IMG(COL,ROW)+65536
112        END DO
113      END DO
114     
115      RETURN
116      END
117
118     
119      SUBROUTINE PACK_F3(N,CMPR,MX,MY,IMG)
120
121Cf2py intent(in) N
122Cf2py intent(in) CMPR
123Cf2py depend(N) CMPR
124Cf2py intent(in) MX
125Cf2py intent(in) MY
126Cf2py intent(in,out) IMG
127Cf2py depend(MX,MY) IMG
128
129      IMPLICIT NONE
130      INTEGER*4 BITDECODE(0:7),SETBITS(0:16),IN,N,MX,MY,BITNUM
131      INTEGER*4 PIXEL,SPILLBITS,USEDBITS,VALIDS,WINDOW,TOTAL
132      INTEGER*4 IMG(0:MX-1,0:MY-1),NEXTINT
133      INTEGER*4 SPILL,ROW,COL,PIXNUM,MM1
134      INTEGER*2 TMP
135      INTEGER*1 CMPR(0:N-1)
136      DATA BITDECODE /0,4,5,6,7,8,16,32/
137      DATA SETBITS /Z'0000',Z'0001',Z'0003',Z'0007',
138     1  Z'000F',Z'001F',Z'003F',Z'007F',Z'00FF',
139     1  Z'01FF',Z'03FF',Z'07FF',Z'0FFF',Z'1FFF',
140     1  Z'3FFF',Z'7FFF',Z'FFFF'/
141
142      PIXEL = 0
143      SPILLBITS = 0
144      SPILL = 0
145      USEDBITS = 0
146      VALIDS = 0
147      WINDOW = 0
148      ROW = 0
149      COL = 0
150      TOTAL = MX*MY
151      MM1 = MX-1
152      IN = 0
153      DO WHILE (PIXEL .LT. TOTAL)
154        IF (VALIDS .LT. 6) THEN
155          IF (SPILLBITS .GT. 0) THEN
156            WINDOW = IOR(WINDOW,ISHFT(SPILL,VALIDS))
157            VALIDS = VALIDS + SPILLBITS
158            SPILLBITS = 0
159          ELSE
160            SPILL = ICHAR(CHAR(CMPR(IN)))
161            IN = IN+1
162            SPILLBITS = 8
163          END IF
164        ELSE
165          PIXNUM = ISHFT(1,IAND(WINDOW,SETBITS(3)))
166          WINDOW = ISHFT(WINDOW,-3)
167          BITNUM = BITDECODE(IAND(WINDOW,SETBITS(3)))
168          WINDOW = ISHFT(WINDOW,-3)
169          VALIDS = VALIDS-6
170          DO WHILE ( (PIXNUM .GT. 0) .AND. (PIXEL .LT. TOTAL) )
171            IF ( VALIDS .LT. BITNUM ) THEN
172              IF ( SPILLBITS .GT. 0 ) THEN
173                WINDOW = IOR(WINDOW,ISHFT(SPILL,VALIDS))
174                IF ( (32-VALIDS) .GT. SPILLBITS ) THEN
175                  VALIDS = VALIDS + SPILLBITS
176                  SPILLBITS = 0
177                ELSE
178                  USEDBITS = 32-VALIDS
179                  SPILL = ISHFT(SPILL,-USEDBITS)
180                  SPILLBITS = SPILLBITS-USEDBITS
181                  VALIDS = 32
182                END IF
183              ELSE
184                SPILL = ICHAR(CHAR(CMPR(IN)))
185                IN = IN+1
186                SPILLBITS = 8
187              END IF               
188            ELSE
189              PIXNUM = PIXNUM-1
190              IF ( BITNUM .EQ. 0 ) THEN
191                NEXTINT = 0
192              ELSE
193                NEXTINT = IAND(WINDOW,SETBITS(BITNUM))
194                VALIDS = VALIDS-BITNUM
195                WINDOW = ISHFT(WINDOW,-BITNUM)
196                IF ( BTEST(NEXTINT,BITNUM-1) ) 
197     1            NEXTINT = IOR(NEXTINT,NOT(SETBITS(BITNUM)))
198              END IF
199
200              ROW = PIXEL/MX
201              COL = MOD(PIXEL,MX)
202              IF ( PIXEL .GT. MX ) THEN
203                IF ( COL .EQ. 0 ) THEN
204                  TMP = NEXTINT +
205     1              (IMG(MM1,ROW-1)+IMG(COL+1,ROW-1)+
206     1              IMG(COL,ROW-1)+IMG(MM1,ROW-2) +2)/4
207                ELSE IF ( COL.EQ.MM1 ) THEN
208                  TMP = NEXTINT +
209     1              (IMG(COL-1,ROW)+IMG(0,ROW)+
210     1              IMG(MM1,ROW-1)+IMG(MM1-1,ROW-1) +2)/4
211                ELSE
212                  TMP = NEXTINT + 
213     1              (IMG(COL-1,ROW)+IMG(COL+1,ROW-1)+
214     1              IMG(COL,ROW-1)+IMG(COL-1,ROW-1) +2)/4
215                END IF
216              ELSE IF (PIXEL .NE. 0) THEN
217                TMP = IMG(COL-1,ROW)+NEXTINT
218              ELSE
219                TMP = NEXTINT
220              END IF
221              IMG(COL,ROW) = TMP
222              PIXEL = PIXEL+1
223            END IF
224          END DO
225        END IF     
226      END DO
227      DO ROW=0,MM1
228        DO COL=0,MM1
229            IF ( IMG(COL,ROW).LT.0 ) IMG(COL,ROW) = IMG(COL,ROW)+65536
230        END DO
231      END DO
232     
233      RETURN
234      END
235
Note: See TracBrowser for help on using the repository browser.