source: trunk/WRF.COMMON/WRFV3/external/io_grib2/g2lib/getgb2.F @ 3567

Last change on this file since 3567 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: 17.4 KB
Line 
1C-----------------------------------------------------------------------
2      SUBROUTINE GETGB2(LUGB,LUGI,J,GUESS,JDISC,JIDS,JPDTN,JPDT,JGDTN,
3     &                  JGDT,UNPACK,K,GFLD,IRET)
4C$$$  SUBPROGRAM DOCUMENTATION BLOCK
5C
6C SUBPROGRAM: GETGB2         FINDS AND UNPACKS A GRIB MESSAGE
7C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 94-04-01
8C
9C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE.
10C   READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF)
11C   TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE.
12C   FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB FIELD REQUESTED.
13C   THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF FIELDS TO SKIP
14C   AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND
15C   PRODUCT DEFINTION SECTION PARAMETERS.  (A REQUESTED PARAMETER
16C   OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.)
17C   IF THE REQUESTED GRIB FIELD IS FOUND, THEN IT IS READ FROM THE
18C   GRIB FILE AND UNPACKED.  ITS NUMBER IS RETURNED ALONG WITH
19C   THE ASSOCIATED UNPACKED PARAMETERS.  THE BITMAP (IF ANY),
20C   AND THE DATA VALUES ARE UNPACKED ONLY IF ARGUMENT "UNPACK" IS SET TO
21C   TRUE.  IF THE GRIB FIELD IS NOT FOUND, THEN THE
22C   RETURN CODE WILL BE NONZERO.
23C
24C   The decoded information for the selected GRIB field
25C   is returned in a derived type variable, gfld.
26C   Gfld is of type gribfield, which is defined
27C   in module grib_mod, so users of this routine will need to include
28C   the line "USE GRIB_MOD" in their calling routine.  Each component of the
29C   gribfield type is described in the OUTPUT ARGUMENT LIST section below.
30C
31C PROGRAM HISTORY LOG:
32C   94-04-01  IREDELL
33C   95-10-31  IREDELL     MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS
34C                         AND ALLOWED FOR UNSPECIFIED INDEX FILE
35C 2002-01-11  GILBERT     MODIFIED FROM GETGB AND GETGBM TO WORK WITH GRIB2
36C
37C USAGE:    CALL GETGB2(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT,
38C    &                  UNPACK,K,GFLD,IRET)
39C   INPUT ARGUMENTS:
40C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
41C                  FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING
42C                  THIS ROUTINE.
43C     LUGI         INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE.
44C                  IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE
45C                  CALLING THIS ROUTINE.
46C                  >0 - READ INDEX FROM INDEX FILE LUGI, IF INDEX DOESN"T
47C                       ALREADY EXIST.
48C                  =0 - TO GET INDEX BUFFER FROM THE GRIB FILE, IF INDEX
49C                       DOESN"T ALREADY EXIST.
50C                  <0 - FORCE REREAD OF INDEX FROM INDEX FILE ABS(LUGI).
51C                  =LUGB - FORCE REGENERATION OF INDEX FROM GRIB2 FILE LUGB.
52C     J            INTEGER NUMBER OF FIELDS TO SKIP
53C                  (=0 TO SEARCH FROM BEGINNING)
54C     JDISC        GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD
55C                  ( IF = -1, ACCEPT ANY DISCIPLINE)
56C                  ( SEE CODE TABLE 0.0 )
57C                  0 - Meteorological products
58C                  1 - Hydrological products
59C                  2 - Land surface products
60C                  3 - Space products
61C                  10 - Oceanographic products
62C     JIDS()       INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION
63C                  (=-9999 FOR WILDCARD)
64C            JIDS(1)   = IDENTIFICATION OF ORIGINATING CENTRE
65C                         ( SEE COMMON CODE TABLE C-1 )
66C            JIDS(2)   = IDENTIFICATION OF ORIGINATING SUB-CENTRE
67C            JIDS(3)   = GRIB MASTER TABLES VERSION NUMBER
68C                         ( SEE CODE TABLE 1.0 )
69C                       0 - Experimental
70C                       1 - Initial operational version number
71C            JIDS(4)   = GRIB LOCAL TABLES VERSION NUMBER
72C                         ( SEE CODE TABLE 1.1 )
73C                       0     - Local tables not used
74C                       1-254 - Number of local tables version used
75C            JIDS(5)   = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2)
76C                       0 - Analysis
77C                       1 - Start of forecast
78C                       2 - Verifying time of forecast
79C                       3 - Observation time
80C            JIDS(6)   = YEAR ( 4 DIGITS )
81C            JIDS(7)   = MONTH
82C            JIDS(8)   = DAY
83C            JIDS(9)   = HOUR
84C            JIDS(10)  = MINUTE
85C            JIDS(11)  = SECOND
86C            JIDS(12)  = PRODUCTION STATUS OF PROCESSED DATA
87C                         ( SEE CODE TABLE 1.3 )
88C                       0 - Operational products
89C                       1 - Operational test products
90C                       2 - Research products
91C                       3 - Re-analysis products
92C            JIDS(13)  = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 )
93C                       0  - Analysis products
94C                       1  - Forecast products
95C                       2  - Analysis and forecast products
96C                       3  - Control forecast products
97C                       4  - Perturbed forecast products
98C                       5  - Control and perturbed forecast products
99C                       6  - Processed satellite observations
100C                       7  - Processed radar observations
101C     JPDTN        INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N)
102C                  ( IF = -1, DON'T BOTHER MATCHING PDT - ACCEPT ANY )
103C     JPDT()       INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION
104C                  TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH
105C                  (=-9999 FOR WILDCARD)
106C     JGDTN        INTEGER GRID DEFINITION TEMPLATE NUMBER (M)
107C                  ( IF = -1, DON'T BOTHER MATCHING GDT - ACCEPT ANY )
108C     JGDT()       INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION
109C                  TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH
110C                  (=-9999 FOR WILDCARD)
111C     UNPACK       LOGICAL VALUE INDICATING WHETHER TO UNPACK BITMAP/DATA
112C                  .TRUE. = UNPACK BITMAP AND DATA VALUES
113C                  .FALSE. = DO NOT UNPACK BITMAP AND DATA VALUES
114C
115C   OUTPUT ARGUMENTS:
116C     K            INTEGER FIELD NUMBER UNPACKED
117C     gfld - derived type gribfield ( defined in module grib_mod )
118C            ( NOTE: See Remarks Section )
119C        gfld%version = GRIB edition number ( currently 2 )
120C        gfld%discipline = Message Discipline ( see Code Table 0.0 )
121C        gfld%idsect() = Contains the entries in the Identification
122C                        Section ( Section 1 )
123C                        This element is actually a pointer to an array
124C                        that holds the data.
125C            gfld%idsect(1)  = Identification of originating Centre
126C                                    ( see Common Code Table C-1 )
127C                             7 - US National Weather Service
128C            gfld%idsect(2)  = Identification of originating Sub-centre
129C            gfld%idsect(3)  = GRIB Master Tables Version Number
130C                                    ( see Code Table 1.0 )
131C                             0 - Experimental
132C                             1 - Initial operational version number
133C            gfld%idsect(4)  = GRIB Local Tables Version Number
134C                                    ( see Code Table 1.1 )
135C                             0     - Local tables not used
136C                             1-254 - Number of local tables version used
137C            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
138C                             0 - Analysis
139C                             1 - Start of forecast
140C                             2 - Verifying time of forecast
141C                             3 - Observation time
142C            gfld%idsect(6)  = Year ( 4 digits )
143C            gfld%idsect(7)  = Month
144C            gfld%idsect(8)  = Day
145C            gfld%idsect(9)  = Hour
146C            gfld%idsect(10)  = Minute
147C            gfld%idsect(11)  = Second
148C            gfld%idsect(12)  = Production status of processed data
149C                                    ( see Code Table 1.3 )
150C                              0 - Operational products
151C                              1 - Operational test products
152C                              2 - Research products
153C                              3 - Re-analysis products
154C            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
155C                              0  - Analysis products
156C                              1  - Forecast products
157C                              2  - Analysis and forecast products
158C                              3  - Control forecast products
159C                              4  - Perturbed forecast products
160C                              5  - Control and perturbed forecast products
161C                              6  - Processed satellite observations
162C                              7  - Processed radar observations
163C        gfld%idsectlen = Number of elements in gfld%idsect().
164C        gfld%local() = Pointer to character array containing contents
165C                       of Local Section 2, if included
166C        gfld%locallen = length of array gfld%local()
167C        gfld%ifldnum = field number within GRIB message
168C        gfld%griddef = Source of grid definition (see Code Table 3.0)
169C                      0 - Specified in Code table 3.1
170C                      1 - Predetermined grid Defined by originating centre
171C        gfld%ngrdpts = Number of grid points in the defined grid.
172C        gfld%numoct_opt = Number of octets needed for each
173C                          additional grid points definition.
174C                          Used to define number of
175C                          points in each row ( or column ) for
176C                          non-regular grids.
177C                          = 0, if using regular grid.
178C        gfld%interp_opt = Interpretation of list for optional points
179C                          definition.  (Code Table 3.11)
180C        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
181C        gfld%igdtmpl() = Contains the data values for the specified Grid
182C                         Definition Template ( NN=gfld%igdtnum ).  Each
183C                         element of this integer array contains an entry (in
184C                         the order specified) of Grid Defintion Template 3.NN
185C                         This element is actually a pointer to an array
186C                         that holds the data.
187C        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
188C                       entries in Grid Defintion Template 3.NN
189C                       ( NN=gfld%igdtnum ).
190C        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array
191C                          contains the number of grid points contained in
192C                          each row ( or column ).  (part of Section 3)
193C                          This element is actually a pointer to an array
194C                          that holds the data.  This pointer is nullified
195C                          if gfld%numoct_opt=0.
196C        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
197C                       in array ideflist.  i.e. number of rows ( or columns )
198C                       for which optional grid points are defined.  This value
199C                       is set to zero, if gfld%numoct_opt=0.
200C        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
201C        gfld%ipdtmpl() = Contains the data values for the specified Product
202C                         Definition Template ( N=gfdl%ipdtnum ).  Each element
203C                         of this integer array contains an entry (in the
204C                         order specified) of Product Defintion Template 4.N.
205C                         This element is actually a pointer to an array
206C                         that holds the data.
207C        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
208C                       entries in Product Defintion Template 4.N
209C                       ( N=gfdl%ipdtnum ).
210C        gfld%coord_list() = Real array containing floating point values
211C                            intended to document the vertical discretisation
212C                            associated to model data on hybrid coordinate
213C                            vertical levels.  (part of Section 4)
214C                            This element is actually a pointer to an array
215C                            that holds the data.
216C        gfld%num_coord = number of values in array gfld%coord_list().
217C        gfld%ndpts = Number of data points unpacked and returned.
218C        gfld%idrtnum = Data Representation Template Number
219C                       ( see Code Table 5.0)
220C        gfld%idrtmpl() = Contains the data values for the specified Data
221C                         Representation Template ( N=gfld%idrtnum ).  Each
222C                         element of this integer array contains an entry
223C                         (in the order specified) of Product Defintion
224C                         Template 5.N.
225C                         This element is actually a pointer to an array
226C                         that holds the data.
227C        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number
228C                       of entries in Data Representation Template 5.N
229C                       ( N=gfld%idrtnum ).
230C        gfld%unpacked = logical value indicating whether the bitmap and
231C                        data values were unpacked.  If false,
232C                        gfld%bmap and gfld%fld pointers are nullified.
233C        gfld%expanded = Logical value indicating whether the data field
234C                         was expanded to the grid in the case where a
235C                         bit-map is present.  If true, the data points in
236C                         gfld%fld match the grid points and zeros were
237C                         inserted at grid points where data was bit-mapped
238C                         out.  If false, the data values in gfld%fld were
239C                         not expanded to the grid and are just a consecutive
240C                         array of data points corresponding to each value of
241C                         "1" in gfld%bmap.
242C        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
243C                     0 = bitmap applies and is included in Section 6.
244C                     1-253 = Predefined bitmap applies
245C                     254 = Previously defined bitmap applies to this field
246C                     255 = Bit map does not apply to this product.
247C        gfld%bmap() = Logical*1 array containing decoded bitmap,
248C                      if ibmap=0 or ibap=254.  Otherwise nullified.
249C                      This element is actually a pointer to an array
250C                      that holds the data.
251C        gfld%fld() = Array of gfld%ndpts unpacked data points.
252C                     This element is actually a pointer to an array
253C                     that holds the data.
254C     IRET         INTEGER RETURN CODE
255C                    0      ALL OK
256C                    96     ERROR READING INDEX
257C                    97     ERROR READING GRIB FILE
258C                    99     REQUEST NOT FOUND
259C                    OTHER  GF_GETFLD GRIB2 UNPACKER RETURN CODE
260C
261C SUBPROGRAMS CALLED:
262C   GETIDX         GET INDEX
263C   GETGB2S        SEARCH INDEX RECORDS
264C   GETGB2R        READ AND UNPACK GRIB RECORD
265C   GF_FREE        FREES MEMORY USED BY GFLD  ( SEE REMARKS )
266C
267C REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED.
268C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
269C
270C   Note that derived type gribfield contains pointers to many
271C   arrays of data.  The memory for these arrays is allocated
272C   when the values in the arrays are set, to help minimize
273C   problems with array overloading.  Because of this users
274C   are encouraged to free up this memory, when it is no longer
275C   needed, by an explicit call to subroutine gf_free.
276C   ( i.e.   CALL GF_FREE(GFLD) )
277C
278C ATTRIBUTES:
279C   LANGUAGE: FORTRAN 90
280C
281C$$$
282      USE GRIB_MOD
283
284      INTEGER,INTENT(IN) :: LUGB,LUGI,J,JDISC,JPDTN,JGDTN
285      INTEGER,INTENT(IN) :: GUESS
286      INTEGER,DIMENSION(:) :: JIDS(*),JPDT(*),JGDT(*)
287      LOGICAL,INTENT(IN) :: UNPACK
288      INTEGER,INTENT(OUT) :: K,IRET
289      TYPE(GRIBFIELD),INTENT(OUT) :: GFLD
290
291      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
292
293C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
294C  DECLARE INTERFACES (REQUIRED FOR CBUF POINTER)
295      INTERFACE
296         SUBROUTINE GETIDX(LUGB,LUGI,CBUF,NLEN,NNUM,IRGI)
297           CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
298           INTEGER,INTENT(IN) :: LUGB,LUGI
299           INTEGER,INTENT(OUT) :: NLEN,NNUM,IRGI
300         END SUBROUTINE GETIDX
301      END INTERFACE
302C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
303C  DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED
304      IRGI=0
305      CALL GETIDX(LUGB,LUGI,CBUF,NLEN,NNUM,IRGI)
306      IF(IRGI.GT.1) THEN
307        IRET=96
308        RETURN
309      ENDIF
310C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
311C  SEARCH INDEX BUFFER
312      CALL GETGB2S(CBUF,NLEN,NNUM,J,GUESS,JDISC,JIDS,JPDTN,JPDT,JGDTN,
313     &             JGDT,JK,GFLD,LPOS,IRGS)
314      IF(IRGS.NE.0) THEN
315        IRET=99
316        CALL GF_FREE(GFLD)
317        RETURN
318      ENDIF
319
320C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
321C  READ LOCAL USE SECTION, IF AVAILABLE
322      CALL GETGB2L(LUGB,CBUF(LPOS),GFLD,IRET)
323C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
324C  READ AND UNPACK GRIB RECORD
325      IF (UNPACK) THEN
326    !    NUMFLD=GFLD%IFLDNUM
327    !    CALL GF_FREE(GFLD)
328         CALL GETGB2R(LUGB,CBUF(LPOS),GFLD,IRET)
329      ENDIF
330      K=JK
331C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
332      RETURN
333      END
Note: See TracBrowser for help on using the repository browser.