hwrf-baseline-20120103-1354/ungrib/src/ngl/w3/w3fi58.f

   1       SUBROUTINE W3FI58(IFIELD,NPTS,NWORK,NPFLD,NBITS,LEN,KMIN)
   2 C$$$  SUBPROGRAM DOCUMENTATION BLOCK  ***
   3 C                .      .    .                                       .
   4 C SUBPROGRAM:  W3FI58   - PACK POSITIVE DIFFERENCES IN LEAST BITS
   5 C   PRGMMR:  ALLARD, R.       ORG:  NMC411        DATE:  JULY 1987
   6 C
   7 C ABSTRACT:  CONVERTS AN ARRAY OF INTEGER NUMBERS INTO AN ARRAY OF
   8 C   POSITIVE DIFFERENCES (NUMBER(S) - MINIMUM VALUE) AND PACKS THE
   9 C   MAGNITUDE OF EACH DIFFERENCE RIGHT-ADJUSTED INTO THE LEAST
  10 C   NUMBER OF BITS THAT HOLDS THE LARGEST DIFFERENCE.
  11 C
  12 C PROGRAM HISTORY LOG:
  13 C   87-09-02  ALLARD
  14 C   88-10-02  R.E.JONES   CONVERTED TO CDC CYBER 205 FTN200 FORTRAN
  15 C   90-05-17  R.E.JONES   CONVERTED TO CRAY CFT77 FORTRAN
  16 C   90-05-18  R.E.JONES   CHANGE NAME VBIMPK TO W3LIB NAME W3FI58
  17 C   98-03-10  B. VUONG    REMOVE THE CDIR$ INTEGER=64 DIRECTIVE
  18 C   96-05-14  IREDELL     GENERALIZED COMPUTATION OF NBITS
  19 C
  20 C USAGE:  CALL W3FI58(IFIELD,NPTS,NWORK,NPFLD,NBITS,LEN,KMIN)
  21 C
  22 C   INPUT:
  23 C
  24 C     IFIELD - ARRAY OF INTEGER DATA FOR PROCESSING
  25 C     NPTS   - NUMBER OF DATA VALUES TO PROCESS IN IFIELD (AND NWORK)
  26 C              WHERE, NPTS > 0
  27 C
  28 C   OUTPUT:
  29 C
  30 C     NWORK  - WORK ARRAY WITH INTEGER DIFFERENCE
  31 C     NPFLD  - ARRAY FOR PACKED DATA
  32 C              (USER IS RESPONSIBLE FOR AN ADEQUATE DIMENSION.)
  33 C     NBITS  - NUMBER OF BITS USED TO PACK DATA WHERE, 0 < NBITS < 32
  34 C              (THE MAXIMUM DIFFERENCE WITHOUT OVERFLOW IS 2**31 -1)
  35 C     LEN    - NUMBER OF PACKED BYTES IN NPFLD (SET TO 0 IF NO PACKING)
  36 C              WHERE, LEN = (NBITS * NPTS + 7) / 8 WITHOUT REMAINDER
  37 C     KMIN   - MINIMUM VALUE (SUBTRACTED FROM EACH DATUM). IF THIS
  38 C              PACKED DATA IS BEING USED FOR GRIB DATA, THE
  39 C              PROGRAMER WILL HAVE TO CONVERT THE KMIN VALUE TO AN
  40 C              IBM370 32 BIT FLOATING POINT NUMBER.
  41 C
  42 C   SUBPROGRAMS CALLED:
  43 C
  44 C     W3LIB:  SBYTES, SBYTE
  45 C
  46 C   EXIT STATES:  NONE
  47 C
  48 C     NOTE:  LEN = 0, NBITS = 0, AND NO PACKING PERFORMED IF
  49 C
  50 C     (1) KMAX = KMIN  (A CONSTANT FIELD)
  51 C     (2) NPTS < 1  (SEE INPUT ARGUMENT)
  52 C
  53 C ATTRIBUTES:
  54 C   LANGUAGE: CRAY CFT77 FORTRAN
  55 C   MACHINE:  CRAY Y-MP8/832
  56 C
  57 C$$$
  58 C
  59       INTEGER  IFIELD(*)
  60       INTEGER  NPFLD(*)
  61       INTEGER  NWORK(*)
  62 C
  63       DATA  KZERO / 0 /
  64       PARAMETER(ALOG2=0.69314718056)
  65 C
  66 C / / / / / /
  67 C
  68       LEN   = 0
  69       NBITS = 0
  70       IF (NPTS.LE.0) GO TO 3000
  71 C
  72 C FIND THE MAX-MIN VALUES IN INTEGER FIELD (IFIELD).
  73 C
  74       KMAX = IFIELD(1)
  75       KMIN = KMAX
  76       DO 1000 I = 2,NPTS
  77         KMAX = MAX(KMAX,IFIELD(I))
  78         KMIN = MIN(KMIN,IFIELD(I))
  79  1000 CONTINUE
  80 C
  81 C IF A CONSTANT FIELD, RETURN WITH NO PACKING AND 'LEN' AND 'NBITS' SET
  82 C TO ZERO.
  83 C
  84       IF (KMAX.EQ.KMIN) GO TO 3000
  85 C
  86 C DETERMINE LARGEST DIFFERENCE IN IFIELD AND FLOAT (BIGDIF).
  87 C
  88       BIGDIF = KMAX - KMIN
  89 C
  90 C NBITS IS COMPUTED AS THE LEAST INTEGER SUCH THAT
  91 C   BIGDIF < 2**NBITS
  92 C
  93       NBITS=LOG(BIGDIF+0.5)/ALOG2+1
  94 C
  95 C FORM DIFFERENCES IN NWORK ARRAY.
  96 C
  97       DO 2000 K = 1,NPTS
  98         NWORK(K) = IFIELD(K) - KMIN
  99  2000 CONTINUE
 100 C
 101 C PACK EACH MAGNITUDE IN NBITS (NBITS = THE LEAST POWER OF 2 OR 'N')
 102 C
 103       LEN=(NBITS*NPTS-1)/8+1
 104       CALL SBYTES(NPFLD,NWORK,0,NBITS,0,NPTS)
 105 C
 106 C ADD ZERO-BITS AT END OF PACKED DATA TO INSURE A BYTE BOUNDARY.
 107 C
 108       NOFF = NBITS * NPTS
 109       NZERO=LEN*8-NOFF
 110       IF(NZERO.GT.0) CALL SBYTE(NPFLD,KZERO,NOFF,NZERO)
 111 C
 112  3000 CONTINUE
 113       RETURN
 114 C
 115       END