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

   1       SUBROUTINE GETBIT(IBM,IBS,IDS,LEN,MG,G,GROUND,GMIN,GMAX,NBIT)
   2 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 C
   4 C SUBPROGRAM:    GETBIT      COMPUTE NUMBER OF BITS AND ROUND FIELD.
   5 C   PRGMMR: IREDELL          ORG: W/NMC23    DATE: 92-10-31
   6 C
   7 C ABSTRACT: THE NUMBER OF BITS REQUIRED TO PACK A GIVEN FIELD
   8 C   FOR PARTICULAR BINARY AND DECIMAL SCALINGS IS COMPUTED.
   9 C   THE FIELD IS ROUNDED OFF TO THE DECIMAL SCALING FOR PACKING.
  10 C   THE MINIMUM AND MAXIMUM ROUNDED FIELD VALUES ARE ALSO RETURNED.
  11 C   GRIB BITMAP MASKING FOR VALID DATA IS OPTIONALLY USED.
  12 C
  13 C PROGRAM HISTORY LOG:
  14 C   96-09-16  IREDELL
  15 C
  16 C USAGE:    CALL GTBITS(IBM,IBS,IDS,LEN,MG,G,GMIN,GMAX,NBIT)
  17 C   INPUT ARGUMENT LIST:
  18 C     IBM      - INTEGER BITMAP FLAG (=0 FOR NO BITMAP)
  19 C     IBS      - INTEGER BINARY SCALING
  20 C                (E.G. IBS=3 TO ROUND FIELD TO NEAREST EIGHTH VALUE)
  21 C     IDS      - INTEGER DECIMAL SCALING
  22 C                (E.G. IDS=3 TO ROUND FIELD TO NEAREST MILLI-VALUE)
  23 C                (NOTE THAT IDS AND IBS CAN BOTH BE NONZERO,
  24 C                 E.G. IDS=1 AND IBS=1 ROUNDS TO THE NEAREST TWENTIETH)
  25 C     LEN      - INTEGER LENGTH OF THE FIELD AND BITMAP
  26 C     MG       - INTEGER (LEN) BITMAP IF IBM=1 (0 TO SKIP, 1 TO KEEP)
  27 C     G        - REAL (LEN) FIELD
  28 C
  29 C   OUTPUT ARGUMENT LIST:
  30 C     GROUND   - REAL (LEN) FIELD ROUNDED TO DECIMAL AND BINARY SCALING
  31 C                (SET TO ZERO WHERE BITMAP IS 0 IF IBM=1)
  32 C     GMIN     - REAL MINIMUM VALID ROUNDED FIELD VALUE
  33 C     GMAX     - REAL MAXIMUM VALID ROUNDED FIELD VALUE
  34 C     NBIT     - INTEGER NUMBER OF BITS TO PACK
  35 C
  36 C ATTRIBUTES:
  37 C   LANGUAGE: CRAY FORTRAN
  38 C
  39 C$$$
  40       DIMENSION MG(LEN),G(LEN),GROUND(LEN)
  41 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  42 C  ROUND FIELD AND DETERMINE EXTREMES WHERE BITMAP IS ON
  43       S=2.**IBS*10.**IDS
  44       IF(IBM.EQ.0) THEN
  45         GROUND(1)=NINT(G(1)*S)/S
  46         GMAX=GROUND(1)
  47         GMIN=GROUND(1)
  48         DO I=2,LEN
  49           GROUND(I)=NINT(G(I)*S)/S
  50           GMAX=MAX(GMAX,GROUND(I))
  51           GMIN=MIN(GMIN,GROUND(I))
  52         ENDDO
  53       ELSE
  54         I1=1
  55         DOWHILE(I1.LE.LEN.AND.MG(I1).EQ.0)
  56           I1=I1+1
  57         ENDDO
  58         IF(I1.LE.LEN) THEN
  59           DO I=1,I1-1
  60             GROUND(I)=0.
  61           ENDDO
  62           GROUND(I1)=NINT(G(I1)*S)/S
  63           GMAX=GROUND(I1)
  64           GMIN=GROUND(I1)
  65           DO I=I1+1,LEN
  66             IF(MG(I).NE.0) THEN
  67               GROUND(I)=NINT(G(I)*S)/S
  68               GMAX=MAX(GMAX,GROUND(I))
  69               GMIN=MIN(GMIN,GROUND(I))
  70             ELSE
  71               GROUND(I)=0.
  72             ENDIF
  73           ENDDO
  74         ELSE
  75           DO I=1,LEN
  76             GROUND(I)=0.
  77           ENDDO
  78           GMAX=0.
  79           GMIN=0.
  80         ENDIF
  81       ENDIF
  82 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  83 C  COMPUTE NUMBER OF BITS
  84       NBIT=LOG((GMAX-GMIN)*S+0.9)/LOG(2.)+1.
  85 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  86       RETURN
  87       END