external/io_grib2/g2lib/getgb2l.F

   1 C-----------------------------------------------------------------------
   2       SUBROUTINE GETGB2L(LUGB,CINDEX,GFLD,IRET)
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM: GETGB2L        EXTRACTS LOCAL USE SECTION
   6 C   PRGMMR: GILBERT          ORG: W/NP11     DATE: 02-05-07
   7 C
   8 C ABSTRACT: READ AND UNPACK A LOCAL USE SECTION FROM A GRIB2 MESSAGE.
   9 C
  10 C   The decoded information for the selected GRIB field
  11 C   is returned in a derived type variable, gfld.
  12 C   Gfld is of type gribfield, which is defined
  13 C   in module grib_mod, so users of this routine will need to include
  14 C   the line "USE GRIB_MOD" in their calling routine.  Each component of the
  15 C   gribfield type is described in the OUTPUT ARGUMENT LIST section below.
  16 C
  17 C PROGRAM HISTORY LOG:
  18 C 2002-05-07  GILBERT
  19 C
  20 C USAGE:    CALL GETGB2L(LUGB,CINDEX,GFLD,IRET)
  21 C   INPUT ARGUMENTS:
  22 C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE
  23 C     CINDEX       INDEX RECORD OF THE GRIB FIELD  ( SEE DOCBLOCK OF
  24 C                  SUBROUTINE IXGB2 FOR DESCRIPTION OF AN INDEX RECORD.)
  25 C   OUTPUT ARGUMENTS:
  26 C     gfld - derived type gribfield ( defined in module grib_mod )
  27 C            ( NOTE: See Remarks Section )
  28 C        gfld%version = GRIB edition number ( currently 2 )
  29 C        gfld%discipline = Message Discipline ( see Code Table 0.0 )
  30 C        gfld%idsect() = Contains the entries in the Identification
  31 C                        Section ( Section 1 )
  32 C                        This element is actually a pointer to an array
  33 C                        that holds the data.
  34 C            gfld%idsect(1)  = Identification of originating Centre
  35 C                                    ( see Common Code Table C-1 )
  36 C                             7 - US National Weather Service
  37 C            gfld%idsect(2)  = Identification of originating Sub-centre
  38 C            gfld%idsect(3)  = GRIB Master Tables Version Number
  39 C                                    ( see Code Table 1.0 )
  40 C                             0 - Experimental
  41 C                             1 - Initial operational version number
  42 C            gfld%idsect(4)  = GRIB Local Tables Version Number
  43 C                                    ( see Code Table 1.1 )
  44 C                             0     - Local tables not used
  45 C                             1-254 - Number of local tables version used
  46 C            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
  47 C                             0 - Analysis
  48 C                             1 - Start of forecast
  49 C                             2 - Verifying time of forecast
  50 C                             3 - Observation time
  51 C            gfld%idsect(6)  = Year ( 4 digits )
  52 C            gfld%idsect(7)  = Month
  53 C            gfld%idsect(8)  = Day
  54 C            gfld%idsect(9)  = Hour
  55 C            gfld%idsect(10)  = Minute
  56 C            gfld%idsect(11)  = Second
  57 C            gfld%idsect(12)  = Production status of processed data
  58 C                                    ( see Code Table 1.3 )
  59 C                              0 - Operational products
  60 C                              1 - Operational test products
  61 C                              2 - Research products
  62 C                              3 - Re-analysis products
  63 C            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
  64 C                              0  - Analysis products
  65 C                              1  - Forecast products
  66 C                              2  - Analysis and forecast products
  67 C                              3  - Control forecast products
  68 C                              4  - Perturbed forecast products
  69 C                              5  - Control and perturbed forecast products
  70 C                              6  - Processed satellite observations
  71 C                              7  - Processed radar observations
  72 C        gfld%idsectlen = Number of elements in gfld%idsect().
  73 C        gfld%local() = Pointer to character array containing contents
  74 C                       of Local Section 2, if included
  75 C        gfld%locallen = length of array gfld%local()
  76 C        gfld%ifldnum = field number within GRIB message
  77 C        gfld%griddef = Source of grid definition (see Code Table 3.0)
  78 C                      0 - Specified in Code table 3.1
  79 C                      1 - Predetermined grid Defined by originating centre
  80 C        gfld%ngrdpts = Number of grid points in the defined grid.
  81 C        gfld%numoct_opt = Number of octets needed for each
  82 C                          additional grid points definition.
  83 C                          Used to define number of
  84 C                          points in each row ( or column ) for
  85 C                          non-regular grids.
  86 C                          = 0, if using regular grid.
  87 C        gfld%interp_opt = Interpretation of list for optional points
  88 C                          definition.  (Code Table 3.11)
  89 C        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
  90 C        gfld%igdtmpl() = Contains the data values for the specified Grid
  91 C                         Definition Template ( NN=gfld%igdtnum ).  Each
  92 C                         element of this integer array contains an entry (in
  93 C                         the order specified) of Grid Defintion Template 3.NN
  94 C                         This element is actually a pointer to an array
  95 C                         that holds the data.
  96 C        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
  97 C                       entries in Grid Defintion Template 3.NN
  98 C                       ( NN=gfld%igdtnum ).
  99 C        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array
 100 C                          contains the number of grid points contained in
 101 C                          each row ( or column ).  (part of Section 3)
 102 C                          This element is actually a pointer to an array
 103 C                          that holds the data.  This pointer is nullified
 104 C                          if gfld%numoct_opt=0.
 105 C        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
 106 C                       in array ideflist.  i.e. number of rows ( or columns )
 107 C                       for which optional grid points are defined.  This value
 108 C                       is set to zero, if gfld%numoct_opt=0.
 109 C        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
 110 C        gfld%ipdtmpl() = Contains the data values for the specified Product
 111 C                         Definition Template ( N=gfdl%ipdtnum ).  Each element
 112 C                         of this integer array contains an entry (in the
 113 C                         order specified) of Product Defintion Template 4.N.
 114 C                         This element is actually a pointer to an array
 115 C                         that holds the data.
 116 C        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
 117 C                       entries in Product Defintion Template 4.N
 118 C                       ( N=gfdl%ipdtnum ).
 119 C        gfld%coord_list() = Real array containing floating point values
 120 C                            intended to document the vertical discretisation
 121 C                            associated to model data on hybrid coordinate
 122 C                            vertical levels.  (part of Section 4)
 123 C                            This element is actually a pointer to an array
 124 C                            that holds the data.
 125 C        gfld%num_coord = number of values in array gfld%coord_list().
 126 C        gfld%ndpts = Number of data points unpacked and returned.
 127 C        gfld%idrtnum = Data Representation Template Number
 128 C                       ( see Code Table 5.0)
 129 C        gfld%idrtmpl() = Contains the data values for the specified Data
 130 C                         Representation Template ( N=gfld%idrtnum ).  Each
 131 C                         element of this integer array contains an entry
 132 C                         (in the order specified) of Product Defintion
 133 C                         Template 5.N.
 134 C                         This element is actually a pointer to an array
 135 C                         that holds the data.
 136 C        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number
 137 C                       of entries in Data Representation Template 5.N
 138 C                       ( N=gfld%idrtnum ).
 139 C        gfld%unpacked = logical value indicating whether the bitmap and
 140 C                        data values were unpacked.  If false,
 141 C                        gfld%bmap and gfld%fld pointers are nullified.
 142 C        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
 143 C                     0 = bitmap applies and is included in Section 6.
 144 C                     1-253 = Predefined bitmap applies
 145 C                     254 = Previously defined bitmap applies to this field
 146 C                     255 = Bit map does not apply to this product.
 147 C        gfld%bmap() = Logical*1 array containing decoded bitmap,
 148 C                      if ibmap=0 or ibap=254.  Otherwise nullified.
 149 C                      This element is actually a pointer to an array
 150 C                      that holds the data.
 151 C        gfld%fld() = Array of gfld%ndpts unpacked data points.
 152 C                     This element is actually a pointer to an array
 153 C                     that holds the data.
 154 C     IRET         INTEGER RETURN CODE
 155 C                    0      ALL OK
 156 C                    97     ERROR READING GRIB FILE
 157 C                    OTHER  GF_GETFLD GRIB UNPACKER RETURN CODE
 158 C
 159 C SUBPROGRAMS CALLED:
 160 C   BAREAD         BYTE-ADDRESSABLE READ
 161 C   GF_GETFLD       UNPACK GRIB FIELD
 162 C
 163 C REMARKS:
 164 C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
 165 C   THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY.
 166 C
 167 C   Note that derived type gribfield contains pointers to many
 168 C   arrays of data.  The memory for these arrays is allocated
 169 C   when the values in the arrays are set, to help minimize
 170 C   problems with array overloading.  Because of this users
 171 C   are encouraged to free up this memory, when it is no longer
 172 C   needed, by an explicit call to subroutine gf_free.
 173 C   ( i.e.   CALL GF_FREE(GFLD) )
 174 C
 175 C ATTRIBUTES:
 176 C   LANGUAGE: FORTRAN 90
 177 C
 178 C$$$
 179       USE GRIB_MOD
 180
 181       INTEGER,INTENT(IN) :: LUGB
 182       CHARACTER(LEN=1),INTENT(IN) :: CINDEX(*)
 183       INTEGER,INTENT(OUT) :: IRET
 184       TYPE(GRIBFIELD) :: GFLD
 185
 186       INTEGER :: LSKIP,SKIP2
 187       CHARACTER(LEN=1):: CSIZE(4)
 188       CHARACTER(LEN=1),ALLOCATABLE :: CTEMP(:)
 189
 190       interface
 191          subroutine gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr)
 192            character(len=1),intent(in) :: cgrib(lcgrib)
 193            integer,intent(in) :: lcgrib
 194            integer,intent(inout) :: iofst
 195            integer,intent(out) :: lencsec2
 196            integer,intent(out) :: ierr
 197            character(len=1),pointer,dimension(:) :: csec2
 198          end subroutine gf_unpack2
 199       end interface
 200 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 201 C  GET INFO
 202       NULLIFY(gfld%local)
 203       IRET=0
 204       CALL G2LIB_GBYTE(CINDEX,LSKIP,4*8,4*8)
 205       CALL G2LIB_GBYTE(CINDEX,SKIP2,8*8,4*8)
 206
 207 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 208 C  READ AND UNPACK LOCAL USE SECTION, IF PRESENT
 209       IF ( SKIP2.NE.0 ) THEN
 210          ISKIP=LSKIP+SKIP2
 211          CALL BAREAD(LUGB,ISKIP,4,LREAD,CSIZE)    ! GET LENGTH OF SECTION
 212          CALL G2LIB_GBYTE(CSIZE,ILEN,0,32)
 213          ALLOCATE(CTEMP(ILEN))
 214          CALL BAREAD(LUGB,ISKIP,ILEN,LREAD,CTEMP)  ! READ IN SECTION
 215          IF (ILEN.NE.LREAD) THEN
 216             IRET=97
 217             DEALLOCATE(CTEMP)
 218             RETURN
 219          ENDIF
 220          IOFST=0
 221          CALL GF_UNPACK2(CTEMP,ILEN,IOFST,gfld%locallen,
 222      &                   gfld%local,ierr)
 223          IF (IERR.NE.0) THEN
 224             IRET=98
 225             DEALLOCATE(CTEMP)
 226             RETURN
 227          ENDIF
 228          DEALLOCATE(CTEMP)
 229       ELSE
 230          gfld%locallen=0
 231       ENDIF
 232 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 233       RETURN
 234       END