ungrib/src/ngl/g2/putgb2.f

   1 C-----------------------------------------------------------------------
   2       SUBROUTINE PUTGB2(LUGB,GFLD,IRET)
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM: PUTGB2         PACKS AND WRITES A GRIB2 MESSAGE
   6 C   PRGMMR: GILBERT          ORG: W/NP11     DATE: 2002-04-22
   7 C
   8 C ABSTRACT: PACKS A SINGLE FIELD INTO A GRIB2 MESSAGE
   9 C   AND WRITES OUT THAT MESSAGE TO THE FILE ASSOCIATED WITH UNIT LUGB.
  10 C   NOTE THAT FILE/UNIT LUGB SHOULD BE OPENED WOTH A CALL TO
  11 C   SUBROUTINE BAOPENW BEFORE THIS ROUTINE IS CALLED.
  12 C
  13 C   The information to be packed into the GRIB field
  14 C   is stored in a derived type variable, gfld.
  15 C   Gfld is of type gribfield, which is defined
  16 C   in module grib_mod, so users of this routine will need to include
  17 C   the line "USE GRIB_MOD" in their calling routine.  Each component of the
  18 C   gribfield type is described in the INPUT ARGUMENT LIST section below.
  19 C
  20 C PROGRAM HISTORY LOG:
  21 C 2002-04-22  GILBERT
  22 C 2005-02-28  GILBERT   - Changed dimension of array cgrib to be a multiple
  23 C                         of gfld%ngrdpts instead of gfld%ndpts.
  24 C 2009-03-10  VUONG     - Initialize variable coordlist
  25 C 2011-06-09  VUONG     - Initialize variable gfld%list_opt
  26 C 2012-02-28  VUONG     - Initialize variable ilistopt
  27 C
  28 C USAGE:    CALL PUTGB2(LUGB,GFLD,IRET)
  29 C   INPUT ARGUMENTS:
  30 C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
  31 C                  FILE MUST BE OPENED WITH BAOPEN OR BAOPENW BEFORE CALLING
  32 C                  THIS ROUTINE.
  33 C     gfld - derived type gribfield ( defined in module grib_mod )
  34 C            ( NOTE: See Remarks Section )
  35 C        gfld%version = GRIB edition number ( currently 2 )
  36 C        gfld%discipline = Message Discipline ( see Code Table 0.0 )
  37 C        gfld%idsect() = Contains the entries in the Identification
  38 C                        Section ( Section 1 )
  39 C                        This element is actually a pointer to an array
  40 C                        that holds the data.
  41 C            gfld%idsect(1)  = Identification of originating Centre
  42 C                                    ( see Common Code Table C-1 )
  43 C                             7 - US National Weather Service
  44 C            gfld%idsect(2)  = Identification of originating Sub-centre
  45 C            gfld%idsect(3)  = GRIB Master Tables Version Number
  46 C                                    ( see Code Table 1.0 )
  47 C                             0 - Experimental
  48 C                             1 - Initial operational version number
  49 C            gfld%idsect(4)  = GRIB Local Tables Version Number
  50 C                                    ( see Code Table 1.1 )
  51 C                             0     - Local tables not used
  52 C                             1-254 - Number of local tables version used
  53 C            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
  54 C                             0 - Analysis
  55 C                             1 - Start of forecast
  56 C                             2 - Verifying time of forecast
  57 C                             3 - Observation time
  58 C            gfld%idsect(6)  = Year ( 4 digits )
  59 C            gfld%idsect(7)  = Month
  60 C            gfld%idsect(8)  = Day
  61 C            gfld%idsect(9)  = Hour
  62 C            gfld%idsect(10)  = Minute
  63 C            gfld%idsect(11)  = Second
  64 C            gfld%idsect(12)  = Production status of processed data
  65 C                                    ( see Code Table 1.3 )
  66 C                              0 - Operational products
  67 C                              1 - Operational test products
  68 C                              2 - Research products
  69 C                              3 - Re-analysis products
  70 C            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
  71 C                              0  - Analysis products
  72 C                              1  - Forecast products
  73 C                              2  - Analysis and forecast products
  74 C                              3  - Control forecast products
  75 C                              4  - Perturbed forecast products
  76 C                              5  - Control and perturbed forecast products
  77 C                              6  - Processed satellite observations
  78 C                              7  - Processed radar observations
  79 C        gfld%idsectlen = Number of elements in gfld%idsect().
  80 C        gfld%local() = Pointer to character array containing contents
  81 C                       of Local Section 2, if included
  82 C        gfld%locallen = length of array gfld%local()
  83 C        gfld%ifldnum = field number within GRIB message
  84 C        gfld%griddef = Source of grid definition (see Code Table 3.0)
  85 C                      0 - Specified in Code table 3.1
  86 C                      1 - Predetermined grid Defined by originating centre
  87 C        gfld%ngrdpts = Number of grid points in the defined grid.
  88 C        gfld%numoct_opt = Number of octets needed for each
  89 C                          additional grid points definition.
  90 C                          Used to define number of
  91 C                          points in each row ( or column ) for
  92 C                          non-regular grids.
  93 C                          = 0, if using regular grid.
  94 C        gfld%interp_opt = Interpretation of list for optional points
  95 C                          definition.  (Code Table 3.11)
  96 C        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
  97 C        gfld%igdtmpl() = Contains the data values for the specified Grid
  98 C                         Definition Template ( NN=gfld%igdtnum ).  Each
  99 C                         element of this integer array contains an entry (in
 100 C                         the order specified) of Grid Defintion Template 3.NN
 101 C                         This element is actually a pointer to an array
 102 C                         that holds the data.
 103 C        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
 104 C                       entries in Grid Defintion Template 3.NN
 105 C                       ( NN=gfld%igdtnum ).
 106 C        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array
 107 C                          contains the number of grid points contained in
 108 C                          each row ( or column ).  (part of Section 3)
 109 C                          This element is actually a pointer to an array
 110 C                          that holds the data.  This pointer is nullified
 111 C                          if gfld%numoct_opt=0.
 112 C        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
 113 C                       in array ideflist.  i.e. number of rows ( or columns )
 114 C                       for which optional grid points are defined.  This value
 115 C                       is set to zero, if gfld%numoct_opt=0.
 116 C        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
 117 C        gfld%ipdtmpl() = Contains the data values for the specified Product
 118 C                         Definition Template ( N=gfdl%ipdtnum ).  Each element
 119 C                         of this integer array contains an entry (in the
 120 C                         order specified) of Product Defintion Template 4.N.
 121 C                         This element is actually a pointer to an array
 122 C                         that holds the data.
 123 C        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
 124 C                       entries in Product Defintion Template 4.N
 125 C                       ( N=gfdl%ipdtnum ).
 126 C        gfld%coord_list() = Real array containing floating point values
 127 C                            intended to document the vertical discretisation
 128 C                            associated to model data on hybrid coordinate
 129 C                            vertical levels.  (part of Section 4)
 130 C                            This element is actually a pointer to an array
 131 C                            that holds the data.
 132 C        gfld%num_coord = number of values in array gfld%coord_list().
 133 C        gfld%ndpts = Number of data points unpacked and returned.
 134 C        gfld%idrtnum = Data Representation Template Number
 135 C                       ( see Code Table 5.0)
 136 C        gfld%idrtmpl() = Contains the data values for the specified Data
 137 C                         Representation Template ( N=gfld%idrtnum ).  Each
 138 C                         element of this integer array contains an entry
 139 C                         (in the order specified) of Product Defintion
 140 C                         Template 5.N.
 141 C                         This element is actually a pointer to an array
 142 C                         that holds the data.
 143 C        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number
 144 C                       of entries in Data Representation Template 5.N
 145 C                       ( N=gfld%idrtnum ).
 146 C        gfld%unpacked = logical value indicating whether the bitmap and
 147 C                        data values were unpacked.  If false,
 148 C                        gfld%bmap and gfld%fld pointers are nullified.
 149 C        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
 150 C                     0 = bitmap applies and is included in Section 6.
 151 C                     1-253 = Predefined bitmap applies
 152 C                     254 = Previously defined bitmap applies to this field
 153 C                     255 = Bit map does not apply to this product.
 154 C        gfld%bmap() = Logical*1 array containing decoded bitmap,
 155 C                      if ibmap=0 or ibap=254.  Otherwise nullified.
 156 C                      This element is actually a pointer to an array
 157 C                      that holds the data.
 158 C        gfld%fld() = Array of gfld%ndpts unpacked data points.
 159 C                     This element is actually a pointer to an array
 160 C                     that holds the data.
 161 C
 162 C   OUTPUT ARGUMENTS:
 163 C     IRET         INTEGER RETURN CODE
 164 C                    0      ALL OK
 165 C                    2      MEMORY ALLOCATION ERROR
 166 C                    10     No Section 1 info available
 167 C                    11     No Grid Definition Template info available
 168 C                    12     Missing some required data field info
 169 C
 170 C SUBPROGRAMS CALLED:
 171 C   gribcreate     Start a new grib2 message
 172 C   addlocal       Add local section to a GRIB2 message
 173 C   addgrid        Add grid info to a GRIB2 message
 174 C   addfield       Add data field to a GRIB2 message
 175 C   gribend        End GRIB2 message
 176 C
 177 C REMARKS:
 178 C
 179 C   Note that derived type gribfield contains pointers to many
 180 C   arrays of data.  The memory for these arrays is allocated
 181 C   when the values in the arrays are set, to help minimize
 182 C   problems with array overloading.  Because of this users
 183 C   are encouraged to free up this memory, when it is no longer
 184 C   needed, by an explicit call to subroutine gf_free.
 185 C   ( i.e.   CALL GF_FREE(GFLD) )
 186 C
 187 C ATTRIBUTES:
 188 C   LANGUAGE: FORTRAN 90
 189 C
 190 C$$$
 191       USE GRIB_MOD
 192
 193       INTEGER,INTENT(IN) :: LUGB
 194       TYPE(GRIBFIELD),INTENT(IN) :: GFLD
 195       INTEGER,INTENT(OUT) :: IRET
 196
 197       CHARACTER(LEN=1),ALLOCATABLE,DIMENSION(:) :: CGRIB
 198       integer :: listsec0(2)
 199       integer :: igds(5)
 200       real    :: coordlist
 201       integer :: ilistopt
 202
 203       listsec0=(/0,2/)
 204       igds=(/0,0,0,0,0/)
 205       coordlist=0.0
 206       ilistopt=0
 207
 208 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 209 C  ALLOCATE ARRAY FOR GRIB2 FIELD
 210       lcgrib=gfld%ngrdpts*4
 211       allocate(cgrib(lcgrib),stat=is)
 212       if ( is.ne.0 ) then
 213          print *,'putgb2: cannot allocate memory. ',is
 214          iret=2
 215       endif
 216 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 217 C  CREATE NEW MESSAGE
 218       listsec0(1)=gfld%discipline
 219       listsec0(2)=gfld%version
 220       if ( associated(gfld%idsect) ) then
 221          call gribcreate(cgrib,lcgrib,listsec0,gfld%idsect,ierr)
 222          if (ierr.ne.0) then
 223             write(6,*) 'putgb2: ERROR creating new GRIB2 field = ',ierr
 224          endif
 225       else
 226          print *,'putgb2: No Section 1 info available. '
 227          iret=10
 228          deallocate(cgrib)
 229          return
 230       endif
 231 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 232 C  ADD LOCAL USE SECTION TO GRIB2 MESSAGE
 233       if ( associated(gfld%local).AND.gfld%locallen.gt.0 ) then
 234          call addlocal(cgrib,lcgrib,gfld%local,gfld%locallen,ierr)
 235          if (ierr.ne.0) then
 236             write(6,*) 'putgb2: ERROR adding local info = ',ierr
 237          endif
 238       endif
 239 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 240 C  ADD GRID TO GRIB2 MESSAGE
 241       igds(1)=gfld%griddef
 242       igds(2)=gfld%ngrdpts
 243       igds(3)=gfld%numoct_opt
 244       igds(4)=gfld%interp_opt
 245       igds(5)=gfld%igdtnum
 246       if ( associated(gfld%igdtmpl) ) then
 247          call addgrid(cgrib,lcgrib,igds,gfld%igdtmpl,gfld%igdtlen,
 248      &                ilistopt,gfld%num_opt,ierr)
 249          if (ierr.ne.0) then
 250             write(6,*) 'putgb2: ERROR adding grid info = ',ierr
 251          endif
 252       else
 253          print *,'putgb2: No GDT info available. '
 254          iret=11
 255          deallocate(cgrib)
 256          return
 257       endif
 258 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 259 C  ADD DATA FIELD TO GRIB2 MESSAGE
 260       if ( associated(gfld%ipdtmpl).AND.
 261      &     associated(gfld%idrtmpl).AND.
 262      &     associated(gfld%fld) ) then
 263          call addfield(cgrib,lcgrib,gfld%ipdtnum,gfld%ipdtmpl,
 264      &                 gfld%ipdtlen,coordlist,gfld%num_coord,
 265      &                 gfld%idrtnum,gfld%idrtmpl,gfld%idrtlen,
 266      &                 gfld%fld,gfld%ngrdpts,gfld%ibmap,gfld%bmap,
 267      &                 ierr)
 268          if (ierr.ne.0) then
 269             write(6,*) 'putgb2: ERROR adding data field = ',ierr
 270          endif
 271       else
 272          print *,'putgb2: Missing some field info. '
 273          iret=12
 274          deallocate(cgrib)
 275          return
 276       endif
 277 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 278 C  CLOSE GRIB2 MESSAGE AND WRITE TO FILE
 279       call gribend(cgrib,lcgrib,lengrib,ierr)
 280       call wryte(lugb,lengrib,cgrib)
 281 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 282       deallocate(cgrib)
 283       RETURN
 284       END