| 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 | |
|---|
