source: trunk/WRF.COMMON/WRFV3/external/io_grib2/g2lib/gf_unpack5.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.8 KB
Line 
1      subroutine gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl,
2     &                   mapdrslen,ierr)
3!$$$  SUBPROGRAM DOCUMENTATION BLOCK
4!                .      .    .                                       .
5! SUBPROGRAM:    gf_unpack5
6!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
7!
8! ABSTRACT: This subroutine unpacks Section 5 (Data Representation Section)
9!   starting at octet 6 of that Section. 
10!
11! PROGRAM HISTORY LOG:
12! 2000-05-26  Gilbert
13! 2002-01-24  Gilbert  - Changed to dynamically allocate arrays
14!                        and to pass pointers to those arrays through
15!                        the argument list.
16!
17! USAGE:    CALL gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,idrstmpl,
18!                        mapdrslen,ierr)
19!   INPUT ARGUMENT LIST:
20!     cgrib    - Character array that contains the GRIB2 message
21!     lcgrib   - Length (in bytes) of GRIB message array cgrib.
22!     iofst    - Bit offset of the beginning of Section 5.
23!
24!   OUTPUT ARGUMENT LIST:     
25!     iofst    - Bit offset at the end of Section 5, returned.
26!     ndpts    - Number of data points unpacked and returned.
27!     idrsnum  - Data Representation Template Number ( see Code Table 5.0)
28!     idrstmpl - Pointer to an integer array containing the data values for
29!                the specified Data Representation
30!                Template ( N=idrsnum ).  Each element of this integer
31!                array contains an entry (in the order specified) of Data
32!                Representation Template 5.N
33!     mapdrslen- Number of elements in idrstmpl().  i.e. number of entries
34!                in Data Representation Template 5.N  ( N=idrsnum ).
35!     ierr     - Error return code.
36!                0 = no error
37!                6 = memory allocation error
38!                7 = "GRIB" message contains an undefined Data
39!                    Representation Template.
40!
41! REMARKS: None
42!
43! ATTRIBUTES:
44!   LANGUAGE: Fortran 90
45!   MACHINE:  IBM SP
46!
47!$$$
48
49      use drstemplates
50      use re_alloc        !  needed for subroutine realloc
51
52      character(len=1),intent(in) :: cgrib(lcgrib)
53      integer,intent(in) :: lcgrib
54      integer,intent(inout) :: iofst
55      integer,intent(out) :: ndpts,idrsnum
56      integer,pointer,dimension(:) :: idrstmpl
57      integer,intent(out) :: ierr
58
59      integer,allocatable :: mapdrs(:)
60      integer :: mapdrslen
61      logical needext
62
63      ierr=0
64      nullify(idrstmpl)
65
66      call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
67      iofst=iofst+32
68      iofst=iofst+8     ! skip section number
69      allocate(mapdrs(lensec))
70
71      call g2lib_gbyte(cgrib,ndpts,iofst,32)    ! Get num of data points
72      iofst=iofst+32
73      call g2lib_gbyte(cgrib,idrsnum,iofst,16)     ! Get Data Rep Template Num.
74      iofst=iofst+16
75      !   Gen Data Representation Template
76      call getdrstemplate(idrsnum,mapdrslen,mapdrs,needext,iret)
77      if (iret.ne.0) then
78        ierr=7
79        if( allocated(mapdrs) ) deallocate(mapdrs)
80        return
81      endif
82      !
83      !   Unpack each value into array ipdstmpl from the
84      !   the appropriate number of octets, which are specified in
85      !   corresponding entries in array mappds.
86      !
87      istat=0
88      if (mapdrslen.gt.0) allocate(idrstmpl(mapdrslen),stat=istat)
89      if (istat.ne.0) then
90         ierr=6
91         nullify(idrstmpl)
92         if( allocated(mapdrs) ) deallocate(mapdrs)
93         return
94      endif
95      do i=1,mapdrslen
96        nbits=iabs(mapdrs(i))*8
97        if ( mapdrs(i).ge.0 ) then
98          call g2lib_gbyte(cgrib,idrstmpl(i),iofst,nbits)
99        else
100          call g2lib_gbyte(cgrib,isign,iofst,1)
101          call g2lib_gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1)
102          if (isign.eq.1) idrstmpl(i)=-idrstmpl(i)
103        endif
104        iofst=iofst+nbits
105      enddo
106      !
107      !   Check to see if the Data Representation Template needs to be
108      !   extended.
109      !   The number of values in a specific template may vary
110      !   depending on data specified in the "static" part of the
111      !   template.
112      !
113      if ( needext ) then
114        call extdrstemplate(idrsnum,idrstmpl,newmapdrslen,mapdrs)
115        call realloc(idrstmpl,mapdrslen,newmapdrslen,istat)
116        !   Unpack the rest of the Data Representation Template
117        do i=mapdrslen+1,newmapdrslen
118          nbits=iabs(mapdrs(i))*8
119          if ( mapdrs(i).ge.0 ) then
120            call g2lib_gbyte(cgrib,idrstmpl(i),iofst,nbits)
121          else
122            call g2lib_gbyte(cgrib,isign,iofst,1)
123            call g2lib_gbyte(cgrib,idrstmpl(i),iofst+1,nbits-1)
124            if (isign.eq.1) idrstmpl(i)=-idrstmpl(i)
125          endif
126          iofst=iofst+nbits
127        enddo
128        mapdrslen=newmapdrslen
129      endif
130      if( allocated(mapdrs) ) deallocate(mapdrs)
131
132      return    ! End of Section 5 processing
133      end
134
Note: See TracBrowser for help on using the repository browser.