source: trunk/fsource/pack_f.for @ 199

Last change on this file since 199 was 199, checked in by vondreele, 11 years ago

remove unused variables

File size: 3.7 KB
Line 
1      SUBROUTINE PACK_F(N,CMPR,M,IMG)
2
3Cf2py intent(in) N
4Cf2py intent(in) CMPR
5Cf2py depend(N) CMPR
6Cf2py intent(in) M
7Cf2py intent(in,out) IMG
8Cf2py 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     
Note: See TracBrowser for help on using the repository browser.