source: trunk/fsource/pack_f.for @ 1920

Last change on this file since 1920 was 1920, checked in by vondreele, 7 years ago

modify the pack-f.for code to read rectangular MAR images (NX != NY pixels) Recompiled the Windows 32 & 64 bit fortran sources.

File size: 3.7 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*(*) 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     
Note: See TracBrowser for help on using the repository browser.