source: trunk/fsource/unpack_cbf.for @ 2445

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

fixes to pack_f.for & unpack_cbf.for; replace all binwin2.7 & binwin64-2.7 binaries

File size: 1.9 KB
RevLine 
[2437]1      SUBROUTINE UNPACK_CBF(N,CMPR,MXY,IMG)
2
3Cf2py intent(in) N
4Cf2py intent(in) CMPR
5Cf2py depend(N) CMPR
6Cf2py intent(in) MXY
7Cf2py intent(in,out) IMG
8Cf2py depend(MXY) IMG
9
10      IMPLICIT NONE
11      INTEGER*4 N,MXY
[2445]12      CHARACTER*1 CMPR(0:N-1)
[2437]13      INTEGER*4 IMG(0:MXY-1),BASEPIXEL
14      INTEGER*4 I,J,ISIZE
15      CHARACTER*1 C1,E1
16      CHARACTER*2 C2,E2
17      CHARACTER*4 C4,E4
18      INTEGER*1 IONEBYTE
19      INTEGER*2 ITWOBYTES
20      INTEGER*4 IFOURBYTES
[2441]21
[2437]22      E1 = CHAR(128)
23      E2 = CHAR(0)//CHAR(128)
24      E4 = CHAR(0)//CHAR(0)//CHAR(0)//CHAR(128)
25
[2441]26      I = 0
[2437]27      J = 0
[2441]28      BASEPIXEL = 0
[2437]29      DO WHILE ( I.LT.N )
30        C1 = CMPR(I)
31        ISIZE = 1
32        IF ( C1.EQ.E1 ) THEN
33           ISIZE = 2
34           I = I+1
35           C2 = CMPR(I)//CMPR(I+1)
36           IF ( C2.EQ.E2 ) THEN
37              ISIZE = 4
38              I = I+2
39              C4 = CMPR(I)//CMPR(I+1)//CMPR(I+2)//CMPR(I+3)
40              IF ( C4.EQ.E4 ) THEN
41                 ISIZE = 8
42                 I = I+4
43              END IF
44           END IF
45        END IF
46        IF ( ISIZE .EQ. 1 ) THEN
47           IONEBYTE = ICHAR(CMPR(I))
48           I = I+1
49           BASEPIXEL = BASEPIXEL+IONEBYTE
50        ELSE IF ( ISIZE .EQ. 2 ) THEN
51           ITWOBYTES = ICHAR(CMPR(I))
52           ITWOBYTES = ITWOBYTES+ISHFT(ICHAR(CMPR(I+1)),8)
53           I = I+2
54           BASEPIXEL = BASEPIXEL+ITWOBYTES
55        ELSE IF ( ISIZE.EQ.4 ) THEN
56           IFOURBYTES = ICHAR(CMPR(I))
57           IFOURBYTES = IFOURBYTES+ISHFT(ICHAR(CMPR(I+1)),8)
58           IFOURBYTES = IFOURBYTES+ISHFT(ICHAR(CMPR(I+2)),16)
59           IFOURBYTES = IFOURBYTES+ISHFT(ICHAR(CMPR(I+3)),24)
60           I = I+4
61           BASEPIXEL = BASEPIXEL+IFOURBYTES
62        END IF
[2441]63c        IF ( MOD(J,100000).EQ.0 ) PRINT *,I,J,BASEPIXEL
[2437]64        IMG(J) = BASEPIXEL
65        J = J+1
66      END DO
67      RETURN
68      END
69
70     
Note: See TracBrowser for help on using the repository browser.