m4_include(`fcblib_defines.m4')
`      INTEGER FUNCTION FCB_READ_XDS_I2(FILNAM,TAPIN,NX,NY,IFRAME,JFRAME)
!-----------------------------------------------------------------------
! Reads a 32 bit integer two''`s complement image compressed by a
! BYTE-OFFSET algorithm. W. Kabsch,  Version 9-2006
!
! REVISED 1-2007, H. J. Bernstein to conform to CBFlib_0.7.7
! (http://www.bernstein-plus-sons.com/software/CBF)
!
! The BYTE-OFFSET algorithm is a slightly simplified version of
! that described in Andy Hammersley''`s web page
! (http://www.esrf.fr/computing/Forum/imgCIF/cbf_definition.html)
!
!-----------------------------------------------------------------------
! FILNAM   - Name of the file countaining the image              (GIVEN)
! TAPIN    - Fortran device unit number assigned to image file   (GIVEN)
!   NX     - Number of "fast" pixels of the image                (GIVEN)
!   NY     - Number of "slow" pixels of the image                (GIVEN)
! IFRAME   - 16 bit coded image as needed by XDS                (RESULT)
! Returns (as function value)                                   (RESULT)
!             CBF_FORMAT (=1): 
!                cannot handle this CBF format (not implemented)
!             0: No error
!            -1: Cannot determine endian architecture of this machine
!            -2: Cannot open image file
!            -3: Wrong image format
!            -4: Cannot read image
!-----------------------------------------------------------------------
      IMPLICIT                       NONE
      CHARACTER(len=*),INTENT(IN) :: FILNAM
      INTEGER,         INTENT(IN) :: TAPIN,NX,NY
      INTEGER(2),      INTENT(OUT):: IFRAME(NX*NY)
      INTEGER(4),      INTENT(OUT):: JFRAME(NX,NY)
      INTEGER(8)       NELEM,NELEM_READ
! --  Definition of CBF_FORMAT'
      fcb_errcode_CBF_FORMAT
`! --  External functions called'
      fcb_interface_FCB_READ_BYTE
      fcb_interface_FCB_NEXT_BINARY
      fcb_interface_FCB_CI_STRNCMPARR
      fcb_interface_FCB_DECOMPRESS_PACKED_I4
      INTEGER(2)       CNT2PIX
`! --  Local variables
      INTEGER,PARAMETER:: FCB_BYTES_IN_REC='m4_ifelse(`fcb_bytes_in_rec',`',4096,`fcb_bytes_in_rec')`
      INTEGER             FCB_RECORD_SIZE,BYTE_IN_FILE,REC_IN_FILE,     &
			  STEP,FIRST2,LAST2,FIRST4,LAST4,I,J,IOS
      INTEGER(4)          DIFF,PIXVALUE,MARKER,IADR
      INTEGER(2)          SHORTINT
      INTEGER(1)          BUFFER(FCB_BYTES_IN_REC),LAST_CHAR,ONEBYTE,   &
			  TWOBYTES(2),FOURBYTES(4),ENDIANORDER(4),      &
			  MARKBYTES(4)
      INTEGER  ENCODING
'
      fcb_param_ENC_LIST_ALL
`      INTEGER  SIZE
      INTEGER  ID
      INTEGER  COMPRESSION
'
      fcb_param_CBF_LIST_ALL
`
      INTEGER  BITS,VORZEICHEN,REELL
      CHARACTER(len=24)   DIGEST
      CHARACTER(len=14)   BYTEORDER
      !Possible parameter values for BYTEORDER are:
	 !"LITTLE_ENDIAN"     supported
	 !"BIG_ENDIAN"    not supported
      INTEGER(8)  DIMOVER
      INTEGER(8)  DIM1       !Number of "fast" pixels of the image
      INTEGER(8)  DIM2       !Number of "slow" pixels of the image
      INTEGER(8)  DIM3
      INTEGER(8)  PADDING
      INTEGER(4)  PREV_ELEMENT

      DATA             ENDIANORDER/Z''`12''`,Z''`34''`,Z''`56''`,Z''`78''`/
      DATA             MARKBYTES/Z''`0C''`,Z''`1A''`,Z''`04''`,Z''`D5''`/

!-----------------------------------------------------------------------
! --  Determine endian architecture of this machine
!-----------------------------------------------------------------------
! Definition: If the lowest memory address of multi-byte data is
!             considered the starting address of the data, the least
!             significant byte (LSB) is at the lowest memory address
!             for a ''`little_endian''` cpu architecture.
!
! Example:    The 32 bit hex value Z''`12345678''` is stored as follows:
!             ENDIAN ORDER   BYTE0   BYTE1 BYTE2 BYTE3
!              Big Endian    12       34    56    78(LSB)
!            Little Endian   78(LSB)  56    34    12
!-----------------------------------------------------------------------
      PIXVALUE=TRANSFER(ENDIANORDER,PIXVALUE)
      STEP=0
      IF (PIXVALUE .EQ. int(Z''`78563412''`)) THEN !Little Endian machine
	 STEP=1
	 FIRST2=1;LAST2=2
	 FIRST4=1;LAST4=4
      ENDIF
      IF (PIXVALUE .EQ. int(Z''`12345678''`)) THEN ! Big Endian machine
	 STEP=-1
	 FIRST2=2;LAST2=1
	 FIRST4=4;LAST4=1
      ENDIF
      IF (STEP.EQ.0)GO TO 110

'fcb_macro_FCB_OPEN_CIFIN(`ERR=120',`IOSTAT=IOS',`GO TO 130') m4_dnl
`
      IF (IOS.GT.0) GO TO 140
!-----------------------------------------------------------------------
! --   Skip to the next binary and parse the MIME header
!-----------------------------------------------------------------------
      IF (FCB_NEXT_BINARY(TAPIN,LAST_CHAR,FCB_BYTES_IN_REC,BYTE_IN_FILE,&
	REC_IN_FILE,BUFFER,ENCODING,SIZE,ID,DIGEST,COMPRESSION,BITS,    &
	VORZEICHEN,REELL,BYTEORDER,DIMOVER,DIM1,DIM2,DIM3,PADDING).NE.0)&
	 GO TO 130
      IF ((DIM1.NE.NX).OR.(DIM2.NE.NY))GO TO 130

!-----------------------------------------------------------------------
! --  Advance to start of binary image data
!-----------------------------------------------------------------------
! In CBF the binary data begins immediately after the first occurence
! of the following 4 bytes (MARKBYTES) in the image file
!             Octet    Hex  Decimal             Purpose
!               1       0C   12       (ctrl-L) End the current page
!               2       1A   26       (ctrl-Z) Stop listings in MS-DOS
!               3       04   04       (Ctrl-D) Stop listings in UNIX
!               4       D5   213      Binary section begins
!               5..5+n-1              Binary data (n octets)
!-----------------------------------------------------------------------
      MARKER=TRANSFER(MARKBYTES,MARKER)
      FOURBYTES=0
      DO
	 DO I=1,3
	    FOURBYTES(I)=FOURBYTES(I+1)
	 ENDDO
	 BYTE_IN_FILE=BYTE_IN_FILE+1
	 IF (FCB_READ_BYTE(TAPIN,FCB_BYTES_IN_REC,BUFFER,               &
	    REC_IN_FILE,BYTE_IN_FILE,FOURBYTES(4)).NE.0) GO TO 140
	 PIXVALUE=TRANSFER(FOURBYTES,PIXVALUE)
	 IF (PIXVALUE.EQ.MARKER)EXIT
      ENDDO
      ! *** DEBUG *** PRINT *, "fwa-1 address of IMAGE at: "
      ! *** DEBUG *** PRINT *, "BYTE_IN_FILE: ", BYTE_IN_FILE
      ! *** DEBUG *** PRINT *, "REC_IN_FILE: ", REC_IN_FILE

!-----------------------------------------------------------------------
! --  Read data image of 32 bit two''`s complement integers, compressed
! --  by the BYTE-OFFSET algorithm.
! --  After the expansion the original pixel values are coded by 16 bit
! --  in a special way suitable for XDS (see INTEGER*2 FUNCTION CNT2PIX).
!-----------------------------------------------------------------------
      FCB_READ_XDS_I2=CBF_FORMAT  !Cannot handle this CBF format
      IF ((BYTEORDER.EQ."LITTLE_ENDIAN").AND.(ENCODING.EQ.ENC_NONE).AND.&
	  (IAND(COMPRESSION,CBF_COMPRESSION_MASK).EQ.CBF_BYTE_OFFSET))THEN
	 PIXVALUE=0
	 DO IADR=1,NX*NY
	    BYTE_IN_FILE=BYTE_IN_FILE+1
	    IF (FCB_READ_BYTE(TAPIN,FCB_BYTES_IN_REC,BUFFER,            &
	       REC_IN_FILE,BYTE_IN_FILE,ONEBYTE).NE.0) GO TO 140
	    DIFF=ONEBYTE
	    IF (DIFF.EQ.-128)THEN
	       DO I=FIRST2,LAST2,STEP
		  BYTE_IN_FILE=BYTE_IN_FILE+1
		  IF (FCB_READ_BYTE(TAPIN,FCB_BYTES_IN_REC,BUFFER,      &
		     REC_IN_FILE,BYTE_IN_FILE,TWOBYTES(I)).NE.0)GO TO 140
	       ENDDO
	       SHORTINT=TRANSFER(TWOBYTES,SHORTINT)
	       DIFF=SHORTINT
	       IF (DIFF.EQ.-32768)THEN
		  DO I=FIRST4,LAST4,STEP
		     BYTE_IN_FILE=BYTE_IN_FILE+1
		     IF (FCB_READ_BYTE(TAPIN,FCB_BYTES_IN_REC,BUFFER,   &
			REC_IN_FILE,BYTE_IN_FILE,FOURBYTES(I)).NE.0)    &
			GO TO 140
		  ENDDO
		  DIFF=TRANSFER(FOURBYTES,DIFF)
	       ENDIF
	    ENDIF
	    PIXVALUE=PIXVALUE+DIFF
	    IFRAME(IADR)=CNT2PIX(PIXVALUE) ! xds-specific 16 bit coding
	 ENDDO
	 FCB_READ_XDS_I2=0  !No error
	 ELSE
      IF ((BYTEORDER.EQ."LITTLE_ENDIAN").AND.(ENCODING.EQ.ENC_NONE).AND.&
	  ((IAND(COMPRESSION,CBF_COMPRESSION_MASK).EQ.CBF_PACKED) .OR.       &
	   (IAND(COMPRESSION,CBF_COMPRESSION_MASK).EQ.CBF_PACKED_V2)))THEN
	  NELEM = NX*NY
	  FCB_READ_XDS_I2=FCB_DECOMPRESS_PACKED_I4 (JFRAME,NELEM,NELEM_READ, &
        VORZEICHEN, COMPRESSION, DIM1, DIM2,  &
        TAPIN,FCB_BYTES_IN_REC,BYTE_IN_FILE,        &
        REC_IN_FILE,BUFFER)
      IF (NELEM_READ.NE.NELEM) PRINT *, "EARLY TERMINATION AT ",NELEM_READ
      PREV_ELEMENT = 0
      DO J = 1,NY
      DO I = 1,NX
      IF (JFRAME(I,J).NE.PREV_ELEMENT) THEN
        PREV_ELEMENT = JFRAME(I,J)
        PRINT *,"ARRAY(",I+(J-1)*NX,") =",JFRAME(I,J)
      ENDIF
      IFRAME(I+(J-1)*NX) = CNT2PIX(JFRAME(I,J))
      END DO
      END DO
      END IF
    END IF

!-----------------------------------------------------------------------
100   CLOSE(TAPIN)
      RETURN
110   FCB_READ_XDS_I2=-1 !Cannot determine endian architecture of this machine
      RETURN
120   FCB_READ_XDS_I2=-2 !Cannot open image file
      RETURN
130   FCB_READ_XDS_I2=-3 !Wrong image format
      GO TO 100
140   FCB_READ_XDS_I2=-4 !Cannot read image
      GO TO 100
      END FUNCTION FCB_READ_XDS_I2

      INTEGER(2) FUNCTION CNT2PIX(I32)
      IMPLICIT              NONE
      INTEGER(4),INTENT(IN)::I32
      INTEGER(4),PARAMETER ::RATIO=32            !compression ratio
      INTEGER(4),PARAMETER ::OFLOW=RATIO*32768   !largest  32 bit INTEGER
      INTEGER(4),PARAMETER ::UFLOW=1-32768/RATIO !smallest 32 bit INTEGER
      REAL(4)                R
! I16=CNT2PIX(I32) codes an integer I32 in the range UFLOW<=I32<=OFLOW
! by a 16 bit number I16.
! J32=PIX2CNT(I16) retrieves an approximation to the original value
! with a maximum absolute error of RATIO/2.
      R=MIN(I32,OFLOW)
      R=MAX(I32,UFLOW)
      IF (I32.GT.32767)R=-R/RATIO
      CNT2PIX=NINT(R)
      RETURN
      END FUNCTION CNT2PIX'
