w3fi73.f

Go to the documentation of this file.

C> @file
C> @brief Construct grib bit map section (BMS).
C> @author M. Farley @date 1992-07-01
 
C> This subroutine constructs a grib bit map section.
C>
C> Program history log:
C> - M. Farley 1992-07-01
C> - Bill Cavanaugh 1994-02-14 Recoded
C> - Ebisuzaki 1998-06-30 Linux port
C>
C> @param[in] IBFLAG
C> - 0, if bit map supplied by user
C> - #, Number of predefined center bit map
C> @param[in] IBMAP Integer array containing user bit map
C> @param[in] IBLEN Length of bit map
C> @param[out] BMS Completed grib bit map section
C> @param[out] LENBMS Length of bit map section
C> @param[out] IER 0 normal exit, 8 = ibmap values are all zero
C>
C> @author M. Farley @date 1992-07-01
      SUBROUTINE w3fi73 (IBFLAG,IBMAP,IBLEN,BMS,LENBMS,IER)
C
      INTEGER       IBMAP(*)
      INTEGER       LENBMS
      INTEGER       IBLEN
      INTEGER       IBFLAG
C
      CHARACTER*1   BMS(*)
C
      ier   = 0
C
      iz  = 0
      DO 20 i = 1, iblen
          IF (ibmap(i).EQ.0) iz  = iz + 1
   20 CONTINUE
      IF (iz.EQ.iblen) THEN
C
C     AT THIS POINT ALL BIT MAP POSITIONS ARE ZERO
C
        ier = 8
        RETURN
      END IF
C
C     BIT MAP IS A COMBINATION OF ONES AND ZEROS
C     OR      BIT MAP ALL ONES
C
C     CONSTRUCT BIT MAP FIELD OF BIT MAP SECTION
C
      CALL sbytesc(bms,ibmap,48,1,0,iblen)
C
      IF (mod(iblen,16).NE.0) THEN
          nleft  = 16 - mod(iblen,16)
      ELSE
          nleft  = 0
      END IF
C
      num  = 6 + (iblen+nleft) / 8
C
C     CONSTRUCT BMS FROM COLLECTED DATA
C
C     SIZE INTO FIRST THREE BYTES
C
      CALL sbytec(bms,num,0,24)
C                          NUMBER OF FILL BITS INTO BYTE 4
      CALL sbytec(bms,nleft,24,8)
C                          OCTET 5-6 TO CONTAIN INFO FROM IBFLAG
      CALL sbytec(bms,ibflag,32,16)
C
C     BIT MAP MAY BE ALL ONES OR A COMBINATION
C     OF ONES AND ZEROS
C
C     ACTUAL BITS OF BIT MAP PLACED ALL READY
C
C     INSTALL FILL POSITIONS IF NEEDED
      IF (nleft.NE.0) THEN
          nleft  = 16 - nleft
C                          ZERO FILL POSITIONS
          CALL sbytec(bms,0,iblen+48,nleft)
      END IF
C
C     STORE NUM IN LENBMS  (LENGTH OF BMS SECTION)
C
      lenbms = num
C     PRINT *,'W3FI73 - BMS LEN =',NUM,LENBMS
C
      RETURN
      END