subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl, & mapgridlen,ideflist,idefnum,ierr) !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . . ! SUBPROGRAM: gf_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 ! 2002-01-24 Gilbert - Changed to dynamically allocate arrays ! and to pass pointers to those arrays through ! the argument list. ! ! USAGE: CALL gf_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 - Pointer to integer array containing 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) Pointer to integer array containing ! 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. ! 6 = memory allocation error ! ! REMARKS: Uses Fortran 90 module gridtemplates and module re_alloc. ! ! ATTRIBUTES: ! LANGUAGE: Fortran 90 ! MACHINE: IBM SP ! !$$$ use gridtemplates use re_alloc ! needed for subroutine realloc character(len=1),intent(in) :: cgrib(lcgrib) integer,intent(in) :: lcgrib integer,intent(inout) :: iofst integer,pointer,dimension(:) :: igdstmpl,ideflist integer,intent(out) :: igds(5) integer,intent(out) :: ierr,idefnum integer,allocatable :: mapgrid(:) integer :: mapgridlen,ibyttem logical needext ierr=0 nullify(igdstmpl,ideflist) 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 if( allocated(mapgrid) ) deallocate(mapgrid) 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. ! istat=0 if (mapgridlen.gt.0) allocate(igdstmpl(mapgridlen),stat=istat) if (istat.ne.0) then ierr=6 nullify(igdstmpl) if( allocated(mapgrid) ) deallocate(mapgrid) return endif 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 call realloc(igdstmpl,mapgridlen,newmapgridlen,istat) 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 if( allocated(mapgrid) ) deallocate(mapgrid) ! ! 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) istat=0 if (idefnum.gt.0) allocate(ideflist(idefnum),stat=istat) if (istat.ne.0) then ierr=6 nullify(ideflist) return endif call gbytes(cgrib,ideflist,iofst,nbits,0,idefnum) iofst=iofst+(nbits*idefnum) else idefnum=0 nullify(ideflist) endif return ! End of Section 3 processing end