subroutine gettemplates(cgrib,lcgrib,ifldnum,igds,igdstmpl,,7
& igdslen,ideflist,idefnum,ipdsnum,ipdstmpl,
& ipdslen,coordlist,numcoord,ierr)
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: gettemplates
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26
!
! ABSTRACT: This subroutine returns the Grid Definition, and
! Product Definition 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 gettemplates(cgrib,lcgrib,ifldnum,igds,igdstmpl,igdslen,
! & ideflist,idefnum,ipdsnum,ipdstmpl,ipdslen,
! & coordlist,numcoord,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.
! 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.
! 10 = Error unpacking Section 3.
! 11 = Error unpacking Section 4.
!
! REMARKS: Note that subroutine gribinfo can be used to first determine
! how many data fields exist in the 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) :: idefnum,numcoord
integer,intent(out) :: ierr
real,intent(out) :: coordlist(*)
character(len=4),parameter :: grib='GRIB',c7777='7777'
character(len=4) :: ctemp
integer:: listsec0(2)
integer iofst,ibeg,istart
logical have3,have4
have3=.false.
have4=.false.
ierr=0
numfld=0
!
! Check for valid request number
!
if (ifldnum.le.0) then
print *,'gettemplates: 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 *,'gettemplates: 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 *,'gettemplates: 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 *,'gettemplates: "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
!
! 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 *,'gettemplates: "7777" not found at end of GRIB ',
& 'message.'
ierr=7
return
endif
if (have3.and.have4) return
enddo
!
! If exited from above loop, the end of the GRIB message was reached
! before the requested field was found.
!
print *,'gettemplates: GRIB message contained ',numlocal,
& ' different fields.'
print *,'gettemplates: The request was for the ',ifldnum,
& ' field.'
ierr=6
return
end