external/io_grib2/g2lib/gf_unpack7.F

   1       subroutine gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl,
   2      &                      idrsnum,idrstmpl,ndpts,fld,ierr)
   3 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 !                .      .    .                                       .
   5 ! SUBPROGRAM:    gf_unpack7
   6 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2002-01-24
   7 !
   8 ! ABSTRACT: This subroutine unpacks GRIB2 Section 7 (Data Section).
   9 !
  10 ! PROGRAM HISTORY LOG:
  11 ! 2002-01-24  Gilbert
  12 ! 2002-12-17  Gilbert  - Added support for new templates using
  13 !                        PNG and JPEG2000 algorithms/templates.
  14 ! 2004-12-29  Gilbert  - Added check on comunpack return code.
  15 !
  16 ! USAGE:    CALL gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl,
  17 !    &                      idrsnum,idrstmpl,ndpts,fld,ierr)
  18 !   INPUT ARGUMENT LIST:
  19 !     cgrib    - Character array that contains the GRIB2 message
  20 !     lcgrib   - Length (in bytes) of GRIB message array cgrib.
  21 !     iofst    - Bit offset of the beginning of Section 7.
  22 !     igdsnum  - Grid Definition Template Number ( see Code Table 3.0)
  23 !                (Only required to unpack DRT 5.51)
  24 !     igdstmpl - Pointer to an integer array containing the data values for
  25 !                the specified Grid Definition
  26 !                Template ( N=igdsnum ).  Each element of this integer
  27 !                array contains an entry (in the order specified) of Grid
  28 !                Definition Template 3.N
  29 !                (Only required to unpack DRT 5.51)
  30 !     idrsnum  - Data Representation Template Number ( see Code Table 5.0)
  31 !     idrstmpl - Pointer to an integer array containing the data values for
  32 !                the specified Data Representation
  33 !                Template ( N=idrsnum ).  Each element of this integer
  34 !                array contains an entry (in the order specified) of Data
  35 !                Representation Template 5.N
  36 !     ndpts    - Number of data points unpacked and returned.
  37 !
  38 !   OUTPUT ARGUMENT LIST:
  39 !     iofst    - Bit offset at the end of Section 7, returned.
  40 !     fld()    - Pointer to a real array containing the unpacked data field.
  41 !     ierr     - Error return code.
  42 !                0 = no error
  43 !                4 = Unrecognized Data Representation Template
  44 !                5 = One of GDT 3.50 through 3.53 required to unpack DRT 5.51
  45 !                6 = memory allocation error
  46 !                7 = corrupt section 7.
  47 !
  48 ! REMARKS: None
  49 !
  50 ! ATTRIBUTES:
  51 !   LANGUAGE: Fortran 90
  52 !   MACHINE:  IBM SP
  53 !
  54 !$$$
  55
  56       character(len=1),intent(in) :: cgrib(lcgrib)
  57       integer,intent(in) :: lcgrib,ndpts,igdsnum,idrsnum
  58       integer,intent(inout) :: iofst
  59       integer,pointer,dimension(:) :: igdstmpl,idrstmpl
  60       integer,intent(out) :: ierr
  61       real,pointer,dimension(:) :: fld
  62
  63
  64       ierr=0
  65       nullify(fld)
  66
  67       call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
  68       iofst=iofst+32
  69       iofst=iofst+8     ! skip section number
  70
  71       ipos=(iofst/8)+1
  72       istat=0
  73       allocate(fld(ndpts),stat=istat)
  74       if (istat.ne.0) then
  75          ierr=6
  76          return
  77       endif
  78
  79       if (idrsnum.eq.0) then
  80         call simunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld)
  81       elseif (idrsnum.eq.2.or.idrsnum.eq.3) then
  82         call comunpack(cgrib(ipos),lensec-5,lensec,idrsnum,idrstmpl,
  83      &                 ndpts,fld,ier)
  84         if ( ier .NE. 0 ) then
  85            ierr=7
  86            return
  87         endif
  88       elseif (idrsnum.eq.50) then      !  Spectral simple
  89         call simunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts-1,
  90      &                 fld(2))
  91         ieee=idrstmpl(5)
  92         call rdieee(ieee,fld(1),1)
  93       elseif (idrsnum.eq.51) then      !  Spectral complex
  94         if (igdsnum.ge.50.AND.igdsnum.le.53) then
  95           call specunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,
  96      &                    igdstmpl(1),igdstmpl(2),igdstmpl(3),fld)
  97         else
  98           print *,'gf_unpack7: Cannot use GDT 3.',igdsnum,
  99      &            ' to unpack Data Section 5.51.'
 100           ierr=5
 101           nullify(fld)
 102           return
 103         endif
 104 #ifdef USE_JPEG2000
 105       elseif (idrsnum.eq.40 .OR. idrsnum.eq.40000) then
 106         call jpcunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld)
 107 #endif  /* USE_JPEG2000 */
 108 #ifdef USE_PNG
 109       elseif (idrsnum.eq.41 .OR. idrsnum.eq.40010) then
 110         call pngunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld)
 111 #endif  /* USE_PNG */
 112       else
 113         print *,'gf_unpack7: Data Representation Template ',idrsnum,
 114      &          ' not yet implemented.'
 115         ierr=4
 116         nullify(fld)
 117         return
 118       endif
 119
 120       iofst=iofst+(8*lensec)
 121
 122       return    ! End of Section 7 processing
 123       end
 124