1 | SUBROUTINE PACK_F(N,CMPR,M,IMG) |
---|
2 | |
---|
3 | Cf2py intent(in) N |
---|
4 | Cf2py intent(in) CMPR |
---|
5 | Cf2py depend(N) CMPR |
---|
6 | Cf2py intent(in) M |
---|
7 | Cf2py intent(in,out) IMG |
---|
8 | Cf2py depend(M) IMG |
---|
9 | |
---|
10 | IMPLICIT NONE |
---|
11 | INTEGER*4 BITDECODE(0:7),SETBITS(0:16),IN,N,M,BITNUM |
---|
12 | INTEGER*4 PIXEL,SPILLBITS,USEDBITS,VALIDS,WINDOW,TOTAL |
---|
13 | INTEGER*4 IMG(0:M-1,0:M-1),NEXTINT |
---|
14 | INTEGER*4 SPILL,ROW,COL,PIXNUM,MM1 |
---|
15 | INTEGER*2 TMP |
---|
16 | CHARACTER*(*) CMPR(0:N-1) |
---|
17 | DATA BITDECODE /0,4,5,6,7,8,16,32/ |
---|
18 | DATA SETBITS /Z'0000',Z'0001',Z'0003',Z'0007', |
---|
19 | 1 Z'000F',Z'001F',Z'003F',Z'007F',Z'00FF', |
---|
20 | 1 Z'01FF',Z'03FF',Z'07FF',Z'0FFF',Z'1FFF', |
---|
21 | 1 Z'3FFF',Z'7FFF',Z'FFFF'/ |
---|
22 | |
---|
23 | PIXEL = 0 |
---|
24 | SPILLBITS = 0 |
---|
25 | SPILL = 0 |
---|
26 | USEDBITS = 0 |
---|
27 | VALIDS = 0 |
---|
28 | WINDOW = 0 |
---|
29 | ROW = 0 |
---|
30 | COL = 0 |
---|
31 | TOTAL = M**2 |
---|
32 | MM1 = M-1 |
---|
33 | IN = 0 |
---|
34 | DO WHILE (PIXEL .LT. TOTAL) |
---|
35 | IF (VALIDS .LT. 6) THEN |
---|
36 | IF (SPILLBITS .GT. 0) THEN |
---|
37 | WINDOW = IOR(WINDOW,ISHFT(SPILL,VALIDS)) |
---|
38 | VALIDS = VALIDS + SPILLBITS |
---|
39 | SPILLBITS = 0 |
---|
40 | ELSE |
---|
41 | SPILL = ICHAR(CMPR(IN)) |
---|
42 | IN = IN+1 |
---|
43 | SPILLBITS = 8 |
---|
44 | END IF |
---|
45 | ELSE |
---|
46 | PIXNUM = ISHFT(1,IAND(WINDOW,SETBITS(3))) |
---|
47 | WINDOW = ISHFT(WINDOW,-3) |
---|
48 | BITNUM = BITDECODE(IAND(WINDOW,SETBITS(3))) |
---|
49 | WINDOW = ISHFT(WINDOW,-3) |
---|
50 | VALIDS = VALIDS-6 |
---|
51 | DO WHILE ( (PIXNUM .GT. 0) .AND. (PIXEL .LT. TOTAL) ) |
---|
52 | IF ( VALIDS .LT. BITNUM ) THEN |
---|
53 | IF ( SPILLBITS .GT. 0 ) THEN |
---|
54 | WINDOW = IOR(WINDOW,ISHFT(SPILL,VALIDS)) |
---|
55 | IF ( (32-VALIDS) .GT. SPILLBITS ) THEN |
---|
56 | VALIDS = VALIDS + SPILLBITS |
---|
57 | SPILLBITS = 0 |
---|
58 | ELSE |
---|
59 | USEDBITS = 32-VALIDS |
---|
60 | SPILL = ISHFT(SPILL,-USEDBITS) |
---|
61 | SPILLBITS = SPILLBITS-USEDBITS |
---|
62 | VALIDS = 32 |
---|
63 | END IF |
---|
64 | ELSE |
---|
65 | SPILL = ICHAR(CMPR(IN)) |
---|
66 | IN = IN+1 |
---|
67 | SPILLBITS = 8 |
---|
68 | END IF |
---|
69 | ELSE |
---|
70 | PIXNUM = PIXNUM-1 |
---|
71 | IF ( BITNUM .EQ. 0 ) THEN |
---|
72 | NEXTINT = 0 |
---|
73 | ELSE |
---|
74 | NEXTINT = IAND(WINDOW,SETBITS(BITNUM)) |
---|
75 | VALIDS = VALIDS-BITNUM |
---|
76 | WINDOW = ISHFT(WINDOW,-BITNUM) |
---|
77 | IF ( BTEST(NEXTINT,BITNUM-1) ) |
---|
78 | 1 NEXTINT = IOR(NEXTINT,NOT(SETBITS(BITNUM))) |
---|
79 | END IF |
---|
80 | |
---|
81 | ROW = PIXEL/M |
---|
82 | COL = MOD(PIXEL,M) |
---|
83 | IF ( PIXEL .GT. M ) THEN |
---|
84 | IF ( COL .EQ. 0 ) THEN |
---|
85 | TMP = NEXTINT + |
---|
86 | 1 (IMG(MM1,ROW-1)+IMG(COL+1,ROW-1)+ |
---|
87 | 1 IMG(COL,ROW-1)+IMG(MM1,ROW-2) +2)/4 |
---|
88 | ELSE IF ( COL.EQ.MM1 ) THEN |
---|
89 | TMP = NEXTINT + |
---|
90 | 1 (IMG(COL-1,ROW)+IMG(0,ROW)+ |
---|
91 | 1 IMG(MM1,ROW-1)+IMG(MM1-1,ROW-1) +2)/4 |
---|
92 | ELSE |
---|
93 | TMP = NEXTINT + |
---|
94 | 1 (IMG(COL-1,ROW)+IMG(COL+1,ROW-1)+ |
---|
95 | 1 IMG(COL,ROW-1)+IMG(COL-1,ROW-1) +2)/4 |
---|
96 | END IF |
---|
97 | ELSE IF (PIXEL .NE. 0) THEN |
---|
98 | TMP = IMG(COL-1,ROW)+NEXTINT |
---|
99 | ELSE |
---|
100 | TMP = NEXTINT |
---|
101 | END IF |
---|
102 | IMG(COL,ROW) = TMP |
---|
103 | PIXEL = PIXEL+1 |
---|
104 | END IF |
---|
105 | END DO |
---|
106 | END IF |
---|
107 | END DO |
---|
108 | DO ROW=0,MM1 |
---|
109 | DO COL=0,MM1 |
---|
110 | IF ( IMG(COL,ROW).LT.0 ) IMG(COL,ROW) = IMG(COL,ROW)+65536 |
---|
111 | END DO |
---|
112 | END DO |
---|
113 | |
---|
114 | RETURN |
---|
115 | END |
---|
116 | |
---|
117 | |
---|