ungrib/src/ngl/w3/w3fi59.f

   1       SUBROUTINE W3FI59(FIELD,NPTS,NBITS,NWORK,NPFLD,ISCALE,LEN,RMIN)
   2 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 C                .      .    .                                       .
   4 C SUBPROGRAM:    W3FI59      FORM AND PACK POSITIVE, SCALED DIFFERENCES
   5 C   PRGMMR:  ALLARD, R.      ORG: NMC41      DATE:  84-08-01
   6 C
   7 C ABSTRACT:  CONVERTS AN ARRAY OF SINGLE PRECISION REAL NUMBERS INTO
   8 C   AN ARRAY OF POSITIVE SCALED DIFFERENCES (NUMBER(S) - MINIMUM VALUE),
   9 C   IN INTEGER FORMAT AND PACKS THE ARGUMENT-SPECIFIED NUMBER OF
  10 C   SIGNIFICANT BITS FROM EACH DIFFERENCE.
  11 C
  12 C PROGRAM HISTORY LOG:
  13 C   84-08-01  ALLARD      ORIGINAL AUTHOR
  14 C   90-05-17  R.E.JONES   CONVERT TO CRAY CFT77 FORTRAN
  15 C   90-05-18  R.E.JONES   CHANGE NAME PAKMAG TO W3LIB NAME W3FI59
  16 C   93-07-06  R.E.JONES   ADD NINT TO DO LOOP 2000 SO NUMBERS ARE
  17 C                         ROUNDED TO NEAREST INTEGER, NOT TRUNCATED.
  18 C   94-01-05  IREDELL     COMPUTATION OF ISCALE FIXED WITH RESPECT TO
  19 C                         THE 93-07-06 CHANGE.
  20 C   98-03-10  B. VUONG    REMOVE THE CDIR$ INTEGER=64 DIRECTIVE
  21 C
  22 C USAGE:    CALL W3FI59(FIELD,NPTS,NBITS,NWORK,NPFLD,ISCALE,LEN,RMIN)
  23 C   INPUT ARGUMENT LIST:
  24 C     FIELD - ARRAY OF FLOATING POINT DATA FOR PROCESSING  (REAL)
  25 C     NPTS  - NUMBER OF DATA VALUES TO PROCESS IN FIELD (AND NWORK)
  26 C             WHERE, NPTS > 0
  27 C     NBITS - NUMBER OF SIGNIFICANT BITS OF PROCESSED DATA TO BE PACKED
  28 C             WHERE, 0 < NBITS < 32+1
  29 C
  30 C   OUTPUT ARGUMENT LIST:
  31 C     NWORK - ARRAY FOR INTEGER CONVERSION  (INTEGER)
  32 C             IF PACKING PERFORMED (SEE NOTE BELOW), THE ARRAY WILL
  33 C             CONTAIN THE PRE-PACKED, RIGHT ADJUSTED, SCALED, INTEGER
  34 C             DIFFERENCES UPON RETURN TO THE USER.
  35 C             (THE USER MAY EQUIVALENCE FIELD AND NWORK.  SAME SIZE.)
  36 C     NPFLD - ARRAY FOR PACKED DATA  (INTEGER)
  37 C             (DIMENSION MUST BE AT LEAST (NBITS * NPTS) / 64 + 1  )
  38 C     ISCALE- POWER OF 2 FOR RESTORING DATA, SUCH THAT
  39 C             DATUM = (DIFFERENCE * 2**ISCALE) + RMIN
  40 C     LEN   - NUMBER OF PACKED BYTES IN NPFLD (SET TO 0 IF NO PACKING)
  41 C             WHERE, LEN = (NBITS * NPTS + 7) / 8 WITHOUT REMAINDER
  42 C     RMIN  - MINIMUM VALUE (REFERENCE VALUE SUBTRACTED FROM INPUT DATA)
  43 C             THIS IS A CRAY FLOATING POINT NUMBER, IT WILL HAVE TO BE
  44 C             CONVERTED TO AN IBM370 32 BIT FLOATING POINT NUMBER AT
  45 C             SOME POINT IN YOUR PROGRAM IF YOU ARE PACKING GRIB DATA.
  46 C
  47 C REMARKS:  LEN = 0 AND NO PACKING PERFORMED IF
  48 C
  49 C        (1)  RMAX = RMIN  (A CONSTANT FIELD)
  50 C        (2)  NBITS VALUE OUT OF RANGE  (SEE INPUT ARGUMENT)
  51 C        (3)  NPTS VALUE LESS THAN 1  (SEE INPUT ARGUMENT)
  52 C
  53 C ATTRIBUTES:
  54 C   LANGUAGE: CRAY CFT77 FORTRAN
  55 C   MACHINE:  CRAY C916/256, Y-MP8/864, Y-MP EL92/256, J916/2048
  56 C
  57 C$$$
  58 C
  59       REAL    FIELD(*)
  60 C
  61       INTEGER NPFLD(*)
  62       INTEGER NWORK(*)
  63 C
  64       DATA KZERO / 0 /
  65 C
  66 C  NATURAL LOGARITHM OF 2 AND 0.5 PLUS NOMINAL SAFE EPSILON
  67       PARAMETER(ALOG2=0.69314718056,HPEPS=0.500001)
  68 C
  69 C / / / / / /
  70 C
  71       LEN    = 0
  72       ISCALE = 0
  73       IF (NBITS.LE.0.OR.NBITS.GT.32) GO TO 3000
  74       IF (NPTS.LE.0) GO TO 3000
  75 C
  76 C FIND THE MAX-MIN VALUES IN FIELD.
  77 C
  78       RMAX = FIELD(1)
  79       RMIN = RMAX
  80       DO 1000 K = 2,NPTS
  81         RMAX = AMAX1(RMAX,FIELD(K))
  82         RMIN = AMIN1(RMIN,FIELD(K))
  83  1000 CONTINUE
  84 C
  85 C IF A CONSTANT FIELD, RETURN WITH NO PACKING PERFORMED AND 'LEN' = 0.
  86 C
  87       IF (RMAX.EQ.RMIN) GO TO 3000
  88 C
  89 C DETERMINE LARGEST DIFFERENCE IN FIELD (BIGDIF).
  90 C
  91       BIGDIF = RMAX - RMIN
  92 C
  93 C ISCALE IS THE POWER OF 2 REQUIRED TO RESTORE THE PACKED DATA.
  94 C ISCALE IS COMPUTED AS THE LEAST INTEGER SUCH THAT
  95 C   BIGDIF*2**(-ISCALE) < 2**NBITS-0.5
  96 C IN ORDER TO ENSURE THAT THE PACKED INTEGERS (COMPUTED IN LOOP 2000
  97 C WITH THE NEAREST INTEGER FUNCTION) STAY LESS THAN 2**NBITS.
  98 C
  99       ISCALE=NINT(ALOG(BIGDIF/(2.**NBITS-0.5))/ALOG2+HPEPS)
 100 C
 101 C FORM DIFFERENCES, RESCALE, AND CONVERT TO INTEGER FORMAT.
 102 C
 103       TWON = 2.0 ** (-ISCALE)
 104       DO 2000 K = 1,NPTS
 105         NWORK(K) = NINT( (FIELD(K) - RMIN) * TWON )
 106  2000 CONTINUE
 107 C
 108 C PACK THE MAGNITUDES (RIGHTMOST NBITS OF EACH WORD).
 109 C
 110       KOFF  = 0
 111       ISKIP = 0
 112 C
 113 C     USE NCAR ARRAY BIT PACKER SBYTES  (GBYTES PACKAGE)
 114 C
 115       CALL SBYTES(NPFLD,NWORK,KOFF,NBITS,ISKIP,NPTS)
 116 C
 117 C ADD 7 ZERO-BITS AT END OF PACKED DATA TO INSURE BYTE BOUNDARY.
 118 C     USE NCAR WORD BIT PACKER SBYTE
 119 C
 120       NOFF = NBITS * NPTS
 121       CALL SBYTE(NPFLD,KZERO,NOFF,7)
 122 C
 123 C DETERMINE BYTE LENGTH (LEN) OF PACKED FIELD (NPFLD).
 124 C
 125       LEN = (NOFF + 7) / 8
 126 C
 127  3000 CONTINUE
 128       RETURN
 129 C
 130       END