source: trunk/fsource/unpack_cbf.for @ 2437

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

new fortran routine for reading cbf files

File size: 1.8 KB
Line 
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
12      CHARACTER*1 CMPR(0:N-1)
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
21     
22      E1 = CHAR(128)
23      E2 = CHAR(0)//CHAR(128)
24      E4 = CHAR(0)//CHAR(0)//CHAR(0)//CHAR(128)
25
26      I = 1
27      J = 0
28      DO WHILE ( I.LT.N )
29        C1 = CMPR(I)
30        ISIZE = 1
31        IF ( C1.EQ.E1 ) THEN
32           ISIZE = 2
33           I = I+1
34           C2 = CMPR(I)//CMPR(I+1)
35           IF ( C2.EQ.E2 ) THEN
36              ISIZE = 4
37              I = I+2
38              C4 = CMPR(I)//CMPR(I+1)//CMPR(I+2)//CMPR(I+3)
39              IF ( C4.EQ.E4 ) THEN
40                 ISIZE = 8
41                 I = I+4
42              END IF
43           END IF
44        END IF
45c        BASEPIXEL = 0
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
63        IMG(J) = BASEPIXEL
64        J = J+1
65      END DO
66      RETURN
67      END
68
69     
Note: See TracBrowser for help on using the repository browser.