1 | SUBROUTINE PACK_F(N,CMPR,MX,MY,IMG) |
---|
2 | |
---|
3 | Cf2py intent(in) N |
---|
4 | Cf2py intent(in) CMPR |
---|
5 | Cf2py depend(N) CMPR |
---|
6 | Cf2py intent(in) MX |
---|
7 | Cf2py intent(in) MY |
---|
8 | Cf2py intent(in,out) IMG |
---|
9 | Cf2py 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 | LOGICAL*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 = CMPR(IN) |
---|
43 | C SPILL = ICHAR(CMPR(IN)) |
---|
44 | IN = IN+1 |
---|
45 | SPILLBITS = 8 |
---|
46 | END IF |
---|
47 | ELSE |
---|
48 | PIXNUM = ISHFT(1,IAND(WINDOW,SETBITS(3))) |
---|
49 | WINDOW = ISHFT(WINDOW,-3) |
---|
50 | BITNUM = BITDECODE(IAND(WINDOW,SETBITS(3))) |
---|
51 | WINDOW = ISHFT(WINDOW,-3) |
---|
52 | VALIDS = VALIDS-6 |
---|
53 | DO WHILE ( (PIXNUM .GT. 0) .AND. (PIXEL .LT. TOTAL) ) |
---|
54 | IF ( VALIDS .LT. BITNUM ) THEN |
---|
55 | IF ( SPILLBITS .GT. 0 ) THEN |
---|
56 | WINDOW = IOR(WINDOW,ISHFT(SPILL,VALIDS)) |
---|
57 | IF ( (32-VALIDS) .GT. SPILLBITS ) THEN |
---|
58 | VALIDS = VALIDS + SPILLBITS |
---|
59 | SPILLBITS = 0 |
---|
60 | ELSE |
---|
61 | USEDBITS = 32-VALIDS |
---|
62 | SPILL = ISHFT(SPILL,-USEDBITS) |
---|
63 | SPILLBITS = SPILLBITS-USEDBITS |
---|
64 | VALIDS = 32 |
---|
65 | END IF |
---|
66 | ELSE |
---|
67 | SPILL = CMPR(IN) |
---|
68 | C SPILL = ICHAR(CMPR(IN)) |
---|
69 | IN = IN+1 |
---|
70 | SPILLBITS = 8 |
---|
71 | END IF |
---|
72 | ELSE |
---|
73 | PIXNUM = PIXNUM-1 |
---|
74 | IF ( BITNUM .EQ. 0 ) THEN |
---|
75 | NEXTINT = 0 |
---|
76 | ELSE |
---|
77 | NEXTINT = IAND(WINDOW,SETBITS(BITNUM)) |
---|
78 | VALIDS = VALIDS-BITNUM |
---|
79 | WINDOW = ISHFT(WINDOW,-BITNUM) |
---|
80 | IF ( BTEST(NEXTINT,BITNUM-1) ) |
---|
81 | 1 NEXTINT = IOR(NEXTINT,NOT(SETBITS(BITNUM))) |
---|
82 | END IF |
---|
83 | |
---|
84 | ROW = PIXEL/MX |
---|
85 | COL = MOD(PIXEL,MX) |
---|
86 | IF ( PIXEL .GT. MX ) THEN |
---|
87 | IF ( COL .EQ. 0 ) THEN |
---|
88 | TMP = NEXTINT + |
---|
89 | 1 (IMG(MM1,ROW-1)+IMG(COL+1,ROW-1)+ |
---|
90 | 1 IMG(COL,ROW-1)+IMG(MM1,ROW-2) +2)/4 |
---|
91 | ELSE IF ( COL.EQ.MM1 ) THEN |
---|
92 | TMP = NEXTINT + |
---|
93 | 1 (IMG(COL-1,ROW)+IMG(0,ROW)+ |
---|
94 | 1 IMG(MM1,ROW-1)+IMG(MM1-1,ROW-1) +2)/4 |
---|
95 | ELSE |
---|
96 | TMP = NEXTINT + |
---|
97 | 1 (IMG(COL-1,ROW)+IMG(COL+1,ROW-1)+ |
---|
98 | 1 IMG(COL,ROW-1)+IMG(COL-1,ROW-1) +2)/4 |
---|
99 | END IF |
---|
100 | ELSE IF (PIXEL .NE. 0) THEN |
---|
101 | TMP = IMG(COL-1,ROW)+NEXTINT |
---|
102 | ELSE |
---|
103 | TMP = NEXTINT |
---|
104 | END IF |
---|
105 | IMG(COL,ROW) = TMP |
---|
106 | PIXEL = PIXEL+1 |
---|
107 | END IF |
---|
108 | END DO |
---|
109 | END IF |
---|
110 | END DO |
---|
111 | DO ROW=0,MM1 |
---|
112 | DO COL=0,MM1 |
---|
113 | IF ( IMG(COL,ROW).LT.0 ) IMG(COL,ROW) = IMG(COL,ROW)+65536 |
---|
114 | END DO |
---|
115 | END DO |
---|
116 | |
---|
117 | RETURN |
---|
118 | END |
---|
119 | |
---|
120 | |
---|