!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$ $Date$
!-----------------------------------------------------------------
SUBROUTINE GET_COMPHEADER(KTAB,SIZEKTAB,KNBELT,KTYPECOD)

INTEGER, INTENT(IN) :: SIZEKTAB
INTEGER(KIND=8), DIMENSION(SIZEKTAB), INTENT(IN) :: KTAB
INTEGER, INTENT(OUT) :: KNBELT    ! size of decompressed array
INTEGER, INTENT(OUT) :: KTYPECOD  ! code for compression type

CHARACTER(LEN=8) :: STRKEY

INTEGER :: INTCHAR
INTEGER :: JI

CALL SET_EXTRACTIDX(0,0)
! extract string header 
DO JI=1,8
  CALL EXTRACT_BBUFF(KTAB,8,INTCHAR)
  STRKEY(JI:JI) = CHAR(INTCHAR)
END DO

! Treat array if it is compressed
IF (STRKEY == 'COMPRESS') THEN
  CALL EXTRACT_BBUFF(KTAB,32,KTYPECOD)
  CALL EXTRACT_BBUFF(KTAB,32,KNBELT)
ELSE
  KNBELT    =-1
  KTYPECOD = 0
END IF

END SUBROUTINE GET_COMPHEADER

SUBROUTINE DECOMPRESS_FIELD(XTAB,NBELT,COMPTAB,NBCOMPELT,CODINGTYPE)
USE MODD_COMPPAR
USE MODE_SEARCHGRP

IMPLICIT NONE 
INTEGER,                                INTENT(IN)  :: NBELT 
INTEGER,                                INTENT(IN)  :: NBCOMPELT 
REAL   (KIND=8),DIMENSION(NBELT),TARGET,INTENT(OUT) :: XTAB
INTEGER(KIND=8),DIMENSION(NBCOMPELT),   INTENT(IN)  :: COMPTAB
INTEGER,                                INTENT(IN)  :: CODINGTYPE

INTEGER,DIMENSION(:), ALLOCATABLE  :: ITAB
LOGICAL,DIMENSION(:), ALLOCATABLE  :: GMASK

REAL :: XREF, XCOEFF
INTEGER :: INBLEV
INTEGER :: ILEVNBELT
INTEGER :: JI
INTEGER :: IND1, IND2
INTEGER :: IDIMX,IDIMY
INTEGER :: IEXTCOD
REAL(KIND=8),DIMENSION(:),POINTER  :: XPTRTAB
REAL :: XMIN,XMAX

SELECT CASE (CODINGTYPE)
CASE (JPCSTENCOD)
  CALL EXTRACT_BBUFF(COMPTAB,32,XREF)
  XTAB(:) = XREF

CASE (JPSOPENCOD)
  CALL EXTRACT_BBUFF(COMPTAB,32,IDIMX)
  CALL EXTRACT_BBUFF(COMPTAB,32,IDIMY)
  ILEVNBELT = IDIMX * IDIMY
  INBLEV = NBELT/(ILEVNBELT)
  ALLOCATE(ITAB(ILEVNBELT))
  DO JI=1,INBLEV
    IND1=(JI-1)*ILEVNBELT+1
    IND2=JI*ILEVNBELT
    XPTRTAB=>XTAB(IND1:IND2)
    IF (LPDEBUG) PRINT *,'######   Decompress(SOPENCOD) LEVEL ',JI,'######'
    CALL EXTRACT_BBUFF(COMPTAB,32,XREF)
    CALL EXTRACT_BBUFF(COMPTAB,32,XCOEFF)
    CALL EXTRACTINTARRAY(ITAB)
    CALL DECOMP_FOP(XPTRTAB,ITAB,XREF,XCOEFF)
  END DO
  
CASE (JPEXTENCOD)
  CALL EXTRACT_BBUFF(COMPTAB,32,IDIMX)
  CALL EXTRACT_BBUFF(COMPTAB,32,IDIMY)
  ILEVNBELT = IDIMX * IDIMY
  INBLEV = NBELT/(ILEVNBELT)
  ALLOCATE(ITAB(ILEVNBELT))
  ALLOCATE(GMASK(ILEVNBELT))
  DO JI=1,INBLEV

    IF (LPDEBUG) PRINT *,'###### Decompress(EXTENCOD) LEVEL ',JI,'######'
    IND1=(JI-1)*ILEVNBELT+1
    IND2=JI*ILEVNBELT
    XPTRTAB=>XTAB(IND1:IND2)
    !
    CALL EXTRACT_BBUFF(COMPTAB,3,IEXTCOD)
    IF (IEXTCOD == JPOTHER) THEN
      CALL EXTRACT_BBUFF(COMPTAB,3,IEXTCOD)
      IEXTCOD = IEXTCOD + 8
    END IF
    IF (LPDEBUG) PRINT *, "IEXTCOD = ",IEXTCOD
    SELECT CASE(IEXTCOD)
    CASE(JPLOG)
      ! Conversion to log values of original data 0<=x<1
      CALL EXTRACT_BBUFF(COMPTAB,32,XREF)
      CALL EXTRACT_BBUFF(COMPTAB,32,XCOEFF)
      CALL EXTRACTINTARRAY(ITAB)
      GMASK(:) = .TRUE.
      WHERE (ITAB == 0)
        GMASK = .FALSE.
        XPTRTAB = 0.0
      END WHERE
      CALL DECOMP_FOP(XPTRTAB,ITAB,XREF,XCOEFF,GMASK,1)
      WHERE(GMASK)
        XPTRTAB = EXP(XPTRTAB)
      END WHERE
      
    CASE(JPCONST)
      ! constant value array
      CALL EXTRACT_BBUFF(COMPTAB,32,XREF)
      XPTRTAB(:) = XREF
      IF (LPDEBUG) PRINT *,"  CONST value=",XREF

    CASE(JP2VAL)
      ! 2 different values in array
      CALL EXTRACT_BBUFF(COMPTAB,32,XMIN)
      CALL EXTRACT_BBUFF(COMPTAB,32,XMAX)
      CALL EXTRACTINTARRAY(ITAB)
      WHERE (ITAB == 0)
        XPTRTAB = XMIN
      ELSEWHERE
        XPTRTAB = XMAX
      END WHERE
      IF (LPDEBUG) PRINT *,"  2 values:",XMIN,XMAX
      
    CASE(JP3VAL)
      ! 3 different values in array
      CALL EXTRACT_BBUFF(COMPTAB,32,XMIN)
      CALL EXTRACT_BBUFF(COMPTAB,32,XREF)
      CALL EXTRACT_BBUFF(COMPTAB,32,XMAX)
      CALL EXTRACTINTARRAY(ITAB)
      WHERE (ITAB == 0)
        XPTRTAB = XMIN
      ELSEWHERE
        XPTRTAB = XREF
      END WHERE
      WHERE (ITAB == 2) XPTRTAB = XMAX
      IF (LPDEBUG) PRINT *,"  3 values:",XMIN,XREF,XMAX

    CASE(JPNORM)
      ! same as JPSOPENCOD
      CALL EXTRACT_BBUFF(COMPTAB,32,XREF)
      CALL EXTRACT_BBUFF(COMPTAB,32,XCOEFF)
      CALL EXTRACTINTARRAY(ITAB)
      CALL DECOMP_FOP(XPTRTAB,ITAB,XREF,XCOEFF)
      IF (LPDEBUG) PRINT *,"  normal, XREF/XCOEFF = ",XREF,XCOEFF 

    CASE(JPMINEXCL)
      ! Min value is isolated
      CALL EXTRACT_BBUFF(COMPTAB,32,XMIN)
      CALL EXTRACT_BBUFF(COMPTAB,32,XREF)
      CALL EXTRACT_BBUFF(COMPTAB,32,XCOEFF)
      CALL EXTRACTINTARRAY(ITAB)
      GMASK(:) = .TRUE.
      WHERE (ITAB == 0)
        GMASK = .FALSE.
        XPTRTAB = XMIN
      END WHERE
      CALL DECOMP_FOP(XPTRTAB,ITAB,XREF,XCOEFF,GMASK,1)
      IF (LPDEBUG) PRINT *,"  Min exclus, MIN/XREF/XCOEFF = ",XMIN,XREF,XCOEFF

    CASE(JPMAXEXCL)
      ! Max value is isolated
      CALL EXTRACT_BBUFF(COMPTAB,32,XMAX)
      CALL EXTRACT_BBUFF(COMPTAB,32,XREF)
      CALL EXTRACT_BBUFF(COMPTAB,32,XCOEFF)
      CALL EXTRACTINTARRAY(ITAB)
      GMASK(:) = .TRUE.
      WHERE (ITAB == 65535)
        GMASK = .FALSE.
        XPTRTAB = XMAX
      END WHERE
      CALL DECOMP_FOP(XPTRTAB,ITAB,XREF,XCOEFF,GMASK,0)   
      IF (LPDEBUG) PRINT *,"  Max exclus, MAX/XREF/XCOEFF = ",XMAX,XREF,XCOEFF

    CASE(JPMINMAXEXCL)
      ! Min&Max value are isolated
      CALL EXTRACT_BBUFF(COMPTAB,32,XMIN)        
      CALL EXTRACT_BBUFF(COMPTAB,32,XMAX)
      CALL EXTRACT_BBUFF(COMPTAB,32,XREF)
      CALL EXTRACT_BBUFF(COMPTAB,32,XCOEFF)
      CALL EXTRACTINTARRAY(ITAB)
      GMASK(:) = .TRUE.
      WHERE (ITAB == 0)
        GMASK = .FALSE.
        XPTRTAB = XMIN
      END WHERE
      WHERE (ITAB == 65535)
        GMASK = .FALSE.
        XPTRTAB = XMAX
      END WHERE
      CALL DECOMP_FOP(XPTRTAB,ITAB,XREF,XCOEFF,GMASK,1)
      IF (LPDEBUG) PRINT *,"  Min et Max exclus, MIN/MAX/XREF/XCOEFF = ",&
           &XMIN,XMAX,XREF,XCOEFF
    END SELECT
  END DO
  
CASE DEFAULT
  PRINT *,'Error in CODINGTYPE : program aborted'
  STOP
END SELECT

CONTAINS 

SUBROUTINE DECOMP_FOP(PTAB,KTAB,PREF,PCOEFF,OMASK,KINDCOR)
REAL(KIND=8), DIMENSION(:), INTENT(INOUT) :: PTAB 
! Attention: avec le compilateur PGF, utiliser INTENT(OUT) provoque une recopie
! complete du tableau dans PTAB (avec ecrasement possible des valeurs 
! presentes a l'appel de la procedure). Le phenomene est genant lorsque
! DECOMP_FOP ne calcule que sur une portion de PTAB (valeurs min et/ou max 
! sont presentes). En declarant PTAB en INOUT, les valeurs en entree de la routine
! sont conservees si elles n'ont pas ete modifiees.

INTEGER,      DIMENSION(:), INTENT(IN) :: KTAB 
REAL, INTENT(IN) :: PREF
REAL, INTENT(IN) :: PCOEFF
LOGICAL, DIMENSION(:),INTENT(IN),OPTIONAL :: OMASK
INTEGER,INTENT(IN),OPTIONAL  :: KINDCOR ! 1 if Min value is isolated, 0 otherwise

INTEGER :: INDCOR

IF (.NOT. PRESENT(KINDCOR)) THEN
  INDCOR = 0
ELSE
  INDCOR = KINDCOR
END IF
  
IF (PRESENT(OMASK)) THEN
  WHERE (OMASK)
    PTAB(:) = PCOEFF*(KTAB(:)-INDCOR)+PREF
  END WHERE
ELSE
  IF (PCOEFF == 0.0) THEN
    PTAB(:) = PREF
  ELSE
    PTAB(:) = PCOEFF*KTAB(:)+PREF
  END IF
END IF

END SUBROUTINE DECOMP_FOP

SUBROUTINE EXTRACTINTARRAY(KTAB)
INTEGER,DIMENSION(:),INTENT(OUT) :: KTAB
!
! COMPTAB, IDIMX and IDIMY  are defined in the calling routine
!
INTEGER :: NBGRP
INTEGER :: IBE
INTEGER :: CPT
INTEGER :: JJ
INTEGER :: ALONE
INTEGER :: NBITCOD,IMIN
INTEGER :: GELT
INTEGER :: JELT
INTEGER :: IEPS

CALL EXTRACT_BBUFF(COMPTAB,32,NBGRP)
!      PRINT *,'Nbre de groupes =',NBGRP
CALL EXTRACT_BBUFF(COMPTAB,5,IBE)
!      PRINT *,'Nbre de bits pour coder le nombre d''elements:',IBE
CPT = 1
DO JJ=1,NBGRP
  !      PRINT *,'Groupe ',JJ,' : '
  CALL EXTRACT_BBUFF(COMPTAB,1,ALONE)
  CALL EXTRACT_BBUFF(COMPTAB,16,IMIN)
  !      PRINT *,'IREF=',IMIN
  
  IF (ALONE == 1) THEN
    ! 1 seul elt dans le groupe
    !        PRINT *,'--> un seul element dans le groupe'
    KTAB(CPT)=IMIN
    CPT=CPT+1
  ELSE
    CALL EXTRACT_BBUFF(COMPTAB,4,NBITCOD)
    CALL EXTRACT_BBUFF(COMPTAB,IBE,GELT)
    !        PRINT *,'--> ',GELT,' elts, codage ecart sur ',nbitcod,'bits'
    IF (NBITCOD > 0) THEN
      DO JELT=1,GELT
        CALL EXTRACT_BBUFF(COMPTAB,NBITCOD,IEPS)
        KTAB(CPT) = IMIN+IEPS
        CPT=CPT+1
      END DO
    ELSE
      KTAB(CPT:CPT+GELT-1) = IMIN
      CPT = CPT+GELT
    END IF
  END IF
END DO
CALL INVERTCOL(KTAB,IDIMX,IDIMY)        
END SUBROUTINE EXTRACTINTARRAY

END SUBROUTINE DECOMPRESS_FIELD