external/io_grib2/g2lib/gf_unpack6.F

   1       subroutine gf_unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr)
   2 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 !                .      .    .                                       .
   4 ! SUBPROGRAM:    gf_unpack6
   5 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
   6 !
   7 ! ABSTRACT: This subroutine unpacks Section 6 (Bit-Map Section)
   8 !   starting at octet 6 of that Section.
   9 !
  10 ! PROGRAM HISTORY LOG:
  11 ! 2000-05-26  Gilbert
  12 ! 2002-01-24  Gilbert  - Changed to dynamically allocate arrays
  13 !                        and to pass pointers to those arrays through
  14 !                        the argument list.
  15 !
  16 ! USAGE:    CALL gf_unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr)
  17 !   INPUT ARGUMENT LIST:
  18 !     cgrib    - Character array that contains the GRIB2 message
  19 !     lcgrib   - Length (in bytes) of GRIB message array cgrib.
  20 !     iofst    - Bit offset of the beginning of Section 6.
  21 !     ngpts    - Number of grid points specified in the bit-map
  22 !
  23 !   OUTPUT ARGUMENT LIST:
  24 !     iofst    - Bit offset at the end of Section 6, returned.
  25 !     ibmap    - Bitmap indicator ( see Code Table 6.0 )
  26 !                0 = bitmap applies and is included in Section 6.
  27 !                1-253 = Predefined bitmap applies
  28 !                254 = Previously defined bitmap applies to this field
  29 !                255 = Bit map does not apply to this product.
  30 !     bmap()   - Pointer to a logical*1 array containing decoded bitmap.
  31 !                ( if ibmap=0 )
  32 !     ierr     - Error return code.
  33 !                0 = no error
  34 !                4 = Unrecognized pre-defined bit-map.
  35 !                6 = memory allocation error
  36 !
  37 ! REMARKS: None
  38 !
  39 ! ATTRIBUTES:
  40 !   LANGUAGE: Fortran 90
  41 !   MACHINE:  IBM SP
  42 !
  43 !$$$
  44
  45       character(len=1),intent(in) :: cgrib(lcgrib)
  46       integer,intent(in) :: lcgrib,ngpts
  47       integer,intent(inout) :: iofst
  48       integer,intent(out) :: ibmap
  49       integer,intent(out) :: ierr
  50       logical*1,pointer,dimension(:) :: bmap
  51
  52       integer :: intbmap(ngpts)
  53
  54       ierr=0
  55       nullify(bmap)
  56
  57       iofst=iofst+32    ! skip Length of Section
  58       iofst=iofst+8     ! skip section number
  59
  60       call g2lib_gbyte(cgrib,ibmap,iofst,8)    ! Get bit-map indicator
  61       iofst=iofst+8
  62
  63       if (ibmap.eq.0) then               ! Unpack bitmap
  64          istat=0
  65          if (ngpts.gt.0) allocate(bmap(ngpts),stat=istat)
  66          if (istat.ne.0) then
  67             ierr=6
  68             nullify(bmap)
  69             return
  70          endif
  71          call g2lib_gbytes(cgrib,intbmap,iofst,1,0,ngpts)
  72          iofst=iofst+ngpts
  73          do j=1,ngpts
  74            bmap(j)=.true.
  75            if (intbmap(j).eq.0) bmap(j)=.false.
  76          enddo
  77 !      elseif (ibmap.eq.254) then               ! Use previous bitmap
  78 !        return
  79 !      elseif (ibmap.eq.255) then               ! No bitmap in message
  80 !        bmap(1:ngpts)=.true.
  81 !      else
  82 !        print *,'gf_unpack6: Predefined bitmap ',ibmap,' not recognized.'
  83 !        ierr=4
  84       endif
  85
  86       return    ! End of Section 6 processing
  87       end
  88