LIBTOOLS/lib/COMPRESS/src/decompress.f90

+!-----------------------------------------------------------------
+!--------------- 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
+

LIBTOOLS/lib/COMPRESS/src/ieee754.h

+#undef __BYTE_ORDER
+
+#ifdef BIG_endian
+# define __BYTE_ORDER 1234
+#endif
+#ifdef LITTLE_endian
+# define __BYTE_ORDER 4321
+#endif
+#if !(defined(__BYTE_ORDER))
+ #error "ieee754.h : you MUST specify \
+-DBIG_endian or -DLITTLE_endian \
+in CPPFLAGS of your Makefile."
+/* Compiler must throw us out at this point! */
+#endif
+
+#define __BIG_ENDIAN    1234
+#define __LITTLE_ENDIAN 4321
+
+union ieee754_double
+  {
+    double d;
+
+    /* This is the IEEE 754 double-precision format.  */
+    struct
+      {
+#if     __BYTE_ORDER == __BIG_ENDIAN
+        unsigned int negative:1;
+        unsigned int exponent:11;
+        /* Together these comprise the mantissa.  */
+        unsigned int mantissa0:20;
+        unsigned int mantissa1:32;
+#endif                          /* Big endian.  */
+#if     __BYTE_ORDER == __LITTLE_ENDIAN
+        /* Together these comprise the mantissa.  */
+        unsigned int mantissa1:32;
+        unsigned int mantissa0:20;
+        unsigned int exponent:11;
+        unsigned int negative:1;
+#endif                          /* Little endian.  */
+      } ieee;
+
+    /* This format makes it easier to see if a NaN is a signalling NaN.  */
+    struct
+      {
+#if     __BYTE_ORDER == __BIG_ENDIAN
+        unsigned int negative:1;
+        unsigned int exponent:11;
+        unsigned int quiet_nan:1;
+        /* Together these comprise the mantissa.  */
+        unsigned int mantissa0:19;
+        unsigned int mantissa1:32;
+#else
+        /* Together these comprise the mantissa.  */
+        unsigned int mantissa1:32;
+        unsigned int mantissa0:19;
+        unsigned int quiet_nan:1;
+        unsigned int exponent:11;
+        unsigned int negative:1;
+#endif
+      } ieee_nan;
+  };
+
+#define IEEE754_DOUBLE_BIAS     0x3ff /* Added to exponent.  */

LIBTOOLS/lib/COMPRESS/src/nearestpow2.c

+#include <stdio.h>
+#include "ieee754.h"
+#include <math.h>
+
+#ifdef NO_UNDERSCORE
+# define NEAREST_POW2 nearest_pow2
+# define MINBITS_IN_WORD minbits_in_word
+# define FMINBITS_IN_WORD fminbits_in_word
+#else
+# define NEAREST_POW2 nearest_pow2_
+# define MINBITS_IN_WORD minbits_in_word_
+# define FMINBITS_IN_WORD fminbits_in_word_
+#endif
+
+void NEAREST_POW2(union ieee754_double *xval, unsigned int *pow)
+{
+
+  if (xval->d != 0.0)
+    *pow = xval->ieee.exponent - IEEE754_DOUBLE_BIAS;
+  else {
+      printf("Warning : NEAREST_POW2 ne traite que des reels > 0.0\n");
+      *pow = 0;
+  }
+
+}
+
+void MINBITS_IN_WORD(int *nval, unsigned int *nbit)
+{
+  union ieee754_double xval;
+  int ival = *nval;
+
+  /* ne fonctionne qu'avec des entiers non signs */
+  if (ival-- < 0){
+    printf("Warning : MINBITS_IN_WORD ne traite que des entiers POSITIFS.\n");
+    *nbit = -1;
+    return;
+  } else
+    if (ival > 0){
+      xval.d = (double)ival;
+      NEAREST_POW2(&xval,nbit);
+      (*nbit)++;
+    } else 
+      *nbit = 0 ;
+    
+}
+
+int FMINBITS_IN_WORD(int *nval)
+{
+  union ieee754_double xval;
+  int ival = *nval;
+  unsigned int nbit;
+
+  /* ne fonctionne qu'avec des entiers non signs */
+  if (ival < 0){
+    printf("Warning : MINBITS_IN_WORD ne traite que des entiers POSITIFS.\n");
+    return -1;
+  } else {
+    if (ival > 0){
+      xval.d = (double)ival;
+      NEAREST_POW2(&xval,&nbit);
+      nbit++;
+    } else 
+      nbit = 0 ;
+    return nbit;
+  }
+}
+
+/* int main(){ */
+
+/*   double x; */
+/*   int i,nbit; */
+/*   int exp2; */
+
+/*   printf("Reel : "); */
+/*   scanf("%lf",&x); */
+  
+/*   nearest_pow2_((union ieee754_double*)&x,&exp2); */
+
+/*   printf("2**%d = %lf est la puissance de 2 la plus proche et inferieure  %lf\n", */
+/* 	 exp2,pow(2.,exp2),x); */
+/*   printf("%lf <= %lf <= %lf\n",pow(2.,(double)exp2),x,pow(2.,(double)exp2+1.)); */
+  
+/*   printf("Entier positif : "); */
+/*   scanf("%d",&i); */
+/*   minbits_in_word_(&i,&nbit); */
+/*   printf("%d valeurs : %d bits (2**%d = %d).\n",i,nbit,nbit,(1<<nbit)); */
+/* } */

LIBTOOLS/lib/COMPRESS/src/searchgrp.f90

+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$ $Date$
+!-----------------------------------------------------------------
+!-----------------------------------------------------------------
+MODULE MODE_SEARCHGRP
+IMPLICIT NONE 
+TYPE SOP_t
+  INTEGER :: NBGRP
+  INTEGER,DIMENSION(:),POINTER :: IBEG
+  INTEGER,DIMENSION(:),POINTER :: IEND
+  INTEGER,DIMENSION(:),POINTER :: VALMIN
+  INTEGER,DIMENSION(:),POINTER :: VALMAX
+END TYPE SOP_t
+
+INTEGER,EXTERNAL :: FMINBITS_IN_WORD
+
+! Private variables
+INTEGER,SAVE,                           PRIVATE :: IGRP
+INTEGER,DIMENSION(:),ALLOCATABLE,TARGET,PRIVATE :: IBEG,IEND,VALMAX,VALMIN
+INTEGER,PARAMETER,                      PRIVATE :: MAINSEUIL=8
+INTEGER,SAVE,                           PRIVATE :: IGRPMAX
+INTEGER,SAVE,                           PRIVATE :: ICOUNT
+INTEGER,DIMENSION(16),PARAMETER,      PRIVATE :: MINELT=(/4,4,4,4,5,5,6,6,7,8,9,11,13,17,26,51/)
+
+! Private routines
+PRIVATE :: RECSEARCH_GRP
+
+CONTAINS 
+SUBROUTINE INI_SOPDATA(SOPDATA)
+TYPE(SOP_t), INTENT(OUT) :: SOPDATA
+
+SOPDATA%NBGRP = 0
+NULLIFY(SOPDATA%IBEG)
+NULLIFY(SOPDATA%IEND)
+NULLIFY(SOPDATA%VALMIN)
+NULLIFY(SOPDATA%VALMAX)
+
+END SUBROUTINE INI_SOPDATA
+
+SUBROUTINE RECSEARCH(KTAB,SOPDATA)
+INTEGER,DIMENSION(:) :: KTAB
+TYPE(SOP_t), INTENT(OUT) :: SOPDATA
+
+INTEGER :: NELT
+INTEGER :: GELT,BGELT
+
+IF (ALLOCATED(IBEG)) THEN
+  DEALLOCATE(IBEG,IEND,VALMAX,VALMIN)
+END IF
+
+NELT=SIZE(KTAB)
+ALLOCATE(IBEG(NELT),IEND(NELT),VALMAX(NELT),VALMIN(NELT))
+ICOUNT = 0
+IGRP   = 0
+IGRPMAX = NELT
+CALL RECSEARCH_GRP(1,NELT,KTAB,MAINSEUIL)
+GELT = MAXVAL(IEND(1:IGRP)-IBEG(1:IGRP)+1)
+BGELT = FMINBITS_IN_WORD(GELT)
+
+#ifdef DEBUG
+PRINT *,'Routine RECSEARCH_GRP appelee',ICOUNT,'fois.'
+PRINT *,'Nbre de groupes =',IGRP
+PRINT *,'Nbre maxi d''elements dans groupes',GELT
+PRINT *,'Nbre de bits pour coder le nombre d''elements:',BGELT
+#endif
+
+SOPDATA%NBGRP=IGRP
+SOPDATA%IBEG=>IBEG
+SOPDATA%IEND=>IEND
+SOPDATA%VALMIN=>VALMIN
+SOPDATA%VALMAX=>VALMAX
+
+END SUBROUTINE RECSEARCH
+
+RECURSIVE SUBROUTINE RECSEARCH_GRP(IND1,IND2,ITAB,ISEUIL)
+INTEGER,             INTENT(IN) :: IND1,IND2,ISEUIL
+INTEGER,DIMENSION(:),INTENT(IN) :: ITAB
+
+INTEGER :: II
+INTEGER :: IMAX,IMIN
+INTEGER :: IVAL
+INTEGER :: nbitcod
+INTEGER :: tmpidx1,tmpidx2
+
+ICOUNT=ICOUNT+1
+
+IF (IGRP == 0) THEN
+  IMIN = MINVAL(ITAB(IND1:IND2))
+  IMAX = MAXVAL(ITAB(IND1:IND2))
+  IGRP = 1
+  VALMIN(IGRP) = IMIN
+  VALMAX(IGRP) = IMAX
+  IBEG(IGRP) = IND1
+  IEND(IGRP) = IND2
+ELSE
+  IMIN = VALMIN(IGRP)
+  IMAX = VALMAX(IGRP)
+END IF
+
+IF (IMAX > IMIN) THEN
+
+  IBEG(IGRP) = IND1
+  IEND(IGRP) = IND1
+  VALMIN(IGRP) = ITAB(IND1)
+  VALMAX(IGRP) = ITAB(IND1)
+  
+  DO II=IND1,IND2-1
+    IVAL = ITAB(II+1)
+    IMAX=MAX(VALMAX(IGRP),IVAL)
+    IMIN=MIN(VALMIN(IGRP),IVAL)
+    IF ((IMAX-IMIN)<(2**ISEUIL)) THEN
+      ! II+1 belong to group IGRP
+      IEND(IGRP) = II+1
+      VALMIN(IGRP) = IMIN
+      VALMAX(IGRP) = IMAX
+    ELSE
+      ! Search the created group
+      nbitcod=FMINBITS_IN_WORD(VALMAX(IGRP)-VALMIN(IGRP))
+#ifdef DEBUG
+      PRINT *,'F:(IGRP,IBEG,IEND,MAX,MIN,nbitcod)=',IGRP,',',IBEG(IGRP),',',IEND(IGRP),',',VALMAX(IGRP),',',VALMIN(IGRP),',',nbitcod
+#endif      
+      IF (IEND(IGRP)-IBEG(IGRP)>MINELT(nbitcod+1)) THEN
+        IF (nbitcod > 0) THEN
+          tmpidx1=IBEG(IGRP)
+          tmpidx2=IEND(IGRP)
+#ifdef DEBUG
+          PRINT *,'Appel 1 RECSEARCH_GRP (first,last,seuil):',tmpidx1,tmpidx2,nbitcod/2
+#endif
+          CALL RECSEARCH_GRP(tmpidx1,tmpidx2,ITAB,nbitcod/2)
+        END IF
+      ELSE
+        IF (IGRP > 1) THEN
+          nbitcod=FMINBITS_IN_WORD(VALMAX(IGRP-1)-VALMIN(IGRP-1))
+          IMIN=MIN(VALMIN(IGRP-1),VALMIN(IGRP))
+          IMAX=MAX(VALMAX(IGRP-1),VALMAX(IGRP))
+          IF (IEND(IGRP-1)-IBEG(IGRP-1)<=MINELT(nbitcod+1)) THEN
+            IF ((IMAX-IMIN) < 2**15) THEN 
+            ! concat IGRP-1 and IGRP
+              IEND(IGRP-1) = IEND(IGRP)
+              VALMIN(IGRP-1) = IMIN
+              VALMAX(IGRP-1) = IMAX
+              IGRP = IGRP-1
+            END IF
+          ELSE
+            IF (FMINBITS_IN_WORD(IMAX-IMIN) <= nbitcod) THEN
+              ! concat IGRP-1 and IGRP
+              IEND(IGRP-1) = IEND(IGRP)
+              VALMIN(IGRP-1) = IMIN
+              VALMAX(IGRP-1) = IMAX
+              IGRP = IGRP-1
+            END IF
+          END IF
+        END IF
+      END IF
+      ! New group is created
+      IGRP = IGRP+1
+      IF (IGRP>IGRPMAX) THEN
+        PRINT *,'ERROR max number of group exceeded !'
+        STOP
+      END IF
+      IBEG(IGRP) = II+1
+      IEND(IGRP) = II+1
+      VALMIN(IGRP) = IVAL
+      VALMAX(IGRP) = IVAL
+    END IF
+  END DO
+#ifdef DEBUG
+  PRINT *,'L:',IGRP,':',VALMAX(IGRP)-VALMIN(IGRP),FMINBITS_IN_WORD(VALMAX(IGRP)-VALMIN(IGRP))
+#endif
+  nbitcod = FMINBITS_IN_WORD(VALMAX(IGRP)-VALMIN(IGRP))
+  IF (IEND(IGRP)-IBEG(IGRP)>= MINELT(nbitcod+1)) THEN
+    IF (nbitcod > 0) THEN
+      tmpidx1=IBEG(IGRP)
+      tmpidx2=IEND(IGRP)
+#ifdef DEBUG
+      PRINT *,'Appel 2 RECSEARCH_GRP (first,last,seuil):',tmpidx1,tmpidx2,nbitcod/2
+#endif
+      CALL RECSEARCH_GRP(tmpidx1,tmpidx2,ITAB,nbitcod/2)
+    END IF
+  END IF
+END IF
+    
+END SUBROUTINE RECSEARCH_GRP
+
+END MODULE MODE_SEARCHGRP
+
+SUBROUTINE INVERTCOL(ITAB,KX,KY)
+IMPLICIT NONE 
+INTEGER,                  INTENT(IN)   :: KX,KY
+INTEGER,DIMENSION(KX,KY), INTENT(INOUT)::ITAB
+
+ITAB(:,2:KY:2) = ITAB(KX:1:-1,2:KY:2)
+
+END SUBROUTINE INVERTCOL
+

LIBTOOLS/lib/MPIvide

+../../src/LIB/MPIvide
\ No newline at end of file

LIBTOOLS/lib/Makefile

+GRIB_DIR=$(wildcard gribex*)
+SUBDIRS = NEWLFI COMPRESS MPIvide RAD2 SURCOUCHE vis5d
+.PHONY: subdirs $(SUBDIRS) $(GRIB_DIR)
+
+ifndef ARCH
+VALID_ARCH=$(subst ../conf/config.,,$(wildcard ../conf/config.*))
+dummy %:
+	@echo "ERROR : ARCH variable is not set !";echo
+	@echo "Please, choose one of these statements then try again :";echo " "
+	@for i in $(VALID_ARCH); do echo export ARCH=$$i; done
+
+else	
+subdirs: $(SUBDIRS) $(GRIB_DIR)
+
+$(SUBDIRS):
+	$(MAKE) -C $@
+
+$(GRIB_DIR):
+	@echo "==========================================================================="
+	@echo "GRIB library : please go into $@ directory and see README files"
+	@echo "               in order to generate manually the GRIB library."
+	@echo "==========================================================================="
+
+clean distclean:
+	@for dir in $(SUBDIRS) $(GRIB_DIR); do \
+	$(MAKE) -C $$dir $@; \
+	done
+
+endif
+
+
+

LIBTOOLS/lib/NEWLFI

+../../src/LIB/NEWLFI
\ No newline at end of file

LIBTOOLS/lib/RAD2

+../../src/LIB/RAD
\ No newline at end of file

LIBTOOLS/lib/SURCOUCHE

+../../src/LIB/SURCOUCHE
\ No newline at end of file

LIBTOOLS/lib/gribex_1302b

+../../src/LIB/grib_api-1.13.1
\ No newline at end of file

LIBTOOLS/lib/vis5d/Makefile

+DIR_OBJ = ./$(ARCH)
+
+VPATH = src:$(DIR_OBJ)
+DIR_CONF:=$(shell pwd|sed -e 's/lib\/.*/conf/')
+
+include $(DIR_CONF)/config.$(ARCH)
+include Rules.$(ARCH)
+
+
+OBJS = binio.o v5d.o
+
+# The following are dependencies generated by running makedepend:
+
+all : libv5d.a
+
+libv5d.a : $(DIR_OBJ)/.dummy $(OBJS)
+	cd $(DIR_OBJ) ; $(AR) crv $@ $(OBJS)
+
+binio.o: binio.c binio.h
+	$(CC) -c $(CFLAGS) $< -o $(DIR_OBJ)/$@
+v5d.o: v5d.c binio.h v5d.h vis5d.h
+	$(CC) -c $(CFLAGS) $< -o $(DIR_OBJ)/$@
+
+$(DIR_OBJ)/.dummy :
+	mkdir -p $(DIR_OBJ)
+	@touch $(DIR_OBJ)/.dummy
+tar :
+	tar cvf vis5d.tar Makefile Rules* binio.c binio.h v5d.c v5d.h vis5d.h
+clean :
+	(if [ -d $(DIR_OBJ) ] ; then cd $(DIR_OBJ) ; rm -f $(OBJS); fi)
+
+distclean:
+	rm -rf $(DIR_OBJ)

LIBTOOLS/lib/vis5d/Makefile.v5d

+CC = cc
+#CFLAGS = -c -O2 -DUNDERSCORE -DLITTLE
+CFLAGS = -c -O2 -DUNDERSCORE -DVPP
+
+OBJETS = binio.o v5d.o
+
+# The following are dependencies generated by running makedepend:
+
+all : libv5d.a
+
+libv5d.a : $(OBJETS)
+	ar crv $@ $?
+
+binio.o: binio.c binio.h
+	$(CC) $(CFLAGS) binio.c
+v5d.o: binio.h v5d.h vis5d.h v5d.c
+	$(CC) $(CFLAGS) v5d.c
+
+tar :
+	 tar cvf libvis5d.tar Makefile binio.c binio.h v5d.c v5d.h vis5d.h
+clean :
+	rm -rf libv5d.a $(OBJETS)
+

LIBTOOLS/lib/vis5d/Rules.HPf90

+#CFLAGS += -DUNDERSCORE -DVPP
+#CFLAGS += -DUNDERSCORE -DLITTLE
+CFLAGS += -DUNDERSCORE

LIBTOOLS/lib/vis5d/Rules.LXNAGf95

+#CFLAGS += -DUNDERSCORE -DVPP
+#CFLAGS += -DUNDERSCORE -DLITTLE
+CFLAGS += -DUNDERSCORE

LIBTOOLS/lib/vis5d/Rules.LXg95

+#
+# Don't forget -DLITTLE flag for little-endian architecture
+#
+
+#CFLAGS += -DUNDERSCORE -DVPP
+CFLAGS += -DUNDERSCORE -DLITTLE
+

LIBTOOLS/lib/vis5d/Rules.LXgfortran

+#CFLAGS += -DUNDERSCORE -DVPP
+#CFLAGS += -DUNDERSCORE -DLITTLE
+CFLAGS += -DUNDERSCORE

LIBTOOLS/lib/vis5d/Rules.SGI32

+CFLAGS += -DUNDERSCORE

LIBTOOLS/lib/vis5d/Rules.VPP

+CFLAGS += -DUNDERSCORE -DVPP

LIBTOOLS/lib/vis5d/src/binio.c

+/* Vis5D version 5.1 */
+
+/*
+Vis5D system for visualizing five dimensional gridded data sets
+Copyright (C) 1990 - 1997 Bill Hibbard, Johan Kellum, Brian Paul,
+Dave Santek, and Andre Battaiola.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 1, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*/
+
+/*
+ * Functions to do binary I/O of floats, ints.
+ *
+ * >>>> These functions are built on top of Unix I/O functions, not stdio! <<<<
+ *
+ * The file format is assumed to be BIG-ENDIAN.
+ * If this code is compiled with -DLITTLE and executes on a little endian
+ * CPU then byte-swapping will be done.
+ *
+ * If an ANSI compiler is used prototypes and ANSI function declarations
+ * are used.  Otherwise use K&R conventions.
+ *
+ * If we're running on a CRAY (8-byte ints and floats), conversions will
+ * be done as needed.
+ */
+
+
+/*
+ * Updates:
+ *
+ * April 13, 1995, brianp
+ *   added cray_to_ieee and iee_to_cray array conversion functions.
+ *   fixed potential cray bug in write_float4_array function.
+ *
+ */
+
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#ifdef _CRAY
+#  include <string.h>
+#endif
+#include "binio.h"
+
+
+
+
+/**********************************************************************/
+/******                     Byte Flipping                         *****/
+/**********************************************************************/
+
+
+#define FLIP4( n )  (  (n & 0xff000000) >> 24     \
+                     | (n & 0x00ff0000) >> 8      \
+                     | (n & 0x0000ff00) << 8      \
+                     | (n & 0x000000ff) << 24  )
+
+
+#define FLIP2( n )  (((unsigned short) (n & 0xff00)) >> 8  |  (n & 0x00ff) << 8)
+
+
+
+/*
+ * Flip the order of the 4 bytes in an array of 4-byte words.
+ */
+void flip4( const unsigned int *src, unsigned int *dest, int n )
+{
+   int i;
+
+   for (i=0;i<n;i++) {
+      unsigned int tmp = src[i];
+      dest[i] = FLIP4( tmp );
+   }
+}
+
+
+
+/*
+ * Flip the order of the 2 bytes in an array of 2-byte words.
+ */
+void flip2( const unsigned short *src, unsigned short *dest, int n )
+{
+   int i;
+
+   for (i=0;i<n;i++) {
+      unsigned short tmp = src[i];
+      dest[i] = FLIP2( tmp );
+   }
+}
+
+
+#ifdef _CRAY
+/*****************************************************************************
+*
+* The following source code is in the public domain.
+* Specifically, we give to the public domain all rights for future licensing
+* of the source code, all resale rights, and all publishing rights.
+*
+* We ask, but do not require, that the following message be included in all
+* derived works:
+*
+* Portions developed at the National Center for Supercomputing Applications at
+* the University of Illinois at Urbana-Champaign.
+*
+* THE UNIVERSITY OF ILLINOIS GIVES NO WARRANTY, EXPRESSED OR IMPLIED, FOR THE
+* SOFTWARE AND/OR DOCUMENTATION PROVIDED, INCLUDING, WITHOUT LIMITATION,
+* WARRANTY OF MERCHANTABILITY AND WARRANTY OF FITNESS FOR A PARTICULAR PURPOSE
+*
+****************************************************************************/
+
+/** THESE ROUTINES MUST BE COMPILED ON THE CRAY ONLY SINCE THEY **/
+/** REQUIRE 8-BYTES PER C-TYPE LONG                             **/
+
+/* Cray to IEEE single precision */
+static void c_to_if( long *t, const long *f)
+{
+    if (*f != 0){
+        *t = (((*f & 0x8000000000000000) |      /* sign bit */
+                 ((((*f & 0x7fff000000000000) >> 48)-16258) << 55)) + /* exp */
+                 (((*f & 0x00007fffff000000) +
+                    ((*f & 0x0000000000800000) << 1)) << 8));  /* mantissa */
+    }
+    else *t = *f;
+}
+
+
+#define C_TO_IF( T, F )							\
+	if (F != 0) {							\
+		T = (((F & 0x8000000000000000) |			\
+		((((F & 0x7fff000000000000) >> 48)-16258) << 55)) +	\
+		(((F & 0x00007fffff000000) +				\
+		((F & 0x0000000000800000) << 1)) << 8));		\
+	}								\
+	else {								\
+		T = F;							\
+	}
+
+
+
+/* IEEE single precison to Cray */
+static void if_to_c( long *t, const long *f)
+{
+    if (*f != 0) {
+        *t = (((*f & 0x8000000000000000) |
+                ((*f & 0x7f80000000000000) >> 7) +
+                (16258 << 48)) |
+                (((*f & 0x007fffff00000000) >> 8) | (0x0000800000000000)));
+        if ((*f << 1) == 0) *t = 0;
+    }
+    else *t = *f;
+}
+
+/* T and F must be longs! */
+#define IF_TO_C( T, F )							\
+	if (F != 0) {							\
+		T = (((F & 0x8000000000000000) |			\
+		((F & 0x7f80000000000000) >> 7) +			\
+		(16258 << 48)) |					\
+		(((F & 0x007fffff00000000) >> 8) | (0x0000800000000000)));  \
+		if ((F << 1) == 0) T = 0;				\
+	}								\
+	else {								\
+		T = F;							\
+	}
+
+
+
+
+/*
+ * Convert an array of Cray 8-byte floats to an array of IEEE 4-byte floats.
+ */
+void cray_to_ieee_array( long *dest, const float *source, int n )
+{
+   long *dst;
+   const long *src;
+   long tmp1, tmp2;
+   int i;
+
+   dst = dest;
+   src = (const long *) source;
+
+   for (i=0;i<n;i+=2) {       /* add 1 in case n is odd */
+      c_to_if( &tmp1, &src[i] );
+      c_to_if( &tmp2, &src[i+1] );
+      *dst = (tmp1 & 0xffffffff00000000) | (tmp2 >> 32);
+      dst++;
+   }
+}
+
+
+
+/*
+ * Convert an array of IEEE 4-byte floats to an array of 8-byte Cray floats.
+ */
+void ieee_to_cray_array( float *dest, const long *source, int n )
+{
+   long *dst;
+   const long *src;
+   int i;
+   long ieee;
+
+   src = source;
+   dst = (long *) dest;
+
+   for (i=0;i<n;i++) {
+      /* most significant 4-bytes of ieee contain bit pattern to convert */
+      if ((i&1)==0) {
+         /* get upper half */
+         ieee = src[i/2] & 0xffffffff00000000;
+      }
+      else {
+         /* get lower half */
+         ieee = src[i/2] << 32;
+      }
+      if_to_c( dst, &ieee );
+      dst++;
+   }
+}
+
+
+#endif /*_CRAY*/
+
+
+
+/**********************************************************************/
+/*****                     Read Functions                         *****/
+/**********************************************************************/
+
+
+/*
+ * Read a block of bytes.
+ *  Input:  f - the file descriptor to read from.
+ *         b - address of buffer to read into.
+ *         n - number of bytes to read.
+ * Return:  number of bytes read, 0 if error.
+ */
+int read_bytes( int f, void *b, int n )
+{
+   return read( f, b, n );
+}
+
+
+
+/*
+ * Read an array of 2-byte integers.
+ * Input:  f - file descriptor
+ *         iarray - address to put integers
+ *         n - number of integers to read.
+ * Return:  number of integers read.
+ */
+int read_int2_array( int f, short *iarray, int n )
+{
+#ifdef _CRAY
+   int i;
+   signed char *buffer;
+   int nread;
+   buffer = (signed char *) malloc( n * 2 );
+   if (!buffer)  return 0;
+   nread = read( f, buffer, n*2 );
+   if (nread<=0)  return 0;
+   nread /= 2;
+   for (i=0;i<nread;i++) {
+      /* don't forget about sign extension! */
+      iarray[i] = (buffer[i*2] * 256) | buffer[i*2+1];
+   }
+   free( buffer );
+   return nread;
+#else
+   int nread = read( f, iarray, n*2 );
+   if (nread<=0)
+      return 0;
+#ifdef LITTLE
+   flip2( (const unsigned short *) iarray, (unsigned short *) iarray, nread/2);
+#endif
+   return nread/2;
+#endif
+}
+
+
+
+/*
+ * Read an array of unsigned 2-byte integers.
+ * Input:  f - file descriptor
+ *         iarray - address to put integers
+ *         n - number of integers to read.
+ * Return:  number of integers read.
+ */
+int read_uint2_array( int f, unsigned short *iarray, int n )
+{
+#ifdef _CRAY
+   int i;
+   unsigned char *buffer;
+   int nread;
+   buffer = (unsigned char *) malloc( n * 2 );
+   if (!buffer)  return 0;
+   nread = read( f, buffer, n*2 );
+   if (nread<=0)  return 0;
+   nread /= 2;
+   for (i=0;i<nread;i++) {
+      iarray[i] = (buffer[i*2] << 8) | buffer[i*2+1];
+   }
+   free( buffer );
+   return nread;
+#else
+   int nread = read( f, iarray, n*2 );
+   if (nread<=0)
+      return 0;
+#ifdef LITTLE
+   flip2( iarray, iarray, nread/2 );
+#endif
+   return nread/2;
+#endif
+}
+
+
+
+/*
+ * Read a 4-byte integer.
+ * Input:  f - the file descriptor to read from
+ *         i - pointer to integer to put result into.
+ * Return:  1 = ok, 0 = error
+ */
+int read_int4( int f, int *i )
+{
+#ifdef LITTLE
+   /* read big endian and convert to little endian */
+   unsigned int n;
+   if (read( f, &n, 4 )==4) {
+      *i = FLIP4( n );
+      return 1;
+   }
+   else {
+      return 0;
+   }
+#else
+   if (read( f, i, 4 )==4) {
+#  ifdef _CRAY
+      *i = *i >> 32;
+#  endif
+      return 1;
+   }
+   else {
+      return 0;
+   }
+#endif
+}
+
+
+
+/*
+ * Read an array of 4-byte integers.
+ * Input:  f - file descriptor
+ *         iarray - address to put integers
+ *         n - number of integers to read.
+ * Return:  number of integers read.
+ */
+int read_int4_array( int f, int *iarray, int n )
+{
+#ifdef _CRAY
+   int j, nread;
+   int *buffer;
+
+   buffer = (int *) malloc( (n+1)*4 );
+   if (!buffer)
+      return 0;
+   nread = read( f, buffer, 4*n );
+   if (nread<=0) {
+      return 0;
+   }
+   nread /= 4;
+
+   for (j=0;j<nread;j++) {
+      if ((j&1)==0) {
+         iarray[j] = buffer[j/2] >> 32;
+      }
+      else {
+         iarray[j] = buffer[j/2] & 0xffffffff;
+      }
+   }
+   free( buffer );
+   return nread;
+#else
+   int nread = read( f, iarray, 4*n );
+   if (nread<=0)
+     return 0;
+#  ifdef LITTLE
+      flip4( (const unsigned int *) iarray, (unsigned int *) iarray, nread/4 );
+#  endif
+   return nread/4;
+#endif
+}
+
+
+
+/*
+ * Read a 4-byte IEEE float.
+ * Input:  f - the file descriptor to read from.
+ *         x - pointer to float to put result into.
+ * Return:  1 = ok, 0 = error
+ */
+int read_float4( int f, float *x )
+{
+#ifdef _CRAY
+   long buffer = 0;
+
+   if ( read( f, &buffer, 4 )==4 ) {
+      /* convert IEEE float (buffer) to Cray float (x) */
+      if_to_c( (long *) x, &buffer );
+      return 1;
+    }
+    return 0;
+#else
+#  ifdef LITTLE
+      unsigned int n, *iptr;
+      if (read( f, &n, 4 )==4) {
+         iptr = (unsigned int *) x;
+         *iptr = FLIP4( n );
+         return 1;
+      }
+      else {
+         return 0;
+      }
+#  else
+      if (read( f, x, 4 )==4) {
+         return 1;
+      }
+      else {
+         return 0;
+      }
+#  endif
+#endif
+}
+
+
+
+/*
+ * Read an array of 4-byte IEEE floats.
+ * Input:  f - file descriptor
+ *         x - address to put floats
+ *         n - number of floats to read.
+ * Return:  number of floats read.
+ */
+int read_float4_array( int f, float *x, int n )
+{
+#ifdef _CRAY
+   /* read IEEE floats into buffer, then convert to Cray format */
+   long *buffer;
+   int i, nread;
+
+   buffer = (long *) malloc( (n+1) * 4 );
+   if (!buffer) return 0;
+   nread = read( f, buffer, n*4 );
+   if (nread<=0)  return 0;
+   nread /= 4;
+   ieee_to_cray_array( x, buffer, nread );
+   free( buffer );
+   return nread;
+#else
+   int nread = read( f, x, 4*n );
+   if (nread<=0)
+      return 0;
+#ifdef LITTLE
+   flip4( (const unsigned int *) x, (unsigned int*) x, nread/4 );
+#endif
+   return nread/4;
+#endif
+}
+
+
+
+/*
+ * Read a block of memory.
+ * Input:  f - file descriptor
+ *         data - address of first byte
+ *         elements - number of elements to read
+ *         elsize - size of each element to read (1, 2 or 4)
+ * Return: number of elements written
+ */
+int read_block( int f, void *data, int elements, int elsize )
+{
+   if (elsize==1) {
+      return read( f, data, elements );
+   }
+   else if (elsize==2) {
+#ifdef LITTLE
+      int n;
+      n = read( f, data, elements*2 ) / 2;
+      if (n==elements) {
+         flip2( (const unsigned short *) data, (unsigned short *) data,
+                elements );
+      }
+      return n;
+#else
+      return read( f, data, elements*2 ) / 2;
+#endif
+   }
+   else if (elsize==4) {
+#ifdef LITTLE
+      int n;
+      n = read( f, data, elements*4 ) / 4;
+      if (n==elements) {
+         flip4( (const unsigned int *) data, (unsigned int *) data, elements );
+      }
+      return n;
+#else
+      return read( f, data, elements*4 ) / 4;
+#endif
+   }
+   else {
+      printf("Fatal error in read_block(): bad elsize (%d)\n", elsize );
+      abort();
+   }
+   return 0;
+}
+
+
+
+
+/**********************************************************************/
+/*****                         Write Functions                    *****/
+/**********************************************************************/
+
+
+
+/*
+ * Write a block of bytes.
+ * Input:  f - the file descriptor to write to.
+ *         b - address of buffer to write.
+ *         n - number of bytes to write.
+ * Return:  number of bytes written, 0 if error.
+ */
+int write_bytes( int f, const void *b, int n )
+{
+   return write( f, b, n );
+}
+
+
+
+
+/*
+ * Write an array of 2-byte integers.
+ * Input:  f - file descriptor
+ *         iarray - address to put integers
+ *         n - number of integers to write.
+ * Return:  number of integers written
+ */
+int write_int2_array( int f, const short *iarray, int n )
+{
+#ifdef _CRAY
+   printf("write_int2_array not implemented!\n");
+   exit(1);
+#else
+   int nwritten;
+#ifdef LITTLE
+   flip2( (const unsigned short *) iarray, (unsigned short *) iarray, n );
+#endif
+   nwritten = write( f, iarray, 2*n );
+#ifdef LITTLE
+   flip2( (const unsigned short *) iarray, (unsigned short *) iarray, n );
+#endif
+   if (nwritten<=0)
+      return 0;
+   return nwritten/2;
+#endif
+}
+
+
+
+/*
+ * Write an array of 2-byte unsigned integers.
+ * Input:  f - file descriptor
+ *         iarray - address to put integers
+ *         n - number of integers to write.
+ * Return:  number of integers written
+ */
+int write_uint2_array( int f, const unsigned short *iarray, int n )
+{
+#ifdef _CRAY
+   int i, nwritten;
+   unsigned char *buffer;
+   buffer = (unsigned char *) malloc( 2*n );
+   if (!buffer)  return 0;
+   for (i=0;i<n;i++) {
+      buffer[i*2] = (iarray[i] >> 8) & 0xff;
+      buffer[i*2+1] = iarray[i] & 0xff;
+   }
+   nwritten = write( f, buffer, 2*n );
+   free( buffer );
+   if (nwritten<=0)
+      return 0;
+   else
+      return nwritten/2;
+#else
+   int nwritten;
+#ifdef LITTLE
+   flip2( iarray, (unsigned short *) iarray, n );
+#endif
+   nwritten = write( f, iarray, 2*n );
+#ifdef LITTLE
+   flip2( iarray, (unsigned short *) iarray, n );
+#endif
+   if (nwritten<=0)
+      return 0;
+   else
+      return nwritten/2;
+#endif
+}
+
+
+
+/*
+ * Write a 4-byte integer.
+ *Input:  f - the file descriptor
+ *         i - the integer
+ * Return:  1 = ok, 0 = error
+ */
+int write_int4( int f, int i )
+{
+#ifdef _CRAY
+   i = i << 32;
+   return write( f, &i, 4 ) > 0;
+#else
+#  ifdef LITTLE
+     i = FLIP4( i );
+#  endif
+   return write( f, &i, 4 ) > 0;
+#endif
+}
+
+
+
+/*
+ * Write an array of 4-byte integers.
+ * Input:  f - the file descriptor
+ *         i - the array of ints
+ *           n - the number of ints in array
+ *  Return:  number of integers written.
+ */
+int write_int4_array( int f, const int *i, int n )
+{
+#ifdef _CRAY
+   int j, nwritten;
+   char *buf, *b, *ptr;
+
+   b = buf = (char *) malloc( n*4 + 8 );
+   if (!b)
+      return 0;
+   ptr = (char *) i;
+   for (j=0;j<n;j++) {
+      ptr += 4;      /* skip upper 4 bytes */
+      *b++ = *ptr++;
+      *b++ = *ptr++;
+      *b++ = *ptr++;
+      *b++ = *ptr++;
+   }
+   nwritten = write( f, buf, 4*n );
+   free( buf );
+   if (nwritten<=0)
+      return 0;
+   else
+      return nwritten / 4;
+#else
+#  ifdef LITTLE
+      int nwritten;
+      flip4( (const unsigned int *) i, (unsigned int *) i, n );
+      nwritten = write( f, i, 4*n );
+      flip4( (const unsigned int *) i, (unsigned int *) i, n );
+      if (nwritten<=0)
+         return 0;
+      else
+        return nwritten / 4;
+#  else
+      return write( f, i, 4*n ) / 4;
+#  endif
+#endif
+}
+
+
+
+/*
+ * Write a 4-byte IEEE float.
+ * Input:  f - the file descriptor
+ *         x - the float
+ * Return:  1 = ok, 0 = error
+ */
+int write_float4( int f, float x )
+{
+#ifdef _CRAY
+   char buffer[8];
+   c_to_if( (long *) buffer, (const long *) &x );
+   return write( f, buffer, 4 ) > 0;
+#else
+#  ifdef LITTLE
+      float y;
+      unsigned int *iptr = (unsigned int *) &y, temp;
+      y = (float) x;
+      temp = FLIP4( *iptr );
+      return write( f, &temp, 4 ) > 0;
+#  else
+      float y;
+      y = (float) x;
+      return write( f, &y, 4 ) > 0;
+#  endif
+#endif
+}
+
+
+
+/*
+ * Write an array of 4-byte IEEE floating point numbers.
+ * Input:  f - the file descriptor
+ *         x - the array of floats
+ *         n - number of floats in array
+ * Return:  number of float written.
+ */
+int write_float4_array( int f, const float *x, int n )
+{
+#ifdef _CRAY
+   /* convert cray floats to IEEE and put into buffer */
+   int nwritten;
+   long *buffer;
+   buffer = (long *) malloc( n*4 + 8 );
+   if (!buffer)
+      return 0;
+   cray_to_ieee_array( buffer, x, n );
+   nwritten = write( f, buffer, 4*n );
+   free( buffer );
+   if (nwritten<=0)
+      return 0;
+   else
+      return nwritten / 4;
+#else
+#  ifdef LITTLE
+      int nwritten;
+      flip4( (const unsigned int *) x, (unsigned int *) x, n );
+      nwritten = write( f, x, 4*n );
+      flip4( (const unsigned int *) x, (unsigned int *) x, n );
+      if (nwritten<=0)
+         return 0;
+      else 
+         return nwritten / 4;
+#  else
+      return write( f, x, 4*n ) / 4;
+#  endif
+#endif
+}
+
+
+
+/*
+ * Write a block of memory.
+ * Input:  f - file descriptor
+ *         data - address of first byte
+ *         elements - number of elements to write
+ *         elsize - size of each element to write (1, 2 or 4)
+ * Return: number of elements written
+ */
+int write_block( int f, const void *data, int elements, int elsize )
+{
+   if (elsize==1) {
+      return write( f, data, elements );
+   }
+   else if (elsize==2) {
+#ifdef LITTLE
+      int n;
+      flip2( (const unsigned short *) data, (unsigned short *) data, elements);
+      n = write( f, data, elements*2 ) / 2;
+      flip2( (const unsigned short *) data, (unsigned short *) data, elements);
+      return n;
+#else
+      return write( f, data, elements*2 ) / 2;
+#endif
+   }
+   else if (elsize==4) {
+#ifdef LITTLE
+      int n;
+      flip4( (const unsigned int *) data, (unsigned int *) data, elements );
+      n = write( f, data, elements*4 ) / 4;
+      flip4( (const unsigned int *) data, (unsigned int *) data, elements );
+      return n;
+#else
+      return write( f, data, elements*4 ) / 4;
+#endif
+   }
+   else {
+      printf("Fatal error in write_block(): bad elsize (%d)\n", elsize );
+      abort();
+   }
+   return 0;
+}

LIBTOOLS/lib/vis5d/src/binio.h

+/* Vis5D version 5.1 */
+
+/*
+Vis5D system for visualizing five dimensional gridded data sets
+Copyright (C) 1990 - 1997  Bill Hibbard, Brian Paul, Dave Santek,
+and Andre Battaiola.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 1, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*/
+
+
+/*
+ * Functions to do binary I/O of floats, ints, etc. with byte swapping
+ * as needed.
+ */
+
+
+#ifndef BINIO_H
+#define BINIO_H
+
+
+/* Include files which define SEEK_SET, O_RD_ONLY, etc. */
+/* and prototype open(), close(), lseek(), etc. */
+#include <unistd.h>
+#include <fcntl.h>
+
+
+
+extern void flip4( const unsigned int *src, unsigned int *dest, int n );
+
+extern void flip2( const unsigned short *src, unsigned short *dest, int n );
+
+
+/* Modif pour prendre en compte la FUJI avec des entiers 32 bits
+   et des reels 64 bits. Or on a :
+
+   sizeof(int)       = 4
+   sizeof(long)      = 4
+   sizeof(long long) = 8
+   sizeof(float)     = 4
+   sizeof(double)    = 8
+*/
+
+
+#ifdef _CRAY
+  extern void cray_to_ieee_array( long *dest, const float *source, int n );
+  extern void ieee_to_cray_array( float *dest, const long *source, int n );
+#endif
+
+
+/**********************************************************************/
+/*****                     Read Functions                         *****/
+/**********************************************************************/
+
+
+extern int read_bytes( int f, void *b, int n );
+
+extern int read_int2_array( int f, short *iarray, int n );
+
+extern int read_uint2_array( int f, unsigned short *iarray, int n );
+
+extern int read_int4( int f, int *i );
+
+extern int read_int4_array( int f, int *iarray, int n );
+
+extern int read_float4( int f, float *x );
+
+extern int read_float4_array( int f, float *x, int n );
+
+extern int read_block( int f, void *data, int elements, int elsize );
+
+
+
+/**********************************************************************/
+/*****                         Write Functions                    *****/
+/**********************************************************************/
+
+
+extern int write_bytes( int f, const void *b, int n );
+
+extern int write_int2_array( int f, const short *iarray, int n );
+
+extern int write_uint2_array( int f, const unsigned short *iarray, int n );
+
+extern int write_int4( int f, int i );
+
+extern int write_int4_array( int f, const int *iarray, int n );
+
+extern int write_float4( int f, float x );
+
+extern int write_float4_array( int f, const float *x, int n );
+
+extern int write_block( int f, const void *data, int elements, int elsize );
+
+#endif