gf_unpack7.f

计算线性趋势 回归系数 主要用于气象站点值的线性趋势计算

      subroutine gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl,
     &                      idrsnum,idrstmpl,ndpts,fld,ierr)
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .                                       .
! SUBPROGRAM:    gf_unpack7 
!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2002-01-24
!
! ABSTRACT: This subroutine unpacks GRIB2 Section 7 (Data Section).
!
! PROGRAM HISTORY LOG:
! 2002-01-24  Gilbert
! 2002-12-17  Gilbert  - Added support for new templates using 
!                        PNG and JPEG2000 algorithms/templates.
! 2004-12-29  Gilbert  - Added check on comunpack return code.
!
! USAGE:    CALL gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl,
!    &                      idrsnum,idrstmpl,ndpts,fld,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 7.
!     igdsnum  - Grid Definition Template Number ( see Code Table 3.0)
!                (Only required to unpack DRT 5.51)
!     igdstmpl - Pointer to an integer array containing the data values for
!                the specified Grid Definition
!                Template ( N=igdsnum ).  Each element of this integer
!                array contains an entry (in the order specified) of Grid
!                Definition Template 3.N
!                (Only required to unpack DRT 5.51)
!     idrsnum  - Data Representation Template Number ( see Code Table 5.0)
!     idrstmpl - Pointer to an integer array containing 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
!     ndpts    - Number of data points unpacked and returned.
!
!   OUTPUT ARGUMENT LIST:      
!     iofst    - Bit offset at the end of Section 7, returned.
!     fld()    - Pointer to a real array containing the unpacked data field.
!     ierr     - Error return code.
!                0 = no error
!                4 = Unrecognized Data Representation Template
!                5 = One of GDT 3.50 through 3.53 required to unpack DRT 5.51
!                6 = memory allocation error
!                7 = corrupt section 7.
!
! REMARKS: None
!
! ATTRIBUTES:
!   LANGUAGE: Fortran 90
!   MACHINE:  IBM SP
!
!$$$

      character(len=1),intent(in) :: cgrib(lcgrib)
      integer,intent(in) :: lcgrib,ndpts,igdsnum,idrsnum
      integer,intent(inout) :: iofst
      integer,pointer,dimension(:) :: igdstmpl,idrstmpl
      integer,intent(out) :: ierr
      real,pointer,dimension(:) :: fld


      ierr=0
      nullify(fld)

      call gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
      iofst=iofst+32    
      iofst=iofst+8     ! skip section number

      ipos=(iofst/8)+1
      istat=0
      allocate(fld(ndpts),stat=istat)
      if (istat.ne.0) then
         ierr=6
         return
      endif

      if (idrsnum.eq.0) then
        call simunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld)
      elseif (idrsnum.eq.2.or.idrsnum.eq.3) then
        call comunpack(cgrib(ipos),lensec-5,lensec,idrsnum,idrstmpl,
     &                 ndpts,fld,ier)
        if ( ier .NE. 0 ) then
           ierr=7
           return
        endif
      elseif (idrsnum.eq.50) then      !  Spectral simple
        call simunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts-1,
     &                 fld(2))
        ieee=idrstmpl(5)
        call rdieee(ieee,fld(1),1)
      elseif (idrsnum.eq.51) then      !  Spectral complex
        if (igdsnum.ge.50.AND.igdsnum.le.53) then
          call specunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,
     &                    igdstmpl(1),igdstmpl(2),igdstmpl(3),fld)
        else
          print *,'gf_unpack7: Cannot use GDT 3.',igdsnum,
     &            ' to unpack Data Section 5.51.'
          ierr=5
          nullify(fld)
          return
        endif
#ifdef USE_JPEG2000
      elseif (idrsnum.eq.40 .OR. idrsnum.eq.40000) then
        call jpcunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld)
#endif  /* USE_JPEG2000 */
#ifdef USE_PNG
      elseif (idrsnum.eq.41 .OR. idrsnum.eq.40010) then
        call pngunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld)
#endif  /* USE_PNG */
      else
        print *,'gf_unpack7: Data Representation Template ',idrsnum,
     &          ' not yet implemented.'
        ierr=4
        nullify(fld)
        return
      endif

      iofst=iofst+(8*lensec)
      
      return    ! End of Section 7 processing
      end