ungrib/src/ngl/g2/getgb2s.f

   1 C-----------------------------------------------------------------------
   2       SUBROUTINE GETGB2S(CBUF,NLEN,NNUM,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,
   3      &                   JGDT,K,GFLD,LPOS,IRET)
   4 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   5 C
   6 C SUBPROGRAM: GETGB2S        FINDS A GRIB MESSAGE
   7 C   PRGMMR: GILBERT          ORG: W/NP11     DATE: 02-01-15
   8 C
   9 C ABSTRACT: FIND A GRIB MESSAGE.
  10 C   FIND IN THE INDEX FILE A REFERENCE TO THE GRIB FIELD REQUESTED.
  11 C   THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP
  12 C   AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND
  13 C   PRODUCT DEFINTION SECTION PARAMETERS.  (A REQUESTED PARAMETER
  14 C   OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.)
  15 C
  16 C           EACH INDEX RECORD HAS THE FOLLOWING FORM:
  17 C       BYTE 001 - 004: LENGTH OF INDEX RECORD
  18 C       BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
  19 C       BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
  20 C                       SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
  21 C       BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
  22 C       BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
  23 C       BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
  24 C       BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
  25 C       BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
  26 C       BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
  27 C       BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
  28 C       BYTE 042 - 042: MESSAGE DISCIPLINE
  29 C       BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
  30 C       BYTE 045 -  II: IDENTIFICATION SECTION (IDS)
  31 C       BYTE II+1-  JJ: GRID DEFINITION SECTION (GDS)
  32 C       BYTE JJ+1-  KK: PRODUCT DEFINITION SECTION (PDS)
  33 C       BYTE KK+1-  LL: THE DATA REPRESENTATION SECTION (DRS)
  34 C       BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
  35 C
  36 C   Most of the decoded information for the selected GRIB field
  37 C   is returned in a derived type variable, gfld.
  38 C   Gfld is of type gribfield, which is defined
  39 C   in module grib_mod, so users of this routine will need to include
  40 C   the line "USE GRIB_MOD" in their calling routine.  Each component of the
  41 C   gribfield type is described in the OUTPUT ARGUMENT LIST section below.
  42 C   Only the unpacked bitmap and data field components are not set by this
  43 C   routine.
  44 C
  45 C PROGRAM HISTORY LOG:
  46 C   95-10-31  IREDELL
  47 C 2002-01-02  GILBERT   MODIFIED FROM GETG1S TO WORK WITH GRIB2
  48 C 2011-06-24  VUONG BOI Initialize variable gfld%idsect and gfld%local
  49 C
  50 C USAGE:    CALL GETGB2S(CBUF,NLEN,NNUM,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,
  51 C    &                   JGDT,K,GFLD,LPOS,IRET)
  52 C   INPUT ARGUMENTS:
  53 C     CBUF         CHARACTER*1 (NLEN) BUFFER CONTAINING INDEX DATA
  54 C     NLEN         INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
  55 C     NNUM         INTEGER NUMBER OF INDEX RECORDS
  56 C     J            INTEGER NUMBER OF MESSAGES TO SKIP
  57 C                  (=0 TO SEARCH FROM BEGINNING)
  58 C     JDISC        GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD
  59 C                  ( IF = -1, ACCEPT ANY DISCIPLINE)
  60 C                  ( SEE CODE TABLE 0.0 )
  61 C                  0 - Meteorological products
  62 C                  1 - Hydrological products
  63 C                  2 - Land surface products
  64 C                  3 - Space products
  65 C                  10 - Oceanographic products
  66 C     JIDS()       INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION
  67 C                  (=-9999 FOR WILDCARD)
  68 C            JIDS(1)   = IDENTIFICATION OF ORIGINATING CENTRE
  69 C                         ( SEE COMMON CODE TABLE C-1 )
  70 C            JIDS(2)   = IDENTIFICATION OF ORIGINATING SUB-CENTRE
  71 C            JIDS(3)   = GRIB MASTER TABLES VERSION NUMBER
  72 C                         ( SEE CODE TABLE 1.0 )
  73 C                       0 - Experimental
  74 C                       1 - Initial operational version number
  75 C            JIDS(4)   = GRIB LOCAL TABLES VERSION NUMBER
  76 C                         ( SEE CODE TABLE 1.1 )
  77 C                       0     - Local tables not used
  78 C                       1-254 - Number of local tables version used
  79 C            JIDS(5)   = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2)
  80 C                       0 - Analysis
  81 C                       1 - Start of forecast
  82 C                       2 - Verifying time of forecast
  83 C                       3 - Observation time
  84 C            JIDS(6)   = YEAR ( 4 DIGITS )
  85 C            JIDS(7)   = MONTH
  86 C            JIDS(8)   = DAY
  87 C            JIDS(9)   = HOUR
  88 C            JIDS(10)  = MINUTE
  89 C            JIDS(11)  = SECOND
  90 C            JIDS(12)  = PRODUCTION STATUS OF PROCESSED DATA
  91 C                         ( SEE CODE TABLE 1.3 )
  92 C                       0 - Operational products
  93 C                       1 - Operational test products
  94 C                       2 - Research products
  95 C                       3 - Re-analysis products
  96 C            JIDS(13)  = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 )
  97 C                       0  - Analysis products
  98 C                       1  - Forecast products
  99 C                       2  - Analysis and forecast products
 100 C                       3  - Control forecast products
 101 C                       4  - Perturbed forecast products
 102 C                       5  - Control and perturbed forecast products
 103 C                       6  - Processed satellite observations
 104 C                       7  - Processed radar observations
 105 C     JPDTN        INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N)
 106 C                  ( IF = -1, DON'T BOTHER MATCHING PDT )
 107 C     JPDT()       INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION
 108 C                  TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH
 109 C                  (=-9999 FOR WILDCARD)
 110 C     JGDTN        INTEGER GRID DEFINITION TEMPLATE NUMBER (M)
 111 C                  ( IF = -1, DON'T BOTHER MATCHING GDT )
 112 C     JGDT()       INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION
 113 C                  TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH
 114 C                  (=-9999 FOR WILDCARD)
 115 C   OUTPUT ARGUMENTS:
 116 C     K            INTEGER MESSAGE NUMBER FOUND
 117 C                  (CAN BE SAME AS J IN CALLING PROGRAM
 118 C                  IN ORDER TO FACILITATE MULTIPLE SEARCHES)
 119 C     gfld - derived type gribfield ( defined in module grib_mod )
 120 C            ( NOTE: See Remarks Section )
 121 C        gfld%version = GRIB edition number ( currently 2 )
 122 C        gfld%discipline = Message Discipline ( see Code Table 0.0 )
 123 C        gfld%idsect() = Contains the entries in the Identification
 124 C                        Section ( Section 1 )
 125 C                        This element is actually a pointer to an array
 126 C                        that holds the data.
 127 C            gfld%idsect(1)  = Identification of originating Centre
 128 C                                    ( see Common Code Table C-1 )
 129 C                             7 - US National Weather Service
 130 C            gfld%idsect(2)  = Identification of originating Sub-centre
 131 C            gfld%idsect(3)  = GRIB Master Tables Version Number
 132 C                                    ( see Code Table 1.0 )
 133 C                             0 - Experimental
 134 C                             1 - Initial operational version number
 135 C            gfld%idsect(4)  = GRIB Local Tables Version Number
 136 C                                    ( see Code Table 1.1 )
 137 C                             0     - Local tables not used
 138 C                             1-254 - Number of local tables version used
 139 C            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
 140 C                             0 - Analysis
 141 C                             1 - Start of forecast
 142 C                             2 - Verifying time of forecast
 143 C                             3 - Observation time
 144 C            gfld%idsect(6)  = Year ( 4 digits )
 145 C            gfld%idsect(7)  = Month
 146 C            gfld%idsect(8)  = Day
 147 C            gfld%idsect(9)  = Hour
 148 C            gfld%idsect(10)  = Minute
 149 C            gfld%idsect(11)  = Second
 150 C            gfld%idsect(12)  = Production status of processed data
 151 C                                    ( see Code Table 1.3 )
 152 C                              0 - Operational products
 153 C                              1 - Operational test products
 154 C                              2 - Research products
 155 C                              3 - Re-analysis products
 156 C            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
 157 C                              0  - Analysis products
 158 C                              1  - Forecast products
 159 C                              2  - Analysis and forecast products
 160 C                              3  - Control forecast products
 161 C                              4  - Perturbed forecast products
 162 C                              5  - Control and perturbed forecast products
 163 C                              6  - Processed satellite observations
 164 C                              7  - Processed radar observations
 165 C        gfld%idsectlen = Number of elements in gfld%idsect().
 166 C        gfld%local() = Pointer to character array containing contents
 167 C                       of Local Section 2, if included
 168 C        gfld%locallen = length of array gfld%local()
 169 C        gfld%ifldnum = field number within GRIB message
 170 C        gfld%griddef = Source of grid definition (see Code Table 3.0)
 171 C                      0 - Specified in Code table 3.1
 172 C                      1 - Predetermined grid Defined by originating centre
 173 C        gfld%ngrdpts = Number of grid points in the defined grid.
 174 C        gfld%numoct_opt = Number of octets needed for each
 175 C                          additional grid points definition.
 176 C                          Used to define number of
 177 C                          points in each row ( or column ) for
 178 C                          non-regular grids.
 179 C                          = 0, if using regular grid.
 180 C        gfld%interp_opt = Interpretation of list for optional points
 181 C                          definition.  (Code Table 3.11)
 182 C        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
 183 C        gfld%igdtmpl() = Contains the data values for the specified Grid
 184 C                         Definition Template ( NN=gfld%igdtnum ).  Each
 185 C                         element of this integer array contains an entry (in
 186 C                         the order specified) of Grid Defintion Template 3.NN
 187 C                         This element is actually a pointer to an array
 188 C                         that holds the data.
 189 C        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
 190 C                       entries in Grid Defintion Template 3.NN
 191 C                       ( NN=gfld%igdtnum ).
 192 C        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array
 193 C                          contains the number of grid points contained in
 194 C                          each row ( or column ).  (part of Section 3)
 195 C                          This element is actually a pointer to an array
 196 C                          that holds the data.  This pointer is nullified
 197 C                          if gfld%numoct_opt=0.
 198 C        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
 199 C                       in array ideflist.  i.e. number of rows ( or columns )
 200 C                       for which optional grid points are defined.  This value
 201 C                       is set to zero, if gfld%numoct_opt=0.
 202 C        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
 203 C        gfld%ipdtmpl() = Contains the data values for the specified Product
 204 C                         Definition Template ( N=gfdl%ipdtnum ).  Each element
 205 C                         of this integer array contains an entry (in the
 206 C                         order specified) of Product Defintion Template 4.N.
 207 C                         This element is actually a pointer to an array
 208 C                         that holds the data.
 209 C        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
 210 C                       entries in Product Defintion Template 4.N
 211 C                       ( N=gfdl%ipdtnum ).
 212 C        gfld%coord_list() = Real array containing floating point values
 213 C                            intended to document the vertical discretisation
 214 C                            associated to model data on hybrid coordinate
 215 C                            vertical levels.  (part of Section 4)
 216 C                            This element is actually a pointer to an array
 217 C                            that holds the data.
 218 C        gfld%num_coord = number of values in array gfld%coord_list().
 219 C        gfld%ndpts = Number of data points unpacked and returned.
 220 C        gfld%idrtnum = Data Representation Template Number
 221 C                       ( see Code Table 5.0)
 222 C        gfld%idrtmpl() = Contains the data values for the specified Data
 223 C                         Representation Template ( N=gfld%idrtnum ).  Each
 224 C                         element of this integer array contains an entry
 225 C                         (in the order specified) of Product Defintion
 226 C                         Template 5.N.
 227 C                         This element is actually a pointer to an array
 228 C                         that holds the data.
 229 C        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number
 230 C                       of entries in Data Representation Template 5.N
 231 C                       ( N=gfld%idrtnum ).
 232 C        gfld%unpacked = logical value indicating whether the bitmap and
 233 C                        data values were unpacked.  If false,
 234 C                        gfld%bmap and gfld%fld pointers are nullified.
 235 C                        NOTE: This routine sets this component to .FALSE.
 236 C        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
 237 C                     0 = bitmap applies and is included in Section 6.
 238 C                     1-253 = Predefined bitmap applies
 239 C                     254 = Previously defined bitmap applies to this field
 240 C                     255 = Bit map does not apply to this product.
 241 C        gfld%bmap() = Logical*1 array containing decoded bitmap,
 242 C                      if ibmap=0 or ibap=254.  Otherwise nullified.
 243 C                      This element is actually a pointer to an array
 244 C                      that holds the data.
 245 C                      NOTE: This component is not set by this routine.
 246 C        gfld%fld() = Array of gfld%ndpts unpacked data points.
 247 C                     This element is actually a pointer to an array
 248 C                     that holds the data.
 249 C                      NOTE: This component is not set by this routine.
 250 C     LPOS         STARTING POSITION OF THE FOUND INDEX RECORD WITHIN
 251 C                  THE COMPLETE INDEX BUFFER, CBUF.
 252 C                  = 0, IF REQUEST NOT FOUND
 253 C     IRET         INTEGER RETURN CODE
 254 C                    0      ALL OK
 255 C                    1      REQUEST NOT FOUND
 256 C
 257 C REMARKS:
 258 C   THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY.
 259 C
 260 C   Note that derived type gribfield contains pointers to many
 261 C   arrays of data.  The memory for these arrays is allocated
 262 C   when the values in the arrays are set, to help minimize
 263 C   problems with array overloading.  Because of this users
 264 C   are encouraged to free up this memory, when it is no longer
 265 C   needed, by an explicit call to subroutine gf_free.
 266 C   ( i.e.   CALL GF_FREE(GFLD) )
 267 C
 268 C SUBPROGRAMS CALLED:
 269 C   GBYTE            UNPACK BYTES
 270 C   GF_UNPACK1          UNPACK IDS
 271 C   GF_UNPACK4          UNPACK PDS
 272 C   GF_UNPACK3          UNPACK GDS
 273 C
 274 C ATTRIBUTES:
 275 C   LANGUAGE: FORTRAN 90
 276 C
 277 C$$$
 278       USE GRIB_MOD
 279
 280 !      CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
 281       CHARACTER(LEN=1),INTENT(IN) :: CBUF(NLEN)
 282       INTEGER,INTENT(IN) :: NLEN,NNUM,J,JDISC,JPDTN,JGDTN
 283       INTEGER,DIMENSION(:) :: JIDS(*),JPDT(*),JGDT(*)
 284       INTEGER,INTENT(OUT) :: K,LPOS,IRET
 285       TYPE(GRIBFIELD),INTENT(OUT) :: GFLD
 286
 287       INTEGER :: KGDS(5)
 288       LOGICAL :: MATCH1,MATCH3,MATCH4
 289 !      INTEGER,POINTER,DIMENSION(:) :: KIDS,KPDT,KGDT
 290 !      INTEGER,POINTER,DIMENSION(:) :: IDEF
 291 !      REAL,POINTER,DIMENSION(:) :: COORD
 292
 293       interface
 294          subroutine gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr)
 295             character(len=1),intent(in) :: cgrib(lcgrib)
 296             integer,intent(in) :: lcgrib
 297             integer,intent(inout) :: iofst
 298             integer,pointer,dimension(:) :: ids
 299             integer,intent(out) :: ierr,idslen
 300          end subroutine gf_unpack1
 301          subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl,
 302      &                         mapgridlen,ideflist,idefnum,ierr)
 303             character(len=1),intent(in) :: cgrib(lcgrib)
 304             integer,intent(in) :: lcgrib
 305             integer,intent(inout) :: iofst
 306             integer,pointer,dimension(:) :: igdstmpl,ideflist
 307             integer,intent(out) :: igds(5)
 308             integer,intent(out) :: ierr,idefnum
 309          end subroutine gf_unpack3
 310          subroutine gf_unpack4(cgrib,lcgrib,iofst,ipdsnum,ipdstmpl,
 311      &                      mappdslen,coordlist,numcoord,ierr)
 312             character(len=1),intent(in) :: cgrib(lcgrib)
 313             integer,intent(in) :: lcgrib
 314             integer,intent(inout) :: iofst
 315             real,pointer,dimension(:) :: coordlist
 316             integer,pointer,dimension(:) :: ipdstmpl
 317             integer,intent(out) :: ipdsnum
 318             integer,intent(out) :: ierr,numcoord
 319          end subroutine gf_unpack4
 320          subroutine gf_unpack5(cgrib,lcgrib,iofst,ndpts,idrsnum,
 321      &                         idrstmpl,mapdrslen,ierr)
 322             character(len=1),intent(in) :: cgrib(lcgrib)
 323             integer,intent(in) :: lcgrib
 324             integer,intent(inout) :: iofst
 325             integer,intent(out) :: ndpts,idrsnum
 326             integer,pointer,dimension(:) :: idrstmpl
 327             integer,intent(out) :: ierr
 328          end subroutine gf_unpack5
 329       end interface
 330
 331 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 332 C  INITIALIZE
 333       K=0
 334       LPOS=0
 335       IRET=1
 336       IPOS=0
 337       nullify(gfld%idsect,gfld%local)
 338       nullify(gfld%list_opt,gfld%igdtmpl,gfld%ipdtmpl)
 339       nullify(gfld%coord_list,gfld%idrtmpl,gfld%bmap,gfld%fld)
 340 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 341 C  SEARCH FOR REQUEST
 342       DOWHILE(IRET.NE.0.AND.K.LT.NNUM)
 343         K=K+1
 344         CALL GBYTE(CBUF,INLEN,IPOS*8,4*8)    ! GET LENGTH OF CURRENT
 345                                               ! INDEX RECORD
 346         IF ( K.LE.J ) THEN           ! SKIP THIS INDEX
 347            IPOS=IPOS+INLEN
 348            CYCLE
 349         ENDIF
 350 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 351 C  CHECK IF GRIB2 DISCIPLINE IS A MATCH
 352         CALL GBYTE(CBUF,GFLD%DISCIPLINE,(IPOS+41)*8,1*8)
 353         IF ( (JDISC.NE.-1).AND.(JDISC.NE.GFLD%DISCIPLINE) ) THEN
 354            IPOS=IPOS+INLEN
 355            CYCLE
 356         ENDIF
 357 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 358 C  CHECK IF IDENTIFICATION SECTION IS A MATCH
 359         MATCH1=.FALSE.
 360         CALL GBYTE(CBUF,LSEC1,(IPOS+44)*8,4*8)  ! GET LENGTH OF IDS
 361         IOF=0
 362         CALL GF_UNPACK1(CBUF(IPOS+45),LSEC1,IOF,GFLD%IDSECT,
 363      &                  GFLD%IDSECTLEN,ICND)
 364         IF ( ICND.EQ.0 ) THEN
 365            MATCH1=.TRUE.
 366            DO I=1,GFLD%IDSECTLEN
 367               IF ( (JIDS(I).NE.-9999).AND.
 368      &             (JIDS(I).NE.GFLD%IDSECT(I)) ) THEN
 369                  MATCH1=.FALSE.
 370                  EXIT
 371               ENDIF
 372            ENDDO
 373         ENDIF
 374         IF ( .NOT. MATCH1 ) THEN
 375            DEALLOCATE(GFLD%IDSECT)
 376            IPOS=IPOS+INLEN
 377            CYCLE
 378         ENDIF
 379 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 380 C  CHECK IF GRID DEFINITION TEMPLATE IS A MATCH
 381         JPOS=IPOS+44+LSEC1
 382         MATCH3=.FALSE.
 383         CALL GBYTE(CBUF,LSEC3,JPOS*8,4*8)  ! GET LENGTH OF GDS
 384         IF ( JGDTN.EQ.-1 ) THEN
 385            MATCH3=.TRUE.
 386         ELSE
 387            CALL GBYTE(CBUF,NUMGDT,(JPOS+12)*8,2*8)  ! GET GDT TEMPLATE NO.
 388            IF ( JGDTN.EQ.NUMGDT ) THEN
 389               IOF=0
 390               CALL GF_UNPACK3(CBUF(JPOS+1),LSEC3,IOF,KGDS,GFLD%IGDTMPL,
 391      &                     GFLD%IGDTLEN,GFLD%LIST_OPT,GFLD%NUM_OPT,ICND)
 392               IF ( ICND.EQ.0 ) THEN
 393                  MATCH3=.TRUE.
 394                  DO I=1,GFLD%IGDTLEN
 395                     IF ( (JGDT(I).NE.-9999).AND.
 396      &                   (JGDT(I).NE.GFLD%IGDTMPL(I)) ) THEN
 397                        MATCH3=.FALSE.
 398                        EXIT
 399                     ENDIF
 400                  ENDDO
 401 C                 WHERE ( JGDT(1:GFLD%IGDTLEN).NE.-9999 )
 402 C     &              MATCH3=ALL(JGDT(1:GFLD%IGDTLEN).EQ.GFLD%IGDTMPL(1:GFLD%IGDTLEN))
 403               ENDIF
 404            ENDIF
 405         ENDIF
 406         IF ( .NOT. MATCH3 ) THEN
 407            IF (ASSOCIATED(GFLD%IGDTMPL)) DEALLOCATE(GFLD%IGDTMPL)
 408            IF (ASSOCIATED(GFLD%LIST_OPT)) DEALLOCATE(GFLD%LIST_OPT)
 409            IPOS=IPOS+INLEN
 410            CYCLE
 411         ELSE
 412            GFLD%GRIDDEF=KGDS(1)
 413            GFLD%NGRDPTS=KGDS(2)
 414            GFLD%NUMOCT_OPT=KGDS(3)
 415            GFLD%INTERP_OPT=KGDS(4)
 416            GFLD%IGDTNUM=KGDS(5)
 417         ENDIF
 418 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 419 C  CHECK IF PRODUCT DEFINITION TEMPLATE IS A MATCH
 420         JPOS=JPOS+LSEC3
 421         MATCH4=.FALSE.
 422         CALL GBYTE(CBUF,LSEC4,JPOS*8,4*8)  ! GET LENGTH OF PDS
 423         IF ( JPDTN.EQ.-1 ) THEN
 424            MATCH4=.TRUE.
 425         ELSE
 426            CALL GBYTE(CBUF,NUMPDT,(JPOS+7)*8,2*8)  ! GET PDT TEMPLATE NO.
 427            IF ( JPDTN.EQ.NUMPDT ) THEN
 428               IOF=0
 429               CALL GF_UNPACK4(CBUF(JPOS+1),LSEC4,IOF,GFLD%IPDTNUM,
 430      &                        GFLD%IPDTMPL,GFLD%IPDTLEN,
 431      &                        GFLD%COORD_LIST,GFLD%NUM_COORD,ICND)
 432               IF ( ICND.EQ.0 ) THEN
 433                  MATCH4=.TRUE.
 434                  DO I=1,GFLD%IPDTLEN
 435                     IF ( (JPDT(I).NE.-9999).AND.
 436      &                   (JPDT(I).NE.GFLD%IPDTMPL(I)) ) THEN
 437                        MATCH4=.FALSE.
 438                        EXIT
 439                     ENDIF
 440                  ENDDO
 441 c                 WHERE ( JPDT.NE.-9999)
 442 c     &              MATCH4=ALL( JPDT(1:GFLD%IPDTLEN) .EQ. GFLD%IPDTMPL(1:GFLD%IPDTLEN) )
 443               ENDIF
 444            ENDIF
 445         ENDIF
 446         IF ( .NOT. MATCH4 ) THEN
 447            IF (ASSOCIATED(GFLD%IPDTMPL)) DEALLOCATE(GFLD%IPDTMPL)
 448            IF (ASSOCIATED(GFLD%COORD_LIST)) DEALLOCATE(GFLD%COORD_LIST)
 449         ENDIF
 450 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 451 C  IF REQUEST IS FOUND
 452 C  SET VALUES FOR DERIVED TYPE GFLD AND RETURN
 453         IF(MATCH1.AND.MATCH3.AND.MATCH4) THEN
 454            LPOS=IPOS+1
 455            CALL GBYTE(CBUF,GFLD%VERSION,(IPOS+40)*8,1*8)
 456            CALL GBYTE(CBUF,GFLD%IFLDNUM,(IPOS+42)*8,2*8)
 457            GFLD%UNPACKED=.FALSE.
 458            JPOS=IPOS+44+LSEC1
 459            IF ( JGDTN.EQ.-1 ) THEN     ! UNPACK GDS, IF NOT DONE BEFORE
 460               IOF=0
 461               CALL GF_UNPACK3(CBUF(JPOS+1),LSEC3,IOF,KGDS,GFLD%IGDTMPL,
 462      &                     GFLD%IGDTLEN,GFLD%LIST_OPT,GFLD%NUM_OPT,ICND)
 463               GFLD%GRIDDEF=KGDS(1)
 464               GFLD%NGRDPTS=KGDS(2)
 465               GFLD%NUMOCT_OPT=KGDS(3)
 466               GFLD%INTERP_OPT=KGDS(4)
 467               GFLD%IGDTNUM=KGDS(5)
 468            ENDIF
 469            JPOS=JPOS+LSEC3
 470            IF ( JPDTN.EQ.-1 ) THEN     ! UNPACK PDS, IF NOT DONE BEFORE
 471               IOF=0
 472               CALL GF_UNPACK4(CBUF(JPOS+1),LSEC4,IOF,GFLD%IPDTNUM,
 473      &                        GFLD%IPDTMPL,GFLD%IPDTLEN,
 474      &                        GFLD%COORD_LIST,GFLD%NUM_COORD,ICND)
 475            ENDIF
 476            JPOS=JPOS+LSEC4
 477            CALL GBYTE(CBUF,LSEC5,JPOS*8,4*8)  ! GET LENGTH OF DRS
 478            IOF=0
 479            CALL GF_UNPACK5(CBUF(JPOS+1),LSEC5,IOF,GFLD%NDPTS,
 480      &                     GFLD%IDRTNUM,GFLD%IDRTMPL,
 481      &                     GFLD%IDRTLEN,ICND)
 482            JPOS=JPOS+LSEC5
 483            CALL GBYTE(CBUF,GFLD%IBMAP,(JPOS+5)*8,1*8)  ! GET IBMAP
 484            IRET=0
 485         ELSE      ! PDT DID NOT MATCH
 486            IPOS=IPOS+INLEN
 487         ENDIF
 488       ENDDO
 489 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 490       RETURN
 491       END