!=====================================================================
! NGB2: g2lib, Library for decoding and encoding GRIB2 data (NCEP)
!=====================================================================
!
! g2lib Library: Fortran Decoder/Encoder Routines for GRIB Edition 2.
! Version 2.5.0 (2013)
! Version 3.1.0 (2017)
!
! http://www.nco.ncep.noaa.gov/pmb/codes/GRIB2/
!
!---------------------------------------------------------------------
!
! ~~~~~~~~~~~~~~~
! Type definition
! ~~~~~~~~~~~~~~~
!
! TYPE gribfield
!
! ~~~~~~~~~~~~~~~~
! Utilily Routines
! ~~~~~~~~~~~~~~~~
!
! SUBROUTINE NG_CNVG12(cfl1, cfl2, ipack, iusem, imiss, ivect, itblv )
! SUBROUTINE NG_CNVG21(cfl1, cfl2 )
! SUBROUTINE NG_CNVG22(cfl1, cfl2, ipack, iusem, imiss, itblv )
!
! SUBROUTINE NG_DEGRB2( gb2file )
!
! SUBROUTINE ng_gb2_missingvalue( Missing_Value )
!
! ~~~~~~~~~~~
! Get Message
! ~~~~~~~~~~~
!
! SUBROUTINE NG_SKGB2(LUGB, ISEEK, MSEEK, LSKIP, LGRIB)
! SUBROUTINE NG_IXGB2(LUGB, LSKIP, LGRIB, CBUF, NUMFLD, MLEN, IRET)
!
! SUBROUTINE NG_GETGB2(LUGB, LUGI, J, JDISC, JIDS, JPDTN, JPDT, JGDTN,&
! JGDT, UNPACK, K, GFLD, IRET)
! SUBROUTINE NG_GETGB2P(LUGB, LUGI, J, JDISC, JIDS, JPDTN, JPDT, JGDTN,&
! JGDT, EXTRACT, K, GRIBM, LENG, IRET)
!
! SUBROUTINE ng_gb_info(cgrib, lcgrib, listsec0, listsec1, numfields,&
! numlocal, maxlocal, ierr)
! SUBROUTINE ng_gf_getfld(cgrib, lcgrib, ifldnum, unpack, expand, gfld, ierr)
! SUBROUTINE ng_gf_free(gfld)
!
! SUBROUTINE ng_gribinfo(cgrib, lcgrib, listsec0, listsec1, numlocal,&
! numfields, maxvals, ierr)
! SUBROUTINE ng_getlocal(cgrib, lcgrib, localnum, csec2, lcsec2, ierr)
! SUBROUTINE ng_gettemplates(cgrib, lcgrib, ifldnum, igds, igdstmpl,&
! igdslen, ideflist, idefnum, ipdsnum,&
! ipdstmpl, ipdslen, coordlist, numcoord,&
! ierr)
! SUBROUTINE ng_getfield(cgrib, lcgrib, ifldnum, igds, igdstmpl,igdslen,&
! ideflist, idefnum, ipdsnum, ipdstmpl, ipdslen,&
! coordlist, numcoord, ndpts, idrsnum, idrstmpl,&
! idrslen, ibmap, bmap, fld, ierr)
!
! SUBROUTINE NG_GETIDX (LUGB, LUGI, CINDEX, NLEN, NNUM, IRET)
! SUBROUTINE NG_GETGB2L (LUGB, CINDEX, GFLD, IRET)
! SUBROUTINE NG_GETGB2S (CBUF, NLEN, NNUM, J, JDISC, JIDS, JPDTN, JPDT,&
! JGDTN, JGDT, K, GFLD, LPOS, IRET)
! SUBROUTINE NG_GETGB2R (LUGB, CINDEX, GFLD, IRET)
! SUBROUTINE NG_GETGB2RP(LUGB, CINDEX, EXTRACT, GRIBM, LENG, IRET)
! SUBROUTINE NG_GETG2IR (LUGB, MSK1, MSK2, MNUM, CBUF, NLEN, NNUM,&
! NMESS, IRET)
! SUBROUTINE NG_GETG2I (LUGI, CBUF, NLEN, NNUM, IRET)
!
! SUBROUTINE ng_getdim(csec3, lcsec3, width, height, iscan)
!
! SUBROUTINE ng_getpoly(csec3, lcsec3, jj, kk, mm)
!
! ~~~~~~~~~~~
! Put Message
! ~~~~~~~~~~~
!
! SUBROUTINE NG_PUTGB2(LUGB, GFLD, IRET)
!
! SUBROUTINE ng_gribcreate(cgrib, lcgrib, listsec0, listsec1, ierr)
! SUBROUTINE ng_addlocal(cgrib, lcgrib, csec2, lcsec2, ierr)
! SUBROUTINE ng_addgrid(cgrib, lcgrib, igds, igdstmpl, igdstmplen,&
! ideflist, idefnum, ierr)
! SUBROUTINE ng_addfield(cgrib, lcgrib, ipdsnum, ipdstmpl, ipdstmplen,&
! coordlist, numcoord, idrsnum, idrstmpl,&
! idrstmplen, fld, ngrdpts, ibmap, bmap, ierr)
! SUBROUTINE ng_gribend(cgrib, lcgrib, lengrib, ierr)
!
! ~~~~~~~~~~~
! Convert 1/2
! ~~~~~~~~~~~
!
! SUBROUTINE ng_gdt2gds(igds, igdstmpl, idefnum, ideflist, kgds, igrid, iret)
! SUBROUTINE ng_makepds(idisc, idsect, ipdsnum, ipdstmpl, ibmap, idrsnum,&
! idrstmpl, kpds, iret)
! SUBROUTINE ng_makepdsens(ipdsnum, ipdstmpl,kpds, kens, kprob, xprob,&
! kclust, kmembr, iret)
!
! SUBROUTINE ng_gds2gdt(kgds, igds, igdstmpl, idefnum, ideflist, iret)
! SUBROUTINE ng_pds2pdt(kpds, ipdsnum, ipdstmpl, numcoord, coordlist, iret)
! SUBROUTINE ng_pds2pdtens(kpds, kens, kprob, xprob, kclust, kmember,&
! ipdsnum, ipdstmpl, numcoord, coordlist, iret)
!
! SUBROUTINE ng_cnvlevel(ltype, lval, ipdstmpl)
! SUBROUTINE ng_levelcnv(ipdstmpl, ltype, lval)
!
! ~~~~~~~~~~~
! Pack/Unpack
! ~~~~~~~~~~~
!
! SUBROUTINE ng_cmplxpack(fld, ndpts, idrsnum, idrstmpl, cpack, lcpack)
! SUBROUTINE ng_comunpack(cpack, len, lensec, idrsnum, idrstmpl, ndpts, fld, ier)
!
! SUBROUTINE ng_jpcpack(fld, width, height, idrstmpl, cpack, lcpack)
! SUBROUTINE ng_jpcunpack(cpack, nlen, idrstmpl, ndpts, fld)
!
! SUBROUTINE ng_pngpack(fld, width, height, idrstmpl, cpack, lcpack)
! SUBROUTINE ng_pngunpack(cpack, nlen, idrstmpl, ndpts, fld)
!
! SUBROUTINE ng_simpack(fld, ndpts, idrstmpl, cpack, lcpack)
! SUBROUTINE ng_simunpack(cpack, len, idrstmpl, ndpts, fld)
!
! SUBROUTINE ng_specpack(fld, ndpts, JJ, KK, MM, idrstmpl, cpack, lcpack)
! SUBROUTINE ng_specunpack(cpack, len, idrstmpl, ndpts, JJ, KK, MM, fld)
!
! SUBROUTINE ng_mkieee(a, rieee, num)
! SUBROUTINE ng_rdieee(rieee, a, num)
!
! SUBROUTINE NG_GRIB_GBYTES(IN,IOUT,ISKIP,NBYTE,NSKIP,N)
! SUBROUTINE NG_GRIB_SBYTES( OUT,IN,ISKIP,NBYTE,NSKIP,N)
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Access GRIB2 Grid Definition
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! INTEGER FUNCTION ng_getgridindex(number)
!
! SUBROUTINE ng_getgridtemplate(number, nummap, map, needext, iret)
!
! SUBROUTINE ng_extgridtemplate(number, list, nummap, map)
!
! INTEGER FUNCTION ng_getgdtlen(number)
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Access GRIB2 Product Definition
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! INTEGER FUNCTION ng_getpdsindex(number)
!
! SUBROUTINE ng_getpdstemplate(number, nummap, map, needext, iret)
!
! SUBROUTINE ng_extpdstemplate(number, list, nummap, map)
!
! INTEGER FUNCTION ng_getpdtlen(number)
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Access GRIB2 Data Representation
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! INTEGER FUNCTION ng_getdrsindex(number)
!
! SUBROUTINE ng_getdrstemplate(number, nummap, map, needext, iret)
!
! SUBROUTINE ng_extdrstemplate(number, list, nummap, map)
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Access GRIB2 Grid Definition Templates
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! INTEGER FUNCTION ng_readgrids(lunit)
!
! SUBROUTINE ng_getgridbynum(lunit, number, igdtn, igdtmpl, iret)
!
! SUBROUTINE ng_getgridbyname(lunit, name, igdtn, igdtmpl, iret)
!
! ~~~~~~~~~~~~~~~~~~~~~~~
! Access GRIB2 Parameters
! ~~~~~~~~~~~~~~~~~~~~~~~
!
! SUBROUTINE ng_param_g1_to_g2(g1val, g1ver, g2disc, g2cat, g2num)
!
! SUBROUTINE ng_param_g2_to_g1(g2disc, g2cat, g2num, g1val, g1ver)
!
! CHARACTER(8) FUNCTION ng_param_get_abbrev(g2disc, g2cat, g2num)
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Access ECMWF GRIB Parameters
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! SUBROUTINE ng_param_ecmwf_g1_to_g2(g1val, g1ver, g2disc, g2cat, g2num)
!
! SUBROUTINE ng_param_ecmwf_g2_to_g1(g2disc, g2cat, g2num, g1val, g1ver)
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Reallocate CHARACTER/REAL/INTEGER pointered arrays
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! SUBROUTINE ng_realloc(c, n, m, istat)
!
!=====================================================================
!
! ~~~~~~~~~~~~~~~
! Type definition
! ~~~~~~~~~~~~~~~
!
! TYPE gribfield
!
!---------------------------------------------------------------------
!
! ! use "USE CNCARG" to access type definition for the CNCARG users
! TYPE gribfield
! INTEGER :: version
! INTEGER :: discipline
!
! INTEGER, POINTER, DIMENSION(:) :: idsect => NULL()
! INTEGER :: idsectlen
!
! CHARACTER(1), POINTER, DIMENSION(:) :: local => NULL()
! INTEGER :: locallen
!
! INTEGER :: ifldnum
! INTEGER :: griddef
! INTEGER :: ngrdpts
!
! INTEGER :: numoct_opt
! INTEGER :: interp_opt
! INTEGER :: num_opt
! INTEGER, POINTER, DIMENSION(:) :: list_opt => NULL()
!
! INTEGER :: igdtnum
! INTEGER :: igdtlen
! integer, POINTER, DIMENSION(:) :: igdtmpl => NULL()
!
! INTEGER :: ipdtnum
! INTEGER :: ipdtlen
! INTEGER, POINTER, DIMENSION(:) :: ipdtmpl => NULL()
!
! INTEGER :: num_coord
! REAL, POINTER, DIMENSION(:) :: coord_list => NULL()
!
! INTEGER :: ndpts
! INTEGER :: idrtnum
! INTEGER :: idrtlen
! INTEGER, POINTER, DIMENSION(:) :: idrtmpl => NULL()
!
! LOGICAL :: unpacked ! default (4-byte)
! LOGICAL :: expanded
!
! INTEGER :: ibmap
! LOGICAL*1, POINTER, DIMENSION(:) :: bmap => NULL() ! 1-byte
!
! REAL, POINTER, DIMENSION(:) :: fld => NULL()
! END TYPE gribfield
!
!-------------------
!
! TYPE DEFINITION: GRIBFIELD
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-01-23
!
! ABSTRACT: The declaration of derived type gribfield.
! If variable gfld is declared of type gribfield
! ( i.e. TYPE(GRIBFIELD) :: gfld ), it would have the following
! componenets:
!
! gfld%version = GRIB edition number ( currently 2 )
!
! gfld%discipline = Message Discipline ( see Code Table 0.0 )
!
! gfld%idsect() = Contains the entries in the Identification
! Section ( Section 1 )
! This element is actually a pointer to an array
! that holds the data.
! gfld%idsect(1) = Identification of originating Centre
! ( see Common Code Table C-1 )
! 7 - US National Weather Service
! gfld%idsect(2) = Identification of originating Sub-centre
! gfld%idsect(3) = GRIB Master Tables Version Number
! ( see Code Table 1.0 )
! 0 - Experimental
! 1 - Initial operational version number
! gfld%idsect(4) = GRIB Local Tables Version Number
! ( see Code Table 1.1 )
! 0 - Local tables not used
! 1-254 - Number of local tables version used
! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2)
! 0 - Analysis
! 1 - Start of forecast
! 2 - Verifying time of forecast
! 3 - Observation time
! gfld%idsect(6) = Year ( 4 digits )
! gfld%idsect(7) = Month
! gfld%idsect(8) = Day
! gfld%idsect(9) = Hour
! gfld%idsect(10) = Minute
! gfld%idsect(11) = Second
! gfld%idsect(12) = Production status of processed data
! ( see Code Table 1.3 )
! 0 - Operational products
! 1 - Operational test products
! 2 - Research products
! 3 - Re-analysis products
! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 )
! 0 - Analysis products
! 1 - Forecast products
! 2 - Analysis and forecast products
! 3 - Control forecast products
! 4 - Perturbed forecast products
! 5 - Control and perturbed forecast products
! 6 - Processed satellite observations
! 7 - Processed radar observations
!
! gfld%idsectlen = Number of elements in gfld%idsect().
!
! gfld%local() = Pointer to character array containing contents
! of Local Section 2, if included
!
! gfld%locallen = length of array gfld%local()
!
! gfld%ifldnum = field number within GRIB message
!
! gfld%griddef = Source of grid definition (see Code Table 3.0)
! 0 - Specified in Code table 3.1
! 1 - Predetermined grid Defined by originating centre
!
! gfld%ngrdpts = Number of grid points in the defined grid.
! Note that the number of actual data values returned from
! getgb2 (in gfld%ndpts) may be less than this value if a
! logical bitmap is in use with grid points that are being masked out.
!
! gfld%numoct_opt = Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
!
! gfld%interp_opt = Interpretation of list for optional points
! definition. (Code Table 3.11)
!
! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
!
! gfld%igdtmpl() = Contains the data values for the specified Grid
! Definition Template ( NN=gfld%igdtnum ). Each
! element of this integer array contains an entry (in
! the order specified) of Grid Defintion Template 3.NN
! This element is actually a pointer to an array
! that holds the data.
!
! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of
! entries in Grid Defintion Template 3.NN
! ( NN=gfld%igdtnum ).
!
! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array
! contains the number of grid points contained in
! each row ( or column ). (part of Section 3)
! This element is actually a pointer to an array
! that holds the data. This pointer is nullified
! if gfld%numoct_opt=0.
!
! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined. This value
! is set to zero, if gfld%numoct_opt=0.
!
! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
!
! gfld%ipdtmpl() = Contains the data values for the specified Product
! Definition Template ( N=gfdl%ipdtnum ). Each element
! of this integer array contains an entry (in the
! order specified) of Product Defintion Template 4.N.
! This element is actually a pointer to an array
! that holds the data.
!
! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of
! entries in Product Defintion Template 4.N
! ( N=gfdl%ipdtnum ).
!
! gfld%coord_list() = Real array containing floating point values
! intended to document the vertical discretisation
! associated to model data on hybrid coordinate
! vertical levels. (part of Section 4)
! This element is actually a pointer to an array
! that holds the data.
!
! gfld%num_coord = number of values in array gfld%coord_list().
!
! gfld%ndpts = Number of data points unpacked and returned.
! Note that this number may be different from the value of
! gfld%ngrdpts if a logical bitmap is in use with grid points
! that are being masked out.
!
! gfld%idrtnum = Data Representation Template Number
! ( see Code Table 5.0)
!
! gfld%idrtmpl() = Contains the data values for the specified Data
! Representation Template ( N=gfld%idrtnum ). Each
! element of this integer array contains an entry
! (in the order specified) of Product Defintion
! Template 5.N.
! This element is actually a pointer to an array
! that holds the data.
!
! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number
! of entries in Data Representation Template 5.N
! ( N=gfld%idrtnum ).
!
! gfld%unpacked = logical value indicating whether the bitmap and
! data values were unpacked. If false,
! gfld%bmap and gfld%fld pointers are nullified.
!
! gfld%expanded = Logical value indicating whether the data field
! was expanded to the grid in the case where a
! bit-map is present. If true, the data points in
! gfld%fld match the grid points and "Missing_Value" were
! inserted at grid points where data was bit-mapped
! out. If false, the data values in gfld%fld were
! not expanded to the grid and are just a consecutive
! array of data points corresponding to each value of
! "1" in gfld%bmap.
!
! Note: You can call the routine "ng_gb2_missingvalue"
! to get "Missing_Value" used in CNCARG
!
! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
!
! gfld%bmap() = Logical*1 array containing decoded bitmap,
! if ibmap=0 or ibap=254. Otherwise nullified.
! This element is actually a pointer to an array
! that holds the data.
!
! gfld%fld() = Array of gfld%ndpts unpacked data points.
! This element is actually a pointer to an array
! that holds the data.
!
!-------------------
!
! PROGRAM HISTORY LOG:
!
! 2002-01-23 Gilbert
!
! 2007-04-24 Vuong - Added GDT 3.204 Curvilinear Orthogonal Grids
! 2008-05-29 Vuong - Added GDT 3.32768 Rotate Lat/Lon E-grid
! 2009-02-17 Vuong - Allow negative scale factors and limits for
! Templates 4.5 and 4.9
! 2009-12-14 Vuong - Fixed bug in routine getidx.f
! - Modified to increase length of seek(512)
! - Added Templates (Satellite Product) 4.31
! - Added Templates (ICAO WAFS) 4.15
! 2013-08-29 Vuong - Changed version number 2.5.0
! 2015-11-01 Vuong - Changed version number 2.6.0
! 2015-11-10 VUONG - MODIFIED DOC BLOCK FOR gfld%ngrdpts and gfld%ndpts
! 2017-18-01 Vuong - Changed version number 3.1.0
!
!=====================================================================
!
! ~~~~~~~~~~~~~~~~
! Utilily Routines
! ~~~~~~~~~~~~~~~~
!
! SUBROUTINE NG_CNVG12(cfl1, cfl2, ipack, iusem, imiss, ivect, itblv )
! SUBROUTINE NG_CNVG21(cfl1, cfl2 )
! SUBROUTINE NG_CNVG22(cfl1, cfl2, ipack, iusem, imiss, itblv )
!
! SUBROUTINE NG_DEGRB2( gb2file )
!
! SUBROUTINE ng_gb2_missingvalue( Missing_Value )
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_CNVG12(cfl1, cfl2, ipack, iusem, imiss, ivect, itblv)
!
! CHARACTER(*), INTENT(IN) :: cfl1, cfl2
! INTEGER, INTENT(IN) :: ipack, imiss, itblv
! LOGICAL, INTENT(IN) :: iusem, ivect
!
! Routine to convert every GRIB1 field in a file to a GRIB2 field.
!
! Variables:
!
! cfl1 - Name of input GRIB1 file
!
! cfl2 - Name of output GRIB2 file
!
! ipack - GRIB2 packing option:
! 0 = simple packing
! 2 = group packing
! 31 = group pack with 1st order differencing
! 32 = group pack with 2nd order differencing
! 40 = JPEG2000 encoding
! 40000 = JPEG2000 encoding (obsolete)
! 41 = PNG encoding
! 40010 = PNG encoding (obsolete)
! if ipack .ne. one of the values above, 31 is used as a default.
!
! iusem - uses missing value management (instead of bitmaps), for use
! ipack options 2, 31, and 32.
!
! imiss - Missing value management:
! 0 = No explicit missing values included within data values
! 1 = Primary missing values included within data values
!
! ivect - .TRUE. = combine U and V wind components into one GRIB2 msg.
! .FALSE. = does not combine U and V wind components
!
! itblv - Master Table version, a number from 2 to 17
!
! Note: a wapper routine of "SUBROUTINE cnv12" of "PROGRAM cnvgrib"
! Ref: http://www.nco.ncep.noaa.gov/pmb/codes/GRIB2/cnvgrib-3.1.0.tar
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_CNVG21(cfl1, cfl2)
!
! CHARACTER(*), INTENT(IN) :: cfl1, cfl2
!
! Routine to convert every GRIB2 field in a file to a GRIB1 field. If
! a GRIB2 message contains more than one data field, then each field
! is saved in individual GRIB1 messages.
!
! Variables:
!
! cfl1 - Name of input GRIB2 file
!
! cfl2 - Name of output GRIB1 file
!
! Note: a wapper routine of "SUBROUTINE cnv21" of "PROGRAM cnvgrib"
! Ref: http://www.nco.ncep.noaa.gov/pmb/codes/GRIB2/cnvgrib-3.1.0.tar
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_CNVG22(cfl1, cfl2, ipack, iusem, imiss, itblv)
!
! CHARACTER(*), INTENT(IN) :: cfl1, cfl2
! INTEGER, INTENT(IN) :: ipack, imiss, itblv
! LOGICAL, INTENT(IN) :: iusem
!
! Routine to convert every GRIB2 field in a file to another GRIB2 field,
! most likely one using a different packing option.
!
! Variables:
!
! cfl1 - Name of input GRIB2 file
!
! cfl2 - Name of output GRIB2 file
!
! ipack - GRIB2 packing option:
! 0 = simple packing
! 2 = group packing
! 31 = group pack with 1st order differencing
! 32 = group pack with 2nd order differencing
! 40 = JPEG2000 encoding
! 40000 = JPEG2000 encoding (obsolete)
! 41 = PNG encoding
! 40010 = PNG encoding (obsolete)
! if ipack .ne. one of the values above, 31 is used as a default.
!
! iusem - uses missing value management (instead of bitmaps), for use
! ipack options 2, 31, and 32.
!
! imiss - Missing value management:
! 0 = No explicit missing values included within data values
! 1 = Primary missing values included within data values
!
! itblv - Master Table version, a number from 2 to 17
!
! Note: a wapper routine of "SUBROUTINE cnv22" of "PROGRAM cnvgrib"
! Ref: http://www.nco.ncep.noaa.gov/pmb/codes/GRIB2/cnvgrib-3.1.0.tar
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_DEGRB2( gb2file )
!
! CHARACTER(*), INTENT(IN) :: gb2file
!
! Routine to reads GRIB2 file and write the inventory to a text file
!
! Variables:
!
! gb2file - Name of input GRIB2 data file
!
! Note:
!
! 1. the inventory text file will be named by "TRIM(gb2file)//'.txt'"
!
! 2. a wapper routine of the utility program "degrib2.f"
! Ref: http://www.nco.ncep.noaa.gov/pmb/codes/degrib2/degrib2.tar
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_gb2_missingvalue( Missing_Value )
!
! REAL, INTENT(OUT) :: Missing_Value
!
! Routine to get the missing value (fill value, special value) used
! in CNACRG.
!
! Missing_Value - Value inserted at grid points where data was
! bit-mapped out (refer the illustration of component
! "expanded" of the derived type "GRIBFIELD")
!
!-------------------
!
! TYPE(GRIBFIELD) :: gfld
!
! gfld%expanded = Logical value indicating whether the data field
! was expanded to the grid in the case where a
! bit-map is present. If true, the data points in
! gfld%fld match the grid points and "Missing_Value" were
! inserted at grid points where data was bit-mapped
! out. If false, the data values in gfld%fld were
! not expanded to the grid and are just a consecutive
! array of data points corresponding to each value of
! "1" in gfld%bmap.
!
!=====================================================================
!
! ~~~~~~~~~~~
! Get Message
! ~~~~~~~~~~~
!
! SUBROUTINE NG_SKGB2(LUGB, ISEEK, MSEEK, LSKIP, LGRIB)
! SUBROUTINE NG_IXGB2(LUGB, LSKIP, LGRIB, CBUF, NUMFLD, MLEN, IRET)
!
! SUBROUTINE NG_GETGB2(LUGB, LUGI, J, JDISC, JIDS, JPDTN, JPDT, JGDTN,&
! JGDT, UNPACK, K, GFLD, IRET)
! SUBROUTINE NG_GETGB2P(LUGB, LUGI, J, JDISC, JIDS, JPDTN, JPDT, JGDTN,&
! JGDT, EXTRACT, K, GRIBM, LENG, IRET)
!
! SUBROUTINE ng_gb_info(cgrib, lcgrib, listsec0, listsec1, numfields,&
! numlocal, maxlocal, ierr)
! SUBROUTINE ng_gf_getfld(cgrib, lcgrib, ifldnum, unpack, expand, gfld, ierr)
! SUBROUTINE ng_gf_free(gfld)
!
! SUBROUTINE ng_gribinfo(cgrib, lcgrib, listsec0, listsec1, numlocal,&
! numfields, maxvals, ierr)
! SUBROUTINE ng_getlocal(cgrib, lcgrib, localnum, csec2, lcsec2, ierr)
! SUBROUTINE ng_gettemplates(cgrib, lcgrib, ifldnum, igds, igdstmpl,&
! igdslen, ideflist, idefnum, ipdsnum,&
! ipdstmpl, ipdslen, coordlist, numcoord,&
! ierr)
! SUBROUTINE ng_getfield(cgrib, lcgrib, ifldnum, igds, igdstmpl,igdslen,&
! ideflist, idefnum, ipdsnum, ipdstmpl, ipdslen,&
! coordlist, numcoord, ndpts, idrsnum, idrstmpl,&
! idrslen, ibmap, bmap, fld, ierr)
!
! SUBROUTINE NG_GETIDX (LUGB, LUGI, CINDEX, NLEN, NNUM, IRET)
! SUBROUTINE NG_GETGB2L (LUGB, CINDEX, GFLD, IRET)
! SUBROUTINE NG_GETGB2S (CBUF, NLEN, NNUM, J, JDISC, JIDS, JPDTN, JPDT,&
! JGDTN, JGDT, K, GFLD, LPOS, IRET)
! SUBROUTINE NG_GETGB2R (LUGB, CINDEX, GFLD, IRET)
! SUBROUTINE NG_GETGB2RP(LUGB, CINDEX, EXTRACT, GRIBM, LENG, IRET)
! SUBROUTINE NG_GETG2IR (LUGB, MSK1, MSK2, MNUM, CBUF, NLEN, NNUM,&
! NMESS, IRET)
! SUBROUTINE NG_GETG2I (LUGI, CBUF, NLEN, NNUM, IRET)
!
! SUBROUTINE ng_getdim(csec3, lcsec3, width, height, iscan)
!
! SUBROUTINE ng_getpoly(csec3, lcsec3, jj, kk, mm)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_SKGB2(LUGB, ISEEK, MSEEK, LSKIP, LGRIB)
!
! INTEGER, INTENT(IN ) :: LUGB, ISEEK, MSEEK
! INTEGER, INTENT( OUT) :: LSKIP, LGRIB
!
! SUBPROGRAM: SEARCH FOR NEXT GRIB MESSAGE
! PRGMMR: IREDELL ORG: W/NMC23 DATE: 93-11-22
!
! ABSTRACT: THIS SUBPROGRAM SEARCHES A FILE FOR THE NEXT GRIB 1 MESSAGE.
! A GRIB 1 MESSAGE IS IDENTIFIED BY ITS INDICATOR SECTION, I.E.
! AN 8-BYTE SEQUENCE WITH 'GRIB' IN BYTES 1-4 AND 1 IN BYTE 8.
! IF FOUND, THE LENGTH OF THE MESSAGE IS DECODED FROM BYTES 5-7.
! THE SEARCH IS DONE OVER A GIVEN SECTION OF THE FILE.
! THE SEARCH IS TERMINATED IF AN EOF OR I/O ERROR IS ENCOUNTERED.
!
! PROGRAM HISTORY LOG:
! 93-11-22 IREDELL
! 95-10-31 IREDELL ADD CALL TO BAREAD
! 97-03-14 IREDELL CHECK FOR '7777'
! 2001-12-05 GILBERT MODIFIED TO ALSO LOOK FOR GRIB2 MESSAGES
! 2009-12-14 VUONG MODIFIED TO INCREASE LENGTH OF SEEK (512)
!
! USAGE: CALL NG_SKGB2SKGB2(LUGB,ISEEK,MSEEK,LSKIP,LGRIB)
! INPUT ARGUMENTS:
! LUGB INTEGER LOGICAL UNIT OF INPUT GRIB FILE
! ISEEK INTEGER NUMBER OF BYTES TO SKIP BEFORE SEARCH
! MSEEK INTEGER MAXIMUM NUMBER OF BYTES TO SEARCH
! OUTPUT ARGUMENTS:
! LSKIP INTEGER NUMBER OF BYTES TO SKIP BEFORE MESSAGE
! LGRIB INTEGER NUMBER OF BYTES IN MESSAGE (0 IF NOT FOUND)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_IXGB2(LUGB, LSKIP, LGRIB, CBUF, NUMFLD, MLEN, IRET)
!
! INTEGER, INTENT(IN ) :: LUGB, LSKIP, LGRIB
! CHARACTER(1), POINTER :: CBUF(:)
! INTEGER, INTENT( OUT) :: NUMFLD, MLEN, IRET
!
! SUBPROGRAM: MAKE INDEX RECORDS FOR FIELDS IN A GRIB2 MESSAGE
! PRGMMR: GILBERT ORG: W/NP11 DATE: 2001-12-10
!
! ABSTRACT: THIS SUBPROGRAM GENERATES AN INDEX RECORD FOR EACH FIELD IN A
! GRIB2 MESSAGE. THE INDEX RECORDS ARE WRITTEN TO INDEX BUFFER
! POINTED TO BY CBUF.
!
! EACH INDEX RECORD HAS THE FOLLOWING FORM:
! BYTE 001 - 004: LENGTH OF INDEX RECORD
! BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
! BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
! SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
! BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
! BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
! BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
! BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
! BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
! BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
! BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
! BYTE 042 - 042: MESSAGE DISCIPLINE
! BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
! BYTE 045 - II: IDENTIFICATION SECTION (IDS)
! BYTE II+1- JJ: GRID DEFINITION SECTION (GDS)
! BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS)
! BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS)
! BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
!
! PROGRAM HISTORY LOG:
! 95-10-31 IREDELL
! 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
! 2001-12-10 GILBERT MODIFIED FROM IXGB TO CREATE GRIB2 INDEXES
! 2002-01-31 GILBERT ADDED IDENTIFICATION SECTION TO INDEX RECORD
!
! USAGE: CALL NG_IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET)
! INPUT ARGUMENTS:
! LUGB INTEGER LOGICAL UNIT OF INPUT GRIB FILE
! LSKIP INTEGER NUMBER OF BYTES TO SKIP BEFORE GRIB MESSAGE
! LGRIB INTEGER NUMBER OF BYTES IN GRIB MESSAGE
! OUTPUT ARGUMENTS:
! CBUF CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS.
! USERS SHOULD FREE MEMORY THAT CBUF POINTS TO
! USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED.
! NUMFLD INTEGER NUMBER OF INDEX RECORDS CREATED.
! = 0, IF PROBLEMS
! MLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
! IRET INTEGER RETURN CODE
! =0, ALL OK
! =1, NOT ENOUGH MEMORY TO ALLOCATE INITIAL INDEX BUFFER
! =2, I/O ERROR IN READ
! =3, GRIB MESSAGE IS NOT EDITION 2
! =4, NOT ENOUGH MEMORY TO ALLOCATE EXTENT TO INDEX BUFFER
! =5, UNIDENTIFIED GRIB SECTION ENCOUNTERED...PROBLEM
! SOMEWHERE.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GETGB2(LUGB, LUGI, J, JDISC, JIDS, JPDTN, JPDT, JGDTN,&
! JGDT, UNPACK, K, GFLD, IRET)
!
! INTEGER, INTENT(IN ) :: LUGB, LUGI, J, JDISC, JPDTN, JGDTN
! INTEGER, INTENT(IN ) :: JIDS(*), JPDT(*), JGDT(*)
! LOGICAL, INTENT(IN ) :: UNPACK
! INTEGER, INTENT( OUT) :: K, IRET
! TYPE(GRIBFIELD) :: GFLD
!
! SUBPROGRAM: FINDS AND UNPACKS A GRIB MESSAGE
! PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01
!
! ABSTRACT: FIND AND UNPACK A GRIB MESSAGE.
! READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF)
! TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE.
! FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB FIELD REQUESTED.
! THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF FIELDS TO SKIP
! AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND
! PRODUCT DEFINTION SECTION PARAMETERS. (A REQUESTED PARAMETER
! OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.)
! IF THE REQUESTED GRIB FIELD IS FOUND, THEN IT IS READ FROM THE
! GRIB FILE AND UNPACKED. ITS NUMBER IS RETURNED ALONG WITH
! THE ASSOCIATED UNPACKED PARAMETERS. THE BITMAP (IF ANY),
! AND THE DATA VALUES ARE UNPACKED ONLY IF ARGUMENT "UNPACK" IS SET TO
! TRUE. IF THE GRIB FIELD IS NOT FOUND, THEN THE
! RETURN CODE WILL BE NONZERO.
!
! The decoded information for the selected GRIB field
! is returned in a derived type variable, gfld.
! Gfld is of type gribfield, which is defined
! in module grib_mod, so users of this routine will need to include
! the line "USE GRIB_MOD" in their calling routine. Each component of the
! gribfield type is described in the OUTPUT ARGUMENT LIST section below.
!
! PROGRAM HISTORY LOG:
! 94-04-01 IREDELL
! 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS
! AND ALLOWED FOR UNSPECIFIED INDEX FILE
! 2002-01-11 GILBERT MODIFIED FROM GETGB AND GETGBM TO WORK WITH GRIB2
! 2015-11-10 VUONG MODIFIED DOC BLOCK FOR gfld%ngrdpts and gfld%ndpts
!
! USAGE: CALL NG_GETGB2(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT,
! & UNPACK,K,GFLD,IRET)
! INPUT ARGUMENTS:
! LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
! FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING
! THIS ROUTINE.
! LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE.
! IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE
! CALLING THIS ROUTINE.
! >0 - READ INDEX FROM INDEX FILE LUGI, IF INDEX DOESN"T
! ALREADY EXIST.
! =0 - TO GET INDEX BUFFER FROM THE GRIB FILE, IF INDEX
! DOESN"T ALREADY EXIST.
! <0 - FORCE REREAD OF INDEX FROM INDEX FILE ABS(LUGI).
! =LUGB - FORCE REGENERATION OF INDEX FROM GRIB2 FILE LUGB.
! J INTEGER NUMBER OF FIELDS TO SKIP
! (=0 TO SEARCH FROM BEGINNING)
! JDISC GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD
! ( IF = -1, ACCEPT ANY DISCIPLINE)
! ( SEE CODE TABLE 0.0 )
! 0 - Meteorological products
! 1 - Hydrological products
! 2 - Land surface products
! 3 - Space products
! 10 - Oceanographic products
! JIDS() INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION
! (=-9999 FOR WILDCARD)
! JIDS(1) = IDENTIFICATION OF ORIGINATING CENTRE
! ( SEE COMMON CODE TABLE C-1 )
! JIDS(2) = IDENTIFICATION OF ORIGINATING SUB-CENTRE
! JIDS(3) = GRIB MASTER TABLES VERSION NUMBER
! ( SEE CODE TABLE 1.0 )
! 0 - Experimental
! 1 - Initial operational version number
! JIDS(4) = GRIB LOCAL TABLES VERSION NUMBER
! ( SEE CODE TABLE 1.1 )
! 0 - Local tables not used
! 1-254 - Number of local tables version used
! JIDS(5) = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2)
! 0 - Analysis
! 1 - Start of forecast
! 2 - Verifying time of forecast
! 3 - Observation time
! JIDS(6) = YEAR ( 4 DIGITS )
! JIDS(7) = MONTH
! JIDS(8) = DAY
! JIDS(9) = HOUR
! JIDS(10) = MINUTE
! JIDS(11) = SECOND
! JIDS(12) = PRODUCTION STATUS OF PROCESSED DATA
! ( SEE CODE TABLE 1.3 )
! 0 - Operational products
! 1 - Operational test products
! 2 - Research products
! 3 - Re-analysis products
! JIDS(13) = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 )
! 0 - Analysis products
! 1 - Forecast products
! 2 - Analysis and forecast products
! 3 - Control forecast products
! 4 - Perturbed forecast products
! 5 - Control and perturbed forecast products
! 6 - Processed satellite observations
! 7 - Processed radar observations
! JPDTN INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N)
! ( IF = -1, DON'T BOTHER MATCHING PDT - ACCEPT ANY )
! JPDT() INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION
! TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH
! (=-9999 FOR WILDCARD)
! JGDTN INTEGER GRID DEFINITION TEMPLATE NUMBER (M)
! ( IF = -1, DON'T BOTHER MATCHING GDT - ACCEPT ANY )
! JGDT() INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION
! TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH
! (=-9999 FOR WILDCARD)
! UNPACK LOGICAL VALUE INDICATING WHETHER TO UNPACK BITMAP/DATA
! .TRUE. = UNPACK BITMAP AND DATA VALUES
! .FALSE. = DO NOT UNPACK BITMAP AND DATA VALUES
!
! OUTPUT ARGUMENTS:
! K INTEGER FIELD NUMBER UNPACKED
! gfld - derived type gribfield ( defined in module grib_mod )
! ( NOTE: See Remarks Section )
! gfld%version = GRIB edition number ( currently 2 )
! gfld%discipline = Message Discipline ( see Code Table 0.0 )
! gfld%idsect() = Contains the entries in the Identification
! Section ( Section 1 )
! This element is actually a pointer to an array
! that holds the data.
! gfld%idsect(1) = Identification of originating Centre
! ( see Common Code Table C-1 )
! 7 - US National Weather Service
! gfld%idsect(2) = Identification of originating Sub-centre
! gfld%idsect(3) = GRIB Master Tables Version Number
! ( see Code Table 1.0 )
! 0 - Experimental
! 1 - Initial operational version number
! gfld%idsect(4) = GRIB Local Tables Version Number
! ( see Code Table 1.1 )
! 0 - Local tables not used
! 1-254 - Number of local tables version used
! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2)
! 0 - Analysis
! 1 - Start of forecast
! 2 - Verifying time of forecast
! 3 - Observation time
! gfld%idsect(6) = Year ( 4 digits )
! gfld%idsect(7) = Month
! gfld%idsect(8) = Day
! gfld%idsect(9) = Hour
! gfld%idsect(10) = Minute
! gfld%idsect(11) = Second
! gfld%idsect(12) = Production status of processed data
! ( see Code Table 1.3 )
! 0 - Operational products
! 1 - Operational test products
! 2 - Research products
! 3 - Re-analysis products
! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 )
! 0 - Analysis products
! 1 - Forecast products
! 2 - Analysis and forecast products
! 3 - Control forecast products
! 4 - Perturbed forecast products
! 5 - Control and perturbed forecast products
! 6 - Processed satellite observations
! 7 - Processed radar observations
! gfld%idsectlen = Number of elements in gfld%idsect().
! gfld%local() = Pointer to character array containing contents
! of Local Section 2, if included
! gfld%locallen = length of array gfld%local()
! gfld%ifldnum = field number within GRIB message
! gfld%griddef = Source of grid definition (see Code Table 3.0)
! 0 - Specified in Code table 3.1
! 1 - Predetermined grid Defined by originating centre
! gfld%ngrdpts = Number of grid points in the defined grid.
! Note that the number of actual data values returned from
! getgb2 (in gfld%ndpts) may be less than this value if a
! logical bitmap is in use with grid points that are being masked out.
! gfld%numoct_opt = Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! gfld%interp_opt = Interpretation of list for optional points
! definition. (Code Table 3.11)
! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
! gfld%igdtmpl() = Contains the data values for the specified Grid
! Definition Template ( NN=gfld%igdtnum ). Each
! element of this integer array contains an entry (in
! the order specified) of Grid Defintion Template 3.NN
! This element is actually a pointer to an array
! that holds the data.
! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of
! entries in Grid Defintion Template 3.NN
! ( NN=gfld%igdtnum ).
! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array
! contains the number of grid points contained in
! each row ( or column ). (part of Section 3)
! This element is actually a pointer to an array
! that holds the data. This pointer is nullified
! if gfld%numoct_opt=0.
! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined. This value
! is set to zero, if gfld%numoct_opt=0.
! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
! gfld%ipdtmpl() = Contains the data values for the specified Product
! Definition Template ( N=gfdl%ipdtnum ). Each element
! of this integer array contains an entry (in the
! order specified) of Product Defintion Template 4.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of
! entries in Product Defintion Template 4.N
! ( N=gfdl%ipdtnum ).
! gfld%coord_list() = Real array containing floating point values
! intended to document the vertical discretisation
! associated to model data on hybrid coordinate
! vertical levels. (part of Section 4)
! This element is actually a pointer to an array
! that holds the data.
! gfld%num_coord = number of values in array gfld%coord_list().
! gfld%ndpts = Number of data points unpacked and returned.
! Note that this number may be different from the value of
! gfld%ngrdpts if a logical bitmap is in use with grid points
! that are being masked out.
! gfld%idrtnum = Data Representation Template Number
! ( see Code Table 5.0)
! gfld%idrtmpl() = Contains the data values for the specified Data
! Representation Template ( N=gfld%idrtnum ). Each
! element of this integer array contains an entry
! (in the order specified) of Product Defintion
! Template 5.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number
! of entries in Data Representation Template 5.N
! ( N=gfld%idrtnum ).
! gfld%unpacked = logical value indicating whether the bitmap and
! data values were unpacked. If false,
! gfld%bmap and gfld%fld pointers are nullified.
! gfld%expanded = Logical value indicating whether the data field
! was expanded to the grid in the case where a
! bit-map is present. If true, the data points in
! gfld%fld match the grid points and "Missing_Value" were
! inserted at grid points where data was bit-mapped
! out. If false, the data values in gfld%fld were
! not expanded to the grid and are just a consecutive
! array of data points corresponding to each value of
! "1" in gfld%bmap.
! Note: You can call the routine "ng_gb2_missingvalue"
! to get "Missing_Value" used in CNCARG
! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
! gfld%bmap() = Logical*1 array containing decoded bitmap,
! if ibmap=0 or ibap=254. Otherwise nullified.
! This element is actually a pointer to an array
! that holds the data.
! gfld%fld() = Array of gfld%ndpts unpacked data points.
! This element is actually a pointer to an array
! that holds the data.
! IRET INTEGER RETURN CODE
! 0 ALL OK
! 96 ERROR READING INDEX
! 97 ERROR READING GRIB FILE
! 99 REQUEST NOT FOUND
! OTHER GF_GETFLD GRIB2 UNPACKER RETURN CODE
!
! REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED.
! DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
!
! Note that derived type gribfield contains pointers to many
! arrays of data. The memory for these arrays is allocated
! when the values in the arrays are set, to help minimize
! problems with array overloading. Because of this users
! are encouraged to free up this memory, when it is no longer
! needed, by an explicit call to subroutine gf_free.
! ( i.e. CALL GF_FREE(GFLD) )
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GETGB2P(LUGB, LUGI, J, JDISC, JIDS, JPDTN, JPDT, JGDTN,&
! JGDT, EXTRACT, K, GRIBM, LENG, IRET)
!
! INTEGER, INTENT(IN ) :: LUGB, LUGI, J, JDISC, JPDTN, JGDTN
! INTEGER, INTENT(IN ) :: JIDS(*),JPDT(*),JGDT(*)
! LOGICAL, INTENT(IN ) :: EXTRACT
! INTEGER, INTENT( OUT) :: K, IRET, LENG
! CHARACTER(1), POINTER :: GRIBM(:)
!
! SUBPROGRAM: FINDS AND EXTRACTS A GRIB MESSAGE
! PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01
!
! ABSTRACT: FIND AND EXTRACTS A GRIB MESSAGE FROM A FILE.
! READ A GRIB INDEX FILE (OR OPTIONALLY THE GRIB FILE ITSELF)
! TO GET THE INDEX BUFFER (I.E. TABLE OF CONTENTS) FOR THE GRIB FILE.
! FIND IN THE INDEX BUFFER A REFERENCE TO THE GRIB FIELD REQUESTED.
! THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF FIELDS TO SKIP
! AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND
! PRODUCT DEFINTION SECTION PARAMETERS. (A REQUESTED PARAMETER
! OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.)
! IF THE REQUESTED GRIB FIELD IS FOUND, THEN IT IS READ FROM THE
! GRIB FILE AND RETURNED.
! IF THE GRIB FIELD IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO.
!
! PROGRAM HISTORY LOG:
! 94-04-01 IREDELL
! 95-10-31 IREDELL MODULARIZED PORTIONS OF CODE INTO SUBPROGRAMS
! AND ALLOWED FOR UNSPECIFIED INDEX FILE
! 2002-01-11 GILBERT MODIFIED FROM GETGB AND GETGBM TO WORK WITH GRIB2
! 2003-12-17 GILBERT MODIFIED FROM GETGB2 TO RETURN PACKED GRIB2 MESSAGE.
!
! USAGE: CALL NG_GETGB2P(LUGB,LUGI,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,JGDT,
! & EXTRACT,K,GRIBM,LENG,IRET)
! INPUT ARGUMENTS:
! LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
! FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING
! THIS ROUTINE.
! LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE.
! IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE
! CALLING THIS ROUTINE.
! (=0 TO GET INDEX BUFFER FROM THE GRIB FILE)
! J INTEGER NUMBER OF FIELDS TO SKIP
! (=0 TO SEARCH FROM BEGINNING)
! JDISC GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD
! ( IF = -1, ACCEPT ANY DISCIPLINE)
! ( SEE CODE TABLE 0.0 )
! 0 - Meteorological products
! 1 - Hydrological products
! 2 - Land surface products
! 3 - Space products
! 10 - Oceanographic products
! JIDS() INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION
! (=-9999 FOR WILDCARD)
! JIDS(1) = IDENTIFICATION OF ORIGINATING CENTRE
! ( SEE COMMON CODE TABLE C-1 )
! JIDS(2) = IDENTIFICATION OF ORIGINATING SUB-CENTRE
! JIDS(3) = GRIB MASTER TABLES VERSION NUMBER
! ( SEE CODE TABLE 1.0 )
! 0 - Experimental
! 1 - Initial operational version number
! JIDS(4) = GRIB LOCAL TABLES VERSION NUMBER
! ( SEE CODE TABLE 1.1 )
! 0 - Local tables not used
! 1-254 - Number of local tables version used
! JIDS(5) = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2)
! 0 - Analysis
! 1 - Start of forecast
! 2 - Verifying time of forecast
! 3 - Observation time
! JIDS(6) = YEAR ( 4 DIGITS )
! JIDS(7) = MONTH
! JIDS(8) = DAY
! JIDS(9) = HOUR
! JIDS(10) = MINUTE
! JIDS(11) = SECOND
! JIDS(12) = PRODUCTION STATUS OF PROCESSED DATA
! ( SEE CODE TABLE 1.3 )
! 0 - Operational products
! 1 - Operational test products
! 2 - Research products
! 3 - Re-analysis products
! JIDS(13) = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 )
! 0 - Analysis products
! 1 - Forecast products
! 2 - Analysis and forecast products
! 3 - Control forecast products
! 4 - Perturbed forecast products
! 5 - Control and perturbed forecast products
! 6 - Processed satellite observations
! 7 - Processed radar observations
! JPDTN INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N)
! ( IF = -1, DON'T BOTHER MATCHING PDT - ACCEPT ANY )
! JPDT() INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION
! TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH
! (=-9999 FOR WILDCARD)
! JGDTN INTEGER GRID DEFINITION TEMPLATE NUMBER (M)
! ( IF = -1, DON'T BOTHER MATCHING GDT - ACCEPT ANY )
! JGDT() INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION
! TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH
! (=-9999 FOR WILDCARD)
! EXTRACT LOGICAL VALUE INDICATING WHETHER TO RETURN A GRIB2
! MESSAGE WITH JUST THE REQUESTED FIELD, OR THE ENTIRE
! GRIB2 MESSAGE CONTAINING THE REQUESTED FIELD.
! .TRUE. = RETURN GRIB2 MESSAGE CONTAINING ONLY THE REQUESTED
! FIELD.
! .FALSE. = RETURN ENTIRE GRIB2 MESSAGE CONTAINING THE
! REQUESTED FIELD.
!
! OUTPUT ARGUMENTS:
! K INTEGER FIELD NUMBER RETURNED.
! GRIBM RETURNED GRIB MESSAGE.
! LENG LENGTH OF RETURNED GRIB MESSAGE IN BYTES.
! IRET INTEGER RETURN CODE
! 0 ALL OK
! 96 ERROR READING INDEX FILE
! 97 ERROR READING GRIB FILE
! 99 REQUEST NOT FOUND
!
! REMARKS: SPECIFY AN INDEX FILE IF FEASIBLE TO INCREASE SPEED.
! DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
!
! Note that derived type gribfield contains pointers to many
! arrays of data. The memory for these arrays is allocated
! when the values in the arrays are set, to help minimize
! problems with array overloading. Because of this users
! are encouraged to free up this memory, when it is no longer
! needed, by an explicit call to subroutine gf_free.
! ( i.e. CALL GF_FREE(GFLD) )
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_gb_info(cgrib, lcgrib, listsec0, listsec1, numfields,&
! numlocal, maxlocal, ierr)
!
! INTEGER, INTENT(IN ) :: lcgrib
! CHARACTER(1), INTENT(IN ) :: cgrib(lcgrib)
! INTEGER, INTENT( OUT) :: listsec0(3), listsec1(13)
! INTEGER, INTENT( OUT) :: numlocal, numfields, maxlocal, ierr
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-25
!
! ABSTRACT: This subroutine searches through a GRIB2 message and
! returns the number of gridded fields found in the message and
! the number (and maximum size) of Local Use Sections.
! Also various checks are performed
! to see if the message is a valid GRIB2 message.
!
! PROGRAM HISTORY LOG:
! 2000-05-25 Gilbert
!
! USAGE: CALL ng_gb_info(cgrib,lcgrib,listsec0,listsec1,&
! numfields,numlocal,maxlocal,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array that contains the GRIB2 message
! lcgrib - Length (in bytes) of GRIB message in array cgrib.
!
! OUTPUT ARGUMENT LIST:
! listsec0 - Contains information decoded from GRIB Indicator Section 0.
! Must be dimensioned >= 2.
! listsec0(1)=Discipline-GRIB Master Table Number
! (see Code Table 0.0)
! listsec0(2)=GRIB Edition Number (currently 2)
! listsec0(3)=Length of GRIB message
! listsec1 - Contains information read from GRIB Identification Section 1.
! Must be dimensioned >= 13.
! listsec1(1)=Id of orginating centre (Common Code Table C-1)
! listsec1(2)=Id of orginating sub-centre (local table)
! listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0)
! listsec1(4)=GRIB Local Tables Version Number
! listsec1(5)=Significance of Reference Time (Code Table 1.1)
! listsec1(6)=Reference Time - Year (4 digits)
! listsec1(7)=Reference Time - Month
! listsec1(8)=Reference Time - Day
! listsec1(9)=Reference Time - Hour
! listsec1(10)=Reference Time - Minute
! listsec1(11)=Reference Time - Second
! listsec1(12)=Production status of data (Code Table 1.2)
! listsec1(13)=Type of processed data (Code Table 1.3)
! numfields- The number of gridded fieldse found in the GRIB message.
! numlocal - The number of Local Use Sections ( Section 2 ) found in
! the GRIB message.
! maxlocal- The size of the largest Local Use Section ( Section 2 ).
! Can be used to ensure that the return array passed
! to subroutine getlocal is dimensioned large enough.
! ierr - Error return code.
! 0 = no error
! 1 = Beginning characters "GRIB" not found.
! 2 = GRIB message is not Edition 2.
! 3 = Could not find Section 1, where expected.
! 4 = End string "7777" found, but not where expected.
! 5 = End string "7777" not found at end of message.
! 6 = Invalid section number found.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_gf_getfld(cgrib, lcgrib, ifldnum, unpack, expand, gfld, ierr)
!
! INTEGER, INTENT(IN ) :: lcgrib, ifldnum
! CHARACTER(1), INTENT(IN ) :: cgrib(lcgrib)
! LOGICAL, INTENT(IN ) :: unpack, expand
! TYPE(gribfield) :: gfld
! INTEGER, INTENT( OUT) :: ierr
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26
!
! ABSTRACT: This subroutine returns the Grid Definition, Product Definition,
! Bit-map ( if applicable ), and the unpacked data for a given data
! field. All of the information returned is stored in a derived
! type variable, gfld. Gfld is of type gribfield, which is defined
! in module grib_mod, so users of this routine will need to include
! the line "USE GRIB_MOD" in their calling routine. Each component of the
! gribfield type is described in the OUTPUT ARGUMENT LIST section below.
!
! Since there can be multiple data fields packed into a GRIB2
! message, the calling routine indicates which field is being requested
! with the ifldnum argument.
!
! PROGRAM HISTORY LOG:
! 2000-05-26 Gilbert
! 2002-01-24 Gilbert - Changed to pass back derived type gribfield
! variable through argument list, instead of
! having many different arguments.
! 2004-05-20 Gilbert - Added check to see if previous a bit-map is specified,
! but none was found.
! 2015-11-10 VUONG - MODIFIED DOC BLOCK FOR gfld%ngrdpts and gfld%ndpts
! 2015-10-29 Vuong - Initial all pointers in derive type gribfield
!
! USAGE: CALL ng_gf_getfld(cgrib,lcgrib,ifldnum,unpack,expand,gfld,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array that contains the GRIB2 message
! lcgrib - Length (in bytes) of GRIB message array cgrib.
! ifldnum - Specifies which field in the GRIB2 message to return.
! unpack - Logical value indicating whether to unpack bitmap/data
! .true. = unpack bitmap and data values
! .false. = do not unpack bitmap and data values
! expand - Boolean value indicating whether the data points should be
! expanded to the correspond grid, if a bit-map is present.
! 1 = if possible, expand data field to grid, inserting zero
! values at gridpoints that are bitmapped out.
! (SEE REMARKS2)
! 0 = do not expand data field, leaving it an array of
! consecutive data points for each "1" in the bitmap.
! This argument is ignored if unpack == 0 OR if the
! returned field does not contain a bit-map.
!
! OUTPUT ARGUMENT LIST:
! gfld - derived type gribfield ( defined in module grib_mod )
! ( NOTE: See Remarks Section )
! gfld%version = GRIB edition number ( currently 2 )
! gfld%discipline = Message Discipline ( see Code Table 0.0 )
! gfld%idsect() = Contains the entries in the Identification
! Section ( Section 1 )
! This element is actually a pointer to an array
! that holds the data.
! gfld%idsect(1) = Identification of originating Centre
! ( see Common Code Table C-1 )
! 7 - US National Weather Service
! gfld%idsect(2) = Identification of originating Sub-centre
! gfld%idsect(3) = GRIB Master Tables Version Number
! ( see Code Table 1.0 )
! 0 - Experimental
! 1 - Initial operational version number
! gfld%idsect(4) = GRIB Local Tables Version Number
! ( see Code Table 1.1 )
! 0 - Local tables not used
! 1-254 - Number of local tables version used
! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2)
! 0 - Analysis
! 1 - Start of forecast
! 2 - Verifying time of forecast
! 3 - Observation time
! gfld%idsect(6) = Year ( 4 digits )
! gfld%idsect(7) = Month
! gfld%idsect(8) = Day
! gfld%idsect(9) = Hour
! gfld%idsect(10) = Minute
! gfld%idsect(11) = Second
! gfld%idsect(12) = Production status of processed data
! ( see Code Table 1.3 )
! 0 - Operational products
! 1 - Operational test products
! 2 - Research products
! 3 - Re-analysis products
! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 )
! 0 - Analysis products
! 1 - Forecast products
! 2 - Analysis and forecast products
! 3 - Control forecast products
! 4 - Perturbed forecast products
! 5 - Control and perturbed forecast products
! 6 - Processed satellite observations
! 7 - Processed radar observations
! gfld%idsectlen = Number of elements in gfld%idsect().
! gfld%local() = Pointer to character array containing contents
! of Local Section 2, if included
! gfld%locallen = length of array gfld%local()
! gfld%ifldnum = field number within GRIB message
! gfld%griddef = Source of grid definition (see Code Table 3.0)
! 0 - Specified in Code table 3.1
! 1 - Predetermined grid Defined by originating centre
! gfld%ngrdpts = Number of grid points in the defined grid.
! Note that the number of actual data values returned from
! getgb2 (in gfld%ndpts) may be less than this value if a
! logical bitmap is in use with grid points that are being masked out.
! gfld%numoct_opt = Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! gfld%interp_opt = Interpretation of list for optional points
! definition. (Code Table 3.11)
! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
! gfld%igdtmpl() = Contains the data values for the specified Grid
! Definition Template ( NN=gfld%igdtnum ). Each
! element of this integer array contains an entry (in
! the order specified) of Grid Defintion Template 3.NN
! This element is actually a pointer to an array
! that holds the data.
! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of
! entries in Grid Defintion Template 3.NN
! ( NN=gfld%igdtnum ).
! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array
! contains the number of grid points contained in
! each row ( or column ). (part of Section 3)
! This element is actually a pointer to an array
! that holds the data. This pointer is nullified
! if gfld%numoct_opt=0.
! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined. This value
! is set to zero, if gfld%numoct_opt=0.
! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
! gfld%ipdtmpl() = Contains the data values for the specified Product
! Definition Template ( N=gfdl%ipdtnum ). Each element
! of this integer array contains an entry (in the
! order specified) of Product Defintion Template 4.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of
! entries in Product Defintion Template 4.N
! ( N=gfdl%ipdtnum ).
! gfld%coord_list() = Real array containing floating point values
! intended to document the vertical discretisation
! associated to model data on hybrid coordinate
! vertical levels. (part of Section 4)
! This element is actually a pointer to an array
! that holds the data.
! gfld%num_coord = number of values in array gfld%coord_list().
! gfld%ndpts = Number of data points unpacked and returned.
! Note that this number may be different from the value of
! gfld%ngrdpts if a logical bitmap is in use with grid points
! that are being masked out.
! gfld%idrtnum = Data Representation Template Number
! ( see Code Table 5.0)
! gfld%idrtmpl() = Contains the data values for the specified Data
! Representation Template ( N=gfld%idrtnum ). Each
! element of this integer array contains an entry
! (in the order specified) of Product Defintion
! Template 5.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number
! of entries in Data Representation Template 5.N
! ( N=gfld%idrtnum ).
! gfld%unpacked = logical value indicating whether the bitmap and
! data values were unpacked. If false,
! gfld%bmap and gfld%fld pointers are nullified.
! gfld%expanded = Logical value indicating whether the data field
! was expanded to the grid in the case where a
! bit-map is present. If true, the data points in
! gfld%fld match the grid points and "Missing_Value" were
! inserted at grid points where data was bit-mapped
! out. If false, the data values in gfld%fld were
! not expanded to the grid and are just a consecutive
! array of data points corresponding to each value of
! "1" in gfld%bmap.
! Note: You can call the routine "ng_gb2_missingvalue"
! to get "Missing_Value" used in CNCARG
! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
! gfld%bmap() = Logical*1 array containing decoded bitmap,
! if ibmap=0 or ibap=254. Otherwise nullified.
! This element is actually a pointer to an array
! that holds the data.
! gfld%fld() = Array of gfld%ndpts unpacked data points.
! This element is actually a pointer to an array
! that holds the data.
! ierr - Error return code.
! 0 = no error
! 1 = Beginning characters "GRIB" not found.
! 2 = GRIB message is not Edition 2.
! 3 = The data field request number was not positive.
! 4 = End string "7777" found, but not where expected.
! 6 = GRIB message did not contain the requested number of
! data fields.
! 7 = End string "7777" not found at end of message.
! 8 = Unrecognized Section encountered.
! 9 = Data Representation Template 5.NN not yet implemented.
! 15 = Error unpacking Section 1.
! 16 = Error unpacking Section 2.
! 10 = Error unpacking Section 3.
! 11 = Error unpacking Section 4.
! 12 = Error unpacking Section 5.
! 13 = Error unpacking Section 6.
! 14 = Error unpacking Section 7.
! 17 = Previous bitmap specified, but none exists.
!
! REMARKS: Note that derived type gribfield contains pointers to many
! arrays of data. The memory for these arrays is allocated
! when the values in the arrays are set, to help minimize
! problems with array overloading. Because of this users
! are encouraged to free up this memory, when it is no longer
! needed, by an explicit call to subroutine gf_free.
! ( i.e. CALL GF_FREE(GFLD) )
!
! Subroutine gb_info can be used to first determine
! how many data fields exist in a given GRIB message.
!
! REMARKS2: It may not always be possible to expand a bit-mapped data field.
! If a pre-defined bit-map is used and not included in the GRIB2
! message itself, this routine would not have the necessary
! information to expand the data. In this case, gfld%expanded would
! would be set to 0 (false), regardless of the value of input
! argument expand.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_gf_free(gfld)
!
! TYPE(gribfield) :: gfld
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26
!
! ABSTRACT: This subroutine frees up memory that was used to store
! array values in derived type gribfield.
!
! PROGRAM HISTORY LOG:
! 2000-05-26 Gilbert
! 2012-12-11 Vuong Initialize an undefine pointers
! 2015-10-29 Vuong Deallocate pointers in derived type gribfield
! 2015-11-10 VUONG MODIFIED DOC BLOCK FOR gfld%ngrdpts and gfld%ndpts
!
! USAGE: CALL ng_gf_free(gfld)
! INPUT ARGUMENT LIST:
! gfld - derived type gribfield ( defined in module grib_mod )
!
! OUTPUT ARGUMENT LIST:
! gfld - derived type gribfield ( defined in module grib_mod )
! gfld%version = GRIB edition number
! gfld%discipline = Message Discipline ( see Code Table 0.0 )
! gfld%idsect() = Contains the entries in the Identification
! Section ( Section 1 )
! This element is actually a pointer to an array
! that holds the data.
! gfld%idsect(1) = Identification of originating Centre
! ( see Common Code Table C-1 )
! gfld%idsect(2) = Identification of originating Sub-centre
! gfld%idsect(3) = GRIB Master Tables Version Number
! ( see Code Table 1.0 )
! gfld%idsect(4) = GRIB Local Tables Version Number
! ( see Code Table 1.1 )
! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2)
! gfld%idsect(6) = Year ( 4 digits )
! gfld%idsect(7) = Month
! gfld%idsect(8) = Day
! gfld%idsect(9) = Hour
! gfld%idsect(10) = Minute
! gfld%idsect(11) = Second
! gfld%idsect(12) = Production status of processed data
! ( see Code Table 1.3 )
! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 )
! gfld%idsectlen = Number of elements in gfld%idsect().
! gfld%local() = Pointer to character array containing contents
! of Local Section 2, if included
! gfld%locallen = length of array gfld%local()
! gfld%ifldnum = field number within GRIB message
! gfld%griddef = Source of grid definition (see Code Table 3.0)
! gfld%ngrdpts = Number of grid points in the defined grid.
! Note that the number of actual data values returned from
! getgb2 (in gfld%ndpts) may be less than this value if a
! logical bitmap is in use with grid points that are being masked out.
! gfld%numoct_opt = Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! gfld%interp_opt = Interpretation of list for optional points
! definition. (Code Table 3.11)
! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
! gfld%igdtmpl() = Contains the data values for the specified Grid
! Definition Template ( NN=gfld%igdtnum ). Each
! element of this integer array contains an entry (in
! the order specified) of Grid Defintion Template 3.NN
! This element is actually a pointer to an array
! that holds the data.
! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of
! entries in Grid Defintion Template 3.NN
! ( NN=gfld%igdtnum ).
! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array
! contains the number of grid points contained in
! each row ( or column ). (part of Section 3)
! This element is actually a pointer to an array
! that holds the data. This pointer is nullified
! if gfld%numoct_opt=0.
! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined. This value
! is set to zero, if gfld%numoct_opt=0.
! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
! gfld%ipdtmpl() = Contains the data values for the specified Product
! Definition Template ( N=gfdl%ipdtnum ). Each element
! of this integer array contains an entry (in the
! order specified) of Product Defintion Template 4.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of
! entries in Product Defintion Template 4.N
! ( N=gfdl%ipdtnum ).
! gfld%coord_list() = Real array containing floating point values
! intended to document the vertical discretisation
! associated to model data on hybrid coordinate
! vertical levels. (part of Section 4)
! This element is actually a pointer to an array
! that holds the data.
! gfld%num_coord = number of values in array gfld%coord_list().
! gfld%ndpts = Number of data points unpacked and returned.
! Note that this number may be different from the value of
! gfld%ngrdpts if a logical bitmap is in use with grid points
! that are being masked out.
! gfld%idrtnum = Data Representation Template Number
! ( see Code Table 5.0)
! gfld%idrtmpl() = Contains the data values for the specified Data
! Representation Template ( N=gfld%idrtnum ). Each
! element of this integer array contains an entry
! (in the order specified) of Product Defintion
! Template 5.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number
! of entries in Data Representation Template 5.N
! ( N=gfld%idrtnum ).
! gfld%unpacked = logical value indicating whether the bitmap and
! data values were unpacked. If false, gfld%ndpts
! is set to zero, and gfld%bmap and gfld%fld
! pointers are nullified.
! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
! gfld%bmap() - Logical*1 array containing decoded bitmap,
! if ibmap=0 or ibap=254. Otherwise nullified.
! This element is actually a pointer to an array
! that holds the data.
! gfld%fld() = Array of gfld%ndpts unpacked data points.
! This element is actually a pointer to an array
! that holds the data.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_gribinfo(cgrib, lcgrib, listsec0, listsec1, numlocal,&
! numfields, maxvals, ierr)
!
! INTEGER, INTENT(IN ) :: lcgrib
! CHARACTER(1), INTENT(IN ) :: cgrib(lcgrib)
! INTEGER, INTENT( OUT) :: listsec0(3), listsec1(13), maxvals(7)
! INTEGER, INTENT( OUT) :: numlocal, numfields, ierr
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-25
!
! ABSTRACT: This subroutine searches through a GRIB2 message and
! returns the number of Local Use Sections and number of gridded
! fields found in the message. It also performs various checks
! to see if the message is a valid GRIB2 message.
! Last, a list of safe array dimensions is returned for use in
! allocating return arrays from routines getlocal, gettemplates, and
! getfields. (See maxvals and REMARKS)
!
! PROGRAM HISTORY LOG:
! 2000-05-25 Gilbert
!
! USAGE: CALL ng_gribinfo(cgrib,lcgrib,listsec0,listsec1,&
! numlocal,numfields,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array that contains the GRIB2 message
! lcgrib - Length (in bytes) of GRIB message in array cgrib.
!
! OUTPUT ARGUMENT LIST:
! listsec0 - Contains information decoded from GRIB Indicator Section 0.
! Must be dimensioned >= 2.
! listsec0(1)=Discipline-GRIB Master Table Number
! (see Code Table 0.0)
! listsec0(2)=GRIB Edition Number (currently 2)
! listsec0(3)=Length of GRIB message
! listsec1 - Contains information read from GRIB Identification Section 1.
! Must be dimensioned >= 13.
! listsec1(1)=Id of orginating centre (Common Code Table C-1)
! listsec1(2)=Id of orginating sub-centre (local table)
! listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0)
! listsec1(4)=GRIB Local Tables Version Number
! listsec1(5)=Significance of Reference Time (Code Table 1.1)
! listsec1(6)=Reference Time - Year (4 digits)
! listsec1(7)=Reference Time - Month
! listsec1(8)=Reference Time - Day
! listsec1(9)=Reference Time - Hour
! listsec1(10)=Reference Time - Minute
! listsec1(11)=Reference Time - Second
! listsec1(12)=Production status of data (Code Table 1.2)
! listsec1(13)=Type of processed data (Code Table 1.3)
! numlocal - The number of Local Use Sections ( Section 2 ) found in
! the GRIB message.
! numfields- The number of gridded fieldse found in the GRIB message.
! maxvals()- The maximum number of elements that could be returned
! in various arrays from this GRIB2 message. (see REMARKS)
! maxvals(1)=max length of local section 2 (for getlocal)
! maxvals(2)=max length of GDS Template (for gettemplates
! and getfield)
! maxvals(3)=max length of GDS Optional list (for getfield)
! maxvals(4)=max length of PDS Template (for gettemplates
! and getfield)
! maxvals(5)=max length of PDS Optional list (for getfield)
! maxvals(6)=max length of DRS Template (for gettemplates
! and getfield)
! maxvals(7)=max number of gridpoints (for getfield)
! ierr - Error return code.
! 0 = no error
! 1 = Beginning characters "GRIB" not found.
! 2 = GRIB message is not Edition 2.
! 3 = Could not find Section 1, where expected.
! 4 = End string "7777" found, but not where expected.
! 5 = End string "7777" not found at end of message.
!
! REMARKS: Array maxvals contains the maximum possible
! number of values that will be returned in argument arrays
! for routines getlocal, gettemplates, and getfields.
! Users can use this info to determine if their arrays are
! dimensioned large enough for the data that may be returned
! from the above routines, or to dynamically allocate arrays
! with a reasonable size.
! NOTE that the actual number of values in these arrays is returned
! from the routines and will likely be less than the values
! calculated by this routine.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_getlocal(cgrib, lcgrib, localnum, csec2, lcsec2, ierr)
!
! INTEGER, INTENT(IN ) :: lcgrib, localnum
! CHARACTER(1), INTENT(IN ) :: cgrib(lcgrib)
! CHARACTER(1), INTENT( OUT) :: csec2(*)
! INTEGER, INTENT( OUT) :: lcsec2, ierr
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-25
!
! ABSTRACT: This subroutine returns the contents of Section 2 ( Local
! Use Section ) from a GRIB2 message. Since there can be multiple
! occurrences of Section 2 within a GRIB message, the calling routine
! indicates which occurrence is being requested with the localnum argument.
!
! PROGRAM HISTORY LOG:
! 2000-05-25 Gilbert
!
! USAGE: CALL ng_getlocal(cgrib,lcgrib,localnum,csec2,lcsec2,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array that contains the GRIB2 message
! lcgrib - Length (in bytes) of GRIB message in array cgrib.
! localnum - The nth occurrence of Section 2 requested.
!
! OUTPUT ARGUMENT LIST:
! csec2 - Character array containing information read from
! Section 2.
! The dimension of this array can be obtained in advance
! from argument maxlocal, which is returned from subroutine
! gb_info.
! lcsec2 - Number of bytes of character array csec2 read from
! Section 2.
! ierr - Error return code.
! 0 = no error
! 1 = Beginning characters "GRIB" not found.
! 2 = GRIB message is not Edition 2.
! 3 = The section 2 request number was not positive.
! 4 = End string "7777" found, but not where expected.
! 5 = End string "7777" not found at end of message.
! 6 = GRIB message did not contain the requested number of
! Local Use Sections.
!
! REMARKS: Note that subroutine gb_info can be used to first determine
! how many Local Use sections exist in a given GRIB message.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_gettemplates(cgrib, lcgrib, ifldnum, igds, igdstmpl,&
! igdslen, ideflist, idefnum, ipdsnum,&
! ipdstmpl, ipdslen, coordlist, numcoord,&
! ierr)
!
! INTEGER, INTENT(IN ) :: lcgrib, ifldnum
! CHARACTER(1), INTENT(IN ) :: cgrib(lcgrib)
! INTEGER, INTENT( OUT) :: igds(*), igdstmpl(*), ideflist(*)
! INTEGER, INTENT( OUT) :: ipdsnum, ipdstmpl(*)
! INTEGER, INTENT( OUT) :: idefnum, numcoord
! INTEGER, INTENT( OUT) :: ipdslen, igdslen, ierr
! REAL, INTENT( OUT) :: coordlist(*)
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26
!
! ABSTRACT: This subroutine returns the Grid Definition, and
! Product Definition for a given data
! field. Since there can be multiple data fields packed into a GRIB2
! message, the calling routine indicates which field is being requested
! with the ifldnum argument.
!
! PROGRAM HISTORY LOG:
! 2000-05-26 Gilbert
!
! USAGE: CALL ng_gettemplates(cgrib,lcgrib,ifldnum,igds,igdstmpl,igdslen,&
! ideflist,idefnum,ipdsnum,ipdstmpl,ipdslen,&
! coordlist,numcoord,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array that contains the GRIB2 message
! lcgrib - Length (in bytes) of GRIB message array cgrib.
! ifldnum - Specifies which field in the GRIB2 message to return.
!
! OUTPUT ARGUMENT LIST:
! igds - Contains information read from the appropriate GRIB Grid
! Definition Section 3 for the field being returned.
! Must be dimensioned >= 5.
! igds(1)=Source of grid definition (see Code Table 3.0)
! igds(2)=Number of grid points in the defined grid.
! igds(3)=Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! igds(4)=Interpretation of list for optional points
! definition. (Code Table 3.11)
! igds(5)=Grid Definition Template Number (Code Table 3.1)
! igdstmpl - Contains the data values for the specified Grid Definition
! Template ( NN=igds(5) ). Each element of this integer
! array contains an entry (in the order specified) of Grid
! Defintion Template 3.NN
! A safe dimension for this array can be obtained in advance
! from maxvals(2), which is returned from subroutine gribinfo.
! igdslen - Number of elements in igdstmpl(). i.e. number of entries
! in Grid Defintion Template 3.NN ( NN=igds(5) ).
! ideflist - (Used if igds(3) .ne. 0) This array contains the
! number of grid points contained in each row ( or column ).
! (part of Section 3)
! A safe dimension for this array can be obtained in advance
! from maxvals(3), which is returned from subroutine gribinfo.
! idefnum - (Used if igds(3) .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined.
! ipdsnum - Product Definition Template Number ( see Code Table 4.0)
! ipdstmpl - Contains the data values for the specified Product Definition
! Template ( N=ipdsnum ). Each element of this integer
! array contains an entry (in the order specified) of Product
! Defintion Template 4.N
! A safe dimension for this array can be obtained in advance
! from maxvals(4), which is returned from subroutine gribinfo.
! ipdslen - Number of elements in ipdstmpl(). i.e. number of entries
! in Product Defintion Template 4.N ( N=ipdsnum ).
! coordlist- Array containg floating point values intended to document
! the vertical discretisation associated to model data
! on hybrid coordinate vertical levels. (part of Section 4)
! The dimension of this array can be obtained in advance
! from maxvals(5), which is returned from subroutine gribinfo.
! numcoord - number of values in array coordlist.
! ierr - Error return code.
! 0 = no error
! 1 = Beginning characters "GRIB" not found.
! 2 = GRIB message is not Edition 2.
! 3 = The data field request number was not positive.
! 4 = End string "7777" found, but not where expected.
! 6 = GRIB message did not contain the requested number of
! data fields.
! 7 = End string "7777" not found at end of message.
! 10 = Error unpacking Section 3.
! 11 = Error unpacking Section 4.
!
! REMARKS: Note that subroutine gribinfo can be used to first determine
! how many data fields exist in the given GRIB message.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_getfield(cgrib, lcgrib, ifldnum, igds, igdstmpl,igdslen,&
! ideflist, idefnum, ipdsnum, ipdstmpl, ipdslen,&
! coordlist, numcoord, ndpts, idrsnum, idrstmpl,&
! idrslen, ibmap, bmap, fld, ierr)
!
! INTEGER, INTENT(IN ) :: lcgrib, ifldnum
! CHARACTER(1), INTENT(IN ) :: cgrib(lcgrib)
! INTEGER, INTENT( OUT) :: igds(*), igdstmpl(*), ideflist(*)
! INTEGER, INTENT( OUT) :: ipdsnum, ipdstmpl(*)
! INTEGER, INTENT( OUT) :: idrsnum, idrstmpl(*)
! INTEGER, INTENT( OUT) :: ndpts, ibmap, idefnum, numcoord
! INTEGER, INTENT( OUT) :: idrslen, ipdslen, igdslen, ierr
! LOGICAL*1, INTENT( OUT) :: bmap(*)
! REAL, INTENT( OUT) :: fld(*), coordlist(*)
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26
!
! ABSTRACT: This subroutine returns the Grid Definition, Product Definition,
! Bit-map ( if applicable ), and the unpacked data for a given data
! field. Since there can be multiple data fields packed into a GRIB2
! message, the calling routine indicates which field is being requested
! with the ifldnum argument.
!
! PROGRAM HISTORY LOG:
! 2000-05-26 Gilbert
!
! USAGE: CALL ng_getfield(cgrib,lcgrib,ifldnum,igds,igdstmpl,igdslen,&
! ideflist,idefnum,ipdsnum,ipdstmpl,ipdslen,&
! coordlist,numcoord,ndpts,idrsnum,idrstmpl,&
! idrslen,ibmap,bmap,fld,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array that contains the GRIB2 message
! lcgrib - Length (in bytes) of GRIB message array cgrib.
! ifldnum - Specifies which field in the GRIB2 message to return.
!
! OUTPUT ARGUMENT LIST:
! igds - Contains information read from the appropriate GRIB Grid
! Definition Section 3 for the field being returned.
! Must be dimensioned >= 5.
! igds(1)=Source of grid definition (see Code Table 3.0)
! igds(2)=Number of grid points in the defined grid.
! igds(3)=Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! igds(4)=Interpretation of list for optional points
! definition. (Code Table 3.11)
! igds(5)=Grid Definition Template Number (Code Table 3.1)
! igdstmpl - Contains the data values for the specified Grid Definition
! Template ( NN=igds(5) ). Each element of this integer
! array contains an entry (in the order specified) of Grid
! Defintion Template 3.NN
! A safe dimension for this array can be obtained in advance
! from maxvals(2), which is returned from subroutine gribinfo.
! igdslen - Number of elements in igdstmpl(). i.e. number of entries
! in Grid Defintion Template 3.NN ( NN=igds(5) ).
! ideflist - (Used if igds(3) .ne. 0) This array contains the
! number of grid points contained in each row ( or column ).
! (part of Section 3)
! A safe dimension for this array can be obtained in advance
! from maxvals(3), which is returned from subroutine gribinfo.
! idefnum - (Used if igds(3) .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined.
! ipdsnum - Product Definition Template Number ( see Code Table 4.0)
! ipdstmpl - Contains the data values for the specified Product Definition
! Template ( N=ipdsnum ). Each element of this integer
! array contains an entry (in the order specified) of Product
! Defintion Template 4.N
! A safe dimension for this array can be obtained in advance
! from maxvals(4), which is returned from subroutine gribinfo.
! ipdslen - Number of elements in ipdstmpl(). i.e. number of entries
! in Product Defintion Template 4.N ( N=ipdsnum ).
! coordlist- Array containg floating point values intended to document
! the vertical discretisation associated to model data
! on hybrid coordinate vertical levels. (part of Section 4)
! The dimension of this array can be obtained in advance
! from maxvals(5), which is returned from subroutine gribinfo.
! numcoord - number of values in array coordlist.
! ndpts - Number of data points unpacked and returned.
! idrsnum - Data Representation Template Number ( see Code Table 5.0)
! idrstmpl - Contains the data values for the specified Data Representation
! Template ( N=idrsnum ). Each element of this integer
! array contains an entry (in the order specified) of Product
! Defintion Template 5.N
! A safe dimension for this array can be obtained in advance
! from maxvals(6), which is returned from subroutine gribinfo.
! idrslen - Number of elements in idrstmpl(). i.e. number of entries
! in Data Representation Template 5.N ( N=idrsnum ).
! ibmap - Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
! bmap() - Logical*1 array containing decoded bitmap. ( if ibmap=0 )
! The dimension of this array can be obtained in advance
! from maxvals(7), which is returned from subroutine gribinfo.
! fld() - Array of ndpts unpacked data points.
! A safe dimension for this array can be obtained in advance
! from maxvals(7), which is returned from subroutine gribinfo.
! ierr - Error return code.
! 0 = no error
! 1 = Beginning characters "GRIB" not found.
! 2 = GRIB message is not Edition 2.
! 3 = The data field request number was not positive.
! 4 = End string "7777" found, but not where expected.
! 6 = GRIB message did not contain the requested number of
! data fields.
! 7 = End string "7777" not found at end of message.
! 9 = Data Representation Template 5.NN not yet implemented.
! 10 = Error unpacking Section 3.
! 11 = Error unpacking Section 4.
! 12 = Error unpacking Section 5.
! 13 = Error unpacking Section 6.
! 14 = Error unpacking Section 7.
!
! REMARKS: Note that subroutine gribinfo can be used to first determine
! how many data fields exist in a given GRIB message.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GETIDX(LUGB, LUGI, CINDEX, NLEN, NNUM, IRET)
!
! INTEGER, INTENT(IN ) :: LUGB, LUGI
! INTEGER, INTENT( OUT) :: NLEN, NNUM, IRET
! CHARACTER(1), POINTER :: CINDEX(:)
!
! SUBPROGRAM: FINDS, READS OR GENERATES A GRIB2 INDEX
! PRGMMR: GILBERT ORG: W/NP11 DATE: 2005-03-15
!
! ABSTRACT: FINDS, READS OR GENERATES A GRIB2 INDEX FOR THE GRIB2 FILE
! ASSOCIATED WITH UNIT LUGB. IF THE INDEX ALREADY EXISTS, IT IS RETURNED.
! OTHERWISE, THE INDEX IS (1) READ FROM AN EXISTING INDEXFILE ASSOCIATED WITH
! UNIT LUGI. OR (2) GENERATED FROM THE GRIB2FILE LUGB ( IF LUGI=0 ).
! USERS CAN FORCE A REGENERATION OF AN INDEX. IF LUGI EQUALS LUGB, THE INDEX
! WILL BE REGENERATED FROM THE DATA IN FILE LUGB. IF LUGI IS LESS THAN
! ZERO, THEN THE INDEX IS RE READ FROM INDEX FILE ABS(LUGI).
!
! PROGRAM HISTORY LOG:
! 2005-03-15 GILBERT
! 2009-07-09 VUONG Fixed bug for checking (LUGB) unit index file
! 2013-08-02 VUONG Removed SAVE and initial index buffer
! 2016-03-29 VUONG Restore original getidx.f from version 1.2.3
! Modified GETIDEX to allow to open range of unit file number up to 9999
! Added new parameters and new Product Definition Template
! numbers: 4.60, 4.61
!
! USAGE: CALL NG_GETIDX(LUGB,LUGI,CINDEX,NLEN,NNUM,IRET)
!
! INPUT ARGUMENTS:
! LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
! FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING
! THIS ROUTINE.
! LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE.
! IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE
! CALLING THIS ROUTINE.
! >0 - READ INDEX FROM INDEX FILE LUGI, IF INDEX DOESN"T
! ALREADY EXIST.
! =0 - TO GET INDEX BUFFER FROM THE GRIB FILE, IF INDEX
! DOESN"T ALREADY EXIST.
! <0 - FORCE REREAD OF INDEX FROM INDEX FILE ABS(LUGI).
! =LUGB - FORCE REGENERATION OF INDEX FROM GRIB2 FILE LUGB.
!
! OUTPUT ARGUMENTS:
! CINDEX CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS.
! NLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
! NNUM INTEGER NUMBER OF INDEX RECORDS
! IRET INTEGER RETURN CODE
! 0 ALL OK
! 90 UNIT NUMBER OUT OF RANGE
! 96 ERROR READING/CREATING INDEX FILE
!
! REMARKS:
! - Allow file unit numbers in range 0 - 9999
! the grib index will automatically generate the index file.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GETGB2L(LUGB, CINDEX, GFLD, IRET)
!
! INTEGER, INTENT(IN ) :: LUGB
! CHARACTER(1), INTENT(IN ) :: CINDEX(*)
! TYPE(GRIBFIELD) :: GFLD
! INTEGER, INTENT( OUT) :: IRET
!
! SUBPROGRAM: EXTRACTS LOCAL USE SECTION
! PRGMMR: GILBERT ORG: W/NP11 DATE: 02-05-07
!
! ABSTRACT: READ AND UNPACK A LOCAL USE SECTION FROM A GRIB2 MESSAGE.
!
! The decoded information for the selected GRIB field
! is returned in a derived type variable, gfld.
! Gfld is of type gribfield, which is defined
! in module grib_mod, so users of this routine will need to include
! the line "USE GRIB_MOD" in their calling routine. Each component of the
! gribfield type is described in the OUTPUT ARGUMENT LIST section below.
!
! PROGRAM HISTORY LOG:
! 2002-05-07 GILBERT
! 2015-11-10 VUONG - MODIFIED DOC BLOCK FOR gfld%ngrdpts and gfld%ndpts
!
! USAGE: CALL NG_GETGB2L(LUGB,CINDEX,GFLD,IRET)
! INPUT ARGUMENTS:
! LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE
! CINDEX INDEX RECORD OF THE GRIB FIELD ( SEE DOCBLOCK OF
! SUBROUTINE IXGB2 FOR DESCRIPTION OF AN INDEX RECORD.)
! OUTPUT ARGUMENTS:
! gfld - derived type gribfield ( defined in module grib_mod )
! ( NOTE: See Remarks Section )
! gfld%version = GRIB edition number ( currently 2 )
! gfld%discipline = Message Discipline ( see Code Table 0.0 )
! gfld%idsect() = Contains the entries in the Identification
! Section ( Section 1 )
! This element is actually a pointer to an array
! that holds the data.
! gfld%idsect(1) = Identification of originating Centre
! ( see Common Code Table C-1 )
! 7 - US National Weather Service
! gfld%idsect(2) = Identification of originating Sub-centre
! gfld%idsect(3) = GRIB Master Tables Version Number
! ( see Code Table 1.0 )
! 0 - Experimental
! 1 - Initial operational version number
! gfld%idsect(4) = GRIB Local Tables Version Number
! ( see Code Table 1.1 )
! 0 - Local tables not used
! 1-254 - Number of local tables version used
! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2)
! 0 - Analysis
! 1 - Start of forecast
! 2 - Verifying time of forecast
! 3 - Observation time
! gfld%idsect(6) = Year ( 4 digits )
! gfld%idsect(7) = Month
! gfld%idsect(8) = Day
! gfld%idsect(9) = Hour
! gfld%idsect(10) = Minute
! gfld%idsect(11) = Second
! gfld%idsect(12) = Production status of processed data
! ( see Code Table 1.3 )
! 0 - Operational products
! 1 - Operational test products
! 2 - Research products
! 3 - Re-analysis products
! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 )
! 0 - Analysis products
! 1 - Forecast products
! 2 - Analysis and forecast products
! 3 - Control forecast products
! 4 - Perturbed forecast products
! 5 - Control and perturbed forecast products
! 6 - Processed satellite observations
! 7 - Processed radar observations
! gfld%idsectlen = Number of elements in gfld%idsect().
! gfld%local() = Pointer to character array containing contents
! of Local Section 2, if included
! gfld%locallen = length of array gfld%local()
! gfld%ifldnum = field number within GRIB message
! gfld%griddef = Source of grid definition (see Code Table 3.0)
! 0 - Specified in Code table 3.1
! 1 - Predetermined grid Defined by originating centre
! gfld%ngrdpts = Number of grid points in the defined grid.
! Note that the number of actual data values returned from
! getgb2 (in gfld%ndpts) may be less than this value if a
! logical bitmap is in use with grid points that are being masked out.
! gfld%numoct_opt = Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! gfld%interp_opt = Interpretation of list for optional points
! definition. (Code Table 3.11)
! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
! gfld%igdtmpl() = Contains the data values for the specified Grid
! Definition Template ( NN=gfld%igdtnum ). Each
! element of this integer array contains an entry (in
! the order specified) of Grid Defintion Template 3.NN
! This element is actually a pointer to an array
! that holds the data.
! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of
! entries in Grid Defintion Template 3.NN
! ( NN=gfld%igdtnum ).
! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array
! contains the number of grid points contained in
! each row ( or column ). (part of Section 3)
! This element is actually a pointer to an array
! that holds the data. This pointer is nullified
! if gfld%numoct_opt=0.
! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined. This value
! is set to zero, if gfld%numoct_opt=0.
! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
! gfld%ipdtmpl() = Contains the data values for the specified Product
! Definition Template ( N=gfdl%ipdtnum ). Each element
! of this integer array contains an entry (in the
! order specified) of Product Defintion Template 4.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of
! entries in Product Defintion Template 4.N
! ( N=gfdl%ipdtnum ).
! gfld%coord_list() = Real array containing floating point values
! intended to document the vertical discretisation
! associated to model data on hybrid coordinate
! vertical levels. (part of Section 4)
! This element is actually a pointer to an array
! that holds the data.
! gfld%num_coord = number of values in array gfld%coord_list().
! gfld%ndpts = Number of data points unpacked and returned.
! Note that this number may be different from the value of
! gfld%ngrdpts if a logical bitmap is in use with grid points
! that are being masked out.
! gfld%idrtnum = Data Representation Template Number
! ( see Code Table 5.0)
! gfld%idrtmpl() = Contains the data values for the specified Data
! Representation Template ( N=gfld%idrtnum ). Each
! element of this integer array contains an entry
! (in the order specified) of Product Defintion
! Template 5.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number
! of entries in Data Representation Template 5.N
! ( N=gfld%idrtnum ).
! gfld%unpacked = logical value indicating whether the bitmap and
! data values were unpacked. If false,
! gfld%bmap and gfld%fld pointers are nullified.
! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
! gfld%bmap() = Logical*1 array containing decoded bitmap,
! if ibmap=0 or ibap=254. Otherwise nullified.
! This element is actually a pointer to an array
! that holds the data.
! gfld%fld() = Array of gfld%ndpts unpacked data points.
! This element is actually a pointer to an array
! that holds the data.
! IRET INTEGER RETURN CODE
! 0 ALL OK
! 97 ERROR READING GRIB FILE
! OTHER GF_GETFLD GRIB UNPACKER RETURN CODE
!
! REMARKS:
! DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
! THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY.
!
! Note that derived type gribfield contains pointers to many
! arrays of data. The memory for these arrays is allocated
! when the values in the arrays are set, to help minimize
! problems with array overloading. Because of this users
! are encouraged to free up this memory, when it is no longer
! needed, by an explicit call to subroutine gf_free.
! ( i.e. CALL GF_FREE(GFLD) )
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GETGB2S(CBUF, NLEN, NNUM, J, JDISC, JIDS, JPDTN, JPDT,&
! JGDTN, JGDT, K, GFLD, LPOS, IRET)
!
! INTEGER, INTENT(IN ) :: NLEN, NNUM, J, JDISC, JPDTN, JGDTN
! CHARACTER(1), INTENT(IN ) :: CBUF(NLEN) ! CHARACTER(1), POINTER :: CBUF(:)
! INTEGER, INTENT(IN ) :: JIDS(*), JPDT(*), JGDT(*)
! INTEGER, INTENT( OUT) :: K, LPOS, IRET
! TYPE(GRIBFIELD) :: GFLD
!
! SUBPROGRAM: FINDS A GRIB MESSAGE
! PRGMMR: GILBERT ORG: W/NP11 DATE: 02-01-15
!
! ABSTRACT: FIND A GRIB MESSAGE.
! FIND IN THE INDEX FILE A REFERENCE TO THE GRIB FIELD REQUESTED.
! THE GRIB FIELD REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP
! AND THE UNPACKED IDENTIFICATION SECTION, GRID DEFINITION TEMPLATE AND
! PRODUCT DEFINTION SECTION PARAMETERS. (A REQUESTED PARAMETER
! OF -9999 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.)
!
! EACH INDEX RECORD HAS THE FOLLOWING FORM:
! BYTE 001 - 004: LENGTH OF INDEX RECORD
! BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
! BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
! SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
! BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
! BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
! BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
! BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
! BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
! BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
! BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
! BYTE 042 - 042: MESSAGE DISCIPLINE
! BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
! BYTE 045 - II: IDENTIFICATION SECTION (IDS)
! BYTE II+1- JJ: GRID DEFINITION SECTION (GDS)
! BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS)
! BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS)
! BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
!
! Most of the decoded information for the selected GRIB field
! is returned in a derived type variable, gfld.
! Gfld is of type gribfield, which is defined
! in module grib_mod, so users of this routine will need to include
! the line "USE GRIB_MOD" in their calling routine. Each component of the
! gribfield type is described in the OUTPUT ARGUMENT LIST section below.
! Only the unpacked bitmap and data field components are not set by this
! routine.
!
! PROGRAM HISTORY LOG:
! 95-10-31 IREDELL
! 2002-01-02 GILBERT MODIFIED FROM GETG1S TO WORK WITH GRIB2
! 2011-06-24 VUONG BOI Initialize variable gfld%idsect and gfld%local
! 2015-11-10 VUONG MODIFIED DOC BLOCK FOR gfld%ngrdpts and gfld%ndpts
!
! USAGE: CALL NG_GETGB2S(CBUF,NLEN,NNUM,J,JDISC,JIDS,JPDTN,JPDT,JGDTN,&
! JGDT,K,GFLD,LPOS,IRET)
! INPUT ARGUMENTS:
! CBUF CHARACTER*1 (NLEN) BUFFER CONTAINING INDEX DATA
! NLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
! NNUM INTEGER NUMBER OF INDEX RECORDS
! J INTEGER NUMBER OF MESSAGES TO SKIP
! (=0 TO SEARCH FROM BEGINNING)
! JDISC GRIB2 DISCIPLINE NUMBER OF REQUESTED FIELD
! ( IF = -1, ACCEPT ANY DISCIPLINE)
! ( SEE CODE TABLE 0.0 )
! 0 - Meteorological products
! 1 - Hydrological products
! 2 - Land surface products
! 3 - Space products
! 10 - Oceanographic products
! JIDS() INTEGER ARRAY OF VALUES IN THE IDENTIFICATION SECTION
! (=-9999 FOR WILDCARD)
! JIDS(1) = IDENTIFICATION OF ORIGINATING CENTRE
! ( SEE COMMON CODE TABLE C-1 )
! JIDS(2) = IDENTIFICATION OF ORIGINATING SUB-CENTRE
! JIDS(3) = GRIB MASTER TABLES VERSION NUMBER
! ( SEE CODE TABLE 1.0 )
! 0 - Experimental
! 1 - Initial operational version number
! JIDS(4) = GRIB LOCAL TABLES VERSION NUMBER
! ( SEE CODE TABLE 1.1 )
! 0 - Local tables not used
! 1-254 - Number of local tables version used
! JIDS(5) = SIGNIFICANCE OF REFERENCE TIME (CODE TABLE 1.2)
! 0 - Analysis
! 1 - Start of forecast
! 2 - Verifying time of forecast
! 3 - Observation time
! JIDS(6) = YEAR ( 4 DIGITS )
! JIDS(7) = MONTH
! JIDS(8) = DAY
! JIDS(9) = HOUR
! JIDS(10) = MINUTE
! JIDS(11) = SECOND
! JIDS(12) = PRODUCTION STATUS OF PROCESSED DATA
! ( SEE CODE TABLE 1.3 )
! 0 - Operational products
! 1 - Operational test products
! 2 - Research products
! 3 - Re-analysis products
! JIDS(13) = TYPE OF PROCESSED DATA ( SEE CODE TABLE 1.4 )
! 0 - Analysis products
! 1 - Forecast products
! 2 - Analysis and forecast products
! 3 - Control forecast products
! 4 - Perturbed forecast products
! 5 - Control and perturbed forecast products
! 6 - Processed satellite observations
! 7 - Processed radar observations
! JPDTN INTEGER PRODUCT DEFINITION TEMPLATE NUMBER (N)
! ( IF = -1, DON'T BOTHER MATCHING PDT )
! JPDT() INTEGER ARRAY OF VALUES DEFINING THE PRODUCT DEFINITION
! TEMPLATE 4.N OF THE FIELD FOR WHICH TO SEARCH
! (=-9999 FOR WILDCARD)
! JGDTN INTEGER GRID DEFINITION TEMPLATE NUMBER (M)
! ( IF = -1, DON'T BOTHER MATCHING GDT )
! JGDT() INTEGER ARRAY OF VALUES DEFINING THE GRID DEFINITION
! TEMPLATE 3.M OF THE FIELD FOR WHICH TO SEARCH
! (=-9999 FOR WILDCARD)
! OUTPUT ARGUMENTS:
! K INTEGER MESSAGE NUMBER FOUND
! (CAN BE SAME AS J IN CALLING PROGRAM
! IN ORDER TO FACILITATE MULTIPLE SEARCHES)
! gfld - derived type gribfield ( defined in module grib_mod )
! ( NOTE: See Remarks Section )
! gfld%version = GRIB edition number ( currently 2 )
! gfld%discipline = Message Discipline ( see Code Table 0.0 )
! gfld%idsect() = Contains the entries in the Identification
! Section ( Section 1 )
! This element is actually a pointer to an array
! that holds the data.
! gfld%idsect(1) = Identification of originating Centre
! ( see Common Code Table C-1 )
! 7 - US National Weather Service
! gfld%idsect(2) = Identification of originating Sub-centre
! gfld%idsect(3) = GRIB Master Tables Version Number
! ( see Code Table 1.0 )
! 0 - Experimental
! 1 - Initial operational version number
! gfld%idsect(4) = GRIB Local Tables Version Number
! ( see Code Table 1.1 )
! 0 - Local tables not used
! 1-254 - Number of local tables version used
! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2)
! 0 - Analysis
! 1 - Start of forecast
! 2 - Verifying time of forecast
! 3 - Observation time
! gfld%idsect(6) = Year ( 4 digits )
! gfld%idsect(7) = Month
! gfld%idsect(8) = Day
! gfld%idsect(9) = Hour
! gfld%idsect(10) = Minute
! gfld%idsect(11) = Second
! gfld%idsect(12) = Production status of processed data
! ( see Code Table 1.3 )
! 0 - Operational products
! 1 - Operational test products
! 2 - Research products
! 3 - Re-analysis products
! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 )
! 0 - Analysis products
! 1 - Forecast products
! 2 - Analysis and forecast products
! 3 - Control forecast products
! 4 - Perturbed forecast products
! 5 - Control and perturbed forecast products
! 6 - Processed satellite observations
! 7 - Processed radar observations
! gfld%idsectlen = Number of elements in gfld%idsect().
! gfld%local() = Pointer to character array containing contents
! of Local Section 2, if included
! gfld%locallen = length of array gfld%local()
! gfld%ifldnum = field number within GRIB message
! gfld%griddef = Source of grid definition (see Code Table 3.0)
! 0 - Specified in Code table 3.1
! 1 - Predetermined grid Defined by originating centre
! gfld%ngrdpts = Number of grid points in the defined grid.
! Note that the number of actual data values returned from
! getgb2 (in gfld%ndpts) may be less than this value if a
! logical bitmap is in use with grid points that are being masked out.
! gfld%numoct_opt = Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! gfld%interp_opt = Interpretation of list for optional points
! definition. (Code Table 3.11)
! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
! gfld%igdtmpl() = Contains the data values for the specified Grid
! Definition Template ( NN=gfld%igdtnum ). Each
! element of this integer array contains an entry (in
! the order specified) of Grid Defintion Template 3.NN
! This element is actually a pointer to an array
! that holds the data.
! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of
! entries in Grid Defintion Template 3.NN
! ( NN=gfld%igdtnum ).
! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array
! contains the number of grid points contained in
! each row ( or column ). (part of Section 3)
! This element is actually a pointer to an array
! that holds the data. This pointer is nullified
! if gfld%numoct_opt=0.
! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined. This value
! is set to zero, if gfld%numoct_opt=0.
! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
! gfld%ipdtmpl() = Contains the data values for the specified Product
! Definition Template ( N=gfdl%ipdtnum ). Each element
! of this integer array contains an entry (in the
! order specified) of Product Defintion Template 4.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of
! entries in Product Defintion Template 4.N
! ( N=gfdl%ipdtnum ).
! gfld%coord_list() = Real array containing floating point values
! intended to document the vertical discretisation
! associated to model data on hybrid coordinate
! vertical levels. (part of Section 4)
! This element is actually a pointer to an array
! that holds the data.
! gfld%num_coord = number of values in array gfld%coord_list().
! gfld%ndpts = Number of data points unpacked and returned.
! Note that this number may be different from the value of
! gfld%ngrdpts if a logical bitmap is in use with grid points
! that are being masked out.
! gfld%idrtnum = Data Representation Template Number
! ( see Code Table 5.0)
! gfld%idrtmpl() = Contains the data values for the specified Data
! Representation Template ( N=gfld%idrtnum ). Each
! element of this integer array contains an entry
! (in the order specified) of Product Defintion
! Template 5.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number
! of entries in Data Representation Template 5.N
! ( N=gfld%idrtnum ).
! gfld%unpacked = logical value indicating whether the bitmap and
! data values were unpacked. If false,
! gfld%bmap and gfld%fld pointers are nullified.
! NOTE: This routine sets this component to .FALSE.
! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
! gfld%bmap() = Logical*1 array containing decoded bitmap,
! if ibmap=0 or ibap=254. Otherwise nullified.
! This element is actually a pointer to an array
! that holds the data.
! NOTE: This component is not set by this routine.
! gfld%fld() = Array of gfld%ndpts unpacked data points.
! This element is actually a pointer to an array
! that holds the data.
! NOTE: This component is not set by this routine.
! LPOS STARTING POSITION OF THE FOUND INDEX RECORD WITHIN
! THE COMPLETE INDEX BUFFER, CBUF.
! = 0, IF REQUEST NOT FOUND
! IRET INTEGER RETURN CODE
! 0 ALL OK
! 1 REQUEST NOT FOUND
!
! REMARKS:
! THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY.
!
! Note that derived type gribfield contains pointers to many
! arrays of data. The memory for these arrays is allocated
! when the values in the arrays are set, to help minimize
! problems with array overloading. Because of this users
! are encouraged to free up this memory, when it is no longer
! needed, by an explicit call to subroutine gf_free.
! ( i.e. CALL GF_FREE(GFLD) )
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GETGB2R(LUGB, CINDEX, GFLD, IRET)
!
! INTEGER, INTENT(IN ) :: LUGB
! CHARACTER(1), INTENT(IN ) :: CINDEX(*)
! INTEGER, INTENT( OUT) :: IRET
! TYPE(GRIBFIELD) :: GFLD
!
! SUBPROGRAM: READS AND UNPACKS A GRIB FIELD
! PRGMMR: GILBERT ORG: W/NP11 DATE: 02-01-15
!
! ABSTRACT: READ AND UNPACK SECTIONS 6 AND 7 FROM A GRIB2 MESSAGE.
!
! This routine assumes that the "metadata" for this field
! already exists in derived type gribfield. Specifically,
! it requires gfld%ibmap,gfld%ngrdpts,gfld%idrtnum,gfld%idrtmpl,
! and gfld%ndpts.
!
! The decoded information for the selected GRIB field
! is returned in a derived type variable, gfld.
! Gfld is of type gribfield, which is defined
! in module grib_mod, so users of this routine will need to include
! the line "USE GRIB_MOD" in their calling routine. Each component of the
! gribfield type is described in the OUTPUT ARGUMENT LIST section below.
!
! PROGRAM HISTORY LOG:
! 95-10-31 IREDELL
! 2002-01-11 GILBERT MODIFIED FROM GETGB1R TO WORK WITH GRIB2
!
! USAGE: CALL NG_GETGB2R(LUGB,CINDEX,GFLD,IRET)
! INPUT ARGUMENTS:
! LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE
! CINDEX INDEX RECORD OF THE GRIB FIELD ( SEE DOCBLOCK OF
! SUBROUTINE IXGB2 FOR DESCRIPTION OF AN INDEX RECORD.)
! OUTPUT ARGUMENTS:
! gfld - derived type gribfield ( defined in module grib_mod )
! ( NOTE: See Remarks Section )
! gfld%version = GRIB edition number ( currently 2 )
! gfld%discipline = Message Discipline ( see Code Table 0.0 )
! gfld%idsect() = Contains the entries in the Identification
! Section ( Section 1 )
! This element is actually a pointer to an array
! that holds the data.
! gfld%idsect(1) = Identification of originating Centre
! ( see Common Code Table C-1 )
! 7 - US National Weather Service
! gfld%idsect(2) = Identification of originating Sub-centre
! gfld%idsect(3) = GRIB Master Tables Version Number
! ( see Code Table 1.0 )
! 0 - Experimental
! 1 - Initial operational version number
! gfld%idsect(4) = GRIB Local Tables Version Number
! ( see Code Table 1.1 )
! 0 - Local tables not used
! 1-254 - Number of local tables version used
! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2)
! 0 - Analysis
! 1 - Start of forecast
! 2 - Verifying time of forecast
! 3 - Observation time
! gfld%idsect(6) = Year ( 4 digits )
! gfld%idsect(7) = Month
! gfld%idsect(8) = Day
! gfld%idsect(9) = Hour
! gfld%idsect(10) = Minute
! gfld%idsect(11) = Second
! gfld%idsect(12) = Production status of processed data
! ( see Code Table 1.3 )
! 0 - Operational products
! 1 - Operational test products
! 2 - Research products
! 3 - Re-analysis products
! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 )
! 0 - Analysis products
! 1 - Forecast products
! 2 - Analysis and forecast products
! 3 - Control forecast products
! 4 - Perturbed forecast products
! 5 - Control and perturbed forecast products
! 6 - Processed satellite observations
! 7 - Processed radar observations
! gfld%idsectlen = Number of elements in gfld%idsect().
! gfld%local() = Pointer to character array containing contents
! of Local Section 2, if included
! gfld%locallen = length of array gfld%local()
! gfld%ifldnum = field number within GRIB message
! gfld%griddef = Source of grid definition (see Code Table 3.0)
! 0 - Specified in Code table 3.1
! 1 - Predetermined grid Defined by originating centre
! gfld%ngrdpts = Number of grid points in the defined grid.
! Note that the number of actual data values returned from
! getgb2 (in gfld%ndpts) may be less than this value if a
! logical bitmap is in use with grid points that are being masked out.
! gfld%numoct_opt = Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! gfld%interp_opt = Interpretation of list for optional points
! definition. (Code Table 3.11)
! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
! gfld%igdtmpl() = Contains the data values for the specified Grid
! Definition Template ( NN=gfld%igdtnum ). Each
! element of this integer array contains an entry (in
! the order specified) of Grid Defintion Template 3.NN
! This element is actually a pointer to an array
! that holds the data.
! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of
! entries in Grid Defintion Template 3.NN
! ( NN=gfld%igdtnum ).
! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array
! contains the number of grid points contained in
! each row ( or column ). (part of Section 3)
! This element is actually a pointer to an array
! that holds the data. This pointer is nullified
! if gfld%numoct_opt=0.
! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined. This value
! is set to zero, if gfld%numoct_opt=0.
! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
! gfld%ipdtmpl() = Contains the data values for the specified Product
! Definition Template ( N=gfdl%ipdtnum ). Each element
! of this integer array contains an entry (in the
! order specified) of Product Defintion Template 4.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of
! entries in Product Defintion Template 4.N
! ( N=gfdl%ipdtnum ).
! gfld%coord_list() = Real array containing floating point values
! intended to document the vertical discretisation
! associated to model data on hybrid coordinate
! vertical levels. (part of Section 4)
! This element is actually a pointer to an array
! that holds the data.
! gfld%num_coord = number of values in array gfld%coord_list().
! gfld%ndpts = Number of data points unpacked and returned.
! Note that this number may be different from the value of
! gfld%ngrdpts if a logical bitmap is in use with grid points
! that are being masked out.
! gfld%idrtnum = Data Representation Template Number
! ( see Code Table 5.0)
! gfld%idrtmpl() = Contains the data values for the specified Data
! Representation Template ( N=gfld%idrtnum ). Each
! element of this integer array contains an entry
! (in the order specified) of Product Defintion
! Template 5.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number
! of entries in Data Representation Template 5.N
! ( N=gfld%idrtnum ).
! gfld%unpacked = logical value indicating whether the bitmap and
! data values were unpacked. If false,
! gfld%bmap and gfld%fld pointers are nullified.
! gfld%expanded = Logical value indicating whether the data field
! was expanded to the grid in the case where a
! bit-map is present. If true, the data points in
! gfld%fld match the grid points and "Missing_Value" were
! inserted at grid points where data was bit-mapped
! out. If false, the data values in gfld%fld were
! not expanded to the grid and are just a consecutive
! array of data points corresponding to each value of
! "1" in gfld%bmap.
! Note: You can call the routine "ng_gb2_missingvalue"
! to get "Missing_Value" used in CNCARG
! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
! gfld%bmap() = Logical*1 array containing decoded bitmap,
! if ibmap=0 or ibap=254. Otherwise nullified.
! This element is actually a pointer to an array
! that holds the data.
! gfld%fld() = Array of gfld%ndpts unpacked data points.
! This element is actually a pointer to an array
! that holds the data.
! IRET INTEGER RETURN CODE
! 0 ALL OK
! 97 ERROR READING GRIB FILE
! OTHER GF_GETFLD GRIB UNPACKER RETURN CODE
!
! REMARKS:
! DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
! THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB2 ROUTINES ONLY.
!
! Note that derived type gribfield contains pointers to many
! arrays of data. The memory for these arrays is allocated
! when the values in the arrays are set, to help minimize
! problems with array overloading. Because of this, users
! are encouraged to free up this memory, when it is no longer
! needed, by an explicit call to subroutine gf_free.
! ( i.e. CALL GF_FREE(GFLD) )
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GETGB2RP(LUGB, CINDEX, EXTRACT, GRIBM, LENG, IRET)
!
! INTEGER, INTENT(IN ) :: LUGB
! CHARACTER(1), INTENT(IN ) :: CINDEX(*)
! LOGICAL, INTENT(IN ) :: EXTRACT
! INTEGER, INTENT( OUT) :: LENG, IRET
! CHARACTER(1), POINTER :: GRIBM(:)
!
! SUBPROGRAM: EXTRACTS A GRIB MESSAGE FROM A FILE
! PRGMMR: GILBERT ORG: W/NMC23 DATE: 2003-12-31
!
! ABSTRACT: FIND AND EXTRACTS A GRIB MESSAGE FROM A FILE GIVEN THE
! INDEX FOR THE REQUESTED FIELD.
! THE GRIB MESSAGE RETURNED CAN CONTAIN ONLY THE REQUESTED FIELD
! (EXTRACT=.TRUE.). OR THE COMPLETE GRIB MESSAGE ORIGINALLY CONTAINING
! THE DESIRED FIELD CAN BE RETURNED (EXTRACT=.FALSE.) EVEN IF OTHER
! FIELDS WERE INCLUDED IN THE GRIB MESSAGE.
! IF THE GRIB FIELD IS NOT FOUND, THEN THE RETURN CODE WILL BE NONZERO.
!
! PROGRAM HISTORY LOG:
! 2003-12-31 GILBERT
!
! USAGE: CALL NG_GETGB2RP(LUGB,CINDEX,EXTRACT,GRIBM,LENG,IRET)
! INPUT ARGUMENTS:
! LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
! FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING
! THIS ROUTINE.
! CINDEX INDEX RECORD OF THE GRIB FILE ( SEE DOCBLOCK OF
! SUBROUTINE IXGB2 FOR DESCRIPTION OF AN INDEX RECORD.)
! EXTRACT LOGICAL VALUE INDICATING WHETHER TO RETURN A GRIB2
! MESSAGE WITH JUST THE REQUESTED FIELD, OR THE ENTIRE
! GRIB2 MESSAGE CONTAINING THE REQUESTED FIELD.
! .TRUE. = RETURN GRIB2 MESSAGE CONTAINING ONLY THE REQUESTED
! FIELD.
! .FALSE. = RETURN ENTIRE GRIB2 MESSAGE CONTAINING THE
! REQUESTED FIELD.
!
! OUTPUT ARGUMENTS:
! GRIBM RETURNED GRIB MESSAGE.
! LENG LENGTH OF RETURNED GRIB MESSAGE IN BYTES.
! IRET INTEGER RETURN CODE
! 0 ALL OK
! 97 ERROR READING GRIB FILE
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GETG2IR(LUGB, MSK1, MSK2, MNUM, CBUF, NLEN, NNUM,&
! NMESS, IRET)
!
! CHARACTER(1), POINTER :: CBUF(:)
! INTEGER, INTENT(IN ) :: LUGB, MSK1, MSK2, MNUM
! INTEGER, INTENT( OUT) :: NLEN, NNUM, NMESS, IRET
!
! SUBPROGRAM: CREATES AN INDEX OF A GRIB2 FILE
! PRGMMR: GILBERT ORG: W/NP11 DATE: 2002-01-02
!
! ABSTRACT: READ A GRIB FILE AND RETURN ITS INDEX CONTENTS.
! THE INDEX BUFFER RETURNED CONTAINS INDEX RECORDS WITH THE INTERNAL FORMAT:
! BYTE 001 - 004: LENGTH OF INDEX RECORD
! BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
! BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
! SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
! BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
! BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
! BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
! BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
! BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
! BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
! BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
! BYTE 042 - 042: MESSAGE DISCIPLINE
! BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
! BYTE 045 - II: IDENTIFICATION SECTION (IDS)
! BYTE II+1- JJ: GRID DEFINITION SECTION (GDS)
! BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS)
! BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS)
! BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
!
! PROGRAM HISTORY LOG:
! 95-10-31 IREDELL
! 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
! 2002-01-02 GILBERT MODIFIED FROM GETGIR TO CREATE GRIB2 INDEXES
!
! USAGE: CALL NG_GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,NMESS,IRET)
! INPUT ARGUMENTS:
! LUGB INTEGER UNIT OF THE UNBLOCKED GRIB FILE
! MSK1 INTEGER NUMBER OF BYTES TO SEARCH FOR FIRST MESSAGE
! MSK2 INTEGER NUMBER OF BYTES TO SEARCH FOR OTHER MESSAGES
! MNUM INTEGER NUMBER OF GRIB MESSAGES TO SKIP (USUALLY 0)
! OUTPUT ARGUMENTS:
! CBUF CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS.
! USERS SHOULD FREE MEMORY THAT CBUF POINTS TO
! USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED.
! NLEN INTEGER TOTAL LENGTH OF INDEX RECORD BUFFER IN BYTES
! NNUM INTEGER NUMBER OF INDEX RECORDS
! (=0 IF NO GRIB MESSAGES ARE FOUND)
! NMESS LAST GRIB MESSAGE IN FILE SUCCESSFULLY PROCESSED
! IRET INTEGER RETURN CODE
! 0 ALL OK
! 1 NOT ENOUGH MEMORY AVAILABLE TO HOLD FULL INDEX
! BUFFER
! 2 NOT ENOUGH MEMORY TO ALLOCATE INITIAL INDEX BUFFER
!
! REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
! DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GETG2I(LUGI, CBUF, NLEN, NNUM, IRET)
!
! CHARACTER(1), POINTER :: CBUF(:)
! INTEGER, INTENT(IN ) :: LUGI
! INTEGER, INTENT( OUT) :: NLEN, NNUM, IRET
!
! SUBPROGRAM: READS A GRIB2 INDEX FILE
! PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31
!
! ABSTRACT: READ A GRIB2 INDEX FILE AND RETURN ITS CONTENTS.
! VERSION 1 OF THE INDEX FILE HAS THE FOLLOWING FORMAT:
! 81-BYTE S.LORD HEADER WITH 'GB2IX1' IN COLUMNS 42-47 FOLLOWED BY
! 81-BYTE HEADER WITH NUMBER OF BYTES TO SKIP BEFORE INDEX RECORDS,
! TOTAL LENGTH IN BYTES OF THE INDEX RECORDS, NUMBER OF INDEX RECORDS,
! AND GRIB FILE BASENAME WRITTEN IN FORMAT ('IX1FORM:',3I10,2X,A40).
! EACH FOLLOWING INDEX RECORD CORRESPONDS TO A GRIB MESSAGE
! AND HAS THE INTERNAL FORMAT:
! BYTE 001 - 004: LENGTH OF INDEX RECORD
! BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
! BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
! SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
! BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
! BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
! BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
! BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
! BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
! BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
! BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
! BYTE 042 - 042: MESSAGE DISCIPLINE
! BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
! BYTE 045 - II: IDENTIFICATION SECTION (IDS)
! BYTE II+1- JJ: GRID DEFINITION SECTION (GDS)
! BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS)
! BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS)
! BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
!
! PROGRAM HISTORY LOG:
! 95-10-31 IREDELL
! 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
! 2002-01-03 GILBERT MODIFIED FROM GETGI TO WORK WITH GRIB2
!
! USAGE: CALL NG_GETG2I(LUGI,CBUF,NLEN,NNUM,IRET)
! INPUT ARGUMENTS:
! LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE
! OUTPUT ARGUMENTS:
! CBUF CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS.
! USERS SHOULD FREE MEMORY THAT CBUF POINTS TO
! USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED.
! NLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
! NNUM INTEGER NUMBER OF INDEX RECORDS
! IRET INTEGER RETURN CODE
! 0 ALL OK
! 2 NOT ENOUGH MEMORY TO HOLD INDEX BUFFER
! 3 ERROR READING INDEX FILE BUFFER
! 4 ERROR READING INDEX FILE HEADER
!
! REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
! DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_getdim(csec3, lcsec3, width, height, iscan)
!
! CHARACTER(1), INTENT(IN ) :: csec3(*)
! INTEGER, INTENT(IN ) :: lcsec3
! INTEGER, INTENT( OUT) :: width, height, iscan
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-11
!
! ABSTRACT: This subroutine returns the dimensions and scanning mode of
! a grid definition packed in GRIB2 Grid Definition Section 3 format.
!
! PROGRAM HISTORY LOG:
! 2002-12-11 Gilbert
!
! USAGE: CALL getdim(csec3,lcsec3,width,height,iscan)
! INPUT ARGUMENT LIST:
! csec3 - Character array that contains the packed GRIB2 GDS
! lcsec3 - Length (in octets) of section 3
!
! OUTPUT ARGUMENT LIST:
! width - x (or i) dimension of the grid.
! height - y (or j) dimension of the grid.
! iscan - Scanning mode ( see Code Table 3.4 )
!
! REMARKS: Returns width and height set to zero, if grid template
! not recognized.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_getpoly(csec3, lcsec3, jj, kk, mm)
!
! CHARACTER(1), INTENT(IN ) :: csec3(*)
! INTEGER, INTENT(IN ) :: lcsec3
! INTEGER, INTENT( OUT) :: jj,kk,mm
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-11
!
! ABSTRACT: This subroutine returns the J, K, and M pentagonal resolution
! parameters specified in a GRIB Grid Definition Section used
! spherical harmonic coefficients using GDT 5.50 through 5.53
!
! PROGRAM HISTORY LOG:
! 2002-12-11 Gilbert
!
! USAGE: CALL ng_getpoly(csec3,lcsec3,jj,kk,mm)
! INPUT ARGUMENT LIST:
! csec3 - Character array that contains the packed GRIB2 GDS
! lcsec3 - Length (in octets) of section 3
!
! OUTPUT ARGUMENT LIST:
! JJ = J - pentagonal resolution parameter
! KK = K - pentagonal resolution parameter
! MM = M - pentagonal resolution parameter
!
! REMARKS: Returns JJ, KK, and MM set to zero, if grid template
! not recognized.
!
!=====================================================================
!
! ~~~~~~~~~~~
! Put Message
! ~~~~~~~~~~~
!
! SUBROUTINE NG_PUTGB2(LUGB, GFLD, IRET)
!
! SUBROUTINE ng_gribcreate(cgrib, lcgrib, listsec0, listsec1, ierr)
! SUBROUTINE ng_addlocal(cgrib, lcgrib, csec2, lcsec2, ierr)
! SUBROUTINE ng_addgrid(cgrib, lcgrib, igds, igdstmpl, igdstmplen,&
! ideflist, idefnum, ierr)
! SUBROUTINE ng_addfield(cgrib, lcgrib, ipdsnum, ipdstmpl, ipdstmplen,&
! coordlist, numcoord, idrsnum, idrstmpl,&
! idrstmplen, fld, ngrdpts, ibmap, bmap, ierr)
! SUBROUTINE ng_gribend(cgrib, lcgrib, lengrib, ierr)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_PUTGB2(LUGB, GFLD, IRET)
!
! INTEGER, INTENT(IN ) :: LUGB
! TYPE(GRIBFIELD) :: GFLD
! INTEGER, INTENT( OUT) :: IRET
!
! SUBPROGRAM: PACKS AND WRITES A GRIB2 MESSAGE
! PRGMMR: GILBERT ORG: W/NP11 DATE: 2002-04-22
!
! ABSTRACT: PACKS A SINGLE FIELD INTO A GRIB2 MESSAGE
! AND WRITES OUT THAT MESSAGE TO THE FILE ASSOCIATED WITH UNIT LUGB.
! NOTE THAT FILE/UNIT LUGB SHOULD BE OPENED WOTH A CALL TO
! SUBROUTINE BAOPENW BEFORE THIS ROUTINE IS CALLED.
!
! The information to be packed into the GRIB field
! is stored in a derived type variable, gfld.
! Gfld is of type gribfield, which is defined
! in module grib_mod, so users of this routine will need to include
! the line "USE GRIB_MOD" in their calling routine. Each component of the
! gribfield type is described in the INPUT ARGUMENT LIST section below.
!
! PROGRAM HISTORY LOG:
! 2002-04-22 GILBERT
! 2005-02-28 GILBERT - Changed dimension of array cgrib to be a multiple
! of gfld%ngrdpts instead of gfld%ndpts.
! 2009-03-10 VUONG - Initialize variable coordlist
! 2011-06-09 VUONG - Initialize variable gfld%list_opt
! 2012-02-28 VUONG - Initialize variable ilistopt
!
! USAGE: CALL NG_PUTGB2(LUGB,GFLD,IRET)
! INPUT ARGUMENTS:
! LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
! FILE MUST BE OPENED WITH BAOPEN OR BAOPENW BEFORE CALLING
! THIS ROUTINE.
! gfld - derived type gribfield ( defined in module grib_mod )
! ( NOTE: See Remarks Section )
! gfld%version = GRIB edition number ( currently 2 )
! gfld%discipline = Message Discipline ( see Code Table 0.0 )
! gfld%idsect() = Contains the entries in the Identification
! Section ( Section 1 )
! This element is actually a pointer to an array
! that holds the data.
! gfld%idsect(1) = Identification of originating Centre
! ( see Common Code Table C-1 )
! 7 - US National Weather Service
! gfld%idsect(2) = Identification of originating Sub-centre
! gfld%idsect(3) = GRIB Master Tables Version Number
! ( see Code Table 1.0 )
! 0 - Experimental
! 1 - Initial operational version number
! gfld%idsect(4) = GRIB Local Tables Version Number
! ( see Code Table 1.1 )
! 0 - Local tables not used
! 1-254 - Number of local tables version used
! gfld%idsect(5) = Significance of Reference Time (Code Table 1.2)
! 0 - Analysis
! 1 - Start of forecast
! 2 - Verifying time of forecast
! 3 - Observation time
! gfld%idsect(6) = Year ( 4 digits )
! gfld%idsect(7) = Month
! gfld%idsect(8) = Day
! gfld%idsect(9) = Hour
! gfld%idsect(10) = Minute
! gfld%idsect(11) = Second
! gfld%idsect(12) = Production status of processed data
! ( see Code Table 1.3 )
! 0 - Operational products
! 1 - Operational test products
! 2 - Research products
! 3 - Re-analysis products
! gfld%idsect(13) = Type of processed data ( see Code Table 1.4 )
! 0 - Analysis products
! 1 - Forecast products
! 2 - Analysis and forecast products
! 3 - Control forecast products
! 4 - Perturbed forecast products
! 5 - Control and perturbed forecast products
! 6 - Processed satellite observations
! 7 - Processed radar observations
! gfld%idsectlen = Number of elements in gfld%idsect().
! gfld%local() = Pointer to character array containing contents
! of Local Section 2, if included
! gfld%locallen = length of array gfld%local()
! gfld%ifldnum = field number within GRIB message
! gfld%griddef = Source of grid definition (see Code Table 3.0)
! 0 - Specified in Code table 3.1
! 1 - Predetermined grid Defined by originating centre
! gfld%ngrdpts = Number of grid points in the defined grid.
! Note that the number of actual data values returned from
! getgb2 (in gfld%ndpts) may be less than this value if a
! logical bitmap is in use with grid points that are being masked out.
! gfld%numoct_opt = Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! gfld%interp_opt = Interpretation of list for optional points
! definition. (Code Table 3.11)
! gfld%igdtnum = Grid Definition Template Number (Code Table 3.1)
! gfld%igdtmpl() = Contains the data values for the specified Grid
! Definition Template ( NN=gfld%igdtnum ). Each
! element of this integer array contains an entry (in
! the order specified) of Grid Defintion Template 3.NN
! This element is actually a pointer to an array
! that holds the data.
! gfld%igdtlen = Number of elements in gfld%igdtmpl(). i.e. number of
! entries in Grid Defintion Template 3.NN
! ( NN=gfld%igdtnum ).
! gfld%list_opt() = (Used if gfld%numoct_opt .ne. 0) This array
! contains the number of grid points contained in
! each row ( or column ). (part of Section 3)
! This element is actually a pointer to an array
! that holds the data. This pointer is nullified
! if gfld%numoct_opt=0.
! gfld%num_opt = (Used if gfld%numoct_opt .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined. This value
! is set to zero, if gfld%numoct_opt=0.
! gfdl%ipdtnum = Product Definition Template Number (see Code Table 4.0)
! gfld%ipdtmpl() = Contains the data values for the specified Product
! Definition Template ( N=gfdl%ipdtnum ). Each element
! of this integer array contains an entry (in the
! order specified) of Product Defintion Template 4.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%ipdtlen = Number of elements in gfld%ipdtmpl(). i.e. number of
! entries in Product Defintion Template 4.N
! ( N=gfdl%ipdtnum ).
! gfld%coord_list() = Real array containing floating point values
! intended to document the vertical discretisation
! associated to model data on hybrid coordinate
! vertical levels. (part of Section 4)
! This element is actually a pointer to an array
! that holds the data.
! gfld%num_coord = number of values in array gfld%coord_list().
! gfld%ndpts = Number of data points unpacked and returned.
! Note that this number may be different from the value of
! gfld%ngrdpts if a logical bitmap is in use with grid points
! that are being masked out.
! gfld%idrtnum = Data Representation Template Number
! ( see Code Table 5.0)
! gfld%idrtmpl() = Contains the data values for the specified Data
! Representation Template ( N=gfld%idrtnum ). Each
! element of this integer array contains an entry
! (in the order specified) of Product Defintion
! Template 5.N.
! This element is actually a pointer to an array
! that holds the data.
! gfld%idrtlen = Number of elements in gfld%idrtmpl(). i.e. number
! of entries in Data Representation Template 5.N
! ( N=gfld%idrtnum ).
! gfld%unpacked = logical value indicating whether the bitmap and
! data values were unpacked. If false,
! gfld%bmap and gfld%fld pointers are nullified.
! gfld%ibmap = Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
! gfld%bmap() = Logical*1 array containing decoded bitmap,
! if ibmap=0 or ibap=254. Otherwise nullified.
! This element is actually a pointer to an array
! that holds the data.
! gfld%fld() = Array of gfld%ndpts unpacked data points.
! This element is actually a pointer to an array
! that holds the data.
!
! OUTPUT ARGUMENTS:
! IRET INTEGER RETURN CODE
! 0 ALL OK
! 2 MEMORY ALLOCATION ERROR
! 10 No Section 1 info available
! 11 No Grid Definition Template info available
! 12 Missing some required data field info
!
! REMARKS:
!
! Note that derived type gribfield contains pointers to many
! arrays of data. The memory for these arrays is allocated
! when the values in the arrays are set, to help minimize
! problems with array overloading. Because of this users
! are encouraged to free up this memory, when it is no longer
! needed, by an explicit call to subroutine gf_free.
! ( i.e. CALL GF_FREE(GFLD) )
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_gribcreate(cgrib, lcgrib, listsec0, listsec1, ierr)
!
! INTEGER, INTENT(IN ) :: lcgrib
! CHARACTER(1), INTENT(INOUT) :: cgrib(lcgrib)
! INTEGER, INTENT(IN ) :: listsec0(*), listsec1(*)
! INTEGER, INTENT( OUT) :: ierr
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-04-28
!
! ABSTRACT: This subroutine initializes a new GRIB2 message and packs
! GRIB2 sections 0 (Indicator Section) and 1 (Identification Section).
! This routine is used with routines "addlocal", "addgrid", "addfield",
! and "gribend" to create a complete GRIB2 message. Subroutine
! gribcreate must be called first to initialize a new GRIB2 message.
! Also, a call to gribend is required to complete GRIB2 message
! after all fields have been added.
!
! PROGRAM HISTORY LOG:
! 2000-04-28 Gilbert
!
! USAGE: CALL ng_gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array to contain the GRIB2 message
! lcgrib - Maximum length (bytes) of array cgrib.
! listsec0 - Contains information needed for GRIB Indicator Section 0.
! Must be dimensioned >= 2.
! listsec0(1)=Discipline-GRIB Master Table Number
! (see Code Table 0.0)
! listsec0(2)=GRIB Edition Number (currently 2)
! listsec1 - Contains information needed for GRIB Identification Section 1.
! Must be dimensioned >= 13.
! listsec1(1)=Id of orginating centre (Common Code Table C-1)
! listsec1(2)=Id of orginating sub-centre (local table)
! listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0)
! listsec1(4)=GRIB Local Tables Version Number (Code Table 1.1)
! listsec1(5)=Significance of Reference Time (Code Table 1.2)
! listsec1(6)=Reference Time - Year (4 digits)
! listsec1(7)=Reference Time - Month
! listsec1(8)=Reference Time - Day
! listsec1(9)=Reference Time - Hour
! listsec1(10)=Reference Time - Minute
! listsec1(11)=Reference Time - Second
! listsec1(12)=Production status of data (Code Table 1.3)
! listsec1(13)=Type of processed data (Code Table 1.4)
!
! OUTPUT ARGUMENT LIST:
! cgrib - Character array to contain the GRIB2 message
! ierr - Error return code.
! 0 = no error
! 1 = Tried to use for version other than GRIB Edition 2
!
! REMARKS: This routine is intended for use with routines "addlocal",
! "addgrid", "addfield", and "gribend" to create a complete
! GRIB2 message.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_addlocal(cgrib, lcgrib, csec2, lcsec2, ierr)
!
! INTEGER, INTENT(IN ) :: lcgrib, lcsec2
! CHARACTER(1), INTENT(INOUT) :: cgrib(lcgrib)
! CHARACTER(1), INTENT(IN ) :: csec2(lcsec2)
! INTEGER, INTENT( OUT) :: ierr
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-01
!
! ABSTRACT: This subroutine adds a Local Use Section (Section 2) to
! a GRIB2 message.
! This routine is used with routines "gribcreate", "addgrid", "addfield",
! and "gribend" to create a complete GRIB2 message. Subroutine
! gribcreate must be called first to initialize a new GRIB2 message.
!
! PROGRAM HISTORY LOG:
! 2000-05-01 Gilbert
!
! USAGE: CALL ng_addlocal(cgrib,lcgrib,csec2,lcsec2,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array to contain the GRIB2 message
! lcgrib - Maximum length (bytes) of array cgrib.
! csec2 - Character array containing information to be added to
! Section 2.
! lcsec2 - Number of bytes of character array csec2 to be added to
! Section 2.
!
! OUTPUT ARGUMENT LIST:
! cgrib - Character array to contain the GRIB2 message
! ierr - Error return code.
! 0 = no error
! 1 = GRIB message was not initialized. Need to call
! routine gribcreate first.
! 2 = GRIB message already complete. Cannot add new section.
! 3 = Sum of Section byte counts doesn't add to total byte count.
! 4 = Previous Section was not 1 or 7.
!
! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow
! Section 1 or Section 7 in a GRIB2 message.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_addgrid(cgrib, lcgrib, igds, igdstmpl, igdstmplen,&
! ideflist, idefnum, ierr)
!
! INTEGER, INTENT(IN ) :: lcgrib, idefnum, igdstmplen
! CHARACTER(1), INTENT(INOUT) :: cgrib(lcgrib)
! INTEGER, INTENT(IN ) :: igds(*), igdstmpl(*), ideflist(idefnum)
! INTEGER, INTENT( OUT) :: ierr
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-01
!
! ABSTRACT: This subroutine packs up a Grid Definition Section (Section 3)
! and adds it to a GRIB2 message.
! This routine is used with routines "gribcreate", "addlocal", "addfield",
! and "gribend" to create a complete GRIB2 message. Subroutine
! gribcreate must be called first to initialize a new GRIB2 message.
!
! PROGRAM HISTORY LOG:
! 2000-05-01 Gilbert
!
! USAGE: CALL ng_addgrid(cgrib,lcgrib,igds,igdstmpl,igdstmplen,
! ideflist,idefnum,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array to contain the GRIB2 message
! lcgrib - Maximum length (bytes) of array cgrib.
! igds - Contains information needed for GRIB Grid Definition Section 3.
! Must be dimensioned >= 5.
! igds(1)=Source of grid definition (see Code Table 3.0)
! igds(2)=Number of grid points in the defined grid.
! igds(3)=Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! igds(4)=Interpretation of list for optional points
! definition. (Code Table 3.11)
! igds(5)=Grid Definition Template Number (Code Table 3.1)
! igdstmpl - Contains the data values for the specified Grid Definition
! Template ( NN=igds(5) ). Each element of this integer
! array contains an entry (in the order specified) of Grid
! Defintion Template 3.NN
! igdstmplen - Max dimension of igdstmpl()
! ideflist - (Used if igds(3) .ne. 0) This array contains the
! number of grid points contained in each row ( or column )
! idefnum - (Used if igds(3) .ne. 0) The number of entries
! in array ideflist. i.e. number of rows ( or columns )
! for which optional grid points are defined.
!
! OUTPUT ARGUMENT LIST:
! cgrib - Character array to contain the GRIB2 message
! ierr - Error return code.
! 0 = no error
! 1 = GRIB message was not initialized. Need to call
! routine gribcreate first.
! 2 = GRIB message already complete. Cannot add new section.
! 3 = Sum of Section byte counts doesn't add to total byte count.
! 4 = Previous Section was not 1, 2 or 7.
! 5 = Could not find requested Grid Definition Template.
!
! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow
! Section 1 or Section 7 in a GRIB2 message.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_addfield(cgrib, lcgrib, ipdsnum, ipdstmpl, ipdstmplen,&
! coordlist, numcoord, idrsnum, idrstmpl,&
! idrstmplen, fld, ngrdpts, ibmap, bmap, ierr)
!
! INTEGER, INTENT(IN ) :: lcgrib, ngrdpts, ibmap
! CHARACTER(1), INTENT(INOUT) :: cgrib(lcgrib)
! INTEGER, INTENT(IN ) :: ipdsnum, ipdstmpl(*)
! INTEGER, INTENT(IN ) :: idrsnum, numcoord, ipdstmplen, idrstmplen
! REAL, INTENT(IN ) :: coordlist(numcoord)
! REAL, TARGET, INTENT(IN ) :: fld(ngrdpts)
! INTEGER, INTENT(INOUT) :: idrstmpl(*)
! LOGICAL*1, INTENT(IN ) :: bmap(ngrdpts)
! INTEGER, INTENT( OUT) :: ierr
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-02
!
! ABSTRACT: This subroutine packs up Sections 4 through 7 for a given field
! and adds them to a GRIB2 message. They are Product Definition Section,
! Data Representation Section, Bit-Map Section and Data Section,
! respectively.
! This routine is used with routines "gribcreate", "addlocal", "addgrid",
! and "gribend" to create a complete GRIB2 message. Subroutine
! gribcreate must be called first to initialize a new GRIB2 message.
! Also, subroutine addgrid must be called after gribcreate and
! before this routine to add the appropriate grid description to
! the GRIB2 message. Also, a call to gribend is required to complete
! GRIB2 message after all fields have been added.
!
! PROGRAM HISTORY LOG:
! 2000-05-02 Gilbert
! 2002-12-17 Gilbert - Added support for new templates using
! PNG and JPEG2000 algorithms/templates.
! 2004-06-22 Gilbert - Added check to determine if packing algorithm failed.
!
! USAGE: CALL ng_addfield(cgrib,lcgrib,ipdsnum,ipdstmpl,ipdstmplen,
! coordlist,numcoord,idrsnum,idrstmpl,
! idrstmplen,fld,ngrdpts,ibmap,bmap,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array to contain the GRIB2 message
! lcgrib - Maximum length (bytes) of array cgrib.
! ipdsnum - Product Definition Template Number ( see Code Table 4.0)
! ipdstmpl - Contains the data values for the specified Product Definition
! Template ( N=ipdsnum ). Each element of this integer
! array contains an entry (in the order specified) of Product
! Defintion Template 4.N
! ipdstmplen - Max dimension of ipdstmpl()
! coordlist- Array containg floating point values intended to document
! the vertical discretisation associated to model data
! on hybrid coordinate vertical levels.
! numcoord - number of values in array coordlist.
! idrsnum - Data Representation Template Number ( see Code Table 5.0 )
! idrstmpl - Contains the data values for the specified Data Representation
! Template ( N=idrsnum ). Each element of this integer
! array contains an entry (in the order specified) of Data
! Representation Template 5.N
! Note that some values in this template (eg. reference
! values, number of bits, etc...) may be changed by the
! data packing algorithms.
! Use this to specify scaling factors and order of
! spatial differencing, if desired.
! idrstmplen - Max dimension of idrstmpl()
! fld() - Array of data points to pack.
! ngrdpts - Number of data points in grid.
! i.e. size of fld and bmap.
! ibmap - Bitmap indicator ( see Code Table 6.0 )
! 0 = bitmap applies and is included in Section 6.
! 1-253 = Predefined bitmap applies
! 254 = Previously defined bitmap applies to this field
! 255 = Bit map does not apply to this product.
! bmap() - Logical*1 array containing bitmap to be added.
! ( if ibmap=0 or ibmap=254)
!
! OUTPUT ARGUMENT LIST:
! cgrib - Character array to contain the GRIB2 message
! ierr - Error return code.
! 0 = no error
! 1 = GRIB message was not initialized. Need to call
! routine gribcreate first.
! 2 = GRIB message already complete. Cannot add new section.
! 3 = Sum of Section byte counts does not add to total
! byte count.
! 4 = Previous Section was not 3 or 7.
! 5 = Could not find requested Product Definition Template.
! 6 = Section 3 (GDS) not previously defined in message
! 7 = Tried to use unsupported Data Representationi Template
! 8 = Specified use of a previously defined bitmap, but one
! does not exist in the GRIB message.
! 9 = GDT of one of 5.50 through 5.53 required to pack
! using DRT 5.51
! 10 = Error packing data field.
!
! REMARKS: Note that the Local Use Section ( Section 2 ) can only follow
! Section 1 or Section 7 in a GRIB2 message.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_gribend(cgrib, lcgrib, lengrib, ierr)
!
! INTEGER, INTENT(IN ) :: lcgrib
! CHARACTER(1), INTENT(INOUT) :: cgrib(lcgrib)
! INTEGER, INTENT( OUT) :: lengrib,ierr
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-02
!
! ABSTRACT: This subroutine finalizes a GRIB message after all grids
! and fields have been added. It adds the End Section ( "7777" )
! to the end of the GRIB message and calculates the length and stores
! it in the appropriate place in Section 0.
! This routine is used with routines "gribcreate", "addlocal", "addgrid",
! and "addfield" to create a complete GRIB2 message. Subroutine
! gribcreate must be called first to initialize a new GRIB2 message.
!
! PROGRAM HISTORY LOG:
! 2000-05-02 Gilbert
!
! USAGE: CALL ng_gribend(cgrib,lcgrib,lengrib,ierr)
! INPUT ARGUMENT LIST:
! cgrib - Character array to contain the GRIB2 message
! lcgrib - Maximum length (bytes) of array cgrib.
!
! OUTPUT ARGUMENT LIST:
! cgrib - Character array to contain the GRIB2 message
! lengrib - Length of the final GRIB2 message in octets (bytes)
! ierr - Error return code.
! 0 = no error
! 1 = GRIB message was not initialized. Need to call
! routine gribcreate first.
! 2 = GRIB message already complete.
! 3 = Sum of Section byte counts doesn't add to total byte count.
! 4 = Previous Section was not 7.
!
! REMARKS: This routine is intended for use with routines "gribcreate",
! "addlocal", "addgrid", and "addfield" to create a complete
! GRIB2 message.
!
!=====================================================================
!
! ~~~~~~~~~~~
! Convert 1/2
! ~~~~~~~~~~~
!
! SUBROUTINE ng_gdt2gds(igds, igdstmpl, idefnum, ideflist, kgds, igrid, iret)
! SUBROUTINE ng_makepds(idisc, idsect, ipdsnum, ipdstmpl, ibmap, idrsnum,&
! idrstmpl, kpds, iret)
! SUBROUTINE ng_makepdsens(ipdsnum, ipdstmpl,kpds, kens, kprob, xprob,&
! kclust, kmembr, iret)
!
! SUBROUTINE ng_gds2gdt(kgds, igds, igdstmpl, idefnum, ideflist, iret)
! SUBROUTINE ng_pds2pdt(kpds, ipdsnum, ipdstmpl, numcoord, coordlist, iret)
! SUBROUTINE ng_pds2pdtens(kpds, kens, kprob, xprob, kclust, kmember,&
! ipdsnum, ipdstmpl, numcoord, coordlist, iret)
!
! SUBROUTINE ng_cnvlevel(ltype, lval, ipdstmpl)
! SUBROUTINE ng_levelcnv(ipdstmpl, ltype, lval)
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_gdt2gds(igds, igdstmpl, idefnum, ideflist, kgds, igrid, iret)
!
! INTEGER, INTENT(IN ) :: idefnum
! INTEGER, INTENT(IN ) :: igds(*), igdstmpl(*), ideflist(*)
! INTEGER, INTENT( OUT) :: kgds(*), igrid, iret
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-17
!
! ABSTRACT: This routine converts grid information from a GRIB2
! Grid Description Section as well as its
! Grid Definition Template to GRIB1 GDS info. In addition,
! a check is made to determine if the grid is an NCEP
! predefined grid.
!
! PROGRAM HISTORY LOG:
! 2003-06-17 Gilbert
! 2004-04-27 Gilbert - Added support for gaussian grids.
! 2007-04-16 Vuong - Added Curvilinear Orthogonal grids.
! 2007-05-29 Vuong - Added Rotate Lat/Lon E-grid (203)
!
! USAGE: CALL ng_gdt2gds(igds,igdstmpl,idefnum,ideflist,kgds,igrid,iret)
! INPUT ARGUMENT LIST:
! igds() - Contains information read from the appropriate GRIB Grid
! Definition Section 3 for the field being returned.
! Must be dimensioned >= 5.
! igds(1)=Source of grid definition (see Code Table 3.0)
! igds(2)=Number of grid points in the defined grid.
! igds(3)=Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! igds(4)=Interpretation of list for optional points
! definition. (Code Table 3.11)
! igds(5)=Grid Definition Template Number (Code Table 3.1)
! igdstmpl() - Grid Definition Template values for GDT 3.igds(5)
! idefnum - The number of entries in array ideflist.
! i.e. number of rows ( or columns )
! for which optional grid points are defined.
! ideflist() - Optional integer array containing
! the number of grid points contained in each row (or column).
!
! OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS)
! kgds() - GRIB1 GDS as described in w3fi63 format.
! igrid - NCEP predefined GRIB1 grid number
! set to 255, if not NCEP grid
! iret - Error return value:
! 0 = Successful
! 1 = Unrecognized GRIB2 GDT number 3.igds(5)
!
! REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_makepds(idisc, idsect, ipdsnum, ipdstmpl, ibmap, idrsnum,&
! idrstmpl, kpds, iret)
!
! INTEGER, INTENT(IN ) :: idsect(*),ipdstmpl(*),idrstmpl(*)
! INTEGER, INTENT(IN ) :: ipdsnum,idisc,idrsnum,ibmap
! INTEGER, INTENT( OUT) :: kpds(*)
! INTEGER, INTENT( OUT) :: iret
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12
!
! ABSTRACT: This routine creates a GRIB1 PDS (Section 1)
! from appropriate information from a GRIB2 Product Definition Template.
!
! PROGRAM HISTORY LOG:
! 2003-06-12 Gilbert
! 2005-04-19 Gilbert - Changed scaling factor used with potential
! vorticity surfaces.
! 2007-05-08 VUONG - Add Product Definition Template entries
! 120 - Ice Concentration Analysis
! 121 - Western North Atlantic Regional Wave Model
! 122 - Alaska Waters Regional Wave Model
! 123 - North Atlantic Hurricane Wave Model
! 124 - Eastern North Pacific Regional Wave Model
! 131 - Great Lake Wave Model
! 88 - NOAA Wave Watch III (NWW3)
! 45 - Coastal Ocean Circulation
! 47 - HYCOM - North Pacific basin
! 2007-05-14 Boi Vuong - Added Time Range Indicator 51 (Climatological
! Mean Value)
! 2007-10-24 Boi Vuong - Added level 8 (Nominal top of atmosphere)
! 2009-05-19 Boi Vuong - Added levels 10(Entire Atmosphere), 11(Cumulonimbus
! Base),12(Cumulonimbus Top) and level 126(Isobaric Pa)
! 2009-12-14 Boi Vuong - Added check for WAFS to use PDT 4.15 for Icing,
! Turbulence and Cumulonimbus
! 2010-08-10 Boi Vuong - Added check for FNMOC to use TMP as TMAX and TMIN
! - Removed check WAFS MAX wind level
! 2011-10-24 Boi Vuong - Added check for NAM (NMM-B) parameters to set
! statistical processing as MAX and MIN
! 2012-03-29 Boi Vuong - Added check Time Range for APCP in FNMOC
! 2014-05-20 Boi Vuong - Added check Time Range after F252
! 2014-11-14 Boi Vuong - Added check Time Range for 15-hr or 18-hr or 21-hr or
! 24-hr Accumulation for APCP after F240
!
! USAGE: CALL ng_makepds(idisc,idsect,ipdsnum,ipdstmpl,ibmap,
! idrsnum,idrstmpl,kpds,iret)
! INPUT ARGUMENT LIST:
! idisc - GRIB2 discipline from Section 0.
! idsect() - GRIB2 Section 1 info.
! idsect(1)=Id of orginating centre (Common Code Table C-1)
! idsect(2)=Id of orginating sub-centre (local table)
! idsect(3)=GRIB Master Tables Version Number (Code Table 1.0)
! idsect(4)=GRIB Local Tables Version Number (Code Table 1.1)
! idsect(5)=Significance of Reference Time (Code Table 1.2)
! idsect(6)=Reference Time - Year (4 digits)
! idsect(7)=Reference Time - Month
! idsect(8)=Reference Time - Day
! idsect(9)=Reference Time - Hour
! idsect(10)=Reference Time - Minute
! idsect(11)=Reference Time - Second
! idsect(12)=Production status of data (Code Table 1.3)
! idsect(13)=Type of processed data (Code Table 1.4)
! ipdsnum - GRIB2 Product Definition Template Number
! ipdstmpl() - GRIB2 Product Definition Template entries for PDT 4.ipdsnum
! ibmap - GRIB2 bitmap indicator from octet 6, Section 6.
! idrsnum - GRIB2 Data Representation Template Number
! idrstmpl() - GRIB2 Data Representation Template entries
!
! OUTPUT ARGUMENT LIST:
! kpds() - GRIB1 PDS info as specified in W3FI63.
! (1) - ID OF CENTER
! (2) - GENERATING PROCESS ID NUMBER
! (3) - GRID DEFINITION
! (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8)
! (5) - INDICATOR OF PARAMETER
! (6) - TYPE OF LEVEL
! (7) - HEIGHT/PRESSURE , ETC OF LEVEL
! (8) - YEAR INCLUDING (CENTURY-1)
! (9) - MONTH OF YEAR
! (10) - DAY OF MONTH
! (11) - HOUR OF DAY
! (12) - MINUTE OF HOUR
! (13) - INDICATOR OF FORECAST TIME UNIT
! (14) - TIME RANGE 1
! (15) - TIME RANGE 2
! (16) - TIME RANGE FLAG
! (17) - NUMBER INCLUDED IN AVERAGE
! (18) - VERSION NR OF GRIB SPECIFICATION
! (19) - VERSION NR OF PARAMETER TABLE
! (20) - NR MISSING FROM AVERAGE/ACCUMULATION
! (21) - CENTURY OF REFERENCE TIME OF DATA
! (22) - UNITS DECIMAL SCALE FACTOR
! (23) - SUBCENTER NUMBER
! iret - Error return value:
! 0 = Successful
! 1 = Don't know what to do with pre-defined bitmap.
! 2 = Unrecognized GRIB2 PDT 4.ipdsnum
!
! REMARKS: Use pds2pdtens for ensemble related PDS
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_makepdsens(ipdsnum, ipdstmpl,kpds, kens, kprob, xprob,&
! kclust, kmembr, iret)
!
! INTEGER, INTENT(IN ) :: ipdstmpl(*)
! INTEGER, INTENT(IN ) :: ipdsnum
! INTEGER, INTENT(INOUT) :: kpds(*)
! INTEGER, INTENT( OUT) :: kens(5),kprob(2)
! INTEGER, INTENT( OUT) :: kclust(16),kmembr(80)
! REAL, INTENT( OUT) :: xprob(2)
! INTEGER, INTENT( OUT) :: iret
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12
!
! ABSTRACT: This routine creates the GRIB1 NCEP Ensemble PDS
! extension information from appropriate information from a GRIB2
! Product Definition Template.
!
! PROGRAM HISTORY LOG:
! 2003-06-12 Gilbert
! 2007-05-14 Boi Vuong -Corrected scale factor probabilities
! 2010-07-26 Boi Vuong -Added two type of ensemblers (4 and 192)
!
! USAGE: CALL ng_makepdsens(ipdsnum,ipdstmpl,kpds,kens,kprob,
! xprob,kclust,kmembr,iret)
! INPUT ARGUMENT LIST:
! ipdsnum - GRIB2 Product Definition Template Number
! ipdstmpl() - GRIB2 Product Definition Template entries for PDT 4.ipdsnum
! kpds() - GRIB1 PDS info as specified in W3FI63.
! (1) - ID OF CENTER
! (2) - GENERATING PROCESS ID NUMBER
! (3) - GRID DEFINITION
! (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8)
! (5) - INDICATOR OF PARAMETER
! (6) - TYPE OF LEVEL
! (7) - HEIGHT/PRESSURE , ETC OF LEVEL
! (8) - YEAR INCLUDING (CENTURY-1)
! (9) - MONTH OF YEAR
! (10) - DAY OF MONTH
! (11) - HOUR OF DAY
! (12) - MINUTE OF HOUR
! (13) - INDICATOR OF FORECAST TIME UNIT
! (14) - TIME RANGE 1
! (15) - TIME RANGE 2
! (16) - TIME RANGE FLAG
! (17) - NUMBER INCLUDED IN AVERAGE
! (18) - VERSION NR OF GRIB SPECIFICATION
! (19) - VERSION NR OF PARAMETER TABLE
! (20) - NR MISSING FROM AVERAGE/ACCUMULATION
! (21) - CENTURY OF REFERENCE TIME OF DATA
! (22) - UNITS DECIMAL SCALE FACTOR
! (23) - SUBCENTER NUMBER
!
! OUTPUT ARGUMENT LIST:
! kpds() - GRIB1 PDS info as specified in W3FI63.
! (1) - ID OF CENTER
! (2) - GENERATING PROCESS ID NUMBER
! (3) - GRID DEFINITION
! (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8)
! (5) - INDICATOR OF PARAMETER
! (6) - TYPE OF LEVEL
! (7) - HEIGHT/PRESSURE , ETC OF LEVEL
! (8) - YEAR INCLUDING (CENTURY-1)
! (9) - MONTH OF YEAR
! (10) - DAY OF MONTH
! (11) - HOUR OF DAY
! (12) - MINUTE OF HOUR
! (13) - INDICATOR OF FORECAST TIME UNIT
! (14) - TIME RANGE 1
! (15) - TIME RANGE 2
! (16) - TIME RANGE FLAG
! (17) - NUMBER INCLUDED IN AVERAGE
! (18) - VERSION NR OF GRIB SPECIFICATION
! (19) - VERSION NR OF PARAMETER TABLE
! (20) - NR MISSING FROM AVERAGE/ACCUMULATION
! (21) - CENTURY OF REFERENCE TIME OF DATA
! (22) - UNITS DECIMAL SCALE FACTOR
! (23) - SUBCENTER NUMBER
! kens() - Ensemble identification for PDS octets 41-45
! kprob() - Ensemble probability info for PDS octets 46 & 47
! xprob() - Ensemble probability info for PDS octets 48-55
! kclust() - Ensemble cluster info for PDS octets 61-76
! kmembr() - Ensemble membership info for PDS octest 77-86
! iret - Error return value:
! 0 = Successful
! 2 = Unrecognized GRIB2 PDT 4.ipdsnum
!
! REMARKS: Use pds2pdtens for ensemble related PDS
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_gds2gdt(kgds, igds, igdstmpl, idefnum, ideflist, iret)
!
! INTEGER, INTENT(IN ) :: kgds(*)
! INTEGER, INTENT( OUT) :: igds(*), igdstmpl(*), ideflist(*)
! INTEGER, INTENT( OUT) :: idefnum, iret
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-17
!
! ABSTRACT: This routine converts a GRIB1 GDS (in format specfied in
! w3fi63.f) to necessary info for a GRIB2 Grid Definition Section.
!
! PROGRAM HISTORY LOG:
! 2003-06-17 Gilbert
! 2004-04-27 Gilbert - Added support for Gaussian grids.
! 2007-04-16 Vuong - Added Curvilinear Orthogonal grids.
! 2007-05-29 Vuong - Added Rotate Lat/Lon E-grid (203)
! 2010-05-10 Vuong - Added Rotate Lat/Lon for Non-E Stagger grid (205)
! 2011-05-04 Vuong - Corrected Arakawa Lat/Lon of grid points for Non-E Stagger grid (205)
!
! USAGE: CALL ng_gds2gdt(kgds,igds,igdstmpl,idefnum,ideflist,iret)
! INPUT ARGUMENT LIST:
! kgds() - GRIB1 GDS info as returned by w3fi63.f
!
! OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS)
! igds() - Contains information read from the appropriate GRIB Grid
! Definition Section 3 for the field being returned.
! Must be dimensioned >= 5.
! igds(1)=Source of grid definition (see Code Table 3.0)
! igds(2)=Number of grid points in the defined grid.
! igds(3)=Number of octets needed for each
! additional grid points definition.
! Used to define number of
! points in each row ( or column ) for
! non-regular grids.
! = 0, if using regular grid.
! igds(4)=Interpretation of list for optional points
! definition. (Code Table 3.11)
! igds(5)=Grid Definition Template Number (Code Table 3.1)
! igdstmpl() - Grid Definition Template values for GDT 3.igds(5)
! idefnum - The number of entries in array ideflist.
! i.e. number of rows ( or columns )
! for which optional grid points are defined.
! ideflist() - Optional integer array containing
! the number of grid points contained in each row (or column).
! iret - Error return value:
! 0 = Successful
! 1 = Unrecognized GRIB1 grid data representation type
!
! REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_pds2pdt(kpds, ipdsnum, ipdstmpl, numcoord, coordlist, iret)
!
! INTEGER, INTENT(IN ) :: kpds(*)
! INTEGER, INTENT( OUT) :: ipdstmpl(*)
! REAL :: coordlist(*) ! not implementednot
! INTEGER, INTENT( OUT) :: ipdsnum, numcoord, iret
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12
!
! ABSTRACT: This routine converts a GRIB1 PDS (Section 1) info
! to a GRIB2 PDS (Section 4) info with appropriate Product Definition
! Template.
!
! PROGRAM HISTORY LOG:
! 2003-06-12 Gilbert
! 2005-04-19 Gilbert - Changed scaling factor used with potential
! vorticity surfaces.
! 2007-02-07 Gilbert - fixed end date calculation
! 2007-03-26 Gordon - Added check for ECMWF data to reference ECMWF
! Conversion tables.
! 2007-05-14 Boi Vuong - Added Time Range Indicator 51 (Climatological
! Mean Value)
! 2009-05-20 Boi Vuong - Added check for WAFS to use PDT 4.8 for Max Wind
! 2009-12-14 Boi Vuong - Added check for WAFS to use PDT 4.15 for Icing,
! Turbulence and Cumulonimbus
! 2010-02-18 Boi Vuong - Added Time Range Indicator 7
! 2010-08-10 Boi Vuong - Removed check for WAFS to use PDT 4.8 for Max Wind
! 2011-10-24 Boi Vuong - Added check for parameters (MAXUW, MAXVW,
! - to set type of statistical processing (MIN and MAX)
!
! USAGE: CALL ng_pds2pdt(kpds,ipdsnum,ipdstmpl,numcoord,coordlist,iret)
! INPUT ARGUMENT LIST:
! kpds() - GRIB1 PDS info as specified in W3FI63.
!
! OUTPUT ARGUMENT LIST:
! ipdsnum - GRIB2 Product Definition Template Number
! ipdstmpl() - GRIB2 Product Definition Template entries for PDT 4.ipdsnum
! numcoord - number of vertical discretisation values ( not implemented )
! coordlist()- vertical discretisation values ( not implemented )
! iret - Error return value:
! 0 = Successful
! 1 = Unrecognized GRIB1 Time Range Indicator
!
! REMARKS: Use pds2pdtens for ensemble related PDS
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_pds2pdtens(kpds, kens, kprob, xprob, kclust, kmember,&
! ipdsnum, ipdstmpl, numcoord, coordlist, iret)
!
! INTEGER, INTENT(IN ) :: kpds(*), kens(*), kprob(*), kclust(*)
! INTEGER, INTENT(IN ) :: kmember(*)
! REAL, INTENT(IN ) :: xprob(*)
! INTEGER, INTENT( OUT) :: ipdstmpl(*)
! REAL :: coordlist(*) ! not implementednot
! INTEGER, INTENT( OUT) :: ipdsnum, numcoord, iret
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12
!
! ABSTRACT: This routine converts a GRIB1 PDS (Section 1) that includes
! NCEP ensemble PDS extensions
! to a GRIB2 PDS (Section 4) info with appropriate Product Definition
! Template.
!
! PROGRAM HISTORY LOG:
! 2003-06-12 Gilbert
! 2007-02-07 Gilbert - fixed end date calculation
! 2007-05-14 Boi Vuong - Added Time Range Indicator 51 (Climatological
! Mean Value)
!
! USAGE: CALL ng_pds2pdtens(kpds,kens,kprob,xprob,kclust,kmember,
! ipdsnum,ipdstmpl,numcoord,coordlist,iret)
! INPUT ARGUMENT LIST:
! kpds() - GRIB1 PDS info as specified in W3FI63.
! kens() - Ensemble identification from PDS octets 41-45
! kprob() - Ensemble probability info from PDS octets 46 & 47
! xprob() - Ensemble probability info from PDS octets 48-55
! kclust() - Ensemble cluster info from PDS octets 61-76
! kmember()- Ensemble membership info from PDS octest 77-86
!
! OUTPUT ARGUMENT LIST:
! ipdsnum - GRIB2 Product Definition Template Number
! ipdstmpl() - GRIB2 Product Definition Template entries for PDT 4.ipdsnum
! numcoord - number of vertical discretisation values ( not implemented )
! coordlist()- vertical discretisation values ( not implemented )
! iret - Error return value:
! 0 = Successful
! 1 = Unrecognized GRIB1 Time Range Indicator for ensembles
! 2 = Unrecognized GRIB1 Ensemble type
! 10 = Unrecognized GRIB1 Time Range Indicator for probabilities
!
! REMARKS: Use routine pds2pdt for non ensemble related PDS.
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_cnvlevel(ltype, lval, ipdstmpl)
!
! INTEGER, INTENT(IN ) :: ltype, lval
! INTEGER, INTENT(INOUT) :: ipdstmpl(*)
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12
!
! ABSTRACT: this routine converts a GRIB1 Level type and Level value
! to GRIB2 values and fills in the appropriate PDT values for the
! level/layer information.
!
! PROGRAM HISTORY LOG:
! 2003-06-12 Gilbert
! 2011-01-13 Boi Vuong - Added level/layer values from 235 to 239
!
! USAGE: CALL ng_cnvlevel(ltype,lval,ipdstmpl)
! INPUT ARGUMENT LIST:
! ltype - GRIB1 level type (PDS octet 10)
! lval - GRIB1 level/layer value(s) (PDS octets 11 and 12)
!
! OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS)
! ipdstmpl() - GRIB2 Product Definition Template values
!
! REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_levelcnv(ipdstmpl, ltype, lval)
!
! INTEGER, INTENT(IN ) :: ipdstmpl(*)
! INTEGER, INTENT( OUT) :: ltype,lval
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2003-06-12
!
! ABSTRACT: this routine converts Level/layer information
! from a GRIB2 Product Definition Template to GRIB1
! Level type and Level value.
!
! PROGRAM HISTORY LOG:
! 2003-06-12 Gilbert
! 2007-10-24 Boi Vuong - Added level 8 (Nominal top of atmosphere)
! 2011-01-13 Boi Vuong - Added level/layer values from 235 to 239
!
! USAGE: CALL ng_levelcnv(ipdstmpl,ltype,lval)
! INPUT ARGUMENT LIST:
! ipdstmpl() - GRIB2 Product Definition Template values
!
! OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS)
! ltype - GRIB1 level type (PDS octet 10)
! lval - GRIB1 level/layer value(s) (PDS octets 11 and 12)
!
! REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION
!
!=====================================================================
!
! ~~~~~~~~~~~
! Pack/Unpack
! ~~~~~~~~~~~
!
! SUBROUTINE ng_cmplxpack(fld, ndpts, idrsnum, idrstmpl, cpack, lcpack)
! SUBROUTINE ng_comunpack(cpack, len, lensec, idrsnum, idrstmpl, ndpts, fld, ier)
!
! SUBROUTINE ng_jpcpack(fld, width, height, idrstmpl, cpack, lcpack)
! SUBROUTINE ng_jpcunpack(cpack, nlen, idrstmpl, ndpts, fld)
!
! SUBROUTINE ng_pngpack(fld, width, height, idrstmpl, cpack, lcpack)
! SUBROUTINE ng_pngunpack(cpack, nlen, idrstmpl, ndpts, fld)
!
! SUBROUTINE ng_simpack(fld, ndpts, idrstmpl, cpack, lcpack)
! SUBROUTINE ng_simunpack(cpack, len, idrstmpl, ndpts, fld)
!
! SUBROUTINE ng_specpack(fld, ndpts, JJ, KK, MM, idrstmpl, cpack, lcpack)
! SUBROUTINE ng_specunpack(cpack, len, idrstmpl, ndpts, JJ, KK, MM, fld)
!
! SUBROUTINE ng_mkieee(a, rieee, num)
! SUBROUTINE ng_rdieee(rieee, a, num)
!
! SUBROUTINE NG_GRIB_GBYTES(IN,IOUT,ISKIP,NBYTE,NSKIP,N)
! SUBROUTINE NG_GRIB_SBYTES( OUT,IN,ISKIP,NBYTE,NSKIP,N)
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_cmplxpack(fld, ndpts, idrsnum, idrstmpl, cpack, lcpack)
!
! INTEGER, INTENT(IN ) :: ndpts, idrsnum
! REAL, INTENT(IN ) :: fld(ndpts)
! CHARACTER(1), INTENT( OUT) :: cpack(*)
! INTEGER, INTENT(INOUT) :: idrstmpl(*)
! INTEGER, INTENT( OUT) :: lcpack
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-08-27
!
! ABSTRACT: This subroutine packs up a data field using a complex
! packing algorithm as defined in the GRIB2 documention. It
! supports GRIB2 complex packing templates with or without
! spatial differences (i.e. DRTs 5.2 and 5.3).
! It also fills in GRIB2 Data Representation Template 5.2 or 5.3
! with the appropriate values.
!
! PROGRAM HISTORY LOG:
! 2004-08-27 Gilbert
!
! USAGE: CALL cmplxpack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
! INPUT ARGUMENT LIST:
! fld() - Contains the data values to pack
! ndpts - The number of data values in array fld()
! idrsnum - Data Representation Template number 5.N
! Must equal 2 or 3.
! idrstmpl - Contains the array of values for Data Representation
! Template 5.2 or 5.3
! (1) = Reference value - ignored on input
! (2) = Binary Scale Factor
! (3) = Decimal Scale Factor
! .
! .
! (7) = Missing value management
! (8) = Primary missing value
! (9) = Secondary missing value
! .
! .
! (17) = Order of Spatial Differencing ( 1 or 2 )
! .
! .
!
! OUTPUT ARGUMENT LIST:
! idrstmpl - Contains the array of values for Data Representation
! Template 5.3
! (1) = Reference value - set by compack routine.
! (2) = Binary Scale Factor - unchanged from input
! (3) = Decimal Scale Factor - unchanged from input
! .
! .
! cpack - The packed data field (character*1 array)
! lcpack - length of packed field cpack().
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_comunpack(cpack, len, lensec, idrsnum, idrstmpl, ndpts, fld, ier)
!
! INTEGER, INTENT(IN ) :: ndpts, len, lensec, idrsnum
! CHARACTER(1), INTENT(IN ) :: cpack(len)
! INTEGER, INTENT(IN ) :: idrstmpl(*)
! REAL, INTENT( OUT) :: fld(ndpts)
! INTEGER, INTENT( OUT) :: ier
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-06-21
!
! ABSTRACT: This subroutine unpacks a data field that was packed using a
! complex packing algorithm as defined in the GRIB2 documention,
! using info from the GRIB2 Data Representation Template 5.2 or 5.3.
! Supports GRIB2 complex packing templates with or without
! spatial differences (i.e. DRTs 5.2 and 5.3).
!
! PROGRAM HISTORY LOG:
! 2000-06-21 Gilbert
! 2004-12-29 Gilbert - Added test ( provided by Arthur Taylor/MDL )
! to verify that group widths and lengths are
! consistent with section length.
! 2016-02-26 update unpacking for template 5.3
!
! USAGE: CALL comunpack(cpack,len,lensec,idrsnum,idrstmpl,ndpts,fld,ier)
! INPUT ARGUMENT LIST:
! cpack - The packed data field (character*1 array)
! len - length of packed field cpack().
! lensec - length of section 7 (used for error checking).
! idrsnum - Data Representation Template number 5.N
! Must equal 2 or 3.
! idrstmpl - Contains the array of values for Data Representation
! Template 5.2 or 5.3
! ndpts - The number of data values to unpack
!
! OUTPUT ARGUMENT LIST:
! fld() - Contains the unpacked data values
! ier - Error return:
! 0 = OK
! 1 = Problem - inconsistent group lengths of widths.
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_jpcpack(fld, width, height, idrstmpl, cpack, lcpack)
!
! INTEGER, INTENT(IN ) :: width, height
! REAL, INTENT(IN ) :: fld(width*height)
! CHARACTER(1), INTENT( OUT) :: cpack(*)
! INTEGER, INTENT(INOUT) :: idrstmpl(*)
! INTEGER, INTENT(INOUT) :: lcpack
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-17
!
! ABSTRACT: This subroutine packs up a data field into a JPEG2000 code stream.
! After the data field is scaled, and the reference value is subtracted out,
! it is treated as a grayscale image and passed to a JPEG2000 encoder.
! It also fills in GRIB2 Data Representation Template 5.40 or 5.40000 with the
! appropriate values.
!
! PROGRAM HISTORY LOG:
! 2002-12-17 Gilbert
! 2004-07-19 Gilbert - Added check on whether the jpeg2000 encoding was
! successful. If not, try again with different encoder
! options.
!
! USAGE: CALL jpcpack(fld,width,height,idrstmpl,cpack,lcpack)
! INPUT ARGUMENT LIST:
! fld() - Contains the data values to pack
! width - number of points in the x direction
! height - number of points in the y direction
! idrstmpl - Contains the array of values for Data Representation
! Template 5.40 or 5.40000
! (1) = Reference value - ignored on input
! (2) = Binary Scale Factor
! (3) = Decimal Scale Factor
! (4) = number of bits for each data value - ignored on input
! (5) = Original field type - currently ignored on input
! Data values assumed to be reals.
! (6) = 0 - use lossless compression
! = 1 - use lossy compression
! (7) = Desired compression ratio, if idrstmpl(6)=1.
! Set to 255, if idrstmpl(6)=0.
! lcpack - size of array cpack().
!
! OUTPUT ARGUMENT LIST:
! idrstmpl - Contains the array of values for Data Representation
! Template 5.0
! (1) = Reference value - set by jpcpack routine.
! (2) = Binary Scale Factor - unchanged from input
! (3) = Decimal Scale Factor - unchanged from input
! (4) = Number of bits containing each grayscale pixel value
! (5) = Original field type - currently set = 0 on output.
! Data values assumed to be reals.
! (6) = 0 - use lossless compression
! = 1 - use lossy compression
! (7) = Desired compression ratio, if idrstmpl(6)=1
! cpack - The packed data field (character*1 array)
! lcpack - length of packed field in cpack().
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_jpcunpack(cpack, nlen, idrstmpl, ndpts, fld)
!
! INTEGER, INTENT(IN ) :: nlen, ndpts
! CHARACTER(1), INTENT(IN ) :: cpack(nlen)
! INTEGER, INTENT(IN ) :: idrstmpl(*)
! REAL, INTENT( OUT) :: fld(ndpts)
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-17
!
! ABSTRACT: This subroutine unpacks a data field that was packed into a
! JPEG2000 code stream
! using info from the GRIB2 Data Representation Template 5.40 or 5.40000.
!
! PROGRAM HISTORY LOG:
! 2002-12-17 Gilbert
!
! USAGE: CALL jpcunpack(cpack,nlen,idrstmpl,ndpts,fld)
! INPUT ARGUMENT LIST:
! cpack - The packed data field (character*1 array)
! nlen - length of packed field cpack().
! idrstmpl - Contains the array of values for Data Representation
! Template 5.40 or 5.40000
! ndpts - The number of data values to unpack
!
! OUTPUT ARGUMENT LIST:
! fld() - Contains the unpacked data values
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_pngpack(fld, width, height, idrstmpl, cpack, lcpack)
!
! INTEGER, INTENT(IN ) :: width, height
! REAL, INTENT(IN ) :: fld(width*height)
! CHARACTER(1), INTENT( OUT) :: cpack(*)
! INTEGER, INTENT(INOUT) :: idrstmpl(*)
! INTEGER, INTENT( OUT) :: lcpack
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-21
!
! ABSTRACT: This subroutine packs up a data field into PNG image format.
! After the data field is scaled, and the reference value is subtracted out,
! it is treated as a grayscale image and passed to a PNG encoder.
! It also fills in GRIB2 Data Representation Template 5.41 or 5.40010 with the
! appropriate values.
!
! PROGRAM HISTORY LOG:
! 2002-12-21 Gilbert
!
! USAGE: CALL pngpack(fld,width,height,idrstmpl,cpack,lcpack)
! INPUT ARGUMENT LIST:
! fld() - Contains the data values to pack
! width - number of points in the x direction
! height - number of points in the y direction
! idrstmpl - Contains the array of values for Data Representation
! Template 5.41 or 5.40010
! (1) = Reference value - ignored on input
! (2) = Binary Scale Factor
! (3) = Decimal Scale Factor
! (4) = number of bits for each data value - ignored on input
! (5) = Original field type - currently ignored on input
! Data values assumed to be reals.
!
! OUTPUT ARGUMENT LIST:
! idrstmpl - Contains the array of values for Data Representation
! Template 5.41 or 5.40010
! (1) = Reference value - set by pngpack routine.
! (2) = Binary Scale Factor - unchanged from input
! (3) = Decimal Scale Factor - unchanged from input
! (4) = Number of bits containing each grayscale pixel value
! (5) = Original field type - currently set = 0 on output.
! Data values assumed to be reals.
! cpack - The packed data field (character*1 array)
! lcpack - length of packed field cpack().
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_pngunpack(cpack, nlen, idrstmpl, ndpts, fld)
!
! INTEGER, INTENT(IN ) :: ndpts, nlen
! CHARACTER(1), INTENT(IN ) :: cpack(nlen)
! INTEGER, INTENT(IN ) :: idrstmpl(*)
! REAL, INTENT( OUT) :: fld(ndpts)
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-06-21
!
! ABSTRACT: This subroutine unpacks a data field that was packed into a
! PNG image format
! using info from the GRIB2 Data Representation Template 5.41 or 5.40010.
!
! PROGRAM HISTORY LOG:
! 2000-06-21 Gilbert
!
! USAGE: CALL pngunpack(cpack,nlen,idrstmpl,ndpts,fld)
! INPUT ARGUMENT LIST:
! cpack - The packed data field (character*1 array)
! nlen - length of packed field cpack().
! idrstmpl - Contains the array of values for Data Representation
! Template 5.41 or 5.40010
! ndpts - The number of data values to unpack
!
! OUTPUT ARGUMENT LIST:
! fld() - Contains the unpacked data values
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_simpack(fld, ndpts, idrstmpl, cpack, lcpack)
!
! INTEGER, INTENT(IN ) :: ndpts
! REAL, INTENT(IN ) :: fld(ndpts)
! CHARACTER(1), INTENT( OUT) :: cpack(*)
! INTEGER, INTENT(INOUT) :: idrstmpl(*)
! INTEGER, INTENT( OUT) :: lcpack
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-06-21
!
! ABSTRACT: This subroutine packs up a data field using a simple
! packing algorithm as defined in the GRIB2 documention. It
! also fills in GRIB2 Data Representation Template 5.0 with the
! appropriate values.
!
! PROGRAM HISTORY LOG:
! 2000-06-21 Gilbert
! 2011-10-24 Boi Vuong Added variable rmin4 for 4 byte float
!
! USAGE: CALL simpack(fld,ndpts,idrstmpl,cpack,lcpack)
! INPUT ARGUMENT LIST:
! fld() - Contains the data values to pack
! ndpts - The number of data values in array fld()
! idrstmpl - Contains the array of values for Data Representation
! Template 5.0
! (1) = Reference value - ignored on input
! (2) = Binary Scale Factor
! (3) = Decimal Scale Factor
! (4) = Number of bits used to pack data, if value is
! > 0 and <= 31.
! If this input value is 0 or outside above range
! then the num of bits is calculated based on given
! data and scale factors.
! (5) = Original field type - currently ignored on input
! Data values assumed to be reals.
!
! OUTPUT ARGUMENT LIST:
! idrstmpl - Contains the array of values for Data Representation
! Template 5.0
! (1) = Reference value - set by simpack routine.
! (2) = Binary Scale Factor - unchanged from input
! (3) = Decimal Scale Factor - unchanged from input
! (4) = Number of bits used to pack data, unchanged from
! input if value is between 0 and 31.
! If this input value is 0 or outside above range
! then the num of bits is calculated based on given
! data and scale factors.
! (5) = Original field type - currently set = 0 on output.
! Data values assumed to be reals.
! cpack - The packed data field (character*1 array)
! lcpack - length of packed field cpack().
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_simunpack(cpack, len, idrstmpl, ndpts, fld)
!
! INTEGER, INTENT(IN ) :: ndpts, len
! CHARACTER(1), INTENT(IN ) :: cpack(len)
! INTEGER, INTENT(IN ) :: idrstmpl(*)
! REAL, INTENT( OUT) :: fld(ndpts)
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-06-21
!
! ABSTRACT: This subroutine unpacks a data field that was packed using a
! simple packing algorithm as defined in the GRIB2 documention,
! using info from the GRIB2 Data Representation Template 5.0.
!
! PROGRAM HISTORY LOG:
! 2000-06-21 Gilbert
!
! USAGE: CALL simunpack(cpack,len,idrstmpl,ndpts,fld)
! INPUT ARGUMENT LIST:
! cpack - The packed data field (character*1 array)
! len - length of packed field cpack().
! idrstmpl - Contains the array of values for Data Representation
! Template 5.0
! ndpts - The number of data values to unpack
!
! OUTPUT ARGUMENT LIST:
! fld() - Contains the unpacked data values
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_specpack(fld, ndpts, JJ, KK, MM, idrstmpl, cpack, lcpack)
!
! INTEGER, INTENT(IN ) :: ndpts, JJ, KK, MM
! REAL, INTENT(IN ) :: fld(ndpts)
! INTEGER, INTENT(INOUT) :: idrstmpl(*)
! CHARACTER (1), INTENT( OUT) :: cpack(*)
! INTEGER, INTENT( OUT) :: lcpack
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-19
!
! ABSTRACT: This subroutine packs a spectral data field using the complex
! packing algorithm for spherical harmonic data as
! defined in the GRIB2 Data Representation Template 5.51.
!
! PROGRAM HISTORY LOG:
! 2002-12-19 Gilbert
!
! USAGE: CALL specpack(fld,ndpts,JJ,KK,MM,idrstmpl,cpack,lcpack)
! INPUT ARGUMENT LIST:
! fld() - Contains the packed data values
! ndpts - The number of data values to pack
! JJ - J - pentagonal resolution parameter
! KK - K - pentagonal resolution parameter
! MM - M - pentagonal resolution parameter
! idrstmpl - Contains the array of values for Data Representation
! Template 5.51
!
! OUTPUT ARGUMENT LIST:
! cpack - The packed data field (character*1 array)
! lcpack - length of packed field cpack().
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_specunpack(cpack, len, idrstmpl, ndpts, JJ, KK, MM, fld)
!
! INTEGER, INTENT(IN ) :: ndpts, len, JJ, KK, MM
! CHARACTER(1), INTENT(IN ) :: cpack(len)
! INTEGER, INTENT(IN ) :: idrstmpl(*)
! REAL, INTENT( OUT) :: fld(ndpts)
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-19
!
! ABSTRACT: This subroutine unpacks a spectral data field that was packed
! using the complex packing algorithm for spherical harmonic data as
! defined in the GRIB2 documention,
! using info from the GRIB2 Data Representation Template 5.51.
!
! PROGRAM HISTORY LOG:
! 2002-12-19 Gilbert
!
! USAGE: CALL specunpack(cpack,len,idrstmpl,ndpts,JJ,KK,MM,fld)
! INPUT ARGUMENT LIST:
! cpack - The packed data field (character*1 array)
! len - length of packed field cpack().
! idrstmpl - Contains the array of values for Data Representation
! Template 5.51
! ndpts - The number of data values to unpack
! JJ - J - pentagonal resolution parameter
! KK - K - pentagonal resolution parameter
! MM - M - pentagonal resolution parameter
!
! OUTPUT ARGUMENT LIST:
! fld() - Contains the unpacked data values
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_mkieee(a, rieee, num)
!
! INTEGER, INTENT(IN ) :: num
! REAL*4, INTENT(IN ) :: a(num) ! *4: guarantee 4-byte
! REAL*4, INTENT( OUT) :: rieee(num) ! *4: guarantee 4-byte
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-09
!
! ABSTRACT: This subroutine stores a list of real values in
! 32-bit IEEE floating point format.
!
! PROGRAM HISTORY LOG:
! 2000-05-09 Gilbert
!
! USAGE: CALL mkieee(a,rieee,num)
! INPUT ARGUMENT LIST:
! a - Input array of floating point values.
! num - Number of floating point values to convert.
!
! OUTPUT ARGUMENT LIST:
! rieee - Output array of floating point values in 32-bit IEEE format.
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE ng_rdieee(rieee, a, num)
!
! INTEGER, INTENT(IN ) :: num
! REAL*4, INTENT(IN ) :: rieee(num) ! *4: guarantee 4-byte
! REAL, INTENT( OUT) :: a(num)
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-09
!
! ABSTRACT: This subroutine reads a list of real values in
! 32-bit IEEE floating point format.
!
! PROGRAM HISTORY LOG:
! 2000-05-09 Gilbert
!
! USAGE: CALL rdieee(rieee,a,num)
! INPUT ARGUMENT LIST:
! rieee - Input array of floating point values in 32-bit IEEE format.
! num - Number of floating point values to convert.
!
! OUTPUT ARGUMENT LIST:
! a - Output array of real values.
!
! REMARKS: None
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GRIB_GBYTES(IN,IOUT,ISKIP,NBYTE,NSKIP,N) v1.1
!
! CHARACTER(1), INTENT(IN ) :: IN(*)
! INTEGER, INTENT(IN ) :: ISKIP, NBYTE, NSKIP, N
! INTEGER, INTENT( OUT) :: IOUT(N)
!
! Get bytes - unpack bits: Extract arbitrary size values from a
! packed bit string, right justifying each value in the unpacked
! array.
!
! IN = character*1 array input
! IOUT = unpacked array output
! ISKIP = initial number of bits to skip
! NBYTE = number of bits to take
! NSKIP = additional number of bits to skip on each iteration
! N = number of iterations
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GRIB_SBYTES(OUT,IN,ISKIP,NBYTE,NSKIP,N) v1.1
!
! CHARACTER(1), INTENT( OUT) :: OUT(*)
! INTEGER, INTENT(IN ) :: ISKIP, NBYTE, NSKIP, N
! INTEGER, INTENT(IN ) :: IN(N)
!
! Store bytes - pack bits: Put arbitrary size values into a
! packed bit string, taking the low order bits from each value
! in the unpacked array.
!
! IOUT = packed array output
! IN = unpacked array input
! ISKIP = initial number of bits to skip
! NBYTE = number of bits to pack
! NSKIP = additional number of bits to skip on each iteration
! N = number of iterations
!
!=====================================================================
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Access GRIB2 Grid Definition
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! INTEGER FUNCTION ng_getgridindex(number)
!
! SUBROUTINE ng_getgridtemplate(number, nummap, map, needext, iret)
!
! SUBROUTINE ng_extgridtemplate(number, list, nummap, map)
!
! INTEGER FUNCTION ng_getgdtlen(number)
!
!---------------------------------------------------------------------
!
! MODULE: gridtemplates (internal use)
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-09
!
! ABSTRACT: This Fortran Module contains info on all the available
! GRIB2 Grid Definition Templates used in Section 3 (GDS).
! Each Template has three parts: The number of entries in the template
! (mapgridlen); A map of the template (mapgrid), which contains the
! number of octets in which to pack each of the template values; and
! a logical value (needext) that indicates whether the Template needs
! to be extended. In some cases the number of entries in a template
! can vary depending upon values specified in the "static" part of
! the template. ( See Template 3.120 as an example )
!
! This module also contains two subroutines. Subroutine getgridtemplate
! returns the octet map for a specified Template number, and
! subroutine extgridtemplate will calculate the extended octet map
! of an appropriate template given values for the "static" part of the
! template. See docblocks below for the arguments and usage of these
! routines.
!
! NOTE: Array mapgrid contains the number of octets in which the
! corresponding template values will be stored. A negative value in
! mapgrid is used to indicate that the corresponding template entry can
! contain negative values. This information is used later when packing
! (or unpacking) the template data values. Negative data values in GRIB
! are stored with the left most bit set to one, and a negative number
! of octets value in mapgrid() indicates that this possibility should
! be considered. The number of octets used to store the data value
! in this case would be the absolute value of the negative value in
! mapgrid().
!
! PROGRAM HISTORY LOG:
! 2000-05-09 Gilbert
! 2003-09-02 Gilbert - Added GDT 3.31 - Albers Equal Area
! 2007-04-24 Vuong - Added GDT 3.204 Curilinear Orthogonal Grids
! 2008-05-29 Vuong - Added GDT 3.32768 Rotate Lat/Lon E-grid
! 2010-05-10 Vuong - Added GDT 3.32769 Rotate Lat/Lon Non E-Stagger grid
! 2013-08-06 Vuong - Added GDT 3.4,3.5,3.12,3.101,3.140
!
!---------------------------------------
! use following four routines to assess (for CNCARG users)
!---------------------------------------
!
! INTEGER FUNCTION ng_getgridindex(number)
! INTEGER, INTENT(IN) :: number
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-28
!
! ABSTRACT: This function returns the index of specified Grid
! Definition Template 3.NN (NN=number) in array templates.
!
! PROGRAM HISTORY LOG:
! 2001-06-28 Gilbert
!
! USAGE: index=ng_getgridindex(number)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Grid Definition
! Template 3.NN that is being requested.
!
! RETURNS: Index of GDT 3.NN in array templates, if template exists.
! = -1, otherwise.
!
!---------------------------------------
!
! SUBROUTINE ng_getgridtemplate(number, nummap, map, needext, iret)
!
! INTEGER, INTENT(IN ) :: number
! INTEGER, INTENT( OUT) :: nummap, map(*), iret
! LOGICAL, INTENT( OUT) :: needext
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-09
!
! ABSTRACT: This subroutine returns grid template information for a
! specified Grid Definition Template 3.NN.
! The number of entries in the template is returned along with a map
! of the number of octets occupied by each entry. Also, a flag is
! returned to indicate whether the template would need to be extended.
!
! PROGRAM HISTORY LOG:
! 2000-05-09 Gilbert
!
! USAGE: CALL ng_getgridtemplate(number,nummap,map,needext,iret)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Grid Definition
! Template 3.NN that is being requested.
!
! OUTPUT ARGUMENT LIST:
! nummap - Number of entries in the Template
! map() - An array containing the number of octets that each
! template entry occupies when packed up into the GDS.
! needext - Logical variable indicating whether the Grid Defintion
! Template has to be extended.
! ierr - Error return code.
! 0 = no error
! 1 = Undefine Grid Template number.
!
!---------------------------------------
!
! SUBROUTINE ng_extgridtemplate(number, list, nummap, map)
!
! INTEGER, INTENT(IN ) :: number, list(*)
! INTEGER, INTENT( OUT) :: nummap, map(*)
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-09
!
! ABSTRACT: This subroutine generates the remaining octet map for a
! given Grid Definition Template, if required. Some Templates can
! vary depending on data values given in an earlier part of the
! Template, and it is necessary to know some of the earlier entry
! values to generate the full octet map of the Template.
!
! PROGRAM HISTORY LOG:
! 2000-05-09 Gilbert
! 2013-07-30 Vuong - Added GDT 3.4,3.5,3.12,3.101,3.140
!
! USAGE: CALL ng_extgridtemplate(number,list,nummap,map)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Grid Definition
! Template 3.NN that is being requested.
! list() - The list of values for each entry in
! the Grid Definition Template.
!
! OUTPUT ARGUMENT LIST:
! nummap - Number of entries in the Template
! map() - An array containing the number of octets that each
! template entry occupies when packed up into the GDS.
!
!---------------------------------------
!
! INTEGER FUNCTION ng_getgdtlen(number)
! INTEGER, INTENT(IN) :: number
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-05-11
!
! ABSTRACT: This function returns the initial length (number of entries) in
! the "static" part of specified Grid Definition Template 3.number.
!
! PROGRAM HISTORY LOG:
! 2004-05-11 Gilbert
!
! USAGE: CALL ng_getgdtlen(number)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Grid Definition
! Template 3.NN that is being requested.
!
! RETURNS: Number of entries in the "static" part of GDT 3.number
! OR returns 0, if requested template is not found.
!
! REMARKS: If user needs the full length of a specific template that
! contains additional entries based on values set in the "static" part
! of the GDT, subroutine ng_extgridtemplate can be used.
!
!=====================================================================
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Access GRIB2 Product Definition
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! INTEGER FUNCTION ng_getpdsindex(number)
!
! SUBROUTINE ng_getpdstemplate(number, nummap, map, needext, iret)
!
! SUBROUTINE ng_extpdstemplate(number, list, nummap, map)
!
! INTEGER FUNCTION ng_getpdtlen(number)
!
!---------------------------------------------------------------------
!
! MODULE: pdstemplates (internal use)
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11
!
! ABSTRACT: This Fortran Module contains info on all the available
! GRIB2 Product Definition Templates used in Section 4 (PDS).
! Each Template has three parts: The number of entries in the template
! (mapgridlen); A map of the template (mapgrid), which contains the
! number of octets in which to pack each of the template values; and
! a logical value (needext) that indicates whether the Template needs
! to be extended. In some cases the number of entries in a template
! can vary depending upon values specified in the "static" part of
! the template. ( See Template 4.3 as an example )
!
! This module also contains two subroutines. Subroutine getpdstemplate
! returns the octet map for a specified Template number, and
! subroutine extpdstemplate will calculate the extended octet map
! of an appropriate template given values for the "static" part of the
! template. See docblocks below for the arguments and usage of these
! routines.
!
! NOTE: Array mapgrid contains the number of octets in which the
! corresponding template values will be stored. A negative value in
! mapgrid is used to indicate that the corresponding template entry can
! contain negative values. This information is used later when packing
! (or unpacking) the template data values. Negative data values in GRIB
! are stored with the left most bit set to one, and a negative number
! of octets value in mapgrid() indicates that this possibility should
! be considered. The number of octets used to store the data value
! in this case would be the absolute value of the negative value in
! mapgrid().
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
! 2001-12-04 Gilbert - Added Templates 4.12, 4.12, 4.14,
! 4.1000, 4.1001, 4.1002, 4.1100 and 4.1101
! 2009-05-21 VUONG - Allow negative scale factors and limits for
! Templates 4.5 and 4.9
! 2009-12-14 VUONG - Added Templates (Satellite Product) 4.31
! Added Templates (ICAO WAFS) 4.15
! 2010-08-03 VUONG - Added Templates 4.40,4.41,4.42,.4.43
! 2010-12-08 Vuong - Corrected Product Definition Template 4.42 and 4.43
! 2012-02-07 Vuong - Added Templates 4.44,4.45,4.46,4.47,4.48,4.50,
! 4.51,4.91,4.32 and 4.52
! 2013-07-29 Vuong - Corrected 4.91 and added Templates 4.33,4.34,4.53,4.54
!
!---------------------------------------
! use following four routines to assess (for CNCARG users)
!---------------------------------------
!
! INTEGER FUNCTION ng_getpdsindex(number)
! INTEGER, INTENT(IN) :: number
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-28
!
! ABSTRACT: This function returns the index of specified Product
! Definition Template 4.NN (NN=number) in array templates.
!
! PROGRAM HISTORY LOG:
! 2001-06-28 Gilbert
!
! USAGE: index=ng_getpdsindex(number)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Product Definition
! Template 4.NN that is being requested.
!
! RETURNS: Index of PDT 4.NN in array templates, if template exists.
! = -1, otherwise.
!
!---------------------------------------
!
! SUBROUTINE ng_getpdstemplate(number, nummap, map, needext, iret)
!
! INTEGER, INTENT(IN ) :: number
! INTEGER, INTENT( OUT) :: nummap, map(*), iret
! LOGICAL, INTENT( OUT) :: needext
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11
!
! ABSTRACT: This subroutine returns PDS template information for a
! specified Product Definition Template 4.NN.
! The number of entries in the template is returned along with a map
! of the number of octets occupied by each entry. Also, a flag is
! returned to indicate whether the template would need to be extended.
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
! 2010-08-03 VUONG - Added Templates 4.40,4.41,4.42,.4.43
! 2010-12-08 Vuong - Corrected Product Definition Template 4.42 and 4.43
! 2013-07-29 Vuong - Added Templates 4.48,4.50,4.33,4.34,4.53,4.54
!
! USAGE: CALL ng_getpdstemplate(number,nummap,map,needext,iret)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Product Definition
! Template 4.NN that is being requested.
!
! OUTPUT ARGUMENT LIST:
! nummap - Number of entries in the Template
! map() - An array containing the number of octets that each
! template entry occupies when packed up into the PDS.
! needext - Logical variable indicating whether the Product Defintion
! Template has to be extended.
! ierr - Error return code.
! 0 = no error
! 1 = Undefine Product Template number.
!
!---------------------------------------
!
! SUBROUTINE ng_extpdstemplate(number, list, nummap, map)
!
! INTEGER, INTENT(IN ) :: number, list(*)
! INTEGER, INTENT( OUT) :: nummap, map(*)
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11
!
! ABSTRACT: This subroutine generates the remaining octet map for a
! given Product Definition Template, if required. Some Templates can
! vary depending on data values given in an earlier part of the
! Template, and it is necessary to know some of the earlier entry
! values to generate the full octet map of the Template.
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
! 2010-08-03 VUONG - Added Templates 4.40,4.41,4.42,.4.43
! 2010-12-08 Vuong - Corrected Product Definition Template 4.42 and 4.43
! 2013-07-29 Vuong - Added Templates 4.48,4.50,4.33,4.34,4.53,4.54
!
! USAGE: CALL ng_extpdstemplate(number,list,nummap,map)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Product Definition
! Template 4.NN that is being requested.
! list() - The list of values for each entry in the
! the Product Definition Template 4.NN.
!
! OUTPUT ARGUMENT LIST:
! nummap - Number of entries in the Template
! map() - An array containing the number of octets that each
! template entry occupies when packed up into the GDS.
!
!---------------------------------------
!
! INTEGER FUNCTION ng_getpdtlen(number)
! INTEGER, INTENT(IN) :: number
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-05-11
!
! ABSTRACT: This function returns the initial length (number of entries) in
! the "static" part of specified Product Definition Template 4.number.
!
! PROGRAM HISTORY LOG:
! 2004-05-11 Gilbert
!
! USAGE: CALL ng_getpdtlen(number)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Product Definition
! Template 4.NN that is being requested.
!
! RETURNS: Number of entries in the "static" part of PDT 4.number
! OR returns 0, if requested template is not found.
!
! REMARKS: If user needs the full length of a specific template that
! contains additional entries based on values set in the "static" part
! of the PDT, subroutine ng_extpdstemplate can be used.
!
!=====================================================================
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Access GRIB2 Data Representation
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! INTEGER FUNCTION ng_getdrsindex(number)
!
! SUBROUTINE ng_getdrstemplate(number, nummap, map, needext, iret)
!
! SUBROUTINE ng_extdrstemplate(number, list, nummap, map)
!
!---------------------------------------------------------------------
!
! MODULE: drstemplates (internal use)
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-04-03
!
! ABSTRACT: This Fortran Module contains info on all the available
! GRIB2 Data Representation Templates used in Section 5 (DRS).
! Each Template has three parts: The number of entries in the template
! (mapgridlen); A map of the template (mapgrid), which contains the
! number of octets in which to pack each of the template values; and
! a logical value (needext) that indicates whether the Template needs
! to be extended. In some cases the number of entries in a template
! can vary depending upon values specified in the "static" part of
! the template. ( See Template 5.1 as an example )
!
! This module also contains two subroutines. Subroutine getdrstemplate
! returns the octet map for a specified Template number, and
! subroutine extdrstemplate will calculate the extended octet map
! of an appropriate template given values for the "static" part of the
! template. See docblocks below for the arguments and usage of these
! routines.
!
! NOTE: Array mapgrid contains the number of octets in which the
! corresponding template values will be stored. A negative value in
! mapgrid is used to indicate that the corresponding template entry can
! contain negative values. This information is used later when packing
! (or unpacking) the template data values. Negative data values in GRIB
! are stored with the left most bit set to one, and a negative number
! of octets value in mapgrid() indicates that this possibility should
! be considered. The number of octets used to store the data value
! in this case would be the absolute value of the negative value in
! mapgrid().
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
! 2002-12-11 Gilbert - Added templates for JPEG2000 and PNG encoding
!
!---------------------------------------
! use following three routines to assess (for CNCARG users)
!---------------------------------------
!
! INTEGER FUNCTION ng_getdrsindex(number)
! INTEGER, INTENT(IN) :: number
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-28
!
! ABSTRACT: This function returns the index of specified Data
! Representation Template 5.NN (NN=number) in array templates.
!
! PROGRAM HISTORY LOG:
! 2001-06-28 Gilbert
!
! USAGE: index=ng_getdrsindex(number)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Data Representation
! Template 5.NN that is being requested.
!
! RETURNS: Index of DRT 5.NN in array templates, if template exists.
! = -1, otherwise.
!
!---------------------------------------
!
! SUBROUTINE ng_getdrstemplate(number, nummap, map, needext, iret)
!
! INTEGER, INTENT(IN ) :: number
! INTEGER, INTENT( OUT) :: nummap, map(*), iret
! LOGICAL, INTENT( OUT) :: needext
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11
!
! ABSTRACT: This subroutine returns DRS template information for a
! specified Data Representation Template 5.NN.
! The number of entries in the template is returned along with a map
! of the number of octets occupied by each entry. Also, a flag is
! returned to indicate whether the template would need to be extended.
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
!
! USAGE: CALL ng_getdrstemplate(number,nummap,map,needext,iret)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Data Representation
! Template 5.NN that is being requested.
!
! OUTPUT ARGUMENT LIST:
! nummap - Number of entries in the Template
! map() - An array containing the number of octets that each
! template entry occupies when packed up into the DRS.
! needext - Logical variable indicating whether the Data Representation
! Template has to be extended.
! ierr - Error return code.
! 0 = no error
! 1 = Undefined Data Representation Template number.
!
!---------------------------------------
!
! SUBROUTINE ng_extdrstemplate(number, list, nummap, map)
!
! INTEGER, INTENT(IN ) :: number, list(*)
! INTEGER, INTENT( OUT) :: nummap, map(*)
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11
!
! ABSTRACT: This subroutine generates the remaining octet map for a
! given Data Representation Template, if required. Some Templates can
! vary depending on data values given in an earlier part of the
! Template, and it is necessary to know some of the earlier entry
! values to generate the full octet map of the Template.
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
!
! USAGE: CALL ng_extdrstemplate(number,list,nummap,map)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Data Representation
! Template 5.NN that is being requested.
! list() - The list of values for each entry in the
! the Data Representation Template 5.NN.
!
! OUTPUT ARGUMENT LIST:
! nummap - Number of entries in the Template
! map() - An array containing the number of octets that each
! template entry occupies when packed up into the GDS.
!
!=====================================================================
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Access GRIB2 Grid Definition Templates
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! INTEGER FUNCTION ng_readgrids(lunit)
!
! SUBROUTINE ng_getgridbynum(lunit, number, igdtn, igdtmpl, iret)
!
! SUBROUTINE ng_getgridbyname(lunit, name, igdtn, igdtmpl, iret)
!
!---------------------------------------------------------------------
!
! MODULE: g2grids (internal use)
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-04-27
!
! ABSTRACT: This Fortran Module allows access to predefined GRIB2 Grid
! Definition Templates stored in a file. The GDTs are represented by
! a predefined number or a character abbreviation.
!
! At the first request, all the grid GDT entries in the file associated
! with input Fortran file unit number, lunit, are read into a linked list
! named gridlist. This list is searched for the requested entry.
!
! Users of this Fortran module should only call routines getgridbynum
! and getgridbyname.
!
! The format of the file scanned by routines in this module is as follows.
! Each line contains one Grid entry containing five fields, each separated
! by a colon, ":". The fields are:
! 1) - predefined grid number
! 2) - Up to an 8 character abbreviation
! 3) - Grid Definition Template number
! 4) - Number of entries in the Grid Definition Template
! 5) - A list of values for each entry in the Grid Definition Template.
!
! As an example, this is the entry for the 1x1 GFS global grid
! 3:gbl_1deg: 0:19: 0 0 0 0 0 0 0 360 181 0 0 90000000 0 48 -90000000 359000000 1000000 1000000 0
!
! Comments can be included in the file by specifying the symbol "#" as the
! first character on the line. These lines are ignored.
!
! PROGRAM HISTORY LOG:
! 2004-04-27 Gilbert
!
!---------------------------------------
! use following three routines to assess (for CNCARG users)
!---------------------------------------
!
! INTEGER FUNCTION ng_readgrids(lunit)
! INTEGER, INTENT(IN) :: lunit
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-28
!
! ABSTRACT: This function reads the list of GDT entries in the file
! associated with fortran unit, lunit. All the entries are stored in a
! linked list called gridlist.
!
! PROGRAM HISTORY LOG:
! 2001-06-28 Gilbert
!
! USAGE: number=ng_readgrids(lunit)
! INPUT ARGUMENT LIST:
! lunit - Fortran unit number associated the the GDT file.
!
! RETURNS: The number of Grid Definition Templates read in.
!
!---------------------------------------
!
! SUBROUTINE ng_getgridbynum(lunit, number, igdtn, igdtmpl, iret)
!
! INTEGER, INTENT(IN ) :: lunit, number
! INTEGER, INTENT( OUT) :: igdtn, igdtmpl(*), iret
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-04-26
!
! ABSTRACT: This subroutine searches a file referenced by fortran unit lunit
! for a Grid Definition Template assigned to the requested number.
! The input file format is described at the top of this module.
!
! PROGRAM HISTORY LOG:
! 2004-04-26 Gilbert
!
! USAGE: CALL ng_getgridbynum(lunit,number,igdtn,igdtmpl,iret)
! INPUT ARGUMENT LIST:
! lunit - Unit number of file containing Grid definitions
! number - Grid number of the requested Grid definition
!
! OUTPUT ARGUMENT LIST:
! igdtn - NN, indicating the number of the Grid Definition
! Template 3.NN
! igdtmpl()- An array containing the values of each entry in
! the Grid Definition Template.
! iret - Error return code.
! 0 = no error
! -1 = Undefined Grid number.
! 3 = Could not read any grids from file.
!
!---------------------------------------
!
! SUBROUTINE ng_getgridbyname(lunit, name, igdtn, igdtmpl, iret)
!
! INTEGER, INTENT(IN ) :: lunit
! CHARACTER(*), INTENT(IN ) :: name
! INTEGER, INTENT( OUT) :: igdtn, igdtmpl(*), iret
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-04-26
!
! ABSTRACT: This subroutine searches a file referenced by fortran unit lunit
! for a Grid Definition Template assigned to the requested name.
! The input file format is described at the top of this module.
!
! PROGRAM HISTORY LOG:
! 2004-04-26 Gilbert
!
! USAGE: CALL ng_getgridbyname(lunit,name,igdtn,igdtmpl,iret)
! INPUT ARGUMENT LIST:
! lunit - Unit number of file containing Grid definitions
! name - Grid name of the requested Grid definition
!
! OUTPUT ARGUMENT LIST:
! igdtn - NN, indicating the number of the Grid Definition
! Template 3.NN
! igdtmpl()- An array containing the values of each entry in
! the Grid Definition Template.
! iret - Error return code.
! 0 = no error
! -1 = Undefined Grid number.
! 3 = Could not read any grids from file.
!
!=====================================================================
!
! ~~~~~~~~~~~~~~~~~~~~~~~
! Access GRIB2 Parameters
! ~~~~~~~~~~~~~~~~~~~~~~~
!
! SUBROUTINE ng_param_g1_to_g2(g1val, g1ver, g2disc, g2cat, g2num)
!
! SUBROUTINE ng_param_g2_to_g1(g2disc, g2cat, g2num, g1val, g1ver)
!
! CHARACTER(8) FUNCTION ng_param_get_abbrev(g2disc, g2cat, g2num)
!
!---------------------------------------------------------------------
!
! MODULE: params (internal use)
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-05
!
! ABSTRACT: This Fortran Module contains info on all the available
! GRIB Parameters.
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
! 2003-08-07 Gilbert - Added more parameters
! 2003-09-26 Gilbert - Added more parameters
! 2005-11-17 Gordon - Added more parameters for the Wave & Smoke models
! 2007-03-28 Vuong - Added more parameters
! 2007-10-10 Vuong - Added more parameters
! 2008-03-12 Vuong - Added more parameters
! 2008-06-30 Vuong - Reformat entry paramlist from 1 to 173
! Added more parameters and entire table 131
! 2008-11-21 Vuong - Added more parameters
! 2009-06-02 Vuong - Added more parameters
! 2009-12-14 Vuong - Correction VEGT(4.2-0-210)
! 2010-07-27 Vuong - Added more parameters
! 2010-12-06 Vuong - Added more parameters
! 2011-05-24 Vuong - Added more parameters
! 2011-09-12 Vuong - Added more parameters
! 2012-09-12 Vuong - Added more parameters and change HINDEX to
! parameter from 3 to 2 and RHPW from Dis 0 cat 19
! to 1
! 2013-07-24 Vuong - Added more parameters and Removed
! sapces in abbreviation
! 2016-03-30 Vuong - Added parameter Heat Exchange Coefficient (CH)
!
!---------------------------------------
! use following three routines to assess (for CNCARG users)
!---------------------------------------
!
! SUBROUTINE ng_param_g1_to_g2(g1val, g1ver, g2disc, g2cat, g2num)
!
! INTEGER, INTENT(IN ) :: g1val, g1ver
! INTEGER, INTENT( OUT) :: g2disc, g2cat, g2num
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-05
!
! ABSTRACT: This subroutine returns the corresponding GRIB2 Discipline
! Category and Number for a given GRIB1 parameter value and table version.
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
!
! USAGE: CALL ng_param_g1_to_g2(g1val,g1ver,g2disc,g2cat,g2num)
! INPUT ARGUMENT LIST:
! g1val - GRIB1 parameter number for which discipline is requested
! g1ver - GRIB1 parameter table version number
!
! OUTPUT ARGUMENT LIST:
! g2disc - corresponding GRIB2 Discipline number
! g2cat - corresponding GRIB2 Category number
! g2num - corresponding GRIB2 Parameter number within Category g2cat
!
!---------------------------------------
!
! SUBROUTINE ng_param_g2_to_g1(g2disc, g2cat, g2num, g1val, g1ver)
!
! INTEGER, INTENT(IN ) :: g2disc, g2cat, g2num
! INTEGER, INTENT( OUT) :: g1val, g1ver
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-01-04
!
! ABSTRACT: This function returns the GRIB 1 parameter number for
! a given GRIB2 Discipline, Category and Parameter number.
!
! PROGRAM HISTORY LOG:
! 2001-06-05 Gilbert
!
! USAGE: call ng_param_g2_to_g1(g2disc,g2cat,g2num,g1val,g1ver)
! INPUT ARGUMENT LIST:
! g2disc - GRIB2 discipline number (See Code Table 0.0)
! g2cat - corresponding GRIB2 Category number
! g2num - corresponding GRIB2 Parameter number within Category g2cat
!
! OUTPUT ARGUMENT LIST:
! g1val - GRIB1 parameter number for which discipline is requested
! g1ver - GRIB1 parameter table version number
!
!---------------------------------------
!
! CHARACTER(8) FUNCTION ng_param_get_abbrev(g2disc, g2cat, g2num)
! INTEGER, INTENT(IN) :: g2disc, g2cat, g2num
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-01-04
!
! ABSTRACT: This function returns the parameter abbreviation for
! a given GRIB2 Discipline, Category and Parameter number.
!
! PROGRAM HISTORY LOG:
! 2001-06-05 Gilbert
!
! USAGE: abrev=ng_param_get_abbrev(g2disc,g2cat,g2num)
! INPUT ARGUMENT LIST:
! g2disc - GRIB2 discipline number (See Code Table 0.0)
! g2cat - corresponding GRIB2 Category number
! g2num - corresponding GRIB2 Parameter number within Category g2cat
!
! RETURNS: ASCII Paramter Abbreviation
!
!=====================================================================
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Access ECMWF GRIB Parameters
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! SUBROUTINE ng_param_ecmwf_g1_to_g2(g1val, g1ver, g2disc, g2cat, g2num)
!
! SUBROUTINE ng_param_ecmwf_g2_to_g1(g2disc, g2cat, g2num, g1val, g1ver)
!
!---------------------------------------------------------------------
!
! MODULE: params_ecmwf (internal use)
! PRGMMR: Gordon ORG: W/NP11 DATE: 2006-09-07
!
! ABSTRACT: This Fortran Module contains info on all the available
! ECMWF GRIB Parameters.
!
! PROGRAM HISTORY LOG:
! 2006-09-07 Gordon - Modified from Steve Gilbert's params.f for NCEP GRIB data
! 2007-04-20 Vuong - Add more parameters
! 2007-10-11 Vuong - Add more parameters
! 2011-11-16 Vuong - Add parameters MAX and MIN temperature
! 2013-07-24 Vuong - Removed sape in abbreviation
!
!---------------------------------------
! use following two routines to assess (for CNCARG users)
!---------------------------------------
!
! SUBROUTINE ng_param_ecmwf_g1_to_g2(g1val, g1ver, g2disc, g2cat, g2num)
!
! INTEGER, INTENT(IN ) :: g1val, g1ver
! INTEGER, INTENT( OUT) :: g2disc, g2cat, g2num
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-05
!
! ABSTRACT: This subroutine returns the corresponding GRIB2 Discipline
! Category and Number for a given GRIB1 parameter value and table version.
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
!
! USAGE: CALL ng_param_ecmwf_g1_to_g2(g1val,g1ver,g2disc,g2cat,g2num)
! INPUT ARGUMENT LIST:
! g1val - GRIB1 parameter number for which discipline is requested
! g1ver - GRIB1 parameter table version number
!
! OUTPUT ARGUMENT LIST:
! g2disc - corresponding GRIB2 Discipline number
! g2cat - corresponding GRIB2 Category number
! g2num - corresponding GRIB2 Parameter number within Category g2cat
!
!---------------------------------------
!
! SUBROUTINE ng_param_ecmwf_g2_to_g1(g2disc, g2cat, g2num, g1val, g1ver)
!
! INTEGER, INTENT(IN ) :: g2disc, g2cat, g2num
! INTEGER, INTENT( OUT) :: g1val, g1ver
!
! SUBPROGRAM:
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-01-04
!
! ABSTRACT: This function returns the GRIB 1 parameter number for
! a given GRIB2 Discipline, Category and Parameter number.
!
! PROGRAM HISTORY LOG:
! 2001-06-05 Gilbert
!
! USAGE: call ng_param_ecmwf_g2_to_g1(g2disc,g2cat,g2num,g1val,g1ver)
! INPUT ARGUMENT LIST:
! g2disc - GRIB2 discipline number (See Code Table 0.0)
! g2cat - corresponding GRIB2 Category number
! g2num - corresponding GRIB2 Parameter number within Category g2cat
!
! OUTPUT ARGUMENT LIST:
! g1val - GRIB1 parameter number for which discipline is requested
! g1ver - GRIB1 parameter table version number
!
!=====================================================================
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Reallocate CHARACTER/REAL/INTEGER pointered arrays
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! SUBROUTINE ng_realloc(c, n, m, istat)
!
!---------------------------------------------------------------------
!
! Routine to re-allocate pointered array "c" from size "n" to size "m".
! Array "c" can be type of CHAEACTER(1), INTEGER, or, REAL (generic use)
!
! SUBROUTINE ng_realloc(c, n, m, istat)
! IMPLICIT NONE
!
! CHARACTER(1), POINTER :: c(:)
! or
! REAL, POINTER :: c(:)
! or
! INTEGER, POINTER :: c(:)
!
! INTEGER, INTENT(IN ) :: n, m
! INTEGER, INTENT( OUT) :: istat
!
! !-----
!
! CHARACTER(1), POINTER :: tmp(:)
! or
! REAL, , POINTER :: tmp(:)
! or
! INTEGER, POINTER :: tmp(:)
!
! INTEGER :: num
!
! !--------------
!
! IF( n<0 .OR. m<=0 ) THEN
! istat = 10
! RETURN
! END IF
!
! !-----
!
! istat = 0
!
! IF( .NOT. ASSOCIATED(c) ) THEN
! ALLOCATE( c(m), STAT=istat ) ! allocate new memory
! RETURN
! END IF
!
! tmp => c ! save pointer to original mem
! NULLIFY( c )
! ALLOCATE( c(m), STAT=istat ) ! allocate new memory
! IF( istat /= 0 ) THEN
! c => tmp
! RETURN
! END IF
!
! IF( n /= 0 ) THEN
! num = MIN(n,m)
! c(1:num) = tmp(1:num) ! copy data from orig mem to new loc.
! END IF
! DEALLOCATE( tmp ) ! deallocate original memory
!
! END SUBROUTINE ng_realloc
!
!---------------------------------------------------------------------