source: trunk/WRF.COMMON/WRFV3/external/io_grib2/g2lib/gf_unpack7.F @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

File size: 4.5 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.