ungrib/src/ngl/g2/gf_free.f

   1       subroutine gf_free(gfld)
   2 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 !                .      .    .                                       .
   4 ! SUBPROGRAM:    gf_free
   5 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
   6 !
   7 ! ABSTRACT: This subroutine frees up memory that was used to store
   8 !   array values in derived type gribfield.
   9 !
  10 ! PROGRAM HISTORY LOG:
  11 ! 2000-05-26  Gilbert
  12 !
  13 ! USAGE:    CALL gf_free(gfld)
  14 !   INPUT ARGUMENT LIST:
  15 !     gfld - derived type gribfield ( defined in module grib_mod )
  16 !
  17 !   OUTPUT ARGUMENT LIST:
  18 !     gfld - derived type gribfield ( defined in module grib_mod )
  19 !        gfld%version = GRIB edition number
  20 !        gfld%discipline = Message Discipline ( see Code Table 0.0 )
  21 !        gfld%idsect() = Contains the entries in the Identification
  22 !                        Section ( Section 1 )
  23 !                        This element is actually a pointer to an array
  24 !                        that holds the data.
  25 !            gfld%idsect(1)  = Identification of originating Centre
  26 !                                    ( see Common Code Table C-1 )
  27 !            gfld%idsect(2)  = Identification of originating Sub-centre
  28 !            gfld%idsect(3)  = GRIB Master Tables Version Number
  29 !                                    ( see Code Table 1.0 )
  30 !            gfld%idsect(4)  = GRIB Local Tables Version Number
  31 !                                    ( see Code Table 1.1 )
  32 !            gfld%idsect(5)  = Significance of Reference Time (Code Table 1.2)
  33 !            gfld%idsect(6)  = Year ( 4 digits )
  34 !            gfld%idsect(7)  = Month
  35 !            gfld%idsect(8)  = Day
  36 !            gfld%idsect(9)  = Hour
  37 !            gfld%idsect(10)  = Minute
  38 !            gfld%idsect(11)  = Second
  39 !            gfld%idsect(12)  = Production status of processed data
  40 !                                    ( see Code Table 1.3 )
  41 !            gfld%idsect(13)  = Type of processed data ( see Code Table 1.4 )
  42 !        gfld%idsectlen = Number of elements in gfld%idsect().
  43 !        gfld%local() = Pointer to character array containing contents
  44 !                       of Local Section 2, if included
  45 !        gfld%locallen = length of array gfld%local()
  46 !        gfld%ifldnum = field number within GRIB message
  47 !        gfld%griddef = Source of grid definition (see Code Table 3.0)
  48 !        gfld%ngrdpts = Number of grid points in the defined grid.
  49 !        gfld%numoct_opt = Number of octets needed for each
  50 !                          additional grid points definition.
  51 !                          Used to define number of
  52 !                          points in each row ( or column ) for
  53 !                          non-regular grids.
  54 !                          = 0, if using regular grid.
  55 !        gfld%interp_opt = Interpretation of list for optional points
  56 !                          definition.  (Code Table 3.11)
  57 !        gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
  58 !        gfld%igdtmpl() = Contains the data values for the specified Grid
  59 !                         Definition Template ( NN=gfld%igdtnum ).  Each
  60 !                         element of this integer array contains an entry (in
  61 !                         the order specified) of Grid Defintion Template 3.NN
  62 !                         This element is actually a pointer to an array
  63 !                         that holds the data.
  64 !        gfld%igdtlen = Number of elements in gfld%igdtmpl().  i.e. number of
  65 !                       entries in Grid Defintion Template 3.NN
  66 !                       ( NN=gfld%igdtnum ).
  67 !        gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0)  This array
  68 !                          contains the number of grid points contained in
  69 !                          each row ( or column ).  (part of Section 3)
  70 !                          This element is actually a pointer to an array
  71 !                          that holds the data.  This pointer is nullified
  72 !                          if gfld%numoct_opt=0.
  73 !        gfld%num_opt = (Used if gfld%numoct_opt .ne. 0)  The number of entries
  74 !                       in array ideflist.  i.e. number of rows ( or columns )
  75 !                       for which optional grid points are defined.  This value
  76 !                       is set to zero, if gfld%numoct_opt=0.
  77 !        gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
  78 !        gfld%ipdtmpl() = Contains the data values for the specified Product
  79 !                         Definition Template ( N=gfdl%ipdtnum ).  Each element
  80 !                         of this integer array contains an entry (in the
  81 !                         order specified) of Product Defintion Template 4.N.
  82 !                         This element is actually a pointer to an array
  83 !                         that holds the data.
  84 !        gfld%ipdtlen = Number of elements in gfld%ipdtmpl().  i.e. number of
  85 !                       entries in Product Defintion Template 4.N
  86 !                       ( N=gfdl%ipdtnum ).
  87 !        gfld%coord_list() = Real array containing floating point values
  88 !                            intended to document the vertical discretisation
  89 !                            associated to model data on hybrid coordinate
  90 !                            vertical levels.  (part of Section 4)
  91 !                            This element is actually a pointer to an array
  92 !                            that holds the data.
  93 !        gfld%num_coord = number of values in array gfld%coord_list().
  94 !        gfld%ndpts = Number of data points unpacked and returned.
  95 !        gfld%idrtnum = Data Representation Template Number
  96 !                       ( see Code Table 5.0)
  97 !        gfld%idrtmpl() = Contains the data values for the specified Data
  98 !                         Representation Template ( N=gfld%idrtnum ).  Each
  99 !                         element of this integer array contains an entry
 100 !                         (in the order specified) of Product Defintion
 101 !                         Template 5.N.
 102 !                         This element is actually a pointer to an array
 103 !                         that holds the data.
 104 !        gfld%idrtlen = Number of elements in gfld%idrtmpl().  i.e. number
 105 !                       of entries in Data Representation Template 5.N
 106 !                       ( N=gfld%idrtnum ).
 107 !        gfld%unpacked = logical value indicating whether the bitmap and
 108 !                        data values were unpacked.  If false, gfld%ndpts
 109 !                        is set to zero, and gfld%bmap and gfld%fld
 110 !                        pointers are nullified.
 111 !        gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
 112 !                     0 = bitmap applies and is included in Section 6.
 113 !                     1-253 = Predefined bitmap applies
 114 !                     254 = Previously defined bitmap applies to this field
 115 !                     255 = Bit map does not apply to this product.
 116 !        gfld%bmap() - Logical*1 array containing decoded bitmap,
 117 !                      if ibmap=0 or ibap=254.  Otherwise nullified.
 118 !                      This element is actually a pointer to an array
 119 !                      that holds the data.
 120 !        gfld%fld() = Array of gfld%ndpts unpacked data points.
 121 !                     This element is actually a pointer to an array
 122 !                     that holds the data.
 123 !
 124 ! REMARKS:
 125 !
 126 ! ATTRIBUTES:
 127 !   LANGUAGE: Fortran 90
 128 !   MACHINE:  IBM SP
 129 !
 130 !$$$
 131       use grib_mod
 132
 133       type(gribfield) :: gfld
 134
 135       if (associated(gfld%idsect)) then
 136          deallocate(gfld%idsect)
 137          !deallocate(gfld%idsect,stat=is)
 138          !print *,'gfld%idsect: ',is
 139       endif
 140       nullify(gfld%idsect)
 141
 142       if (associated(gfld%local)) then
 143          !deallocate(gfld%local)
 144          !deallocate(gfld%local,stat=is)
 145 !        print *,'WPS devel team - skipping deallocate - FIX THIS'
 146          !print *,'gfld%local: ',is
 147       endif
 148       nullify(gfld%local)
 149
 150       if (associated(gfld%list_opt)) then
 151          deallocate(gfld%list_opt)
 152          !deallocate(gfld%list_opt,stat=is)
 153          !print *,'gfld%list_opt: ',is
 154       endif
 155       nullify(gfld%list_opt)
 156
 157       if (associated(gfld%igdtmpl)) then
 158          deallocate(gfld%igdtmpl)
 159          !deallocate(gfld%igdtmpl,stat=is)
 160          !print *,'gfld%igdtmpl: ',is
 161       endif
 162       nullify(gfld%igdtmpl)
 163
 164       if (associated(gfld%ipdtmpl)) then
 165          deallocate(gfld%ipdtmpl)
 166          !deallocate(gfld%ipdtmpl,stat=is)
 167          !print *,'gfld%ipdtmpl: ',is
 168       endif
 169       nullify(gfld%ipdtmpl)
 170
 171       if (associated(gfld%coord_list)) then
 172          deallocate(gfld%coord_list)
 173          !deallocate(gfld%coord_list,stat=is)
 174          !print *,'gfld%coord_list: ',is
 175       endif
 176       nullify(gfld%coord_list)
 177
 178       if (associated(gfld%idrtmpl)) then
 179          deallocate(gfld%idrtmpl)
 180          !deallocate(gfld%idrtmpl,stat=is)
 181          !print *,'gfld%idrtmpl: ',is
 182       endif
 183       nullify(gfld%idrtmpl)
 184
 185       if (associated(gfld%bmap)) then
 186          deallocate(gfld%bmap)
 187          !deallocate(gfld%bmap,stat=is)
 188          !print *,'gfld%bmap: ',is
 189       endif
 190       nullify(gfld%bmap)
 191
 192       if (associated(gfld%fld)) then
 193          deallocate(gfld%fld)
 194          !deallocate(gfld%fld,stat=is)
 195          !print *,'gfld%fld: ',is
 196       endif
 197       nullify(gfld%fld)
 198
 199       return
 200       end