#include "w3macros.h"
!/
!/ ------------------------------------------------------------------- /
!/ Macros for enabling test output
!/
#define TEST_W3GDATMD___disabled
#define TEST_W3GDATMD_W3NMOD___disabled
#define TEST_W3GDATMD_W3DIMX___disabled
#define TEST_W3GDATMD_W3DIMS___disabled
#define TEST_W3GDATMD_W3SETG___disabled
#define TEST_W3GDATMD_W3GNTX___disabled
#define TEST_W3GDATMD_W3DIMUG___disabled
#define TEST_W3GDATMD_W3SETREF___disabled
!/
!/ ------------------------------------------------------------------- /
      MODULE W3GDATMD
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  !           J. H. Alves             !
!/                  |            F. Ardhuin             |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         04-May-2016 |
!/                  +-----------------------------------+
!/
!/    24-Jun-2005 : Origination.                        ( version 3.07 )
!/    09-Nov-2005 : Remove soft boundary options.       ( version 3.08 )
!/    23-Jun-2006 : Add data for W3SLN1.                ( version 3.09 )
!/    18-Jul-2006 : Add input grids.                    ( version 3.10 )
!/    05-Oct-2006 : Add filter to array pointers.       ( version 3.10 )
!/    02-Feb-2007 : Add FLAGST.                         ( version 3.10 )
!/    14-Apr-2007 : Add Miche style limiter.            ( version 3.11 )
!/                  ( J. H. Alves )
!/    25-Apr-2007 : Adding Battjes-Janssen Sdb.         ( version 3.11 )
!/                  ( J. H. Alves )
!/    06-Aug-2007 : Fixing SLNP !/SEED bug.             ( version 3.13 )
!/    18-Sep-2007 : Adding WAM4 source terms.           ( version 3.13 )
!/                  ( F. Ardhuin )
!/    15-Apr-2008 : Clean up for distribution.          ( version 3.14 )
!/    27-Jun-2008 : Expand WAM4 variants namelist       ( version 3.14 )
!/                  ( F. Ardhuin )
!/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
!/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
!/                  (W. E. Rogers & T. J. Campbell, NRL)
!/    30-Oct-2009 : Implement curvilinear grid type.    ( version 3.14 )
!/                  (W. E. Rogers & T. J. Campbell, NRL)
!/    29-Oct-2010 : Implement unstructured grids        ( version 3.14.1 )
!/                  (A. Roland and F. Ardhuin) 
!/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
!/                  specify index closure for a grid.   ( version 3.14 )
!/                  (T. J. Campbell, NRL)
!/    23-Dec-2010 : Fix HPFAC and HQFAC by including the COS(YGRD)
!/                  factor with DXDP and DXDQ terms.    ( version 3.14 )
!/                  (T. J. Campbell, NRL)
!/    05-Apr-2011 : Implement interations for DTMAX < 1s( version 3.14.1 )
!/                  (F. Ardhuin) 
!/    01-Jul-2011 : Movable bed bottom friction BT4     ( version 4.01 )
!/    03-Nov-2011 : Bug fix: GUGINIT initialization     ( version 4.04 )
!/    29-Nov-2011 : Adding ST6 source term option.      ( version 4.04 )
!/                  (S. Zieger)
!/    14-Mar-2012 : Add PSIC for BT4                    ( version 4.04 )
!/    12-Jun-2012 : Add /RTD option or rotated grid variables. 
!/                  (Jian-Guo Li)                       ( version 4.06 )
!/    13-Jul-2012 : Move data structures GMD (SNL3) and nonlinear
!/                  filter (SNLS) from 3.15 (HLT).      ( version 4.08 )
!/    03-Sep-2012 : Clean up of UG grids                ( version 4.08 )
!/    12-Dec-2012 : Adding SMC grid.  JG_Li             ( version 4.09 )
!/    16-Sep-2013 : Add Arctic part SMC grid.           ( version 4.11 )
!/    11-Nov-2013 : SMC and rotated grid incorporated in the main 
!/                  trunk                               ( version 4.13 )
!/    16-Nov-2013 : Allows reflection on curvi grids    ( version 4.14 )
!/    26-Jul-2013 : Adding IG waves                     ( version 4.16 )
!/    18-Dec-2013 : Moving FLAGLL into GRID TYPE        ( version 4.16 )
!/    11-Jun-2014 : Changed reflection for subgrid      ( version 5.01 )
!/    10-Dec-2014 : Add checks for allocate status      ( version 5.04 )
!/    21-Aug-2015 : Add SMC FUNO3, FVERG options. JGLi  ( version 5.09 )
!/    04-May-2016 : Add IICEDISP                  GB&FA ( version 5.10 )
!/    20-Jan-2017 : Update to new W3GSRUMD APIs         ( version 6.02 )
!/    20-Jan-2017 : Change to preprocessor macros to enable test output.
!/                  (T.J. Campbell, NRL)                ( version 6.02 )
!/    20-Jan-2017 : Change calculation of curvilinear grid metric and
!/                  derivatives calculations to use W3GSRUMD:W3CGDM.
!/                  (T.J. Campbell, NRL)                ( version 6.02 )
!/
!/
!/    Copyright 2009-2013 National Weather Service (NWS),
!/       National Oceanic and Atmospheric Administration.  All rights
!/       reserved.  WAVEWATCH III is a trademark of the NWS. 
!/       No unauthorized use without permission.
!/
!  1. Purpose :
!
!     Define data structures to set up wave model grids and aliases 
!     to use individual grids transparently. Also includes subroutines
!     to manage data structure and pointing to individual models.
!     Definition of grids and model set up.
!
!  2. Variables and types :
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      NGRIDS    Int.  Public   Number of grids, initialized at -1 
!                               to check proper model initialization.
!      NAUXGR    Int.  Public   Auxiliary grids.
!      IGRID     Int.  Public   Selected spatial grid, init. at -1.
!      ISGRD     Int.  Public   Selected spectral grid, init. at -1.
!      IPARS     Int.  Public   Selected num. and ph. pars, init. at -1.
!      RLGTYPE   I.P.  Public   Named constant for rectilinear grid type
!      CLGTYPE   I.P.  Public   Named constant for curvilinear grid type
!      FLAGLL    Log.  Public   Flag to indicate coordinate system for all grids
!                               .TRUE.: Spherical (lon/lat in degrees)
!                               .FALSE.: Cartesian (meters)
!      GRID      TYPE  Public   Data structure defining grid.
!      GRIDS     GRID  Public   Array of grids.
!      SGRD      TYPE  Public   Data structure defining spectral grid.
!      SGRDS     GRID  Public   Array of spectral grids.
!      MPAR      TYPE  Public   Data structure with all other model
!                               parameters.
!      MPARS     GRID  Public   Array of MPAR.
!     ----------------------------------------------------------------
!
!     All elements of GRID are aliased to pointers with the same
!     name. These pointers are defined as :
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      GTYPE     Int.  Public   Flag for type of grid
!                               RLGTYPE: Rectilinear grid
!                               CLGTYPE: Curvilinear grid
!                               UNGTYPE: Unstructured triangular grid                       
!      ICLOSE    Int.  Public   Parameter indicating type of index closure of grid.
!                               ICLOSE_NONE: No grid closure
!                               ICLOSE_SMPL: Simple grid closure
!                                 Grid is periodic in the i-index and wraps at
!                                 I=NX+1. In other words, (NX+1,J) => (1,J).
!                               ICLOSE_TRPL: Tripole grid closure
!                                 Grid is periodic in the i-index and and wraps at
!                                 I=NX+1 and has closure at J=NY+1. In other words,
!                                 (NX+1,J<=NY) => (1,J) and
!                                 (I,NY+1) => (MOD(NX-I+1,NX)+1,NY). The tripole
!                                 closure requires that NX be even.
!      NX, NY    Int.  Public   Discrete dimensions of spatial grid.
!      NSEA(L)   Int.  Public   Number of sea points (local for MPP).
!      NU/VFc    Int.  Public   Number of U/V faces for SMC grid. 
!      NRLv      Int.  Public   Number of refined levels for SMC grid. 
!      NGLO      Int.  Public   Number of cells in global part for SMC grid. 
!      NARC      Int.  Public   Number of cells in Arctic part for SMC grid. 
!      NBAC      Int.  Public   Number of boundary cells in Arctic part.
!      NBGL      Int.  Public   Number of boundary cells in global part.
!      TRFLAG    Int.  Public   Flag for use of transparencies
!                                0: No sub-grid obstacles.
!                                1: Obstructions at cell boundaries.
!                                2: Obstructions at cell centers.
!                                3: Like 1 with continuous ice.
!                                4: Like 2 with continuous ice.
!      MAPSTA    I.A.  Public   Grid status map.
!      MAPST2    I.A.  Public   Second grid status map.
!      MAPxx     I.A.  Public   Storage grid maps.
!      IJKCel    I.A.  Public   Cell info array for SMC grid.
!      IJKU/VFc  I.A.  Public   U/V-Face arrays for SMC grid.
!      NLv*      I.A.  Public   Cell, U/V-Face numbers of refine levels.
!      ICLBAC    I.A.  Public   Mapping index for Arctic boundary cells.
!      SX,SY     Real  Public   Spatial (rectilinear) grid increments.
!      X0,Y0     Real  Public   Lower left corner of spatial (rectilinear) grid.
!      DTCFL     Real  Public   Maximum CFL time step X-Y propagation.
!      DTCFLI    Real  Public   Id. intra-spectral.
!      DTMAX     Real  Public   Maximum overall time step.
!      DTMIN     Real  Public   Minimum dynamic time step for source
!      NITERSEC1 Real  Public   Number of interations when DTMAX < 1s
!      DMIN      Real  Public   Minimum water depth.
!      CTMAX     Real  Public   Maximum CFL number for depth refr.
!      FICE0/N   Real  Public   Cut-off ice conc. for ice coverage.
!      FICEL     Real  Public   Length scale for sea ice damping
!      IICEHMIN  Real  Public   Minimum thickness of sea ice
!      IICEHDISP Real  Public   Minimum thickness of sea ice in the dispersion relation before relaxing the conv. criterion
!      IICEHFAC  Real  Public   Scale factor for sea ice thickness
!      IICEHINIT Real  Public   Initial value of ice thickness
!      ICE100WIND Real  Publ.   Reduction of wind input if ice fraction=1.0
!                               Default is 1.0, meaning that 100% ice 
!                               concentration result in zero wind input. 
!                               Sin_in_ice=Sin_in_open_water * (1-ICE*ICEWIND)
!                               If set to 0.0, then ice has no direct impact on
!                               wind input source function.
!      IC3PARS   R.A.  Public   various parameters for use in IC4, handled as
!                               an array for simplicity
!      IC4_KI    R.A.  Public   KI (dissipation rate) values for use in IC4
!      IC4_FC    R.A.  Public   FC (frequency bin separators) for use in IC4
!      PFMOVE    Real  Public   Tunable parameter in GSE correction
!                               for moving grids.
!      GRIDSHIFT Real  Public   Grid offset for multi-grid w/SCRIP
!      CMPRTRCK  Log.  Public   True for traditional compression of track output
!      PoLat/Lon R.A.  Public   Rotated N-Pole standard latitude/longitude. 
!      AnglD     R.A.  Public   Rotation angle in degree to turn rotated grid
!                               back to standard grid.  JGLi12Jun2012
!      STEXU     Real  Public   Length-scale (X) for space-time extreme averaging
!      STEYU     Real  Public   Length-scale (Y) for space-time extreme averaging
!      STEDU     Real  Public   Time-scale for space-time extreme averaging
!      ZB        R.A.  Public   Bottom levels on storage grid.
!      CLATS(I)  R.A.  Public   (Inverse) cosine of latitude at sea points.
!      CTHG0S    R.A.  Public   Constant in great-circle refr. term at sea points.
!      TRNX/Y    R.A.  Public   Transparencies in X/Y for sub-grid
!      CTRNX/Y   R.A.  Public   Sub-grid transparencies for SMC grid.
!      ANGARC    R.A.  Public   Rotation angle in degree for Arctic cells. 
!      SPCBAC    R.A.  Public   Full 2-D spectra for Arctic boundary cells. 
!      X/YGRD    R.A.  Public   Spatial grid coordinate arrays.
!      SX/SYGRD  R.A.  Public   Spatial grid increment arrays.
!      GINIT     Log.  Public   Flag identifying grid initialization.
!      FLDRY     Log.  Public   Flag for 'dry' run (IO and data
!                               processing only).
!      FLCx      Log.  Public   Flags for prop. is different spaces.
!      FLSOU     Log.  Public   Flag for source term calcualtion.
!      FUNO3     Log.  Public   Flag for 3rd order UNO3 scheme on SMC grid. 
!      FVERG     Log.  Public   Flag for 1-2-1 averaging smoothing on SMC grid.
!      FLAGST    L.A.  Public   Flag for source term computations 
!                               for individual grid points.
!      IICEDISP   Log.  Public   Flag for use of the ice covered dispertion relation.
!      IICESMOOTH Log.  Public   Flag to smooth the ice covered dispertion relation in broken ice.
!       
!
!      GNAME     C*30  Public   Grid name.
!      FILEXT    C*13  Public   Extension of WAVEWATCH III file names
!                               default in 'ww3'.
!     ----------------------------------------------------------------
!
!     All elements of SGRD are aliased to pointers with the same
!     name. These pointers are defined as :
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      NK        Int.  Public   Number of discrete wavenumbers.
!      NK2       Int.  Public   Extended wavenumber range.
!      NTH       Int.  Public   Number of discrete directions.
!      NSPEC     Int.  Public   Number of discrete spectral bins.
!      MAPxx     I.A.  Public   Spectral maps.
!      DTH       Real  Public   Directional increments (radians).
!      XFR       Real  Public   Frequency multiplication factor.
!      FR1       Real  Public   Lowest frequency                 (Hz)
!      FTE       Real  Public   Factor in tail integration energy.
!      FTF       Real  Public   Id. frequency.
!      FTWN      Real  Public   Id. wavenumber.
!      FTTR      Real  Public   Id. wave period.
!      FTWL      Real  Public   Id. wave length.
!      FACTIn    Real  Public   Factors for obtaining integer cut-off
!                               frequency.
!      FACHFx    Real  Public   Factor for tail.
!      TH        R.A   Public   Directions (radians).
!      ESIN      R.A   Public   Sine of discrete directions.
!      ECOS      R.A   Public   Cosine of discrete directions.
!      ES2, ESC, EC2
!                R.A   Public   Sine and cosine products
!      SIG       R.A   Public   Relative frequencies (invariant
!                                                     in grid). (rad)
!      SIG2      R.A   Public   Id. for full 2-D spectrum.
!      DSIP      R.A   Public   Frequency bandwidths (prop.)    (rad)
!      DSII      R.A   Public   Frequency bandwidths (int.)     (rad)
!      DDEN      R.A   Public   DSII * DTH * SIG (for integration
!                               based on energy)
!      DDEN2     R.A   Public   Idem, full spectrum.
!      SINIT     Log.  Public   Flag identifying grid initialization.
!     ----------------------------------------------------------------
!
!     The structure MPAR contains all other model parameters for
!     numerical methods and physical parameterizations. It contains
!     itself several structures as outlined below.
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      PINIT     Log.  Public   Flag identifying initialization.
!      NPARS     NPAR  Public   Numerical parameters,
!      PROPS     PROP  Public   Parameters propagatrion schemes.
!      SFLPS     SFLP  Public   Parameters for flux computation.
!      SLNPS     SLNP  Public   Parameters Sln.
!      SRCPS     SRCP  Public   Parameters Sin and Sds.
!      SNLPS     SNLP  Public   Parameters Snl.
!      SBTPS     SBTP  Public   Parameters Sbt.
!      SDBPS     SDBP  Public   Parameters Sdb.
!      STRPS     STRP  Public   Parameters Str.
!      SBSPS     SBSP  Public   Parameters Sbs.
!      SXXPS     SXXP  Public   Parameters Sxx.
!     ----------------------------------------------------------------
!
!     The structure NPAR contains numerical parameters and is aliased
!     as above:
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      FACP      Real  Public   Constant in maximum par. change in
!                               dynamic integration scheme (depends
!                               upon Xp).
!      XREL      Real  Public   Id. relative change.
!      XFLT      Real  Public   Id. filter level.
!      FXFM      Real  Public   Constant for mean frequency in
!                               cut-off.                       (!/ST1)
!      FXPM      Real  Public   Id. PM.
!      XFT       Real  Public   Constant for cut-off freq.     (!/ST2)
!      XFC       Real  Public   Id.
!      FACSD     Real  Public   Constant in seeding algorithm.
!      FHMAX     Real  Public   Hs/depth ratio in limiter     (!/MLIM)
!      RWINDC    Real  Public   Coefficient for current in relative 
!                               wind                          (!/RWND)
!      WWCOR     R.A.  Public   Wind correction factors       (!/WCOR)
!     ----------------------------------------------------------------
!
!     The structure PROP contains parameters for the propagation
!     schemes and is aliased as above:
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      DTME      Real  Public   Swell age in disp. corr.      (!/PR2)
!      CLATMN    Real  Public   Id. minimum cosine of lat.    (!/PR2)
!
!      WDCG      Real  Public   Factors in width of av. Cg.   (!/PR3)
!      WDTH      Real  Public   Factors in width of av. Th.   (!/PR3)
!     ----------------------------------------------------------------
!
!     The structure SFLP contains parameters for the fluxes
!     and is aliased as above:
!     ----------------------------------------------------------------
!                                                            (!/FLX2)
!      NITTIN    Int.  Public   Number of itterations for drag calc.
!      CINXSI    Real  Public   Constant in parametric description
!                                                            (!/FLX3)
!      NITTIN    Int.  Public   Number of itterations for drag calc.
!      CAP_ID    Int   Public   Type of cap used.
!      CINXSI    Real  Public   Constant in parametric description
!      CD_MAX    Real  Public   Cap on Cd.
!                                                            (!/FLX4)
!      FLX4A0    Real  Public   Scaling value in parametric description
!     ----------------------------------------------------------------
!
!     The structure SLNP contains parameters for the linear input
!     source terms and is aliased as above:
!
!     ----------------------------------------------------------------
!                                                             (!/LN1)
!      SLNC1     Real  Public   Proportionality and other constants in
!                               input source term.
!      FSPM      Real  Public   Factor for fPM in filter.
!      FSHF      Real  Public   Factor for fh in filter.
!     ----------------------------------------------------------------
!
!     The structure SRCP contains parameters for the input and dis,
!     source terms and is aliased as above:
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      WWNMEANPTAIL R  Public   Power of tail for WNMEAN calculation
!      SSTXFTFTAIL  R  Public   Tail factor for  WNMEAN calculation
!                                                             (!/ST1)
!      SINC1     Real  Public   Proportionality and other constants in
!                               input source term.
!      SDSC1     Real  Public   Combined constant in dissipation
!                               source term.
!                                                             (!/ST2)
!      ZWIND     Real  Public   Height at which the wind is defined
!                               of drag.
!      FSWELL    Real  Public   Reduction factor of negative input
!                               for swell.
!      SHSTAB, OFSTAB, CCNG, CCPS, FFNG, FFPS
!                Real  Public   Factors in effective wind speed.
!      CDSAn     Real  Public   Constants in high-freq. dis.
!      SDSALN    Real  Public   Factor for nondimensional 1-D spectrum.
!      CDSBn     Real  Public   Constants in parameterization of PHI.
!      XFH       Real  Public   Constant for turbulent length scale.
!      XFn       Real  Public   Constants in combining low and high
!                               frequency dissipation.
!                                                             (!/ST3)
!      ZZWND     Real  Public   Height at which the wind is defined
!      AALPHA    Real  Public   Minimum value of charnock parameter
!      BBETA     Real  Public   Wind-wave coupling coefficient
!      ZZALP     Real  Public   Wave age tuning coefficient in Sin
!      TTAUWSHELTER Real  Public Sheltering coefficient for short waves
!      ZZ0MAX    Real  Public   Maximum value of air-side roughness
!      ZZ0RAT    Real  Public   ratio of roughness for mean and
!                               oscillatory flows
!      SSINTHP   Real  Public   Power in cosine of wind input
!      SSWELLF   R.A.  Public   Swell damping coefficients
!      SSDSCn    Real  Public   Dissipation parameters
!      SSDSBR    Real  Public   Threshold in saturation spectrum for Sds
!      SSDSP     Real  Public   Power of B(k) in Sds
!      WWNMEANP  Real  Public   Power that defines the mean wavenumber
!                               in Sds
!      SSTXFTF, SSTXFTWN Real  Public   Tail constants
!      SSDSC4,   Real  Public   Threshold shift in saturation diss.
!      SSDSC5,   Real  Public   Wave-turbulence dissipation factor
!      SSDSC6,   Real  Public   dissipation parameter
!      DDELTA1   Real  Public   Low-frequency dissipation coefficient
!                               in WAM4
!      DDELTA2   Real  Public   High-frequency dissipation coefficient
!                               in WAM4
!      SSDSDTH   Real  Public   Maximum angular sector for saturation
!                               spectrum
!      SSDSCOS   Real  Public   Power of cosine in saturation integral
!      SSDSISO   Int.  Public   Choice of definition of the isotropic
!                               saturation
!     ----------------------------------------------------------------
!
!     The structure SNLP contains parameters for the nonl. inter.
!     source term and is aliased as above:
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!                                                             (!/NL1)
!      SNLC1     Real  Public   Scaled proportionality constant.
!      LAM       Real  Public   Factor defining quadruplet.
!      KDCON     Real  Public   Conversion factor for relative depth.
!      KDMN      Real  Public   Minimum relative depth.
!      SNLSn     Real  Public   Constants in shallow water factor.
!                                                             (!/NL2)
!      IQTPE     Int.  Public   Type of depth treatment 
!                                1 : Deep water         
!                                2 : Deep water / WAM scaling
!                                3 : Finite water depth 
!      NDPTHS    Int.  Public   Number of depth for which integration
!                               space needs to be computed.
!      NLTAIL    Real  Public   Tail factor for parametric tail.
!      DPTHNL    R.A.  Public   Depths corresponding to NDPTHS.   
!                               *** NOTE: This array is not allocated
!                                         in the W3DIMP routine ***
!                                                             (!/NL3)
!      NFR       Int.  Public   Number of frequencies or wavenumbers
!                               in discrete spectral space (NFR=>NK).
!      NFRMIN    Int.  Public   Minimum discrete frequency in the
!                               expanded frequency space.
!      NFRMAX    Int.  Public   Idem maximum for first part.
!      NFRCUT    Int.  Public   Idem maximum for second part.
!      NTHMAX    Int.  Public   Extension of directional space.
!      NTHEXP    Int   Public   Number of bins in extended dir. space.
!      NSPMIN, NSPMAX, NSPMX2
!                Int.  Public   1D spectral space range.
!      FRQ       R.A.  Public   Expanded frequency range (Hz).
!      XSI       R.A.  Public   Expanded frequency range (rad/s).
!      NQA       Int.  Public   Number of actual quadruplets.
!      QST1      I.A.  Public   Spectral offsets for compuation of
!                               quadruplet spectral desnities.
!      QST2      R.A.  Public   Idem weights.
!      QST3      R.A.  Public   Proportionality constants and k factors
!                               in diagonal strength.
!      QST4      I.A.  Public   Spectral offsets for combining of
!                               interactions and diagonal.
!      QST5      R.A.  Public   Idem weights for interactions.
!      QST6      R.A.  Public   Idem weights for diagonal.
!      SNLNQ     Int.  Public   Number of quadruplet definitions.
!      SNLMSC    Real  Public   Tuning power 'deep' scaling.
!      SNLNSC    Real  Public   Tuning power 'shallow' scaling.
!      SNLSFD    Real  Public   'Deep' nondimensional filer freq.
!      SNLSFS    Real  Public   'Shallow' nondimensional filer freq.
!      SNLL      R.A.  Public   Array with lambda for quadruplet.
!      SNLM      R.A.  Public   Array with mu for quadruplet.
!      SNLT      R.A.  Public   Array with Dtheta for quadruplet.
!      SNLCD     R.A.  Public   Array with Cd for quadruplet.
!      SNLCS     R.A.  Public   Array with Cs for quadruplet.
!                                                             (!/NL4)
!      ITSA      Int.  Public   Integer indicating TSA (1) or FBI (0)
!      IALT      Int.  Public   Integer determining alternating looping
!                                                             (!/NLS)
!      NTHX      Int.  Public   Expanded discrete direction range.
!      NFRX      Int.  Public   Expanded discrete frequency range.
!      NSPL-H    Int.  Public   Range of 1D spectrum.
!      SNSST     R.A.  Public   Array with interpolation weights.
!      CNLSA     Real  Public   a34 in quadruplet definition.
!      CNLSC     Real  Public   C in Snl definition.
!      CNLSFM    Real  Public   Maximum relative spectral change.
!      CNLSC1/3  Real  Public   Constant in frequency filter.
!     ----------------------------------------------------------------
!
!     The structure SBTP contains parameters for the bottom friction
!     source term and is aliased as above:
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      SBTC1     Real  Public   Proportionality constant.    (!/BT1)
!      SBTCX     R.A.  Public   Parameters for bottom fric.  (!/BT4)
!     ----------------------------------------------------------------
!
!     The structure SDBP contains parameters for the depth incduced
!     breaking source term and is aliased as above:
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      SDBC1     Real  Public   Proportionality constant.    (!/DB1)
!      SDBC2     Real  Public   Hmax/d ratio.                (!/DB1)
!      FDONLY    Log.  Public   Flag for checking depth only (!/DB1)
!                               otherwise Miche criterion.
!     ----------------------------------------------------------------
!
!     The structure STRP contains parameters for the triad interaction
!     source term and is aliased as above:
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!     The structure SBSP contains parameters for the bottom scattering
!     source term and is aliased as above:
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!     The structure SICP contains parameters for arbitrary source 
!     term and is aliased as above:
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!     IS1C1      Real  Public   Scale factor for icecon.     (!/ISx)
!     IS1C2      Real  Public   Offset for ice concentration (!/ISx)
!     ----------------------------------------------------------------
!
!     The structure SXXP contains parameters for arbitrary source 
!     term and is aliased as above:
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  3. Subroutines and functions :
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      W3NMOD    Subr. Public   Set number of grids.
!      W3DIMX    Subr. Public   Set dimensions of spatial grid.
!      W3DIMS    Subr. Public   Set dimensions of spectral grid.
!      W3SETG    Subr. Public   Point to selected grid / model.
!      W3GNTX    Subr. Public   Construct grid arrays
!     ----------------------------------------------------------------
!
!  4. Subroutines and functions used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!      EXTCDE    Subr. W3SERVMD Abort program with exit code.
!     ----------------------------------------------------------------
!
!  5. Remarks :
!
!     - In model versions before 3.06 the parameters in the grid
!       structure were stored in the module W3IOGR.
!     - No subroutine DIMP is provided, instead, arrays are set
!       one-by-one in W3IOGR.
!
!  6. Switches :
!
!     See subroutine documentation.
!
!     !/PRn  Select propagation scheme
!     !/SMC  UNO2 propagation on SMC grid.   
!
!     !/LNn  Select source terms
!     !/STn
!     !/NLn
!     !/BTn
!     !/DBn
!     !/TRn
!     !/BSn
!     !/XXn
!
!     !/S    Enable subroutine tracing.
!
!  7. Source code :
!
!/ ------------------------------------------------------------------- /
!/
!/ Required modules
!/
      USE W3GSRUMD
!/
!/ Specify default accessibility
!/
      PUBLIC
!/
!/ Module private variable for checking error returns
!/
      INTEGER, PRIVATE        :: ISTAT
!/
!/ Conventional declarations
!/
      INTEGER                 :: NGRIDS = -1, IGRID = -1, ISGRD = -1, &
                                 IPARS = -1, NAUXGR
!
!/IC4      INTEGER, PARAMETER      :: NIC4=10
      INTEGER, PARAMETER      :: RLGTYPE = 1
      INTEGER, PARAMETER      :: CLGTYPE = 2
      INTEGER, PARAMETER      :: UNGTYPE = 3      

      INTEGER, PARAMETER      :: ICLOSE_NONE = ICLO_NONE
      INTEGER, PARAMETER      :: ICLOSE_SMPL = ICLO_SMPL
      INTEGER, PARAMETER      :: ICLOSE_TRPL = ICLO_TRPL
!
! Dimensions of tables for pre-computing of dissipation 
!  
!/ST4      INTEGER,    PARAMETER   :: NKHS=2000, NKD=1300
!/ST4      INTEGER,    PARAMETER   :: NDTAB=2000          
!/
!/ Data structures
!/
!/ Grid type
      TYPE GRID          ! this is the geographical grid with all associated parameters 
        INTEGER          :: GTYPE
        INTEGER          :: ICLOSE
        INTEGER          :: NX, NY, NSEA, NSEAL, TRFLAG
!/SEC1     INTEGER          :: NITERSEC1
        INTEGER, POINTER :: MAPSTA(:,:), MAPST2(:,:),            &
                            MAPFS(:,:), MAPSF(:,:)
!
!/SMC !!Li     Cell and face arrays for SMC grid.  
!/SMC        INTEGER               :: NCel, NUFc, NVFc, NRLv, MRFct
!/SMC        INTEGER, POINTER      :: NLvCel(:), NLvUFc(:), NLvVFc(:)
!/SMC        INTEGER, POINTER      :: IJKCel(:,:), IJKUFc(:,:), IJKVFc(:,:)
!
!/ARC        INTEGER               :: NGLO, NARC, NBGL, NBAC
!/ARC        INTEGER, POINTER      :: ICLBAC(:)
!
        REAL             :: SX, SY, X0, Y0, DTCFL, DTCFLI, DTMAX,      &
                            DTMIN, DMIN, CTMAX, FICE0, FICEN, FICEL,   &
                            PFMOVE, STEXU, STEYU, STEDU, IICEHMIN,     &
                            IICEHINIT, ICE100WIND, IICEHFAC, IICEHDISP, &
		                    IICEDDISP, IICEFDISP

        REAL(8)          :: GRIDSHIFT ! see notes in WMGHGH

!/RTD        REAL                  :: Polat, Polon   ! Rotated N-Pole lat/lon
!/RTD        REAL, POINTER         :: AnglD(:)       ! Angle in degree

        REAL   , POINTER :: ZB(:)     ! BOTTOM GRID, DEFINED ON ISEA
        REAL   , POINTER :: CLATS(:)  ! COS(LAT), DEFINED ON SEA POINTS
        REAL   , POINTER :: CLATIS(:) ! INVERSE OF COS(LAT) DEFINED ON ISEA
        REAL   , POINTER :: CTHG0S(:) ! TAN(Y)/R, DEFINED ON ISEA

        REAL   , POINTER :: TRNX(:,:), TRNY(:,:) ! TRANSPARENCY INFORMATION ON IX,IY
!/SMC        REAL, POINTER         :: CTRNX(:), CTRNY(:), CLATF(:)
        REAL, POINTER         :: SPCBAC(:,:), ANGARC(:)
        REAL   , POINTER :: XGRD(:,:), YGRD(:,:) ! X AND Y DEFINED ON IX,IY
        REAL   , POINTER :: DXDP(:,:), DXDQ(:,:) ! DX/DP & DX/DQ DEFINED ON IX,IY
        REAL   , POINTER :: DYDP(:,:), DYDQ(:,:) ! DY/DP & DY/DQ DEFINED ON IX,IY
        REAL   , POINTER :: DPDX(:,:), DPDY(:,:) ! DP/DX & DP/DY DEFINED ON IX,IY
        REAL   , POINTER :: DQDX(:,:), DQDY(:,:) ! DQ/DX & DQ/DY DEFINED ON IX,IY
        REAL   , POINTER :: GSQRT(:,:) ! SQRT(G) DEFINED ON IX,IY
        REAL   , POINTER :: HPFAC(:,:) ! H_P = SQRT(G_PP) DEFINED ON IX,IY
        REAL   , POINTER :: HQFAC(:,:) ! H_Q = SQRT(G_QQ) DEFINED ON IX,IY

        LOGICAL          :: GINIT, FLDRY, FLCX, FLCY, FLCTH, FLCK, FLSOU, IICEDISP,&
			                IICESMOOTH
        LOGICAL          :: FLAGLL
        LOGICAL          :: CMPRTRCK
        LOGICAL, POINTER :: FLAGST(:)
        CHARACTER(LEN=30):: GNAME
        CHARACTER(LEN=13):: FILEXT
        LOGICAL          :: GUGINIT
        REAL, POINTER    :: REFLC(:,:)  ! reflection coefficient
        INTEGER, POINTER :: REFLD(:,:)  ! reflection direction
        INTEGER          :: E3DF(3,5), P2MSF(3), US3DF(3), USSPF(2) ! freq. indices for 3D output
        REAL             :: USSP_WN(25) !Max set to 25 decay scales.
!
        TYPE(T_GSU) :: GSU ! Grid search utility object
!
        REAL                  :: FFACBERG    ! mutiplicative factor for iceberg mask
!/BT4   REAL, POINTER         :: SED_D50(:), SED_PSIC(:) 
!/REF1        LOGICAL, POINTER      :: RREF(:)
!/REF1        REAL,    POINTER      :: REFPARS(:)
!/IG1        REAL,    POINTER      :: IGPARS(:)
!/IC2        REAL,    POINTER      :: IC2PARS(:)
!/IC3        REAL,    POINTER      :: IC3PARS(:)
!/IC4        INTEGER, POINTER      :: IC4PARS(:)
!/IC4        REAL, POINTER         :: IC4_KI(:)
!/IC4        REAL, POINTER         :: IC4_FC(:)
!/IS2        REAL,    POINTER      :: IS2PARS(:)
!
! unstructured data
!
        INTEGER               :: NTRI
        DOUBLE PRECISION, POINTER         :: XYB(:,:)
        INTEGER, POINTER      :: TRIGP(:,:)
        DOUBLE PRECISION, POINTER         :: LEN(:,:),SI(:), IEN(:,:)

        REAL                  :: MAXX, MAXY, DXYMAX
        REAL, POINTER         :: ANGLE(:,:),ANGLE0(:,:)
        INTEGER               :: COUNTRI,COUNTOT,NNZ
        INTEGER, POINTER      :: CCON(:), COUNTCON(:), IE_CELL(:), VNEIGH(:,:),  &
                                 POS_CELL(:), IOBP(:), IOBPD(:,:), IOBPA(:),     &
                                 IAA(:), JAA(:), POSI(:,:), INDEX_CELL(:) 
        DOUBLE PRECISION, POINTER         :: TRIA(:)
        REAL, POINTER         :: CROSSDIFF(:,:)
      END TYPE GRID
!
      TYPE SGRD   ! this is the spectral grid with all parameters that vary with freq. and direction
        INTEGER               :: NK, NK2, NTH, NSPEC
        INTEGER, POINTER      :: MAPWN(:), MAPTH(:)
        REAL                  :: DTH, XFR, FR1, FTE, FTF, FTWN, FTTR, &
                                 FTWL, FACTI1, FACTI2, FACHFA, FACHFE
        REAL, POINTER         :: TH(:), ESIN(:), ECOS(:), ES2(:),     &
                                 ESC(:), EC2(:), SIG(:), SIG2(:),     &
                                 DSIP(:), DSII(:), DDEN(:), DDEN2(:)
        LOGICAL               :: SINIT
      END TYPE SGRD
!
      TYPE NPAR
        REAL                  :: FACP, XREL, XFLT, FXFM, FXPM,        &
                                 XFT, XFC, FACSD, FHMAX
!/RWND        REAL            :: RWINDC
!/WCOR        REAL            :: WWCOR(2)
      END TYPE NPAR
!
      TYPE PROP
!/PR0        REAL                  :: DUMMY
!/PR1        REAL                  :: DUMMY
!/PR2        REAL                  :: DTME, CLATMN
!/PR3        REAL                  :: WDCG, WDTH
!/SMC        REAL                  :: DTME, CLATMN, Refran
!/SMC        LOGICAL               :: FUNO3, FVERG 
      END TYPE PROP
!
      TYPE FLDP
         REAL :: DUMMY
!/FLD1        INTEGER               :: Tail_ID
!/FLD1        REAL                  :: Tail_Lev, TAIL_TRAN1, TAIL_TRAN2
!/FLD2        INTEGER               :: Tail_ID
!/FLD2        REAL                  :: Tail_Lev, TAIL_TRAN1, TAIL_TRAN2
      END TYPE FLDP
      TYPE SFLP
!/FLX0        REAL                  :: DUMMY
!/FLX1        REAL                  :: DUMMY
!/FLX2        INTEGER               :: NITTIN
!/FLX2        REAL                  :: CINXSI
!/FLX3        INTEGER               :: NITTIN, CAP_ID
!/FLX3        REAL                  :: CINXSI, CD_MAX
!/FLX4        REAL                  :: FLX4A0
!/FLXX        REAL                  :: DUMMY
      END TYPE SFLP
!
      TYPE SLNP
!/SEED        REAL                  :: DUMMY
!/LN0        REAL                  :: DUMMY
!/LN1        REAL                  :: SLNC1, FSPM, FSHF
!/LNX        REAL                  :: DUMMY
      END TYPE SLNP
!
      TYPE SRCP
        REAL                       :: WWNMEANPTAIL, SSTXFTFTAIL
!/ST1        REAL                  :: SINC1, SDSC1
!/ST2        REAL                  :: ZWIND, FSWELL, SHSTAB,               &
!/ST2                                 OFSTAB, CCNG, CCPS, FFNG, FFPS,      &
!/ST2                                 CDSA0, CDSA1, CDSA2, SDSALN,         &
!/ST2                                 CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN,  &
!/ST2                                 XFH, XF1, XF2
!/ST3        INTEGER               :: SSDSISO, SSDSBRFDF
!/ST3        REAL                  :: AALPHA, BBETA, ZZ0MAX, ZZ0RAT, ZZALP,&
!/ST3                                 SSINTHP, TTAUWSHELTER, SSWELLF(1:6), &
!/ST3                                 SSDSC1, SSDSC2, SSDSC3, SSDSBR,      &
!/ST3                                 SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN,  &
!/ST3                                 FFXPM, FFXFM,                        &
!/ST3                                 SSDSC4, SSDSC5, SSDSC6, DDELTA1,     &
!/ST3                                 DDELTA2, ZZWND
!
!/ST4        INTEGER               :: SSWELLFPAR, SSDSISO, SSDSBRFDF
!/ST4        INTEGER,  POINTER     :: IKTAB(:,:), SATINDICES(:,:)
!/ST4        REAL,     POINTER     :: DCKI(:,:), SATWEIGHTS(:,:),CUMULW(:,:),QBI(:,:)
!/ST4        REAL                  :: AALPHA, BBETA, ZZ0MAX, ZZ0RAT, ZZALP,&
!/ST4                                 SSINTHP, TTAUWSHELTER, SSWELLF(1:7), &
!/ST4                                 SSDSC(1:9), SSDSBR,                  &
!/ST4                                 SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN,  &
!/ST4                                 FFXPM, FFXFM, FFXFA, FFXFI, FFXFD,   &
!/ST4                                 SSDSBRF1, SSDSBRF2, SSDSBINT,SSDSBCK,&
!/ST4                                 SSDSHCK, SSDSABK, SSDSPBK, SSINBR
!/ST4        REAL                  :: ZZWND
!/ST4        REAL                  :: SSDSCOS, SSDSDTH, SSDSBR2, SSDSBM(0:4)
!
!/ST6        REAL                  :: SIN6A0, SDS6A1, SDS6A2, SWL6B1
!/ST6        INTEGER               :: SDS6P1, SDS6P2
!/ST6        LOGICAL               :: SDS6ET, SWL6S6, SWL6CSTB1
!
!/STX        REAL                  :: DUMMY
      END TYPE SRCP
!
      TYPE SNLP
!/NL0        REAL                  :: DUMMY
!/NL1        REAL                  :: SNLC1, LAM, KDCON, KDMN,             &
!/NL1                                 SNLS1, SNLS2, SNLS3
!/NL2        INTEGER               :: IQTPE, NDPTHS
!/NL2        REAL                  :: NLTAIL
!/NL2        REAL, POINTER         :: DPTHNL(:)
!/NL3        INTEGER               :: NFRMIN, NFRMAX, NFRCUT, NTHMAX,      &
!/NL3                                 NTHEXP, NSPMIN, NSPMAX, NSPMX2,      &
!/NL3                                 NQA, SNLNQ
!/NL3        INTEGER, POINTER      :: QST1(:,:,:), QST4(:,:,:)
!/NL3        REAL                  :: SNLMSC, SNLNSC, SNLSFD, SNLSFS
!/NL3        REAL, POINTER         :: FRQ(:), XSI(:),                      &
!/NL3                                 QST2(:,:,:), QST3(:,:,:),            &
!/NL3                                 QST5(:,:,:), QST6(:,:,:),            &
!/NL3                                 SNLL(:), SNLM(:), SNLT(:),           &
!/NL3                                 SNLCD(:), SNLCS(:)
!/NL4        INTEGER               :: ITSA, IALT
!/NLX        REAL                  :: DUMMY
!/NLS        INTEGER               :: NTHX, NFRX, NSPL, NSPH
!/NLS        REAL                  :: CNLSA, CNLSC, CNLSFM,                &
!/NLS                                 CNLSC1, CNLSC2, CNLSC3
!/NLS        REAL, POINTER         :: SNSST(:,:)

      END TYPE SNLP
!
      TYPE SBTP
!/BTX        REAL                  :: DUMMY
!/BT0        REAL                  :: DUMMY
!/BT1        REAL                  :: SBTC1
!/BT4        REAL                  :: SBTCX(10)
!/BT8        REAL                  :: DUMMY
!/BT9        REAL                  :: DUMMY
      END TYPE SBTP
!
      TYPE SDBP
!/DB0        REAL                  :: DUMMY
!/DB1        REAL                  :: SDBC1, SDBC2
!/DB1        LOGICAL               :: FDONLY
!/DBX        REAL                  :: DUMMY
      END TYPE SDBP
!
      TYPE STRP
!/TR0        REAL                  :: DUMMY
!/TR1        REAL                  :: DUMMY
!/TRX        REAL                  :: DUMMY
      END TYPE STRP
!
      TYPE SBSP
!/BS0        REAL                  :: DUMMY
!/BS1        REAL                  :: DUMMY
!/BSX        REAL                  :: DUMMY
      END TYPE SBSP
!
      TYPE SICP
!/IS0        REAL                  :: DUMMY
!/IS1        REAL                  :: IS1C1, IS1C2
!/IS2        REAL                  :: IS2C1, IS2C2
      END TYPE SICP
!
      TYPE SXXP
!/XX0        REAL                  :: DUMMY
!/XXX        REAL                  :: DUMMY
      END TYPE SXXP
      
! specific type for unstructured scheme
      TYPE SCHM
         LOGICAL              :: FSN,FSPSI,FSFCT,FSNIMP
      END TYPE SCHM    
!      
!
      TYPE MPAR
        LOGICAL               :: PINIT
        TYPE(NPAR)            :: NPARS
        TYPE(PROP)            :: PROPS
        TYPE(FLDP)            :: FLDPS
        TYPE(SFLP)            :: SFLPS
        TYPE(SLNP)            :: SLNPS
        TYPE(SRCP)            :: SRCPS
        TYPE(SNLP)            :: SNLPS
        TYPE(SBTP)            :: SBTPS
        TYPE(SDBP)            :: SDBPS
        TYPE(STRP)            :: STRPS
        TYPE(SBSP)            :: SBSPS
        TYPE(SICP)            :: SICPS
        TYPE(SXXP)            :: SXXPS
        TYPE(SCHM)            :: SCHMS
      END TYPE MPAR
!/
!/ Data storage
!/
      TYPE(GRID), TARGET, ALLOCATABLE :: GRIDS(:)
      TYPE(SGRD), TARGET, ALLOCATABLE :: SGRDS(:)
      TYPE(MPAR), TARGET, ALLOCATABLE :: MPARS(:)
!/
!/ Data aliases for structure GRID(S)
!/
      INTEGER, POINTER :: GTYPE
      INTEGER, POINTER :: ICLOSE
      INTEGER, POINTER        :: NX, NY, NSEA, NSEAL, TRFLAG
      INTEGER, POINTER        :: E3DF(:,:), P2MSF(:), US3DF(:), USSPF(:)
      REAL,    POINTER        :: USSP_WN(:)
      REAL,    POINTER        :: REFLC(:,:)
      INTEGER, POINTER        :: REFLD(:,:)    
!
! Variables for unstructured grids 
!
      INTEGER, POINTER        :: NTRI,COUNTRI,COUNTOT,NNZ
!  XYB may not be necessary now that we have XGRD and YGRD
!  but these XGRD and YGRD should probably be double precision
      DOUBLE PRECISION, POINTER  ::     XYB(:,:)   
      INTEGER, POINTER        :: TRIGP(:,:)
      DOUBLE PRECISION, POINTER  :: IEN(:,:), LEN(:,:), SI(:)
      REAL, POINTER           :: ANGLE(:,:),ANGLE0(:,:)
      INTEGER,  POINTER       :: CCON(:),  COUNTCON(:), IE_CELL(:),    &
                                 POS_CELL(:), IOBP(:), IOBPD(:,:),     &
                                 IAA(:), JAA(:), POSI(:,:),            &
                                 VNEIGH(:,:), INDEX_CELL(:), IOBPA(:)
      DOUBLE PRECISION, POINTER  :: TRIA(:)
      REAL, POINTER           :: CROSSDIFF(:,:)
      REAL,POINTER            :: MAXX, MAXY, DXYMAX 
      LOGICAL, POINTER        :: GUGINIT       
!
      REAL,    POINTER        :: FFACBERG
!/REF1      LOGICAL, POINTER        ::  RREF(:)
      REAL,    POINTER        :: REFPARS(:)
!/IG1      REAL,    POINTER        :: IGPARS(:)
!/IC2      REAL,    POINTER        :: IC2PARS(:)
!/IC3      REAL,    POINTER        :: IC3PARS(:)
!/IC4      INTEGER, POINTER        :: IC4PARS(:)
!/IC4      REAL, POINTER           :: IC4_KI(:)
!/IC4      REAL, POINTER           :: IC4_FC(:)
!/IS2      REAL,    POINTER        :: IS2PARS(:)
      INTEGER, POINTER        :: MAPSTA(:,:), MAPST2(:,:),            &
                                 MAPFS(:,:), MAPSF(:,:)
!
!/SMC        INTEGER, POINTER      :: NCel, NUFc, NVFc, NRLv, MRFct
!/SMC        INTEGER, POINTER      :: NLvCel(:), NLvUFc(:), NLvVFc(:)
!/SMC        INTEGER, POINTER      :: IJKCel(:,:), IJKUFc(:,:), IJKVFc(:,:)
!
!/ARC        INTEGER, POINTER      :: NGLO, NARC, NBGL, NBAC
!/ARC        INTEGER, POINTER      :: ICLBAC(:)
!
!/SEC1      INTEGER, POINTER        :: NITERSEC1
      REAL, POINTER           :: SX, SY, X0, Y0, DTCFL, DTCFLI, DTMAX, &
                                 DTMIN, DMIN, CTMAX, FICE0, FICEN,     &
                                 FICEL, PFMOVE, STEXU, STEYU, STEDU,   &
                                 IICEHMIN, IICEHINIT, ICE100WIND,      &
                                 IICEHFAC, IICEHDISP, IICEDDISP, IICEFDISP
      REAL(8),POINTER         :: GRIDSHIFT ! see notes in WMGHGH
!/RTD        REAL, POINTER         :: Polat, Polon
!/RTD        REAL, POINTER         :: AnglD(:)
      REAL, POINTER           :: ZB(:), CLATS(:)
      REAL   , POINTER :: CLATIS(:) ! INVERSE OF COS(LAT) DEFINED ON ISEA
      REAL   , POINTER :: CTHG0S(:) ! TAN(Y)/R, DEFINED ON ISEA

      REAL   , POINTER :: TRNX(:,:), TRNY(:,:) ! TRANSPARENCY INFORMATION ON IX,IY
!/SMC        REAL, POINTER         :: CTRNX(:), CTRNY(:), CLATF(:)
      REAL, POINTER         :: SPCBAC(:,:), ANGARC(:)
      REAL   , POINTER :: XGRD(:,:), YGRD(:,:) ! X AND Y DEFINED ON IX,IY
      REAL   , POINTER :: DXDP(:,:), DXDQ(:,:) ! DX/DP & DX/DQ DEFINED ON IX,IY
      REAL   , POINTER :: DYDP(:,:), DYDQ(:,:) ! DY/DP & DY/DQ DEFINED ON IX,IY
      REAL   , POINTER :: DPDX(:,:), DPDY(:,:) ! DP/DX & DP/DY DEFINED ON IX,IY
      REAL   , POINTER :: DQDX(:,:), DQDY(:,:) ! DQ/DX & DQ/DY DEFINED ON IX,IY
      REAL   , POINTER :: GSQRT(:,:) ! SQRT(G) DEFINED ON IX,IY
      REAL   , POINTER :: HPFAC(:,:) ! H_P = SQRT(G_PP) DEFINED ON IX,IY
      REAL   , POINTER :: HQFAC(:,:) ! H_Q = SQRT(G_QQ) DEFINED ON IX,IY
!/BT4        REAL, POINTER         :: SED_D50(:), SED_PSIC(:)

      LOGICAL, POINTER :: GINIT, FLDRY, FLCX, FLCY, FLCTH, FLCK, FLSOU, IICEDISP,&
                          IICESMOOTH
      LOGICAL, POINTER :: FLAGLL
      LOGICAL, POINTER :: CMPRTRCK
      LOGICAL, POINTER :: FLAGST(:)

      CHARACTER(LEN=30), POINTER :: GNAME
      CHARACTER(LEN=13), POINTER :: FILEXT

      TYPE(T_GSU), POINTER :: GSU ! Grid search utility object
!/
!/ Data aliasses for structure SGRD(S)
!/
      INTEGER, POINTER        :: NK, NK2, NTH, NSPEC
      INTEGER, POINTER        :: MAPWN(:), MAPTH(:)
      REAL, POINTER           :: DTH, XFR, FR1, FTE, FTF, FTWN, FTTR, &
                                 FTWL, FACTI1, FACTI2, FACHFA, FACHFE
      REAL, POINTER           :: TH(:), ESIN(:), ECOS(:), ES2(:),     &
                                 ESC(:), EC2(:), SIG(:), SIG2(:),     &
                                 DSIP(:), DSII(:), DDEN(:), DDEN2(:)
      LOGICAL, POINTER        :: SINIT
!/
!/ Data aliasses for structure MPAR(S)
!/
      LOGICAL, POINTER        :: PINIT
!/
!/ Data aliasses for structure NPAR(S)
!/
      REAL, POINTER           :: FACP, XREL, XFLT, FXFM, FXPM,        &
                                 XFT, XFC, FACSD, FHMAX
!/RWND REAL, POINTER           :: RWINDC
!/WCOR REAL, POINTER           :: WWCOR(:)
!/
!/ Data aliasses for structure PROP(S)
!/
!/PR2      REAL, POINTER           :: DTME, CLATMN
!/PR3      REAL, POINTER           :: WDCG, WDTH
!/SMC      REAL, POINTER           :: DTME, CLATMN, Refran
!/SMC      LOGICAL, POINTER        :: FUNO3, FVERG 
!/
!/ Data aliasses for structure FLDP(S)
!/
!/FLD1     INTEGER, POINTER         :: TAIL_ID
!/FLD1     REAL, POINTER            :: TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2
!/FLD2     INTEGER, POINTER         :: TAIL_ID
!/FLD2     REAL, POINTER            :: TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2
!/
!/ Data aliasses for structure SFLP(S)
!/
!/FLX2      INTEGER, POINTER        :: NITTIN
!/FLX2      REAL, POINTER           :: CINXSI
!/FLX3      INTEGER, POINTER        :: NITTIN, CAP_ID
!/FLX3      REAL, POINTER           :: CINXSI, CD_MAX
!/FLX4      REAL, POINTER           :: FLX4A0
!/
!/ Data aliasses for structure SLNP(S)
!/
!/LN1      REAL, POINTER           :: SLNC1, FSPM, FSHF
!/
!/ Data aliasses for structure SRCP(S)
!/
!/ST1      REAL, POINTER           :: SINC1, SDSC1
!/ST2      REAL, POINTER           :: ZWIND, FSWELL, SHSTAB,               &
!/ST2                                 OFSTAB, CCNG, CCPS, FFNG, FFPS,      &
!/ST2                                 CDSA0, CDSA1, CDSA2, SDSALN,         &
!/ST2                                 CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN,  &
!/ST2                                 XFH, XF1, XF2
!/ST3      REAL, POINTER           :: ZZWND, AALPHA, BBETA, ZZ0MAX, ZZ0RAT,&
!/ST3                                 ZZALP, FFXFM, FFXPM,                 &
!/ST3                                 SSINTHP, TTAUWSHELTER, SSWELLF(:),   &
!/ST3                                 SSDSC1, SSDSC2, SSDSC3, SSDSBR,      &
!/ST3                                 SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN,  &
!/ST3                                 SSDSC4, SSDSC5, SSDSC6, SSDSBR2,     &
!/ST3                                 DDELTA1, DDELTA2,                    &
!/ST3                                 SSDSCOS, SSDSDTH, SSDSBM(:)
!/ST4      INTEGER, POINTER        :: SSWELLFPAR, SSDSISO,SSDSBRFDF,       &
!/ST4                                 IKTAB(:,:), SATINDICES(:,:),SSDSDIK
!/ST4      REAL, POINTER           :: DCKI(:,:), SATWEIGHTS(:,:),CUMULW(:,:),QBI(:,:)
!/ST4      REAL, POINTER           :: ZZWND, AALPHA, BBETA, ZZ0MAX, ZZ0RAT,&
!/ST4                                 ZZALP, FFXFA, FFXFI, FFXFD,          &
!/ST4                                 FFXFM, FFXPM, SSDSBRF1, SSDSBRF2,    &
!/ST4                                 SSDSBINT, SSDSBCK, SSDSHCK, SSDSABK, &
!/ST4                                 SSDSPBK, SSINBR,SSINTHP,TTAUWSHELTER,&
!/ST4                                 SSWELLF(:), SSDSC(:), SSDSBR,        &
!/ST4                                 SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN,  &
!/ST4                                 SSDSBR2, SSDSCOS, SSDSDTH, SSDSBM(:)
!/ST6      REAL, POINTER           :: SIN6A0, SDS6A1, SDS6A2, SWL6B1
!/ST6      INTEGER, POINTER        :: SDS6P1, SDS6P2
!/ST6      LOGICAL, POINTER        :: SDS6ET, SWL6S6, SWL6CSTB1
      REAL, POINTER           :: WWNMEANPTAIL, SSTXFTFTAIL
!/
!/ Data aliasses for structure SNLP(S)
!/
!/NL1      REAL, POINTER           :: SNLC1, LAM, KDCON, KDMN,             &
!/NL1                                 SNLS1, SNLS2, SNLS3
!/NL2      INTEGER, POINTER        :: IQTPE, NDPTHS
!/NL2      REAL, POINTER           :: NLTAIL
!/NL2      REAL, POINTER           :: DPTHNL(:)
!/NL3      INTEGER, POINTER        :: NFRMIN, NFRMAX, NFRCUT, NTHMAX,      &
!/NL3                                 NTHEXP, NSPMIN, NSPMAX, NSPMX2,      &
!/NL3                                 NQA, SNLNQ
!/NL3      INTEGER, POINTER        :: QST1(:,:,:), QST4(:,:,:)
!/NL3      REAL, POINTER           :: SNLMSC, SNLNSC, SNLSFD, SNLSFS
!/NL3      REAL, POINTER           :: FRQ(:), XSI(:),                      &
!/NL3                                 QST2(:,:,:), QST3(:,:,:),            &
!/NL3                                 QST5(:,:,:), QST6(:,:,:),            &
!/NL3                                 SNLL(:), SNLM(:), SNLT(:),           &
!/NL3                                 SNLCD(:), SNLCS(:)
!/NL4      INTEGER, POINTER        :: ITSA, IALT
!/NLS      INTEGER, POINTER        :: NTHX, NFRX, NSPL, NSPH
!/NLS      REAL, POINTER           :: CNLSA, CNLSC, CNLSFM,                &
!/NLS                                 CNLSC1, CNLSC2, CNLSC3, SNSST(:,:)
!/
!/ Data aliasses for structure SBTP(S)
!/
!/BT1      REAL, POINTER           :: SBTC1
!/BT4      REAL, POINTER           :: SBTCX(:)
!/
!/ Data aliasses for structure SDBP(S)
!/
!/DB1      REAL, POINTER           :: SDBC1, SDBC2
!/DB1      LOGICAL, POINTER        :: FDONLY
!/
!/ Data aliasing for structure SCHM(S)
      LOGICAL, POINTER        :: FSN,FSPSI,FSFCT,FSNIMP
!/
!/ Data aliasing for structure SICP(S)
!/IS1      REAL, POINTER           :: IS1C1, IS1C2
!/
      CONTAINS
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3NMOD ( NUMBER, NDSE, NDST, NAUX )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         10-Dec-2014 !
!/                  +-----------------------------------+
!/
!/    24-Feb-2004 : Origination.                        ( version 3.06 )
!/    18-Jul-2006 : Add input grids.                    ( version 3.10 )
!/    10-Dec-2014 : Add checks for allocate status      ( version 5.04 )
!/
!  1. Purpose :
!
!     Set up the number of grids to be used.
!
!  2. Method :
!
!     Store in NGRIDS and allocate GRIDS.
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       NUMBER  Int.   I   Number of grids to be used.
!       NDSE    Int.   I   Error output unit number.
!       NDST    Int.   I   Test output unit number.
!       NAUX    Int.   I   Number of auxiliary grids to be used.
!                          Grids -NAUX:NUBMER are defined, optional
!                          parameters.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!     See module documentation.
!
!  5. Called by :
!
!     Any program that uses this grid structure.
!
!  6. Error messages :
!
!     - Error checks on previous setting of variable.
!
!  7. Remarks :
!
!  8. Structure :
!
!  9. Switches :
!
!     !/S    Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
      USE W3SERVMD, ONLY: EXTCDE
!/S      USE W3SERVMD, ONLY: STRACE
!
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)           :: NUMBER, NDSE, NDST
      INTEGER, INTENT(IN), OPTIONAL :: NAUX
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER                 :: I, NLOW
!/S      INTEGER, SAVE           :: IENT = 0
!/
!/S      CALL STRACE (IENT, 'W3NMOD')
!
! -------------------------------------------------------------------- /
! 1.  Test input and module status
!
      IF ( NGRIDS .NE. -1 ) THEN
          WRITE (NDSE,1001) NGRIDS
          CALL EXTCDE (1)
        END IF
!
      IF ( NUMBER .LT. 1 ) THEN
          WRITE (NDSE,1002) NUMBER
          CALL EXTCDE (2)
        END IF
!
      IF ( PRESENT(NAUX) ) THEN
          NLOW   = -NAUX
        ELSE
          NLOW   = 1
        END IF
!
      IF ( NLOW .GT. 1 ) THEN
          WRITE (NDSE,1003) -NLOW
          CALL EXTCDE (3)
        END IF
!
! -------------------------------------------------------------------- /
! 1.  Set variable and allocate arrays
!
      NGRIDS = NUMBER
      NAUXGR = - NLOW
      ALLOCATE ( GRIDS(NLOW:NUMBER), &
                 SGRDS(NLOW:NUMBER), &
                 MPARS(NLOW:NUMBER), &
                 STAT=ISTAT )
      CHECK_ALLOC_STATUS ( ISTAT )
!
! -------------------------------------------------------------------- /
! 2.  Initialize GINIT and SINIT
!
      DO I=NLOW, NUMBER
        GRIDS(I)%GINIT  = .FALSE.
        GRIDS(I)%GUGINIT  = .FALSE.
        SGRDS(I)%SINIT  = .FALSE.
        MPARS(I)%PINIT  = .FALSE.
!/NL2        MPARS(I)%SNLPS%NDPTHS = 0
        END DO
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3NMOD)
      WRITE (NDST,9000) NLOW, NGRIDS
#endif
!
      RETURN
!
! Formats
!
 1001 FORMAT (/' *** ERROR W3NMOD : GRIDS ALREADY INITIALIZED *** '/  &
               '                    NGRIDS = ',I10/)
 1002 FORMAT (/' *** ERROR W3NMOD : ILLEGAL NUMBER OF GRIDS *** '/    &
               '                    NUMBER = ',I10/)
 1003 FORMAT (/' *** ERROR W3NMOD : ILLEGAL NUMBER OF AUX GRIDS *** '/&
               '                    NUMBER = ',I10/)
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3NMOD)
 9000 FORMAT (' TEST W3NMOD : SETTING UP FOR GRIDS ',I3,           &
              ' THROUGH ',I3)
#endif
!/
!/ End of W3NMOD ----------------------------------------------------- /
!/
      END SUBROUTINE W3NMOD
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3DIMX  ( IMOD, MX, MY, MSEA, NDSE, NDST   & 
!/SMC                    , MCel, MUFc, MVFc, MRLv           &
!/ARC                    , MARC, MBAC, MSPEC                &
                         )
!/SMC  !!Li    A few dimensional numbers for SMC grid.  
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         10-Dec-2014 |
!/                  +-----------------------------------+
!/
!/    24-Jun-2005 : Origination.                        ( version 3.07 )
!/    18-Jul-2006 : Add input grids.                    ( version 3.10 )
!/    05-Oct-2006 : Add filter to array pointers.       ( version 3.10 )
!/    02-Feb-2007 : Add FLAGST.                         ( version 3.10 )
!/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
!/                  (W. E. Rogers & T. J. Campbell, NRL)
!/    30-Oct-2009 : Implement curvilinear grid type.    ( version 3.14 )
!/                  (W. E. Rogers & T. J. Campbell, NRL)
!/    30-Oct-2009 : Implement unstructured grids        ( version 3.14.1)
!/    03-Sep-2012 : Clean up of UG grids                ( version 4.08 )
!/    10-Dec-2014 : Add checks for allocate status      ( version 5.04 )
!/
!  1. Purpose :
!
!     Initialize an individual spatial grid at the proper dimensions.
!
!  2. Method :
!
!     Allocate directly into the structure array GRIDS. Note that
!     this cannot be done through the pointer alias!
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       IMOD    Int.   I   Model number to point to.
!       NDSE    Int.   I   Error output unit number.
!       NDST    Int.   I   Test output unit number.
!       MX, MY, MSEA       Like NX, NY, NSEA in data structure.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!       See module documentation.
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      W3IOGR    Subr. W3IOGRMD Model definition file IO program.
!      WW3_GRID  Prog.   N/A    Model set up program.
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!     - Check on input parameters.
!     - Check on previous allocation.
!
!  7. Remarks :
!
!     - Grid dimensions apre passed through parameter list and then 
!       locally stored to assure consistency between allocation and
!       data in structure.
!     - W3SETG needs to be called after allocation to point to 
!       proper allocated arrays.
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!     !/S    Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
      USE W3SERVMD, ONLY: EXTCDE
!/S      USE W3SERVMD, ONLY: STRACE
!
      IMPLICIT NONE
!
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: IMOD, MX, MY, MSEA, NDSE, NDST
!/SMC       INTEGER, INTENT(IN)     :: MCel, MUFc, MVFc, MRLv 
!/ARC       INTEGER, INTENT(IN)     :: MARC, MBAC, MSPEC 
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
!/S      INTEGER, SAVE           :: IENT = 0
!/
!/S      CALL STRACE (IENT, 'W3DIMX')
!
! -------------------------------------------------------------------- /
! 1.  Test input and module status
!
      IF ( NGRIDS .EQ. -1 ) THEN
          WRITE (NDSE,1001)
          CALL EXTCDE (1)
        END IF
!
      IF ( IMOD.LT.-NAUXGR .OR. IMOD.GT.NGRIDS ) THEN
          WRITE (NDSE,1002) IMOD, -NAUXGR, NGRIDS
          CALL EXTCDE (2)
        END IF
!
      IF ( MX.LT.3 .OR. (MY.LT.3.AND.GTYPE.NE.UNGTYPE) .OR. MSEA.LT.1 ) THEN
        WRITE (NDSE,1003) MX, MY, MSEA, GTYPE
        CALL EXTCDE (3)
        END IF
!
      IF ( GRIDS(IMOD)%GINIT ) THEN
          WRITE (NDSE,1004)
          CALL EXTCDE (4)
        END IF
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX)
      WRITE (NDST,9000) IMOD, MX, MY, MSEA
#endif
!
! -------------------------------------------------------------------- /
! 2.  Allocate arrays
!
! NB: Some array start at 0 because MAPFS(IY,IX)=0 for missing points 
!
      ALLOCATE ( GRIDS(IMOD)%MAPSTA(MY,MX),  &
                 GRIDS(IMOD)%MAPST2(MY,MX),  &
                 GRIDS(IMOD)%MAPFS(MY,MX),   &
                 GRIDS(IMOD)%MAPSF(MSEA,3),  &
                 GRIDS(IMOD)%FLAGST(MSEA),   &
!/RTD                 GRIDS(IMOD)%AnglD(MSEA),    &
                 GRIDS(IMOD)%ZB(MSEA),       &
                 GRIDS(IMOD)%CLATS(0:MSEA),  &
                 GRIDS(IMOD)%CLATIS(0:MSEA), &
                 GRIDS(IMOD)%CTHG0S(0:MSEA), &
                 GRIDS(IMOD)%TRNX(MY,MX),    &
                 GRIDS(IMOD)%TRNY(MY,MX),    &
                 GRIDS(IMOD)%XGRD(MY,MX),    &
                 GRIDS(IMOD)%YGRD(MY,MX),    &
                 GRIDS(IMOD)%DXDP(MY,MX),    &
                 GRIDS(IMOD)%DXDQ(MY,MX),    &
                 GRIDS(IMOD)%DYDP(MY,MX),    &
                 GRIDS(IMOD)%DYDQ(MY,MX),    &
                 GRIDS(IMOD)%DPDX(MY,MX),    &
                 GRIDS(IMOD)%DPDY(MY,MX),    &
                 GRIDS(IMOD)%DQDX(MY,MX),    &
                 GRIDS(IMOD)%DQDY(MY,MX),    &
                 GRIDS(IMOD)%GSQRT(MY,MX),   &
                 GRIDS(IMOD)%HPFAC(MY,MX),   &
                 GRIDS(IMOD)%HQFAC(MY,MX),   &
                 STAT=ISTAT                  )
      CHECK_ALLOC_STATUS ( ISTAT )
!/BT4    ALLOCATE ( GRIDS(IMOD)%SED_D50(0:MSEA), &
!/BT4               GRIDS(IMOD)%SED_PSIC(0:MSEA),&
!/BT4                 STAT=ISTAT                 )
!/BT4      CHECK_ALLOC_STATUS ( ISTAT )
!
!/SMC      ALLOCATE ( GRIDS(IMOD)%NLvCel(0:MRLv),     &
!/SMC                 GRIDS(IMOD)%NLvUFc(0:MRLv),     &
!/SMC                 GRIDS(IMOD)%NLvVFc(0:MRLv),     &
!/SMC                 GRIDS(IMOD)%IJKCel(5, -9:MCel), &
!/SMC                 GRIDS(IMOD)%IJKUFc(7,MUFc),     &
!/SMC                 GRIDS(IMOD)%IJKVFc(8,MVFc),     &
!/SMC                 GRIDS(IMOD)%CTRNX(-9:MCel),     &  
!/SMC                 GRIDS(IMOD)%CTRNY(-9:MCel),     &
!/SMC                 GRIDS(IMOD)%CLATF(MVFc),        &
!/SMC                 STAT=ISTAT                      )
!/SMC      CHECK_ALLOC_STATUS ( ISTAT )
!
!/ARC      ALLOCATE ( GRIDS(IMOD)%ICLBAC(MBAC),       &
!/ARC                 GRIDS(IMOD)%ANGARC(MARC),       &
!/ARC                 GRIDS(IMOD)%SPCBAC(MSPEC,MBAC), &
!/ARC                 STAT=ISTAT                      )
!/ARC      CHECK_ALLOC_STATUS ( ISTAT )
!
      GRIDS(IMOD)%FLAGST = .TRUE.
      GRIDS(IMOD)%GINIT  = .TRUE.
      GRIDS(IMOD)%MAPSF(:,3)=0.
      GRIDS(IMOD)%CLATS(0)=1.
      GRIDS(IMOD)%CLATIS(0)=1.
      GRIDS(IMOD)%CTHG0S(0)=1.
!
!/REF1      ALLOCATE ( GRIDS(IMOD)%RREF(4),     &
!/REF1                 GRIDS(IMOD)%REFPARS(10), &
!/REF1                 STAT=ISTAT               )
!/REF1      CHECK_ALLOC_STATUS ( ISTAT )
!/REF1! Memory footprint can be reduced by defining REFLC and REFLD only over nodes 
!/REF1! where reflection can occur. 
!/REF1      ALLOCATE ( GRIDS(IMOD)%REFLC(4,0:NSEA), &
!/REF1                 GRIDS(IMOD)%REFLD(6,0:NSEA), &
!/REF1                 STAT=ISTAT                    )
!/REF1      CHECK_ALLOC_STATUS ( ISTAT )
!/IG1       ALLOCATE ( GRIDS(IMOD)%IGPARS(12), STAT=ISTAT )
!/IG1       CHECK_ALLOC_STATUS ( ISTAT )
!/IC2       ALLOCATE ( GRIDS(IMOD)%IC2PARS(9), STAT=ISTAT )
!/IC2       CHECK_ALLOC_STATUS ( ISTAT )
!/IC3       ALLOCATE ( GRIDS(IMOD)%IC3PARS(16), STAT=ISTAT )
!/IC3       CHECK_ALLOC_STATUS ( ISTAT )

!/IC4       ALLOCATE ( GRIDS(IMOD)%IC4PARS(1), STAT=ISTAT )
!/IC4       CHECK_ALLOC_STATUS ( ISTAT )
!/IC4       ALLOCATE ( GRIDS(IMOD)%IC4_KI(NIC4), STAT=ISTAT )
!/IC4       CHECK_ALLOC_STATUS ( ISTAT )
!/IC4       ALLOCATE ( GRIDS(IMOD)%IC4_FC(NIC4), STAT=ISTAT )
!/IC4       CHECK_ALLOC_STATUS ( ISTAT )
!/IS2       ALLOCATE ( GRIDS(IMOD)%IS2PARS(18), STAT=ISTAT )
!/IS2       CHECK_ALLOC_STATUS ( ISTAT )
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX)
      WRITE (NDST,9001)
#endif
!/REF1      GRIDS(IMOD)%REFLC(1:4,0:NSEA)=0.
!/REF1      GRIDS(IMOD)%REFLD(:,:)=0
!/IG1      GRIDS(IMOD)%IGPARS(:)=0.
!/IC2      GRIDS(IMOD)%IC2PARS(:)=0.
!/IS2      GRIDS(IMOD)%IS2PARS(:)=0.
!
! -------------------------------------------------------------------- /
! 2.  Update counters in grid
!
      GRIDS(IMOD)%NX     = MX
      GRIDS(IMOD)%NY     = MY
      GRIDS(IMOD)%NSEA   = MSEA
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX)
      WRITE (NDST,9002)
#endif
!
! -------------------------------------------------------------------- /
! 3.  Point to allocated arrays
!
      CALL W3SETG ( IMOD, NDSE, NDST )
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX)
      WRITE (NDST,9003)
#endif
!
      RETURN
!
! Formats
!
 1001 FORMAT (/' *** ERROR W3DIMX : GRIDS NOT INITIALIZED *** '/      &
               '                    RUN W3NMOD FIRST '/)
 1002 FORMAT (/' *** ERROR W3DIMX : ILLEGAL MODEL NUMBER *** '/       &
               '                    IMOD   = ',I10/                   &
               '                    NAUXGR = ',I10/                   &
               '                    NGRIDS = ',I10/)
 1003 FORMAT (/' *** ERROR W3DIMX : ILLEGAL GRID DIMENSION(S) *** '/  &
               '                    INPUT = ',4I10 /)
 1004 FORMAT (/' *** ERROR W3DIMX : ARRAY(S) ALREADY ALLOCATED *** ')
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX)
 9000 FORMAT (' TEST W3DIMX : MODEL ',I4,' DIM. AT ',2I5,I7)
 9001 FORMAT (' TEST W3DIMX : ARRAYS ALLOCATED')
 9002 FORMAT (' TEST W3DIMX : DIMENSIONS STORED')
 9003 FORMAT (' TEST W3DIMX : POINTERS RESET')
#endif
!/
!/ End of W3DIMX ----------------------------------------------------- /
!/
      END SUBROUTINE W3DIMX
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3DIMS  ( IMOD, MK, MTH, NDSE, NDST )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         10-Dec-2014 !
!/                  +-----------------------------------+
!/
!/    19-Feb-2004 : Origination.                        ( version 3.06 )
!/    18-Jul-2006 : Add input grids.                    ( version 3.10 )
!/    05-Oct-2006 : Add filter to array pointers.       ( version 3.10 )
!/    10-Dec-2014 : Add checks for allocate status      ( version 5.04 )
!/
!  1. Purpose :
!
!     Initialize an individual spatial grid at the proper dimensions.
!
!  2. Method :
!
!     Allocate directly into the structure array GRIDS. Note that
!     this cannot be done through the pointer alias!
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       IMOD    Int.   I   Model number to point to.
!       NDSE    Int.   I   Error output unit number.
!       MK,MTH  Int.   I   Spectral dimensions.
!       NDST    Int.   I   Test output unit number.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!     See module documentation.
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      W3IOGR    Subr. W3IOGRMD Model definition file IO program.
!      WW3_GRID  Prog.   N/A    Model set up program.
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!     - Check on input parameters.
!     - Check on previous allocation.
!
!  7. Remarks :
!
!     - Grid dimensions apre passed through parameter list and then 
!       locally stored to assure consistency between allocation and
!       data in structure.
!     - W3SETG needs to be called after allocation to point to 
!       proper allocated arrays.
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!     !/S    Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
      USE W3SERVMD, ONLY: EXTCDE
!/ST4  USE CONSTANTS, ONLY: RADE
!/S      USE W3SERVMD, ONLY: STRACE
!
      IMPLICIT NONE
!
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: IMOD, MK, MTH, NDSE, NDST
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER, SAVE           :: MK2, MSPEC
!/ST4  INTEGER                  :: SDSNTH
!/S      INTEGER, SAVE           :: IENT = 0
!/
!/S      CALL STRACE (IENT, 'W3DIMS')
!
! -------------------------------------------------------------------- /
! 1.  Test input and module status
!
      IF ( NGRIDS .EQ. -1 ) THEN
          WRITE (NDSE,1001)
          CALL EXTCDE (1)
        END IF
!
      IF ( IMOD.LT.-NAUXGR .OR. IMOD.GT.NGRIDS ) THEN
          WRITE (NDSE,1002) IMOD, -NAUXGR, NGRIDS
          CALL EXTCDE (2)
        END IF
!
      IF ( MK.LT.3 .OR. MTH.LT.4 ) THEN
          WRITE (NDSE,1003) MK, MTH
          CALL EXTCDE (3)
        END IF
!
      IF ( SGRDS(IMOD)%SINIT ) THEN
          WRITE (NDSE,1004)
          CALL EXTCDE (4)
        END IF
!
      MK2    = MK + 2
      MSPEC  = MK * MTH
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS)
      WRITE (NDST,9000) IMOD, MTH, MK, MK2, MSPEC
#endif
!
! -------------------------------------------------------------------- /
! 2.  Allocate arrays
!
      ALLOCATE ( SGRDS(IMOD)%MAPWN(MSPEC+MTH),                        &
                 SGRDS(IMOD)%MAPTH(MSPEC+MTH),                        &
                 SGRDS(IMOD)%TH(MTH),                                 &
                 SGRDS(IMOD)%ESIN(MSPEC+MTH),                         &
                 SGRDS(IMOD)%ECOS(MSPEC+MTH),                         &
                 SGRDS(IMOD)%ES2(MSPEC+MTH),                          &
                 SGRDS(IMOD)%ESC(MSPEC+MTH),                          &
                 SGRDS(IMOD)%EC2(MSPEC+MTH),                          &
                 SGRDS(IMOD)%SIG(0:MK+1),                             &
                 SGRDS(IMOD)%SIG2(MSPEC),                             &
                 SGRDS(IMOD)%DSIP(0:MK+1),                            &
                 SGRDS(IMOD)%DSII(MK),                                &
                 SGRDS(IMOD)%DDEN(MK),                                &
                 SGRDS(IMOD)%DDEN2(MSPEC),                            &
                 STAT=ISTAT                                           )
      CHECK_ALLOC_STATUS ( ISTAT )
!/ST4      ALLOCATE ( MPARS(IMOD)%SRCPS%IKTAB(MK,NDTAB), &
!/ST4                 MPARS(IMOD)%SRCPS%DCKI(NKHS,NKD),  &
!/ST4                 MPARS(IMOD)%SRCPS%QBI(NKHS,NKD),   &
!/ST4                 STAT=ISTAT                         )
!/ST4      CHECK_ALLOC_STATUS ( ISTAT )
!/ST4      SDSNTH  = MTH/2-1 !MIN(NINT(SSDSDTH/(DTH*RADE)),MTH/2-1)
!/ST4      ALLOCATE( MPARS(IMOD)%SRCPS%SATINDICES(2*SDSNTH+1,MTH), &
!/ST4                MPARS(IMOD)%SRCPS%SATWEIGHTS(2*SDSNTH+1,MTH), &
!/ST4                MPARS(IMOD)%SRCPS%CUMULW(MSPEC,MSPEC),        &
!/ST4                 STAT=ISTAT                                   )
!/ST4      CHECK_ALLOC_STATUS ( ISTAT )
!
      SGRDS(IMOD)%SINIT  = .TRUE.
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS)
      WRITE (NDST,9001)
#endif
!
! -------------------------------------------------------------------- /
! 3.  Point to allocated arrays
!
      CALL W3SETG ( IMOD, NDSE, NDST )
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS)
      WRITE (NDST,9002)
#endif
!
! -------------------------------------------------------------------- /
! 4.  Update counters in grid
!
      NK     = MK
      NK2    = MK + 2
      NTH    = MTH
      NSPEC  = MK * MTH
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS)
      WRITE (NDST,9003)
#endif
!
      RETURN
!
! Formats
!
 1001 FORMAT (/' *** ERROR W3DIMS : GRIDS NOT INITIALIZED *** '/      &
               '                    RUN W3NMOD FIRST '/)
 1002 FORMAT (/' *** ERROR W3DIMS : ILLEGAL MODEL NUMBER *** '/       &
               '                    IMOD   = ',I10/                   &
               '                    NAUXGR = ',I10/                   &
               '                    NGRIDS = ',I10/)
 1003 FORMAT (/' *** ERROR W3DIMS : ILLEGAL GRID DIMENSION(S) *** '/  &
               '                    INPUT = ',4I10/)
 1004 FORMAT (/' *** ERROR W3DIMS : ARRAY(S) ALREADY ALLOCATED *** ')
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS)
 9000 FORMAT (' TEST W3DIMS : MODEL ',I4,' DIM. AT ',3I5,I7)
 9001 FORMAT (' TEST W3DIMS : ARRAYS ALLOCATED')
 9002 FORMAT (' TEST W3DIMS : POINTERS RESET')
 9003 FORMAT (' TEST W3DIMS : DIMENSIONS STORED')
#endif
!/
!/ End of W3DIMS ----------------------------------------------------- /
!/
      END SUBROUTINE W3DIMS
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3SETG ( IMOD, NDSE, NDST )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  !           J. H. Alves             !
!/                  |                        FORTRAN 90 |
!/                  | Last update :         03-Sep-2012 |
!/                  +-----------------------------------+
!/
!/    24-Jun-2005 : Origination.                        ( version 3.07 )
!/    09-Nov-2005 : Remove soft boundary options.       ( version 3.08 )
!/    23-Jun-2006 : Add data for W3SLN1.                ( version 3.09 )
!/    18-Jul-2006 : Add input grids.                    ( version 3.10 )
!/    05-Oct-2006 : Add filter to array pointers.       ( version 3.10 )
!/    02-Feb-2007 : Add FLAGST.                         ( version 3.10 )
!/    14-Apr-2007 : Add Miche style limiter.            ( version 3.11 )
!/                  ( J. H. Alves )
!/    25-Apr-2007 : Adding Battjes-Janssen Sdb.         ( version 3.11 )
!/                  ( J. H. Alves )
!/    18-Sep-2007 : Adding WAM4 source terms.           ( version 3.13 )
!/                  ( F. Ardhuin )
!/    27-Jun-2008 : Expand WAM4 variants namelist       ( version 3.14 )
!/                  ( F. Ardhuin )
!/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
!/                  (W. E. Rogers & T. J. Campbell, NRL)
!/    30-Oct-2009 : Implement curvilinear grid type.    ( version 3.14 )
!/                  (W. E. Rogers & T. J. Campbell, NRL)
!/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
!/                  specify index closure for a grid.   ( version 3.14 )
!/                  (T. J. Campbell, NRL)
!/    13-Jul-2012 : Move data structures GMD (SNL3) and nonlinear
!/                  filter (SNLS) from 3.15 (HLT).      ( version 4.08 )
!/    03-Sep-2012 : Clean up of UG grids                ( version 4.08 )
!/
!  1. Purpose :
!
!     Select one of the WAVEWATCH III grids / models.
!
!  2. Method :
!
!     Point pointers to the proper variables in the proper element of
!     the GRIDS array.
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       IMOD    Int.   I   Model number to point to.
!       NDSE    Int.   I   Error output unit number.
!       NDST    Int.   I   Test output unit number.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!     See module documentation.
!
!  5. Called by :
!
!     Many subroutines in eth WAVEWATCH system.
!
!  6. Error messages :
!
!     Checks on parameter list IMOD.
!
!  7. Remarks :
!
!  8. Structure :
!
!  9. Switches :
!
!     !/PRn  Select propagation scheme
!
!     !/STn  Select source terms
!     !/NLn
!     !/BTn
!
!     !/S    Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
      USE W3SERVMD, ONLY: EXTCDE
!/S      USE W3SERVMD, ONLY: STRACE
!
      IMPLICIT NONE
!
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: IMOD, NDSE, NDST
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
!/S      INTEGER, SAVE           :: IENT = 0
!/
!/S      CALL STRACE (IENT, 'W3SETG')
!
! -------------------------------------------------------------------- /
! 1.  Test input and module status
!
      IF ( NGRIDS .EQ. -1 ) THEN
          WRITE (NDSE,1001)
          CALL EXTCDE (1)
        END IF
!
      IF ( IMOD.LT.-NAUXGR .OR. IMOD.GT.NGRIDS ) THEN
          WRITE (NDSE,1002) IMOD, -NAUXGR, NGRIDS
          CALL EXTCDE (2)
        END IF
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3SETG)
      WRITE (NDST,9000) IMOD
#endif
!
! -------------------------------------------------------------------- /
! 2.  Set model numbers
!
      IGRID  = IMOD
      ISGRD  = IMOD
      IPARS  = IMOD
!
! -------------------------------------------------------------------- /
! 3.  Set pointers in structure GRID
!
      GTYPE  => GRIDS(IMOD)%GTYPE
      ICLOSE => GRIDS(IMOD)%ICLOSE
!
      NX     => GRIDS(IMOD)%NX
      NY     => GRIDS(IMOD)%NY
      NSEA   => GRIDS(IMOD)%NSEA
      NSEAL  => GRIDS(IMOD)%NSEAL
      TRFLAG => GRIDS(IMOD)%TRFLAG
      FLAGLL => GRIDS(IMOD)%FLAGLL
!
!/SMC      NCel   => GRIDS(IMOD)%NCel 
!/SMC      NUFc   => GRIDS(IMOD)%NUFc 
!/SMC      NVFc   => GRIDS(IMOD)%NVFc 
!/SMC      NRLv   => GRIDS(IMOD)%NRLv 
!/SMC      MRFct  => GRIDS(IMOD)%MRFct 
!
!/ARC      NGLO   => GRIDS(IMOD)%NGLO 
!/ARC      NARC   => GRIDS(IMOD)%NARC 
!/ARC      NBGL   => GRIDS(IMOD)%NBGL 
!/ARC      NBAC   => GRIDS(IMOD)%NBAC 
!
      E3DF   => GRIDS(IMOD)%E3DF
      P2MSF  => GRIDS(IMOD)%P2MSF
      US3DF  => GRIDS(IMOD)%US3DF
      USSPF  => GRIDS(IMOD)%USSPF
      USSP_WN => GRIDS(IMOD)%USSP_WN
      REFLC  => GRIDS(IMOD)%REFLC
      REFLD  => GRIDS(IMOD)%REFLD
      FFACBERG => GRIDS(IMOD)%FFACBERG
!/REF1      RREF   => GRIDS(IMOD)%RREF
!/REF1      REFPARS=> GRIDS(IMOD)%REFPARS
!/IG1      IGPARS => GRIDS(IMOD)%IGPARS
!/IC2      IC2PARS => GRIDS(IMOD)%IC2PARS
!/IC3      IC3PARS => GRIDS(IMOD)%IC3PARS
!/IC4      IC4PARS => GRIDS(IMOD)%IC4PARS
!/IC4      IC4_KI => GRIDS(IMOD)%IC4_KI
!/IC4      IC4_FC => GRIDS(IMOD)%IC4_FC
!/IS2      IS2PARS => GRIDS(IMOD)%IS2PARS
      SX     => GRIDS(IMOD)%SX
      SY     => GRIDS(IMOD)%SY
      X0     => GRIDS(IMOD)%X0
      Y0     => GRIDS(IMOD)%Y0
!
      DTCFL  => GRIDS(IMOD)%DTCFL
      DTCFLI => GRIDS(IMOD)%DTCFLI
      DTMAX  => GRIDS(IMOD)%DTMAX
      DTMIN  => GRIDS(IMOD)%DTMIN
      DMIN   => GRIDS(IMOD)%DMIN
!/SEC1      NITERSEC1  => GRIDS(IMOD)%NITERSEC1
      CTMAX  => GRIDS(IMOD)%CTMAX
      FICE0  => GRIDS(IMOD)%FICE0
      GRIDSHIFT  => GRIDS(IMOD)%GRIDSHIFT
      CMPRTRCK => GRIDS(IMOD)%CMPRTRCK
!/RTD      Polat  => GRIDS(IMOD)%Polat
!/RTD      Polon  => GRIDS(IMOD)%Polon
      FICEN  => GRIDS(IMOD)%FICEN
      FICEL  => GRIDS(IMOD)%FICEL
      IICEHMIN  => GRIDS(IMOD)%IICEHMIN
      IICEHDISP  => GRIDS(IMOD)%IICEHDISP
      IICEFDISP  => GRIDS(IMOD)%IICEFDISP
      IICEDDISP  => GRIDS(IMOD)%IICEDDISP
      IICEHFAC  => GRIDS(IMOD)%IICEHFAC
      IICEHINIT  => GRIDS(IMOD)%IICEHINIT
      ICE100WIND  => GRIDS(IMOD)%ICE100WIND
      PFMOVE => GRIDS(IMOD)%PFMOVE
      STEXU  => GRIDS(IMOD)%STEXU
      STEYU  => GRIDS(IMOD)%STEYU
      STEDU  => GRIDS(IMOD)%STEDU
!
      GINIT  => GRIDS(IMOD)%GINIT
      GUGINIT  => GRIDS(IMOD)%GUGINIT      
      FLDRY  => GRIDS(IMOD)%FLDRY
      FLCX   => GRIDS(IMOD)%FLCX
      FLCY   => GRIDS(IMOD)%FLCY
      FLCTH  => GRIDS(IMOD)%FLCTH
      FLCK   => GRIDS(IMOD)%FLCK
      FLSOU  => GRIDS(IMOD)%FLSOU
      IICEDISP => GRIDS(IMOD)%IICEDISP
      IICESMOOTH => GRIDS(IMOD)%IICESMOOTH
!
      GNAME  => GRIDS(IMOD)%GNAME
      FILEXT => GRIDS(IMOD)%FILEXT
      XYB    => GRIDS(IMOD)%XYB
      TRIGP  => GRIDS(IMOD)%TRIGP
      NTRI     => GRIDS(IMOD)%NTRI
      COUNTRI     => GRIDS(IMOD)%COUNTRI
      SI     => GRIDS(IMOD)%SI
      COUNTOT    => GRIDS(IMOD)%COUNTOT
      IEN     => GRIDS(IMOD)%IEN
      LEN     => GRIDS(IMOD)%LEN 
      ANGLE     => GRIDS(IMOD)%ANGLE 
      ANGLE0     => GRIDS(IMOD)%ANGLE0
      CCON     => GRIDS(IMOD)%CCON
      COUNTCON     => GRIDS(IMOD)%COUNTCON
      VNEIGH       => GRIDS(IMOD)%VNEIGH
      INDEX_CELL  => GRIDS(IMOD)%INDEX_CELL
      IE_CELL     => GRIDS(IMOD)%IE_CELL
      POS_CELL     => GRIDS(IMOD)%POS_CELL
      IOBP     => GRIDS(IMOD)%IOBP
      IAA      => GRIDS(IMOD)%IAA
      JAA      => GRIDS(IMOD)%JAA
      POSI     => GRIDS(IMOD)%POSI
      NNZ      => GRIDS(IMOD)%NNZ
      IOBPD     => GRIDS(IMOD)%IOBPD
      IOBPA    => GRIDS(IMOD)%IOBPA
      TRIA     => GRIDS(IMOD)%TRIA
      CROSSDIFF => GRIDS(IMOD)%CROSSDIFF
      MAXX     => GRIDS(IMOD)%MAXX
      MAXY     => GRIDS(IMOD)%MAXY
      DXYMAX   => GRIDS(IMOD)%DXYMAX      

!
      IF ( GINIT ) THEN
!
          MAPSTA => GRIDS(IMOD)%MAPSTA
          MAPST2 => GRIDS(IMOD)%MAPST2
          MAPFS  => GRIDS(IMOD)%MAPFS
          MAPSF  => GRIDS(IMOD)%MAPSF
          FLAGST => GRIDS(IMOD)%FLAGST
!
!/RTD          AnglD  => GRIDS(IMOD)%AnglD
          ZB     => GRIDS(IMOD)%ZB
          CLATS  => GRIDS(IMOD)%CLATS
          CLATIS => GRIDS(IMOD)%CLATIS
          CTHG0S => GRIDS(IMOD)%CTHG0S
          TRNX   => GRIDS(IMOD)%TRNX
          TRNY   => GRIDS(IMOD)%TRNY
!
          XGRD   => GRIDS(IMOD)%XGRD
          YGRD   => GRIDS(IMOD)%YGRD
          DXDP   => GRIDS(IMOD)%DXDP
          DXDQ   => GRIDS(IMOD)%DXDQ
          DYDP   => GRIDS(IMOD)%DYDP
          DYDQ   => GRIDS(IMOD)%DYDQ
          DPDX   => GRIDS(IMOD)%DPDX
          DPDY   => GRIDS(IMOD)%DPDY
          DQDX   => GRIDS(IMOD)%DQDX
          DQDY   => GRIDS(IMOD)%DQDY
          GSQRT  => GRIDS(IMOD)%GSQRT
          HPFAC  => GRIDS(IMOD)%HPFAC
          HQFAC  => GRIDS(IMOD)%HQFAC
!
!/BT4          SED_D50  => GRIDS(IMOD)%SED_D50
!/BT4          SED_PSIC => GRIDS(IMOD)%SED_PSIC
!
!/SMC          NLvCel => GRIDS(IMOD)%NLvCel
!/SMC          NLvUFc => GRIDS(IMOD)%NLvUFc
!/SMC          NLvVFc => GRIDS(IMOD)%NLvVFc
!/SMC          IJKCel => GRIDS(IMOD)%IJKCel
!/SMC          IJKUFc => GRIDS(IMOD)%IJKUFc
!/SMC          IJKVFc => GRIDS(IMOD)%IJKVFc
!/SMC          CTRNX  => GRIDS(IMOD)%CTRNX
!/SMC          CTRNY  => GRIDS(IMOD)%CTRNY
!/SMC          CLATF  => GRIDS(IMOD)%CLATF
!
!/ARC          ICLBAC => GRIDS(IMOD)%ICLBAC
!/ARC          ANGARC => GRIDS(IMOD)%ANGARC
!/ARC          SPCBAC => GRIDS(IMOD)%SPCBAC
!
          GSU  => GRIDS(IMOD)%GSU
!
        END IF
!
! -------------------------------------------------------------------- /
! 4.  Set pointers in structure SGRD
!
      NK     => SGRDS(IMOD)%NK
      NK2    => SGRDS(IMOD)%NK2
      NTH    => SGRDS(IMOD)%NTH
      NSPEC  => SGRDS(IMOD)%NSPEC
!
      DTH    => SGRDS(IMOD)%DTH
      XFR    => SGRDS(IMOD)%XFR
      FR1    => SGRDS(IMOD)%FR1
      FTE    => SGRDS(IMOD)%FTE
      FTF    => SGRDS(IMOD)%FTF
      FTWN   => SGRDS(IMOD)%FTWN
      FTTR   => SGRDS(IMOD)%FTTR
      FTWL   => SGRDS(IMOD)%FTWL
      FACTI1 => SGRDS(IMOD)%FACTI1
      FACTI2 => SGRDS(IMOD)%FACTI2
      FACHFA => SGRDS(IMOD)%FACHFA
      FACHFE => SGRDS(IMOD)%FACHFE
!
      SINIT  => SGRDS(IMOD)%SINIT
!
      IF ( SINIT ) THEN
!
          MAPWN  => SGRDS(IMOD)%MAPWN
          MAPTH  => SGRDS(IMOD)%MAPTH
!
          TH     => SGRDS(IMOD)%TH
          ESIN   => SGRDS(IMOD)%ESIN
          ECOS   => SGRDS(IMOD)%ECOS
          ES2    => SGRDS(IMOD)%ES2
          ESC    => SGRDS(IMOD)%ESC
          EC2    => SGRDS(IMOD)%EC2
          SIG    => SGRDS(IMOD)%SIG
          SIG2   => SGRDS(IMOD)%SIG2
          DSIP   => SGRDS(IMOD)%DSIP
          DSII   => SGRDS(IMOD)%DSII
          DDEN   => SGRDS(IMOD)%DDEN
          DDEN2  => SGRDS(IMOD)%DDEN2
!
        END IF
!
! -------------------------------------------------------------------- /
! 5.  Set pointers in structure MPAR
!
      PINIT  => MPARS(IMOD)%PINIT
!
!     Structure NPARS
!
      FACP   => MPARS(IMOD)%NPARS%FACP
      XREL   => MPARS(IMOD)%NPARS%XREL
      XFLT   => MPARS(IMOD)%NPARS%XFLT
      FXFM   => MPARS(IMOD)%NPARS%FXFM
      FXPM   => MPARS(IMOD)%NPARS%FXPM
      XFT    => MPARS(IMOD)%NPARS%XFT
      XFC    => MPARS(IMOD)%NPARS%XFC
      FACSD  => MPARS(IMOD)%NPARS%FACSD
      FHMAX  => MPARS(IMOD)%NPARS%FHMAX
!/RWND    RWINDC => MPARS(IMOD)%NPARS%RWINDC
!/WCOR    WWCOR  => MPARS(IMOD)%NPARS%WWCOR
!
!     Structure PROPS
!
!/PR2      DTME   => MPARS(IMOD)%PROPS%DTME
!/PR2      CLATMN => MPARS(IMOD)%PROPS%CLATMN
!/PR3      WDCG   => MPARS(IMOD)%PROPS%WDCG
!/PR3      WDTH   => MPARS(IMOD)%PROPS%WDTH
!/SMC      DTME   => MPARS(IMOD)%PROPS%DTME
!/SMC      CLATMN => MPARS(IMOD)%PROPS%CLATMN
!/SMC      Refran => MPARS(IMOD)%PROPS%Refran
!/SMC      FUNO3  => MPARS(IMOD)%PROPS%FUNO3 
!/SMC      FVERG  => MPARS(IMOD)%PROPS%FVERG 
!
!     Structure FLDP
!
!/FLD1      TAIL_ID  => MPARS(IMOD)%FLDPS%TAIL_ID
!/FLD1      TAIL_LEV => MPARS(IMOD)%FLDPS%TAIL_LEV
!/FLD1      TAIL_TRAN1 => MPARS(IMOD)%FLDPS%TAIL_TRAN1
!/FLD1      TAIL_TRAN2 => MPARS(IMOD)%FLDPS%TAIL_TRAN2
!/FLD2      TAIL_ID  => MPARS(IMOD)%FLDPS%TAIL_ID
!/FLD2      TAIL_LEV => MPARS(IMOD)%FLDPS%TAIL_LEV
!/FLD2      TAIL_TRAN1 => MPARS(IMOD)%FLDPS%TAIL_TRAN1
!/FLD2      TAIL_TRAN2 => MPARS(IMOD)%FLDPS%TAIL_TRAN2
!
!     Structure SFLPS
!
!/FLX2      NITTIN => MPARS(IMOD)%SFLPS%NITTIN
!/FLX2      CINXSI => MPARS(IMOD)%SFLPS%CINXSI
!/FLX3      NITTIN => MPARS(IMOD)%SFLPS%NITTIN
!/FLX3      CAP_ID => MPARS(IMOD)%SFLPS%CAP_ID
!/FLX3      CINXSI => MPARS(IMOD)%SFLPS%CINXSI
!/FLX3      CD_MAX => MPARS(IMOD)%SFLPS%CD_MAX
!/FLX4      FLX4A0 => MPARS(IMOD)%SFLPS%FLX4A0
!
!     Structure SLNPS
!
!/LN1      SLNC1  => MPARS(IMOD)%SLNPS%SLNC1
!/LN1      FSPM   => MPARS(IMOD)%SLNPS%FSPM
!/LN1      FSHF   => MPARS(IMOD)%SLNPS%FSHF
!
!     Structure SRCPS
!
      WWNMEANPTAIL=> MPARS(IMOD)%SRCPS%WWNMEANPTAIL
      SSTXFTFTAIL => MPARS(IMOD)%SRCPS%SSTXFTFTAIL
!/ST1      SINC1  => MPARS(IMOD)%SRCPS%SINC1
!/ST1      SDSC1  => MPARS(IMOD)%SRCPS%SDSC1
!/ST2      ZWIND  => MPARS(IMOD)%SRCPS%ZWIND
!/ST2      FSWELL => MPARS(IMOD)%SRCPS%FSWELL
!/ST2      SHSTAB => MPARS(IMOD)%SRCPS%SHSTAB
!/ST2      OFSTAB => MPARS(IMOD)%SRCPS%OFSTAB
!/ST2      CCNG   => MPARS(IMOD)%SRCPS%CCNG
!/ST2      CCPS   => MPARS(IMOD)%SRCPS%CCPS
!/ST2      FFNG   => MPARS(IMOD)%SRCPS%FFNG
!/ST2      FFPS   => MPARS(IMOD)%SRCPS%FFPS
!/ST2      CDSA0  => MPARS(IMOD)%SRCPS%CDSA0
!/ST2      CDSA1  => MPARS(IMOD)%SRCPS%CDSA1
!/ST2      CDSA2  => MPARS(IMOD)%SRCPS%CDSA2
!/ST2      SDSALN => MPARS(IMOD)%SRCPS%SDSALN
!/ST2      CDSB0  => MPARS(IMOD)%SRCPS%CDSB0
!/ST2      CDSB1  => MPARS(IMOD)%SRCPS%CDSB1
!/ST2      CDSB2  => MPARS(IMOD)%SRCPS%CDSB2
!/ST2      CDSB3  => MPARS(IMOD)%SRCPS%CDSB3
!/ST2      FPIMIN => MPARS(IMOD)%SRCPS%FPIMIN
!/ST2      XFH    => MPARS(IMOD)%SRCPS%XFH
!/ST2      XF1    => MPARS(IMOD)%SRCPS%XF1
!/ST2      XF2    => MPARS(IMOD)%SRCPS%XF2
!
!/ST3      ZZWND  => MPARS(IMOD)%SRCPS%ZZWND
!/ST3      AALPHA => MPARS(IMOD)%SRCPS%AALPHA
!/ST3      BBETA  => MPARS(IMOD)%SRCPS%BBETA
!/ST3      SSINTHP  => MPARS(IMOD)%SRCPS%SSINTHP
!/ST3      ZZ0MAX  => MPARS(IMOD)%SRCPS%ZZ0MAX
!/ST3      ZZ0RAT  => MPARS(IMOD)%SRCPS%ZZ0RAT
!/ST3      ZZALP  => MPARS(IMOD)%SRCPS%ZZALP
!/ST3      TTAUWSHELTER  => MPARS(IMOD)%SRCPS%TTAUWSHELTER
!/ST3      SSWELLF  => MPARS(IMOD)%SRCPS%SSWELLF
!/ST3      SSDSC1 => MPARS(IMOD)%SRCPS%SSDSC1
!/ST3      WWNMEANP => MPARS(IMOD)%SRCPS%WWNMEANP
!/ST3      FFXFM => MPARS(IMOD)%SRCPS%FFXFM
!/ST3      FFXPM => MPARS(IMOD)%SRCPS%FFXPM
!/ST3      DDELTA1 => MPARS(IMOD)%SRCPS%DDELTA1
!/ST3      DDELTA2 => MPARS(IMOD)%SRCPS%DDELTA2
!/ST3      SSTXFTF => MPARS(IMOD)%SRCPS%SSTXFTF
!/ST3      SSTXFTWN => MPARS(IMOD)%SRCPS%SSTXFTWN
!
!/ST4      ZZWND    => MPARS(IMOD)%SRCPS%ZZWND
!/ST4      AALPHA   => MPARS(IMOD)%SRCPS%AALPHA
!/ST4      BBETA    => MPARS(IMOD)%SRCPS%BBETA
!/ST4      SSINTHP  => MPARS(IMOD)%SRCPS%SSINTHP
!/ST4      ZZ0MAX   => MPARS(IMOD)%SRCPS%ZZ0MAX
!/ST4      ZZ0RAT   => MPARS(IMOD)%SRCPS%ZZ0RAT
!/ST4      ZZALP    => MPARS(IMOD)%SRCPS%ZZALP
!/ST4      TTAUWSHELTER  => MPARS(IMOD)%SRCPS%TTAUWSHELTER
!/ST4      SSWELLFPAR  => MPARS(IMOD)%SRCPS%SSWELLFPAR
!/ST4      SSWELLF  => MPARS(IMOD)%SRCPS%SSWELLF
!/ST4      SSDSC    => MPARS(IMOD)%SRCPS%SSDSC
!/ST4      SSDSBR   => MPARS(IMOD)%SRCPS%SSDSBR
!/ST4      SSDSBR2  => MPARS(IMOD)%SRCPS%SSDSBR2
!/ST4      SSDSBRF1 => MPARS(IMOD)%SRCPS%SSDSBRF1
!/ST4      SSDSBRF2 => MPARS(IMOD)%SRCPS%SSDSBRF2
!/ST4      SSDSBRFDF  => MPARS(IMOD)%SRCPS%SSDSBRFDF
!/ST4      SSDSBM   => MPARS(IMOD)%SRCPS%SSDSBM
!/ST4      SSDSBCK  => MPARS(IMOD)%SRCPS%SSDSBCK
!/ST4      SSDSABK  => MPARS(IMOD)%SRCPS%SSDSABK
!/ST4      SSDSPBK  => MPARS(IMOD)%SRCPS%SSDSPBK
!/ST4      SSDSHCK  => MPARS(IMOD)%SRCPS%SSDSHCK
!/ST4      SSDSBINT => MPARS(IMOD)%SRCPS%SSDSBINT
!/ST4      SSDSP    => MPARS(IMOD)%SRCPS%SSDSP
!/ST4      WWNMEANP => MPARS(IMOD)%SRCPS%WWNMEANP
!/ST4      FFXFM    => MPARS(IMOD)%SRCPS%FFXFM
!/ST4      FFXFA    => MPARS(IMOD)%SRCPS%FFXFA
!/ST4      FFXFI    => MPARS(IMOD)%SRCPS%FFXFI
!/ST4      FFXFD    => MPARS(IMOD)%SRCPS%FFXFD
!/ST4      FFXPM    => MPARS(IMOD)%SRCPS%FFXPM
!/ST4      SSDSDTH  => MPARS(IMOD)%SRCPS%SSDSDTH
!/ST4      SSTXFTF  => MPARS(IMOD)%SRCPS%SSTXFTF
!/ST4      SSTXFTWN => MPARS(IMOD)%SRCPS%SSTXFTWN
!/ST4      SSDSCOS  => MPARS(IMOD)%SRCPS%SSDSCOS
!/ST4      SSDSISO  => MPARS(IMOD)%SRCPS%SSDSISO
!/ST4      IKTAB    => MPARS(IMOD)%SRCPS%IKTAB  
!/ST4      DCKI     => MPARS(IMOD)%SRCPS%DCKI  
!/ST4      QBI      => MPARS(IMOD)%SRCPS%QBI  
!/ST4      CUMULW   => MPARS(IMOD)%SRCPS%CUMULW
!/ST4      SATINDICES    => MPARS(IMOD)%SRCPS%SATINDICES
!/ST4      SATWEIGHTS   => MPARS(IMOD)%SRCPS%SATWEIGHTS
!/ST4      SSINBR   => MPARS(IMOD)%SRCPS%SSINBR
!
!/ST6      SIN6A0 => MPARS(IMOD)%SRCPS%SIN6A0
!/ST6      SDS6ET => MPARS(IMOD)%SRCPS%SDS6ET
!/ST6      SDS6A1 => MPARS(IMOD)%SRCPS%SDS6A1
!/ST6      SDS6P1 => MPARS(IMOD)%SRCPS%SDS6P1
!/ST6      SDS6A2 => MPARS(IMOD)%SRCPS%SDS6A2
!/ST6      SDS6P2 => MPARS(IMOD)%SRCPS%SDS6P2
!/ST6      SWL6S6 => MPARS(IMOD)%SRCPS%SWL6S6
!/ST6      SWL6B1 => MPARS(IMOD)%SRCPS%SWL6B1
!/ST6      SWL6CSTB1 => MPARS(IMOD)%SRCPS%SWL6CSTB1
!
!     Structure SRNLS
!
!/NL1      SNLC1  => MPARS(IMOD)%SNLPS%SNLC1
!/NL1      LAM    => MPARS(IMOD)%SNLPS%LAM
!/NL1      KDCON  => MPARS(IMOD)%SNLPS%KDCON
!/NL1      KDMN   => MPARS(IMOD)%SNLPS%KDMN
!/NL1      SNLS1  => MPARS(IMOD)%SNLPS%SNLS1
!/NL1      SNLS2  => MPARS(IMOD)%SNLPS%SNLS2
!/NL1      SNLS3  => MPARS(IMOD)%SNLPS%SNLS3
!/NL2      IQTPE  => MPARS(IMOD)%SNLPS%IQTPE
!/NL2      NDPTHS => MPARS(IMOD)%SNLPS%NDPTHS
!/NL2      NLTAIL => MPARS(IMOD)%SNLPS%NLTAIL
!/NL2      IF ( NDPTHS .NE. 0 ) DPTHNL => MPARS(IMOD)%SNLPS%DPTHNL
!/NL3      NFRMIN => MPARS(IMOD)%SNLPS%NFRMIN
!/NL3      NFRMAX => MPARS(IMOD)%SNLPS%NFRMAX
!/NL3      NFRCUT => MPARS(IMOD)%SNLPS%NFRCUT
!/NL3      NTHMAX => MPARS(IMOD)%SNLPS%NTHMAX
!/NL3      NTHEXP => MPARS(IMOD)%SNLPS%NTHEXP
!/NL3      NSPMIN => MPARS(IMOD)%SNLPS%NSPMIN
!/NL3      NSPMAX => MPARS(IMOD)%SNLPS%NSPMAX
!/NL3      NSPMX2 => MPARS(IMOD)%SNLPS%NSPMX2
!/NL3      FRQ    => MPARS(IMOD)%SNLPS%FRQ
!/NL3      XSI    => MPARS(IMOD)%SNLPS%XSI
!/NL3      NQA    => MPARS(IMOD)%SNLPS%NQA
!/NL3      QST1   => MPARS(IMOD)%SNLPS%QST1
!/NL3      QST2   => MPARS(IMOD)%SNLPS%QST2
!/NL3      QST3   => MPARS(IMOD)%SNLPS%QST3
!/NL3      QST4   => MPARS(IMOD)%SNLPS%QST4
!/NL3      QST5   => MPARS(IMOD)%SNLPS%QST5
!/NL3      QST6   => MPARS(IMOD)%SNLPS%QST6
!/NL3      SNLNQ  => MPARS(IMOD)%SNLPS%SNLNQ
!/NL3      SNLMSC => MPARS(IMOD)%SNLPS%SNLMSC
!/NL3      SNLNSC => MPARS(IMOD)%SNLPS%SNLNSC
!/NL3      SNLSFD => MPARS(IMOD)%SNLPS%SNLSFD
!/NL3      SNLSFS => MPARS(IMOD)%SNLPS%SNLSFS
!/NL3      SNLL   => MPARS(IMOD)%SNLPS%SNLL
!/NL3      SNLM   => MPARS(IMOD)%SNLPS%SNLM
!/NL3      SNLT   => MPARS(IMOD)%SNLPS%SNLT
!/NL3      SNLCD  => MPARS(IMOD)%SNLPS%SNLCD
!/NL3      SNLCS  => MPARS(IMOD)%SNLPS%SNLCS
!/NL4      ITSA   => MPARS(IMOD)%SNLPS%ITSA
!/NL4      IALT   => MPARS(IMOD)%SNLPS%IALT
!/NLS      NTHX   => MPARS(IMOD)%SNLPS%NTHX
!/NLS      NFRX   => MPARS(IMOD)%SNLPS%NFRX
!/NLS      NSPL   => MPARS(IMOD)%SNLPS%NSPL
!/NLS      NSPH   => MPARS(IMOD)%SNLPS%NSPH
!/NLS      SNSST  => MPARS(IMOD)%SNLPS%SNSST
!/NLS      CNLSA  => MPARS(IMOD)%SNLPS%CNLSA
!/NLS      CNLSC  => MPARS(IMOD)%SNLPS%CNLSC
!/NLS      CNLSFM => MPARS(IMOD)%SNLPS%CNLSFM
!/NLS      CNLSC1 => MPARS(IMOD)%SNLPS%CNLSC1
!/NLS      CNLSC2 => MPARS(IMOD)%SNLPS%CNLSC2
!/NLS      CNLSC3 => MPARS(IMOD)%SNLPS%CNLSC3
!
!     Structure SBTPS
!
!/BT1      SBTC1  => MPARS(IMOD)%SBTPS%SBTC1
!/BT4      SBTCX  => MPARS(IMOD)%SBTPS%SBTCX
!
!     Structure SDBPS
!
!/DB1      SDBC1  => MPARS(IMOD)%SDBPS%SDBC1
!/DB1      SDBC2  => MPARS(IMOD)%SDBPS%SDBC2
!/DB1      FDONLY => MPARS(IMOD)%SDBPS%FDONLY
!
!     Structure SICPS
!
!/IS1      IS1C1  => MPARS(IMOD)%SICPS%IS1C1
!/IS1      IS1C2  => MPARS(IMOD)%SICPS%IS1C2
!
!    Structure SCHM
       FSN => MPARS(IMOD)%SCHMS%FSN
       FSPSI => MPARS(IMOD)%SCHMS%FSPSI
       FSFCT => MPARS(IMOD)%SCHMS%FSFCT
       FSNIMP => MPARS(IMOD)%SCHMS%FSNIMP

      RETURN
!
! Formats
!
 1001 FORMAT (/' *** ERROR W3SETG : GRIDS NOT INITIALIZED *** '/      &
               '                    RUN W3NMOD FIRST '/)
 1002 FORMAT (/' *** ERROR W3SETG : ILLEGAL MODEL NUMBER *** '/       &
               '                    IMOD   = ',I10/                   &
               '                    NAUXGR = ',I10/                   &
               '                    NGRIDS = ',I10/)
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3SETG)
 9000 FORMAT (' TEST W3SETG : GRID/MODEL ',I4,' SELECTED')
#endif
!/
!/ End of W3SETG ----------------------------------------------------- /
!/
      END SUBROUTINE W3SETG
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3GNTX ( IMOD, NDSE, NDST, MASK )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH-III           NOAA/NCEP |
!/                  |           T. J. Campbell          |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         20-Jul-2011 |
!/                  +-----------------------------------+
!/
!/    30-Oct-2009 : Origination.                        ( version 3.13 )
!/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
!/                  specify index closure for a grid.   ( version 3.14 )
!/                  (T. J. Campbell, NRL)
!/    23-Dec-2010 : Fix HPFAC and HQFAC by including the COS(YGRD)
!/                  factor with DXDP and DXDQ terms.    ( version 3.14 )
!/                  (T. J. Campbell, NRL)
!/    20-Jul-2011 : HPFAC and HQFAC are now calculated using W3DIST.
!/                  Result should be very similar except near pole.
!/                  Due to precision issues, HPFAC and HQFAC revert
!/                  to SX and SY in case of regular grids.
!/                  (W. E. Rogers, NRL)                 ( version 3.14 )
!/    20-Jan-2017 : Update to new W3GSRUMD APIs         ( version 6.02 )
!/    20-Jan-2017 : Change calculation of curvilinear grid metric and
!/                  derivatives calculations to use W3GSRUMD:W3CGDM.
!/                  (T.J. Campbell, NRL)                ( version 6.02 )
!/
!  1. Purpose :
!
!     Construct required spatial grid quantities for curvilinear grids.
!
!  2. Method :
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       IMOD    Int.   I   Model number to point to.
!       NDSE    Int.   I   Error output unit number.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!     See module documentation.
!
!  5. Called by :
!
!     Any program that uses this grid structure.
!
!  6. Error messages :
!
!     - Check on previous initialization of grids.
!
!  7. Remarks :
!
!  8. Structure :
!
!  9. Switches :
!
!     !/S    Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
      USE W3SERVMD, ONLY: EXTCDE
!/S      USE W3SERVMD, ONLY: STRACE
!
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: IMOD, NDSE, NDST
      LOGICAL, INTENT(IN), OPTIONAL :: MASK(NY,NX)
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER, PARAMETER :: NFD    = 2
      LOGICAL, PARAMETER :: PTILED = .FALSE.
      LOGICAL, PARAMETER :: QTILED = .FALSE.
      LOGICAL, PARAMETER :: IJG    = .FALSE.
      LOGICAL, PARAMETER :: SPHERE = .FALSE.
      INTEGER :: PRANGE(2), QRANGE(2)
      INTEGER :: LBI(2), UBI(2), LBO(2), UBO(2), ISTAT
      REAL   , ALLOCATABLE :: COSA(:,:)
!/S      INTEGER, SAVE      :: IENT = 0
!/
!/S      CALL STRACE (IENT, 'W3GNTX')
!
! -------------------------------------------------------------------- /
! 1.  Test input and module status
!
      IF ( NGRIDS .EQ. -1 ) THEN
          WRITE (NDSE,1001)
          CALL EXTCDE (1)
        END IF
!
      IF ( IMOD.LT.-NAUXGR .OR. IMOD.GT.NGRIDS ) THEN
          WRITE (NDSE,1002) IMOD, -NAUXGR, NGRIDS
          CALL EXTCDE (2)
        END IF
!
      SELECT CASE ( GRIDS(IMOD)%GTYPE )
        CASE ( RLGTYPE )
        CASE ( CLGTYPE )
        CASE DEFAULT
          WRITE (NDSE,1003) GRIDS(IMOD)%GTYPE
          CALL EXTCDE (3)
        END SELECT
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
      WRITE (NDST,9000) IMOD
#endif
!
! -------------------------------------------------------------------- /
! 2.  Create grid search utility object
!
      GRIDS(IMOD)%GSU = W3GSUC( IJG, FLAGLL, GRIDS(IMOD)%ICLOSE, &
                                GRIDS(IMOD)%XGRD, GRIDS(IMOD)%YGRD )
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
      CALL W3GSUP(GRIDS(IMOD)%GSU, NDST)
      WRITE (NDST,9001)
#endif
!
! -------------------------------------------------------------------- /
! 3.  Reset grid pointers
!
      CALL W3SETG ( IMOD, NDSE, NDST )
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
      WRITE (NDST,9002)
#endif
!
! -------------------------------------------------------------------- /
! 4.  Construct curvilinear grid derivatives and metric
!     Note that in the case of lon/lat grids, these quantities do not
!     include the spherical coordinate metric (SPHERE=.FALSE.).
!
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
      ALLOCATE ( COSA(NY,NX), STAT=ISTAT )
      CHECK_ALLOC_STATUS ( ISTAT )
#endif
      PRANGE = (/ 1,NX/)
      QRANGE = (/ 1,NY/)
      LBI = (/ 1, 1/)
      UBI = (/NY,NX/)
      LBO = (/ 1, 1/)
      UBO = (/NY,NX/)
      SELECT CASE ( GTYPE )
        CASE ( RLGTYPE )
          CALL W3CGDM( IJG, FLAGLL, ICLOSE, PTILED, QTILED,            &
                       PRANGE, QRANGE, LBI, UBI, LBO, UBO, XGRD, YGRD, &
                       NFD=NFD, SPHERE=SPHERE, DX=SX, DY=SY,           &
                       DXDP=DXDP, DYDP=DYDP, DXDQ=DXDQ, DYDQ=DYDQ,     &
                       DPDX=DPDX, DPDY=DPDY, DQDX=DQDX, DQDY=DQDY,     &
                       HPFC=HPFAC, HQFC=HQFAC, GSQR=GSQRT,             &
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
                       COSA=COSA,                                      &
#endif
                       RC=ISTAT )
          IF ( ISTAT.NE.0 ) THEN
              WRITE (NDSE,1004) GTYPE
              CALL EXTCDE (4)
            END IF
        CASE ( CLGTYPE )
          CALL W3CGDM( IJG, FLAGLL, ICLOSE, PTILED, QTILED,            &
                       PRANGE, QRANGE, LBI, UBI, LBO, UBO, XGRD, YGRD, &
                       MASK=MASK, NFD=NFD, SPHERE=SPHERE,            &
                       DXDP=DXDP, DYDP=DYDP, DXDQ=DXDQ, DYDQ=DYDQ,     &
                       DPDX=DPDX, DPDY=DPDY, DQDX=DQDX, DQDY=DQDY,     &
                       HPFC=HPFAC, HQFC=HQFAC, GSQR=GSQRT,             &
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
                       COSA=COSA,                                      &
#endif
                       RC=ISTAT )
          IF ( ISTAT.NE.0 ) THEN
              WRITE (NDSE,1004) GTYPE
              CALL EXTCDE (4)
            END IF
        END SELECT
!
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
      WRITE(NDST,'(A,2E14.6)')'HPFAC MIN/MAX:',MINVAL(HPFAC),MAXVAL(HPFAC)
      WRITE(NDST,'(A,2E14.6)')'HQFAC MIN/MAX:',MINVAL(HQFAC),MAXVAL(HQFAC)
      WRITE(NDST,'(A,2E14.6)')'GSQRT MIN/MAX:',MINVAL(GSQRT),MAXVAL(GSQRT)
      WRITE(NDST,'(A,2E14.6)')'DXDP  MIN/MAX:',MINVAL(DXDP),MAXVAL(DXDP)
      WRITE(NDST,'(A,2E14.6)')'DYDP  MIN/MAX:',MINVAL(DYDP),MAXVAL(DYDP)
      WRITE(NDST,'(A,2E14.6)')'DXDQ  MIN/MAX:',MINVAL(DXDQ),MAXVAL(DXDQ)
      WRITE(NDST,'(A,2E14.6)')'DYDQ  MIN/MAX:',MINVAL(DYDQ),MAXVAL(DYDQ)
      WRITE(NDST,'(A,2E14.6)')'DPDX  MIN/MAX:',MINVAL(DPDX),MAXVAL(DPDX)
      WRITE(NDST,'(A,2E14.6)')'DPDY  MIN/MAX:',MINVAL(DPDY),MAXVAL(DPDY)
      WRITE(NDST,'(A,2E14.6)')'DQDX  MIN/MAX:',MINVAL(DQDX),MAXVAL(DQDX)
      WRITE(NDST,'(A,2E14.6)')'DQDY  MIN/MAX:',MINVAL(DQDY),MAXVAL(DQDY)
      WRITE(NDST,'(A,2E14.6)')'COSA  MIN/MAX:',MINVAL(COSA),MAXVAL(COSA)
      WRITE (NDST,9003)
      DEALLOCATE ( COSA, STAT=ISTAT )
      CHECK_DEALLOC_STATUS ( ISTAT )
#endif
!
! Formats
!
 1001 FORMAT (/' *** ERROR W3GNTX : GRIDS NOT INITIALIZED *** '/      &
               '                    RUN W3NMOD FIRST '/)
 1002 FORMAT (/' *** ERROR W3GNTX : ILLEGAL MODEL NUMBER *** '/       &
               '                    IMOD   = ',I10/                   &
               '                    NAUXGR = ',I10/                   &
               '                    NGRIDS = ',I10/)
 1003 FORMAT (/' *** ERROR W3GNTX : UNSUPPORTED TYPE OF GRID *** '/   &
               '                    GTYPE  = ',I10/)
 1004 FORMAT (/' *** ERROR W3GNTX : ERROR OCCURED IN W3CGDM *** '/    &
               '                    GTYPE  = ',I10/)
!
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
 9000 FORMAT (' TEST W3GNTX : MODEL ',I4)
 9001 FORMAT (' TEST W3GNTX : SEARCH OBJECT CREATED')
 9002 FORMAT (' TEST W3GNTX : POINTERS RESET')
 9003 FORMAT (' TEST W3GNTX : GRID ARRAYS CONSTRUCTED')
#endif
!/
!/ End of W3GNTX ----------------------------------------------------- /
!/
      END SUBROUTINE W3GNTX
!/ ------------------------------------------------------------------- /   
      SUBROUTINE W3DIMUG  ( IMOD, MTRI, MX, COUNTOTA, NNZ, NDSE, NDST )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH-III           NOAA/NCEP |
!/                  |             F.ardhuin             |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         15-Mar-2007 !
!/                  +-----------------------------------+
!/
!/    15-Mar-2007 : Origination.                        ( version 3.14 )
!/    11-May-2015 : Updates to 2-ways nestings for UG   ( version 5.08 )
!/
!  1. Purpose :
!
!     Initialize an individual spatial grid at the proper dimensions.
!
!  2. Method :
!
!     Allocate directly into the structure array GRIDS. Note that
!     this cannot be done through the pointer alias!
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       IMOD    Int.   I   Model number to point to.
!       NDSE    Int.   I   Error output unit number.
!       NDST    Int.   I   Test output unit number.
!       MX, MTRI, MSEA       Like NX, NTRI, NSEA in data structure.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!       See module documentation.
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      W3IOGR    Subr. W3IOGRMD Model definition file IO program.
!      WW3_GRID  Prog.   N/A    Model set up program.
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!     - Check on input parameters.
!     - Check on previous allocation.
!
!  7. Remarks :
!
!     - Grid dimensions apre passed through parameter list and then 
!       locally stored to assure consistency between allocation and
!       data in structure.
!     - W3SETG needs to be called after allocation to point to 
!       proper allocated arrays.
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!     !/S    Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
      USE W3SERVMD, ONLY: EXTCDE
!/S      USE W3SERVMD, ONLY: STRACE
!
      IMPLICIT NONE
!
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: IMOD, MTRI, MX, COUNTOTA, NNZ, NDSE, NDST
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
!/S      INTEGER, SAVE           :: IENT = 0
!/
!/S      CALL STRACE (IENT, 'W3DIMUG')
!
! -------------------------------------------------------------------- /
! 1.  Test input and module status
!
      IF ( NGRIDS .EQ. -1 ) THEN
          WRITE (NDSE,1001)
          CALL EXTCDE (1)
        END IF
!
      IF ( IMOD.LT.-NAUXGR .OR. IMOD.GT.NGRIDS ) THEN
          WRITE (NDSE,1002) IMOD, NGRIDS
          CALL EXTCDE (2)
        END IF
      IF ( GRIDS(IMOD)%GUGINIT ) THEN
        WRITE (NDSE,1004)
        CALL EXTCDE (4)
        END IF
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG)
      WRITE (NDST,9000) IMOD, MX, MTRI
#endif
!
! -------------------------------------------------------------------- /
! 2.  Allocate arrays
!
      ALLOCATE ( GRIDS(IMOD)%TRIGP(MTRI,3),                         &
                 GRIDS(IMOD)%XYB(MX,3),                             &
                 GRIDS(IMOD)%SI(MX),                                &
                 GRIDS(IMOD)%TRIA(MTRI),                            & 
                 GRIDS(IMOD)%CROSSDIFF(6,MTRI),                     &
                 GRIDS(IMOD)%IEN(MTRI,6),                           &
                 GRIDS(IMOD)%LEN(MTRI,3),                           &
                 GRIDS(IMOD)%ANGLE(MTRI,3),                         &
                 GRIDS(IMOD)%ANGLE0(MTRI,3),                        &
                 GRIDS(IMOD)%CCON(MX),                              &
                 GRIDS(IMOD)%COUNTCON(MX),                          &
                 GRIDS(IMOD)%VNEIGH(MX,2*COUNTRI),                  &
                 GRIDS(IMOD)%INDEX_CELL(MX+1),                      &
                 GRIDS(IMOD)%IE_CELL(COUNTOTA),                     &
                 GRIDS(IMOD)%POS_CELL(COUNTOTA),                    &
                 GRIDS(IMOD)%IAA(NX+1),                             &
                 GRIDS(IMOD)%JAA(NNZ),                              &
                 GRIDS(IMOD)%POSI(3,COUNTOTA),                      &
                 GRIDS(IMOD)%IOBP(MX),                              &
                 GRIDS(IMOD)%IOBPD(NTH,MX),                         &
                 GRIDS(IMOD)%IOBPA(MX),                             &
                 STAT=ISTAT                                         )
      CHECK_ALLOC_STATUS ( ISTAT )
!
                 GRIDS(IMOD)%IOBP(:)=1
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG)
      WRITE (NDST,9001)
#endif
!
!some segmentation troubles can appear, they are related with the allocation of 
!normal(1st dimension) and the nesting of the triangulated grid.
! -------------------------------------------------------------------- /
! 3.  Point to allocated arrays
!
      CALL W3SETG ( IMOD, NDSE, NDST )
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG)
      WRITE (NDST,9002)
#endif
!
! -------------------------------------------------------------------- /
! 4.  Update counters in grid
!
      NTRI   = MTRI
      COUNTOT=COUNTOTA
      GUGINIT  = .FALSE.
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG)
      WRITE (NDST,9003)
#endif
      RETURN
!
! Formats
!
 1001 FORMAT (/' *** ERROR W3DIMUG : GRIDS NOT INITIALIZED *** '/      &
               '                    RUN W3NMOD FIRST '/)
 1002 FORMAT (/' *** ERROR W3DIMUG : ILLEGAL MODEL NUMBER *** '/       &
               '                    IMOD   = ',I10/                   &
               '                    NGRIDS = ',I10/)
 1003 FORMAT (/' *** ERROR W3DIMUG : ILLEGAL GRID DIMENSION(S) *** '/  &
               '                    INPUT = ',I10/)
 1004 FORMAT (/' *** ERROR W3DIMUG : ARRAY(S) ALREADY ALLOCATED *** ')
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG)
 9000 FORMAT (' TEST W3DIMUG: MODEL ',I4,' DIM. AT ',2I5,I7)
 9001 FORMAT (' TEST W3DIMUG : ARRAYS ALLOCATED')
 9002 FORMAT (' TEST W3DIMUG : POINTERS RESET')
 9003 FORMAT (' TEST W3DIMUG : DIMENSIONS STORED')
#endif
!/
!/ End of W3DIMUG ----------------------------------------------------- /
!/
      END SUBROUTINE W3DIMUG
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3SETREF
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           F. Ardhuin              |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         13-Nov-2013 |
!/                  +-----------------------------------+
!/
!/    13-Nov-2013 : Origination.                        ( version 4.13 )
!/
!  1. Purpose :
!
!     Update reflection directions at shoreline. 
!
!  2. Method :
!
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       None
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!     See module documentation.
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      WW3_GRID  Prog. WW3_GRID Grid preprocessor
!      W3ULEV    Subr. W3UPDTMD Water level update
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!     None.
!
!  7. Remarks :
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!       !/S      Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
      USE CONSTANTS
!/S   USE W3SERVMD, ONLY : STRACE
!
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/
      INTEGER                 :: ISEA, IX, IY, IXY, IXN, IXP, IYN, IYP
      INTEGER                 :: J, K, NEIGH1(0:7)
      INTEGER                 :: ILEV, NLEV
!/S      INTEGER, SAVE           :: IENT = 0

      REAL                    :: TRIX(NY*NX), TRIY(NY*NX), DX, DY,    &
                                 COSAVG, SINAVG, THAVG, ANGLES(0:7), CLAT
!/
!/ ------------------------------------------------------------------- /
!/
!/S      CALL STRACE (IENT, 'W3SETREF')
!
! 1.  Preparations --------------------------------------------------- *
!
!/REF1      IF (REFPARS(2).GT.0) RREF(2)=.TRUE.
!/REF1      IF (REFPARS(3).GT.0) RREF(3)=.TRUE.
!/REF1      IF (REFPARS(4).GT.0) RREF(4)=.TRUE.
!
!/REF1      DO IY=2, NY-1
!/REF1        DO IX=2, NX-1
!/REF1          IF (REFPARS(1).GT.0) RREF(1)=.TRUE.
!/REF1!No reflection from artificial island on pole. 
!/REF1          IF (FLAGLL.AND.(YGRD(IY,IX).GT.85)) RREF(1)=.FALSE.
!/REF1          IF (MAPSTA(IY,IX).GT.0) THEN
!/REF1!
!/REF1! Prepares for reflection from subgrid islands
!/REF1!
!/REF1            IF (RREF(2)) &
!/REF1              REFLC(2,MAPFS(IY,IX))= MAX((1. - TRNX(IY,IX)),(1.-TRNY(IY,IX)))
!/REF1!
!/REF1! Prepares for iceberg reflections
!/REF1!
!/REF1            IF (RREF(4)) &
!/REF1              REFLC(4,MAPFS(IY,IX))= 1.
!/REF1!
!/REF1! resolved shoreline reflection
!/REF1!
!/REF1            IF (RREF(1)) THEN 
!/REF1              REFLC(1,  MAPFS(IY,IX)) = 0.
!/REF1              REFLD(1:6,MAPFS(IY,IX)) = 0
!/REF1!
!/REF1! Search for neighboring coastline.        3 2 1 
!/REF1! around X. These are the neighbors of X:  4 X 0
!/REF1!                                          5 6 7
!/REF1!
!/REF1!
!/REF1              NEIGH1(0)=8*MAPST2(IY,IX+1)+MAPSTA(IY,IX+1)
!/REF1              NEIGH1(1:3)=8*MAPST2(IY+1,IX+1:IX-1:-1)+MAPSTA(IY+1,IX+1:IX-1:-1)
!/REF1              NEIGH1(4)=8*MAPST2(IY,IX-1)+MAPSTA(IY,IX-1)
!/REF1              NEIGH1(5:7)=8*MAPST2(IY-1,IX-1:IX+1)+MAPSTA(IY-1,IX-1:IX+1)
!/REF1!
!/REF1! if one of the surrounding points is land: determines directions ... 
!/REF1!              
!/REF1              IF (MINVAL(ABS(NEIGH1)).EQ.0) THEN 
!/REF1                IF ( FLAGLL ) THEN
!/REF1                  CLAT   = COS(YGRD(IY,IX)*DERA)
!/REF1                ELSE
!/REF1                  CLAT = 1.
!/REF1                  END IF
!/REF1                ANGLES(0)= ATAN2(DYDP(IY,IX),DXDP(IY,IX)*CLAT)
!/REF1                ANGLES(1)= ATAN2(DYDP(IY,IX)+DYDQ(IY,IX),(DXDP(IY,IX)+DXDQ(IY,IX))*CLAT)
!/REF1                ANGLES(2)= ATAN2(DYDQ(IY,IX),DXDQ(IY,IX)*CLAT)
!/REF1                ANGLES(3)= ATAN2(DYDQ(IY,IX)-DYDP(IY,IX),(DXDQ(IY,IX)-DXDP(IY,IX))*CLAT)
!/REF1                ANGLES(4:7)= ANGLES(0:3)+PI
!/REF1                IF ((NEIGH1(0).GE.1).AND.(NEIGH1(4).GE.1)) THEN 
!/REF1                  REFLD(3,MAPFS(IY,IX))=0
!/REF1                ELSE 
!/REF1                  IF ((NEIGH1(0).GE.1).OR.(NEIGH1(4).GE.1)) REFLD(3,MAPFS(IY,IX))=1
!/REF1                  END IF
!/REF1                IF ((NEIGH1(2).EQ.1).AND.(NEIGH1(6).GE.1)) THEN 
!/REF1                  REFLD(4,MAPFS(IY,IX))=0
!/REF1                ELSE
!/REF1                  IF ((NEIGH1(2).GE.1).OR.(NEIGH1(6).GE.1)) REFLD(4,MAPFS(IY,IX))=1
!/REF1                  END IF
!/REF1!
!/REF1! Looks for a locally straight coast in all 8 orientations 
!/REF1!
!/REF1                J=0
!/REF1                REFLD(1,MAPFS(IY,IX))=0
!/REF1                COSAVG=0
!/REF1                SINAVG=0
!/REF1! Shore angle is corrected for grid rotation in w3ref1md.ftn with  REFLD(5:6,MAPFS(IY,IX)) 
!/REF1                REFLD(5,MAPFS(IY,IX))= MOD(NTH+NINT(ANGLES(0)/TPI*NTH),NTH)
!/REF1                REFLD(6,MAPFS(IY,IX))= MOD(NTH+NINT((ANGLES(2)/TPI-0.25)*NTH),NTH)
!/REFT                    IF (IY.EQ.4) THEN 
!/REFT                      WRITE(6,*) 'POINT (IX,IY):',IX,IY
!/REFT                      WRITE(6,*) 'REFT:',NEIGH1(3),NEIGH1(2), NEIGH1(1) 
!/REFT                      WRITE(6,*) 'REFT:',NEIGH1(4),1, NEIGH1(0) 
!/REFT                      WRITE(6,*) 'REFT:',NEIGH1(5:7)
!/REFT                      WRITE(6,*) 'ANG:',ANGLES(3)*RADE,ANGLES(2)*RADE, ANGLES(1)*RADE 
!/REFT                      WRITE(6,*) 'ANG:',ANGLES(4)*RADE,1, ANGLES(0) *RADE
!/REFT                      WRITE(6,*) 'ANG:',ANGLES(5:7)*RADE
!/REFT                      WRITE(6,*) 'REFT:',XGRD(IY+1,IX-1:IX+1), YGRD(IY+1,IX-1:IX+1)
!/REFT                      WRITE(6,*) 'REFT:',XGRD(IY,IX-1:IX+1) , YGRD(IY,IX-1:IX+1)
!/REFT                      WRITE(6,*) 'REFT:',XGRD(IY-1,IX-1:IX+1), YGRD(IY-1,IX-1:IX+1)
!/REFT                      WRITE(6,*) 'REFLD:',REFLD(3:6,MAPFS(IY,IX))
!/REFT                    ENDIF
!/REF1                DO K=0,7
!/REF1                  IF (NEIGH1(K).EQ.0.AND.NEIGH1(MOD(K+7,8)).EQ.0 &
!/REF1                    .AND.NEIGH1(MOD(K+1,8)).EQ.0 &
!/REF1                    .AND.NEIGH1(MOD(K+4,8)).NE.0) THEN 
!/REF1                    REFLC(1,MAPFS(IY,IX))= REFPARS(1)
!/REF1!
!/REF1! Defines direction index for specular reflection (normal to coast)
!/REF1!
!/REF1!  for example, if we have this layout   1 1 0
!/REF1!  (NB: 1 is sea, 0 is land)             1 X 0
!/REF1!                                        1 1 0
!/REF1!
!/REF1!  then there is only a coastline detection for K=0, giving J=1 
!/REF1!  and the final result will be REFLD(1,MAPFS(IY,IX))=1
!/REF1!  Namely, the direction TH(REFLD) is the direction pointing INTO the coast
!/REF1!
!/REF1                    REFLD(2,MAPFS(IY,IX))= 2
!/REF1                    COSAVG=COSAVG+COS(ANGLES(K))  !ECOS(1+(K*NTH)/8)
!/REF1                    SINAVG=SINAVG+SIN(ANGLES(K))  !ESIN(1+(K*NTH)/8)
!/REF1                    J=J+1
!/REF1                    ENDIF
!/REF1                  END DO
!/REF1                IF (J.GT.0) THEN 
!/REF1                  IF (J.GT.1) REFLD(2,MAPFS(IY,IX))= 1
!/REF1                  THAVG=ATAN2(SINAVG,COSAVG) 
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3SETREF)
!/REF1                  !WRITE (6,*) 'COASTAL REFLECTION:',IX,IY,   &
!/REF1                  !SINAVG,COSAVG,THAVG/TPI,NINT(THAVG/TPI*NTH),MOD(NTH+NINT(THAVG/TPI*NTH),NTH)
#endif
!/REF1                  REFLD(1,MAPFS(IY,IX))=1+MOD(NTH+NINT(THAVG/TPI*NTH),NTH)
!/REF1                ELSE
!/REF1
!/REF1!                             1 1 1 
!/REF1! Looks for mild corners like 1 1 1
!/REF1!                             1 0 0          
!/REF1                  DO K=0,7
!/REF1                    IF (NEIGH1(K).EQ.0.AND.NEIGH1(MOD(K+1,8)).EQ.0 &
!/REF1                      .AND.NEIGH1(MOD(K+4,8)).NE.0) THEN 
!/REF1                      REFLC(1,MAPFS(IY,IX))= REFPARS(1)
!/REF1                      REFLD(1,MAPFS(IY,IX))= 1+MOD((K*NTH+(K+1)*NTH)/16,NTH)
!/REF1                      REFLD(2,MAPFS(IY,IX))= 1
!/REF1                      ENDIF
!/REF1                    END DO
!/REF1!                              1 1 1                        1 1 1
!/REF1! Looks for sharp corners like 1 1 1 but not diagonals like 1 1 1
!/REF1!                              1 0 1                        1 1 0          
!/REF1                  IF (REFLC(1,MAPFS(IY,IX)).LE.0) THEN 
!/REF1                    DO K=0,7,2
!/REF1                      IF ( NEIGH1(K).EQ.0.AND.NEIGH1(MOD(K+4,8)).NE.0) THEN 
!/REF1                        REFLC(1,MAPFS(IY,IX))= REFPARS(1)
!/REF1                        REFLD(1,MAPFS(IY,IX))= 1+(K*NTH)/8
!/REF1                        REFLD(2,MAPFS(IY,IX))= 0
!/REF1                        !WRITE(6,*) 'NEIGH3:',IX,IY,K,NEIGH1,K*(NTH/8)
!/REF1                        END IF
!/REF1                      END DO
!/REF1                    END IF
!/REF1                  END IF
!/REF1! End of test if surrounding point is land
!/REF1                END IF
!/REFT                IF (REFLC(1,MAPFS(IY,IX)).GT.0)  THEN 
!/REFT                  WRITE (6,*) 'COAST DIRECTION AT POINT:',IX,IY,' IS ', &
!/REFT                    REFLD(:,MAPFS(IY,IX)),TH(REFLD(1,MAPFS(IY,IX)))*360/TPI
!/REFT                  ENDIF
!/REF1! End of test if local point is sea
!/REF1              END IF
!/REF1            END IF
!/REF1          END DO
!/REF1        END DO
!
      RETURN
!
! Formats
!
!/
!/ End of W3SETREF ----------------------------------------------------- /
!/
      END SUBROUTINE W3SETREF
           
!/
!/ End of module W3GDATMD -------------------------------------------- /
!/
      END MODULE W3GDATMD
