subroutine getfield(cgrib,lcgrib,ifldnum,igds,igdstmpl,igdslen,,13
& ideflist,idefnum,ipdsnum,ipdstmpl,ipdslen,
& coordlist,numcoord,ndpts,idrsnum,idrstmpl,
& idrslen,ibmap,bmap,fld,ierr)
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: getfield
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26
!
! ABSTRACT: This subroutine returns the Grid Definition, Product Definition,
! Bit-map ( if applicable ), and the unpacked data for a given data
! field. Since there can be multiple data fields packed into a GRIB2
! message, the calling routine indicates which field is being requested
! with the ifldnum argument.
!
! PROGRAM HISTORY LOG:
! 2000-05-26 Gilbert
!
! USAGE: CALL getfield(cgrib,lcgrib,ifldnum,igds,igdstmpl,igdslen,
! & ideflist,idefnum,ipdsnum,ipdstmpl,ipdslen,
! & coordlist,numcoord,ndpts,idrsnum,idrstmpl,
! & idrslen,ibmap,bmap,fld,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array that contains the GRIB2 message
! lcgrib - Length (in bytes) of GRIB message array cgrib.
! ifldnum - Specifies which field in the GRIB2 message to return.
!
! OUTPUT ARGUMENT LIST:
! igds - Contains information read from the appropriate GRIB Grid
! Definition Section 3 for the field being returned.
! Must be dimensioned >= 5.
! igds(1)=Source of grid definition (see Code Table 3.0)
! igds(2)=Number of grid points in the defined grid.
! igds(3)=Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! igds(4)=Interpretation of list for optional points
! definition. (Code Table 3.11)
! igds(5)=Grid Definition Template Number (Code Table 3.1)
! igdstmpl - Contains the data values for the specified Grid Definition
! Template ( NN=igds(5) ). Each element of this integer
! array contains an entry (in the order specified) of Grid
! Defintion Template 3.NN
! A safe dimension for this array can be obtained in advance
! from maxvals(2), which is returned from subroutine gribinfo.
! igdslen - Number of elements in igdstmpl(). i.e. number of entries
! in Grid Defintion Template 3.NN ( NN=igds(5) ).
! ideflist - (Used if igds(3) .ne. 0) This array contains the
! number of grid points contained in each row ( or column ).
! (part of Section 3)
! A safe dimension for this array can be obtained in advance
! from maxvals(3), which is returned from subroutine gribinfo.
! idefnum - (Used if igds(3) .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined.
! ipdsnum - Product Definition Template Number ( see Code Table 4.0)
! ipdstmpl - Contains the data values for the specified Product Definition
! Template ( N=ipdsnum ). Each element of this integer
! array contains an entry (in the order specified) of Product
! Defintion Template 4.N
! A safe dimension for this array can be obtained in advance
! from maxvals(4), which is returned from subroutine gribinfo.
! ipdslen - Number of elements in ipdstmpl(). i.e. number of entries
! in Product Defintion Template 4.N ( N=ipdsnum ).
! coordlist- Array containg floating point values intended to document
! the vertical discretisation associated to model data
! on hybrid coordinate vertical levels. (part of Section 4)
! The dimension of this array can be obtained in advance
! from maxvals(5), which is returned from subroutine gribinfo.
! numcoord - number of values in array coordlist.
! ndpts - Number of data points unpacked and returned.
! idrsnum - Data Representation Template Number ( see Code Table 5.0)
! idrstmpl - Contains the data values for the specified Data Representation
! Template ( N=idrsnum ). Each element of this integer
! array contains an entry (in the order specified) of Product
! Defintion Template 5.N
! A safe dimension for this array can be obtained in advance
! from maxvals(6), which is returned from subroutine gribinfo.
! idrslen - Number of elements in idrstmpl(). i.e. number of entries
! in Data Representation Template 5.N ( N=idrsnum ).
! ibmap - Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
! bmap() - Logical*1 array containing decoded bitmap. ( if ibmap=0 )
! The dimension of this array can be obtained in advance
! from maxvals(7), which is returned from subroutine gribinfo.
! fld() - Array of ndpts unpacked data points.
! A safe dimension for this array can be obtained in advance
! from maxvals(7), which is returned from subroutine gribinfo.
! ierr - Error return code.
! 0 = no error
! 1 = Beginning characters "GRIB" not found.
! 2 = GRIB message is not Edition 2.
! 3 = The data field request number was not positive.
! 4 = End string "7777" found, but not where expected.
! 6 = GRIB message did not contain the requested number of
! data fields.
! 7 = End string "7777" not found at end of message.
! 9 = Data Representation Template 5.NN not yet implemented.
! 10 = Error unpacking Section 3.
! 11 = Error unpacking Section 4.
! 12 = Error unpacking Section 5.
! 13 = Error unpacking Section 6.
! 14 = Error unpacking Section 7.
!
! REMARKS: Note that subroutine gribinfo can be used to first determine
! how many data fields exist in a given GRIB message.
!
! ATTRIBUTES:
! LANGUAGE: Fortran 90
! MACHINE: IBM SP
!
!$$$
character(len=1),intent(in) :: cgrib(lcgrib)
integer,intent(in) :: lcgrib,ifldnum
integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*)
integer,intent(out) :: ipdsnum,ipdstmpl(*)
integer,intent(out) :: idrsnum,idrstmpl(*)
integer,intent(out) :: ndpts,ibmap,idefnum,numcoord
integer,intent(out) :: ierr
logical*1,intent(out) :: bmap(*)
real,intent(out) :: fld(*),coordlist(*)
character(len=4),parameter :: grib='GRIB',c7777='7777'
character(len=4) :: ctemp
integer:: listsec0(2)
integer iofst,ibeg,istart
integer(4) :: ieee
logical have3,have4,have5,have6,have7
have3=.false.
have4=.false.
have5=.false.
have6=.false.
have7=.false.
ierr=0
numfld=0
!
! Check for valid request number
!
if (ifldnum.le.0) then
print *,'getfield: Request for field number must be positive.'
ierr=3
return
endif
!
! Check for beginning of GRIB message in the first 100 bytes
!
istart=0
do j=1,100
ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3)
if (ctemp.eq.grib ) then
istart=j
exit
endif
enddo
if (istart.eq.0) then
print *,'getfield: Beginning characters GRIB not found.'
ierr=1
return
endif
!
! Unpack Section 0 - Indicator Section
!
iofst=8*(istart+5)
call gbyte
(cgrib,listsec0(1),iofst,8) ! Discipline
iofst=iofst+8
call gbyte(cgrib,listsec0(2),iofst,8) ! GRIB edition number
iofst=iofst+8
iofst=iofst+32
call gbyte(cgrib,lengrib,iofst,32) ! Length of GRIB message
iofst=iofst+32
lensec0=16
ipos=istart+lensec0
!
! Currently handles only GRIB Edition 2.
!
if (listsec0(2).ne.2) then
print *,'getfield: can only decode GRIB edition 2.'
ierr=2
return
endif
!
! Loop through the remaining sections keeping track of the
! length of each. Also keep the latest Grid Definition Section info.
! Unpack the requested field number.
!
do
! Check to see if we are at end of GRIB message
ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3)
if (ctemp.eq.c7777 ) then
ipos=ipos+4
! If end of GRIB message not where expected, issue error
if (ipos.ne.(istart+lengrib)) then
print *,'getfield: "7777" found, but not where expected.'
ierr=4
return
endif
exit
endif
! Get length of Section and Section number
iofst=(ipos-1)*8
call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section
iofst=iofst+32
call gbyte(cgrib,isecnum,iofst,8) ! Get Section number
iofst=iofst+8
!print *,' lensec= ',lensec,' secnum= ',isecnum
!
! If found Section 3, unpack the GDS info using the
! appropriate template. Save in case this is the latest
! grid before the requested field.
!
if (isecnum.eq.3) then
iofst=iofst-40 ! reset offset to beginning of section
call unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,igdslen,
& ideflist,idefnum,jerr)
if (jerr.eq.0) then
have3=.true.
else
ierr=10
return
endif
endif
!
! If found Section 4, check to see if this field is the
! one requested.
!
if (isecnum.eq.4) then
numfld=numfld+1
if (numfld.eq.ifldnum) then
iofst=iofst-40 ! reset offset to beginning of section
call unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,ipdslen,
& coordlist,numcoord,jerr)
if (jerr.eq.0) then
have4=.true.
else
ierr=11
return
endif
endif
endif
!
! If found Section 5, check to see if this field is the
! one requested.
!
if ((isecnum.eq.5).and.(numfld.eq.ifldnum)) then
iofst=iofst-40 ! reset offset to beginning of section
call unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl,
& idrslen,jerr)
if (jerr.eq.0) then
have5=.true.
else
ierr=12
return
endif
endif
!
! If found Section 6, Unpack bitmap.
! Save in case this is the latest
! bitmap before the requested field.
!
if (isecnum.eq.6) then
iofst=iofst-40 ! reset offset to beginning of section
call unpack6(cgrib,lcgrib,iofst,igds(2),ibmap,bmap,jerr)
if (jerr.eq.0) then
have6=.true.
else
ierr=13
return
endif
endif
!
! If found Section 7, check to see if this field is the
! one requested.
!
if ((isecnum.eq.7).and.(numfld.eq.ifldnum)) then
if (idrsnum.eq.0) then
call simunpack(cgrib(ipos+5),lensec-6,idrstmpl,ndpts,fld)
have7=.true.
elseif (idrsnum.eq.2.or.idrsnum.eq.3) then
call comunpack(cgrib(ipos+5),lensec-6,lensec,idrsnum,
& idrstmpl,ndpts,fld,ier)
if ( ier .ne. 0 ) then
ierr=14
return
endif
have7=.true.
elseif (idrsnum.eq.50) then
call simunpack(cgrib(ipos+5),lensec-6,idrstmpl,ndpts-1,
& fld(2))
ieee=idrstmpl(5)
call rdieee(ieee,fld(1),1)
have7=.true.
else
print *,'getfield: Data Representation Template ',idrsnum,
& ' not yet implemented.'
ierr=9
return
endif
endif
!
! Check to see if we read pass the end of the GRIB
! message and missed the terminator string '7777'.
!
ipos=ipos+lensec ! Update beginning of section pointer
if (ipos.gt.(istart+lengrib)) then
print *,'getfield: "7777" not found at end of GRIB message.'
ierr=7
return
endif
if (have3.and.have4.and.have5.and.have6.and.have7) return
enddo
!
! If exited from above loop, the end of the GRIB message was reached
! before the requested field was found.
!
print *,'getfield: GRIB message contained ',numlocal,
& ' different fields.'
print *,'getfield: The request was for the ',ifldnum,
& ' field.'
ierr=6
return
end
subroutine unpack3(cgrib,lcgrib,iofst,igds,igdstmpl, 2,16
& mapgridlen,ideflist,idefnum,ierr)
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: unpack3
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26
!
! ABSTRACT: This subroutine unpacks Section 3 (Grid Definition Section)
! starting at octet 6 of that Section.
!
! PROGRAM HISTORY LOG:
! 2000-05-26 Gilbert
!
! USAGE: CALL unpack3(cgrib,lcgrib,lensec,iofst,igds,igdstmpl,
! & mapgridlen,ideflist,idefnum,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array that contains the GRIB2 message
! lcgrib - Length (in bytes) of GRIB message array cgrib.
! iofst - Bit offset of the beginning of Section 3.
!
! OUTPUT ARGUMENT LIST:
! iofst - Bit offset at the end of Section 3, returned.
! igds - Contains information read from the appropriate GRIB Grid
! Definition Section 3 for the field being returned.
! Must be dimensioned >= 5.
! igds(1)=Source of grid definition (see Code Table 3.0)
! igds(2)=Number of grid points in the defined grid.
! igds(3)=Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! igds(4)=Interpretation of list for optional points
! definition. (Code Table 3.11)
! igds(5)=Grid Definition Template Number (Code Table 3.1)
! igdstmpl - Contains the data values for the specified Grid Definition
! Template ( NN=igds(5) ). Each element of this integer
! array contains an entry (in the order specified) of Grid
! Defintion Template 3.NN
! mapgridlen- Number of elements in igdstmpl(). i.e. number of entries
! in Grid Defintion Template 3.NN ( NN=igds(5) ).
! ideflist - (Used if igds(3) .ne. 0) This array contains the
! number of grid points contained in each row ( or column ).
! (part of Section 3)
! idefnum - (Used if igds(3) .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined.
! ierr - Error return code.
! 0 = no error
! 5 = "GRIB" message contains an undefined Grid Definition
! Template.
!
! REMARKS: Uses Fortran 90 module gridtemplates.
!
! ATTRIBUTES:
! LANGUAGE: Fortran 90
! MACHINE: IBM SP
!
!$$$
use gridtemplates
character(len=1),intent(in) :: cgrib(lcgrib)
integer,intent(in) :: lcgrib
integer,intent(inout) :: iofst
integer,intent(out) :: igds(*),igdstmpl(*),ideflist(*)
integer,intent(out) :: ierr,idefnum
integer,allocatable :: mapgrid(:)
integer :: mapgridlen,ibyttem
logical needext
ierr=0
call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section
iofst=iofst+32
iofst=iofst+8 ! skip section number
call gbyte(cgrib,igds(1),iofst,8) ! Get source of Grid def.
iofst=iofst+8
call gbyte(cgrib,igds(2),iofst,32) ! Get number of grid pts.
iofst=iofst+32
call gbyte(cgrib,igds(3),iofst,8) ! Get num octets for opt. list
iofst=iofst+8
call gbyte(cgrib,igds(4),iofst,8) ! Get interpret. for opt. list
iofst=iofst+8
call gbyte(cgrib,igds(5),iofst,16) ! Get Grid Def Template num.
iofst=iofst+16
if (igds(1).eq.0) then
! if (igds(1).eq.0.OR.igds(1).eq.255) then ! FOR ECMWF TEST ONLY
allocate(mapgrid(lensec))
! Get Grid Definition Template
call getgridtemplate(igds(5),mapgridlen,mapgrid,needext,
& iret)
if (iret.ne.0) then
ierr=5
return
endif
else
! igdstmpl=-1
mapgridlen=0
needext=.false.
endif
!
! Unpack each value into array igdstmpl from the
! the appropriate number of octets, which are specified in
! corresponding entries in array mapgrid.
!
ibyttem=0
do i=1,mapgridlen
nbits=iabs(mapgrid(i))*8
if ( mapgrid(i).ge.0 ) then
call gbyte(cgrib,igdstmpl(i),iofst,nbits)
else
call gbyte(cgrib,isign,iofst,1)
call gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1)
if (isign.eq.1) igdstmpl(i)=-igdstmpl(i)
endif
iofst=iofst+nbits
ibyttem=ibyttem+iabs(mapgrid(i))
enddo
!
! Check to see if the Grid Definition Template needs to be
! extended.
! The number of values in a specific template may vary
! depending on data specified in the "static" part of the
! template.
!
if ( needext ) then
call extgridtemplate(igds(5),igdstmpl,newmapgridlen,mapgrid)
! Unpack the rest of the Grid Definition Template
do i=mapgridlen+1,newmapgridlen
nbits=iabs(mapgrid(i))*8
if ( mapgrid(i).ge.0 ) then
call gbyte(cgrib,igdstmpl(i),iofst,nbits)
else
call gbyte(cgrib,isign,iofst,1)
call gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1)
if (isign.eq.1) igdstmpl(i)=-igdstmpl(i)
endif
iofst=iofst+nbits
ibyttem=ibyttem+iabs(mapgrid(i))
enddo
mapgridlen=newmapgridlen
endif
!
! Unpack optional list of numbers defining number of points
! in each row or column, if included. This is used for non regular
! grids.
!
if ( igds(3).ne.0 ) then
nbits=igds(3)*8
idefnum=(lensec-14-ibyttem)/igds(3)
call gbytes(cgrib,ideflist,iofst,nbits,0,idefnum)
iofst=iofst+(nbits*idefnum)
else
idefnum=0
endif
if( allocated(mapgrid) ) deallocate(mapgrid)
return ! End of Section 3 processing
end
subroutine unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,mappdslen, 2,14
& coordlist,numcoord,ierr)
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: unpack4
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26
!
! ABSTRACT: This subroutine unpacks Section 4 (Product Definition Section)
! starting at octet 6 of that Section.
!
! PROGRAM HISTORY LOG:
! 2000-05-26 Gilbert
!
! USAGE: CALL unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,mappdslen,
! & coordlist,numcoord,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array that contains the GRIB2 message
! lcgrib - Length (in bytes) of GRIB message array cgrib.
! iofst - Bit offset of the beginning of Section 4.
!
! OUTPUT ARGUMENT LIST:
! iofst - Bit offset of the end of Section 4, returned.
! ipdsnum - Product Definition Template Number ( see Code Table 4.0)
! ipdstmpl - Contains the data values for the specified Product Definition
! Template ( N=ipdsnum ). Each element of this integer
! array contains an entry (in the order specified) of Product
! Defintion Template 4.N
! mappdslen- Number of elements in ipdstmpl(). i.e. number of entries
! in Product Defintion Template 4.N ( N=ipdsnum ).
! coordlist- Array containg floating point values intended to document
! the vertical discretisation associated to model data
! on hybrid coordinate vertical levels. (part of Section 4)
! numcoord - number of values in array coordlist.
! ierr - Error return code.
! 0 = no error
! 5 = "GRIB" message contains an undefined Product Definition
! Template.
!
! REMARKS: Uses Fortran 90 module pdstemplates.
!
! ATTRIBUTES:
! LANGUAGE: Fortran 90
! MACHINE: IBM SP
!
!$$$
use pdstemplates
character(len=1),intent(in) :: cgrib(lcgrib)
integer,intent(in) :: lcgrib
integer,intent(inout) :: iofst
real,intent(out) :: coordlist(*)
integer,intent(out) :: ipdsnum,ipdstmpl(*)
integer,intent(out) :: ierr,numcoord
real(4),allocatable :: coordieee(:)
integer,allocatable :: mappds(:)
integer :: mappdslen
logical needext
ierr=0
call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section
iofst=iofst+32
iofst=iofst+8 ! skip section number
allocate(mappds(lensec))
call gbyte(cgrib,numcoord,iofst,16) ! Get num of coordinate values
iofst=iofst+16
call gbyte(cgrib,ipdsnum,iofst,16) ! Get Prod. Def Template num.
iofst=iofst+16
! Get Product Definition Template
call getpdstemplate(ipdsnum,mappdslen,mappds,needext,iret)
if (iret.ne.0) then
ierr=5
return
endif
!
! Unpack each value into array ipdstmpl from the
! the appropriate number of octets, which are specified in
! corresponding entries in array mappds.
!
do i=1,mappdslen
nbits=iabs(mappds(i))*8
if ( mappds(i).ge.0 ) then
call gbyte(cgrib,ipdstmpl(i),iofst,nbits)
else
call gbyte(cgrib,isign,iofst,1)
call gbyte(cgrib,ipdstmpl(i),iofst+1,nbits-1)
if (isign.eq.1) ipdstmpl(i)=-ipdstmpl(i)
endif
iofst=iofst+nbits
enddo
!
! Check to see if the Product Definition Template needs to be
! extended.
! The number of values in a specific template may vary
! depending on data specified in the "static" part of the
! template.
!
if ( needext ) then
call extpdstemplate(ipdsnum,ipdstmpl,newmappdslen,mappds)
! Unpack the rest of the Product Definition Template
do i=mappdslen+1,newmappdslen
nbits=iabs(mappds(i))*8
if ( mappds(i).ge.0 ) then
call gbyte(cgrib,ipdstmpl(i),iofst,nbits)
else
call gbyte(cgrib,isign,iofst,1)
call gbyte(cgrib,ipdstmpl(i),iofst+1,nbits-1)
if (isign.eq.1) ipdstmpl(i)=-ipdstmpl(i)
endif
iofst=iofst+nbits
enddo
mappdslen=newmappdslen
endif
!
! Get Optional list of vertical coordinate values
! after the Product Definition Template, if necessary.
!
if ( numcoord .ne. 0 ) then
allocate (coordieee(numcoord))
call gbytes(cgrib,coordieee,iofst,32,0,numcoord)
call rdieee(coordieee,coordlist,numcoord)
deallocate (coordieee)
iofst=iofst+(32*numcoord)
endif
if( allocated(mappds) ) deallocate(mappds)
return ! End of Section 4 processing
end
subroutine unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl, 1,12
& mapdrslen,ierr)
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: unpack5
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26
!
! ABSTRACT: This subroutine unpacks Section 5 (Data Representation Section)
! starting at octet 6 of that Section.
!
! PROGRAM HISTORY LOG:
! 2000-05-26 Gilbert
!
! USAGE: CALL unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl,
! mapdrslen,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array that contains the GRIB2 message
! lcgrib - Length (in bytes) of GRIB message array cgrib.
! iofst - Bit offset of the beginning of Section 5.
!
! OUTPUT ARGUMENT LIST:
! iofst - Bit offset at the end of Section 5, returned.
! ndpts - Number of data points unpacked and returned.
! idrsnum - Data Representation Template Number ( see Code Table 5.0)
! idrstmpl - Contains the data values for the specified Data Representation
! Template ( N=idrsnum ). Each element of this integer
! array contains an entry (in the order specified) of Data
! Representation Template 5.N
! mapdrslen- Number of elements in idrstmpl(). i.e. number of entries
! in Data Representation Template 5.N ( N=idrsnum ).
! ierr - Error return code.
! 0 = no error
! 7 = "GRIB" message contains an undefined Data
! Representation Template.
!
! REMARKS: None
!
! ATTRIBUTES:
! LANGUAGE: Fortran 90
! MACHINE: IBM SP
!
!$$$
use drstemplates
character(len=1),intent(in) :: cgrib(lcgrib)
integer,intent(in) :: lcgrib
integer,intent(inout) :: iofst
integer,intent(out) :: ndpts,idrsnum,idrstmpl(*)
integer,intent(out) :: ierr
C integer,allocatable :: mapdrs(:)
integer,allocatable :: mapdrs(:)
integer :: mapdrslen
logical needext
ierr=0
call gbyte(cgrib,lensec,iofst,32) ! Get Length of Section
iofst=iofst+32
iofst=iofst+8 ! skip section number
allocate(mapdrs(lensec))
call gbyte(cgrib,ndpts,iofst,32) ! Get num of data points
iofst=iofst+32
call gbyte(cgrib,idrsnum,iofst,16) ! Get Data Rep Template Num.
iofst=iofst+16
! Gen Data Representation Template
call getdrstemplate(idrsnum,mapdrslen,mapdrs,needext,iret)
if (iret.ne.0) then
ierr=7
return
endif
!
! Unpack each value into array ipdstmpl from the
! the appropriate number of octets, which are specified in
! corresponding entries in array mappds.
!
do i=1,mapdrslen
nbits=iabs(mapdrs(i))*8
if ( mapdrs(i).ge.0 ) then
call gbyte(cgrib,idrstmpl(i),iofst,nbits)
else
call gbyte(cgrib,isign,iofst,1)
call gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1)
if (isign.eq.1) idrstmpl(i)=-idrstmpl(i)
endif
iofst=iofst+nbits
enddo
!
! Check to see if the Data Representation Template needs to be
! extended.
! The number of values in a specific template may vary
! depending on data specified in the "static" part of the
! template.
!
if ( needext ) then
call extdrstemplate(idrsnum,idrstmpl,newmapdrslen,mapdrs)
! Unpack the rest of the Data Representation Template
do i=mapdrslen+1,newmapdrslen
nbits=iabs(mapdrs(i))*8
if ( mapdrs(i).ge.0 ) then
call gbyte(cgrib,idrstmpl(i),iofst,nbits)
else
call gbyte(cgrib,isign,iofst,1)
call gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1)
if (isign.eq.1) idrstmpl(i)=-idrstmpl(i)
endif
iofst=iofst+nbits
enddo
mapdrslen=newmapdrslen
endif
if( allocated(mapdrs) ) deallocate(mapdrs)
return ! End of Section 5 processing
end
subroutine unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr) 1,2
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: unpack6
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26
!
! ABSTRACT: This subroutine unpacks Section 6 (Bit-Map Section)
! starting at octet 6 of that Section.
!
! PROGRAM HISTORY LOG:
! 2000-05-26 Gilbert
!
! USAGE: CALL unpack6(cgrib,lcgrib,iofst,ngpts,ibmap,bmap,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array that contains the GRIB2 message
! lcgrib - Length (in bytes) of GRIB message array cgrib.
! iofst - Bit offset of the beginning of Section 6.
! ngpts - Number of grid points specified in the bit-map
!
! OUTPUT ARGUMENT LIST:
! iofst - Bit offset at the end of Section 6, returned.
! ibmap - Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
! bmap() - Logical*1 array containing decoded bitmap. ( if ibmap=0 )
! ierr - Error return code.
! 0 = no error
! 4 = Unrecognized pre-defined bit-map.
!
! REMARKS: None
!
! ATTRIBUTES:
! LANGUAGE: Fortran 90
! MACHINE: IBM SP
!
!$$$
character(len=1),intent(in) :: cgrib(lcgrib)
integer,intent(in) :: lcgrib,ngpts
integer,intent(inout) :: iofst
integer,intent(out) :: ibmap
integer,intent(out) :: ierr
logical*1,intent(out) :: bmap(ngpts)
integer :: intbmap(ngpts)
ierr=0
iofst=iofst+32 ! skip Length of Section
iofst=iofst+8 ! skip section number
call gbyte(cgrib,ibmap,iofst,8) ! Get bit-map indicator
iofst=iofst+8
if (ibmap.eq.0) then ! Unpack bitmap
call gbytes(cgrib,intbmap,iofst,1,0,ngpts)
iofst=iofst+ngpts
do j=1,ngpts
bmap(j)=.true.
if (intbmap(j).eq.0) bmap(j)=.false.
enddo
elseif (ibmap.eq.254) then ! Use previous bitmap
return
elseif (ibmap.eq.255) then ! No bitmap in message
bmap(1:ngpts)=.true.
else
print *,'unpack6: Predefined bitmap ',ibmap,' not recognized.'
ierr=4
endif
return ! End of Section 6 processing
end