#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 : 15-Apr-2020 |
!/ +-----------------------------------+
!/
!/ 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 )
!/ 07-Jan-2018 : Generalizes ICE100WIND to ICESCALES ( version 6.04 )
!/ 26-Mar-2018 : Add FSWND optional variable. JGLi ( version 6.02 )
!/ 05-Jun-2018 : Add PDLIB/DEBUGINIT and implcit scheme parameters
!/ for unstructured grids ( version 6.04 )
!/ 18-Aug-2018 : S_{ice} IC5 (Q. Liu) ( version 6.06 )
!/ 20-Aug-2018: Extra namelist variables for ST6 ( version 6.06)
!/ (Q. Liu, UoM)
!/ 26-Aug-2018 : UOST (Mentaschi et al. 2015, 2018) ( version 6.06 )
!/ 27-Aug-2018 : Add BTBETA parameter ( version 6.06 )
!/ 22-Feb-2020 : Add AIRGB and AIRCMIN ( version 7.06 )
!/ 15-Apr-2020 : Adds optional opt-out for CFL on BC ( version 7.08 )
!/ 06-May-2021 : Add SMCTYPE, ARCTC options. JGLi ( version 7.12 )
!/ 07-Jun-2021 : the GKE module (NL5, Q. Liu) ( version 7.12 )
!/
!/
!/ 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
! UNGTYPE I.P. Public Named constant for Unstructured triangular grid
! SMCTYPE I.P. Public Named constant for unstructured SMC 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
! SMCTYPE: Unstructured SMC grid
! RSTYPE Int. Public Integer identifyng restart type
! 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.
! NBSMC Int. Public Number of boundary cells for regional SMC grid.
! 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.
! ISMCBP I.A. Public List of SMC grid input boundary cell indexes.
! 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
! ICESCALES R.A. Publ. Scaling coefficient for source terms in the presence of ice
! Default is 1.0, meaning that 100% ice
! concentration result in zero source term
! If set to 0.0, then ice has no direct impact on Sln / Sin / Snl / Sds
! 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
! FLAGUNR Log. Public True if rotating directions back to true north
! 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 calculation.
! 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.
! FSWND Log. Public Flag for sea-point only wind input on SMC grid.
! ARCTC Log. Public Flag to include Arctic polar part 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'.
! BTBETA Real Public The constant used for separating wind sea
! and swell when we estimate WBT
! ----------------------------------------------------------------
!
! 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.
! ----------------------------------------------------------------
!
! 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)
! DTMS Real Public Swell age in disp. corr. (!/SMC)
!
! 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
! (!/NL5)
! QR5DPT Real Public Water depth for the GKE module
! QR5OML Real Public λ cut off value for quasi-resonant quartets
! QI5DIS Int. Public Method to discretize continuous spectrum
! QI5KEV Int. Public GKE (GS13 or J03)
! QI5NNZ Int. Public # of interactive quadruplets
! QI5IPL Int. Public Interp. method to get C₄
! QI5PMX Int. Public Phase mixing related parameter
! (!/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)
! ----------------------------------------------------------------
!
! 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
!
#ifdef W3_IC4
INTEGER, PARAMETER :: NIC4=10
#endif
INTEGER, PARAMETER :: RLGTYPE = 1
INTEGER, PARAMETER :: CLGTYPE = 2
INTEGER, PARAMETER :: UNGTYPE = 3
INTEGER, PARAMETER :: SMCTYPE = 4
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
!
#ifdef W3_ST4
INTEGER, PARAMETER :: NKHS=2000, NKD=1300
INTEGER, PARAMETER :: NDTAB=2000
#endif
!/
!/ Data structures
!/
!/ Grid type
TYPE GRID ! this is the geographical grid with all associated parameters
INTEGER :: GTYPE
INTEGER :: RSTYPE = -1
INTEGER :: ICLOSE
INTEGER :: NX, NY, NSEA, NSEAL, TRFLAG
#ifdef W3_SEC1
INTEGER :: NITERSEC1
#endif
INTEGER, POINTER :: MAPSTA(:,:), MAPST2(:,:), &
MAPFS(:,:), MAPSF(:,:)
!
#ifdef W3_SMC
!!Li Cell and face arrays for SMC grid.
INTEGER :: NCel, NUFc, NVFc, NRLv, MRFct
INTEGER :: NGLO, NARC, NBGL, NBAC, NBSMC
INTEGER, POINTER :: NLvCel(:), NLvUFc(:), NLvVFc(:)
INTEGER, POINTER :: IJKCel(:,:), IJKUFc(:,:), IJKVFc(:,:)
INTEGER, POINTER :: ISMCBP(:), ICLBAC(:)
!/ Data duplicated for better performance
INTEGER, POINTER :: IJKCel3(:), IJKCel4(:), &
IJKVFc5(:), IJKVFc6(:), &
IJKUFc5(:), IJKUFc6(:)
#endif
!
REAL :: SX, SY, X0, Y0, DTCFL, DTCFLI, DTMAX, &
DTMIN, DMIN, CTMAX, FICE0, FICEN, FICEL, &
PFMOVE, STEXU, STEYU, STEDU, IICEHMIN, &
IICEHINIT, ICESCALES(4), IICEHFAC, IICEHDISP, &
IICEDDISP, IICEFDISP, BTBETA, AAIRCMIN, AAIRGB
REAL(8) :: GRIDSHIFT ! see notes in WMGHGH
#ifdef W3_RTD
REAL :: PoLat, PoLon ! Rotated N-Pole lat/lon
REAL, POINTER :: AnglD(:) ! Angle in degree
LOGICAL :: FLAGUNR
#endif
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
#ifdef W3_SMC
REAL, POINTER :: CTRNX(:), CTRNY(:), CLATF(:)
#endif
REAL , POINTER :: SPCBAC(:,:), ANGARC(:)
DOUBLE PRECISION, 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
#ifdef W3_REF1
REAL, POINTER :: REFLC(:,:) ! reflection coefficient
INTEGER, POINTER :: REFLD(:,:) ! reflection direction
#endif
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
#ifdef W3_BT4
REAL, POINTER :: SED_D50(:), SED_PSIC(:)
#endif
#ifdef W3_REF1
LOGICAL, POINTER :: RREF(:)
REAL, POINTER :: REFPARS(:)
#endif
#ifdef W3_IG1
REAL, POINTER :: IGPARS(:)
#endif
#ifdef W3_IC2
REAL, POINTER :: IC2PARS(:)
#endif
#ifdef W3_IC3
REAL, POINTER :: IC3PARS(:)
#endif
#ifdef W3_IC4
INTEGER, POINTER :: IC4PARS(:)
REAL, POINTER :: IC4_KI(:)
REAL, POINTER :: IC4_FC(:)
#endif
#ifdef W3_IC5
REAL, POINTER :: IC5PARS(:)
#endif
#ifdef W3_IS2
REAL, POINTER :: IS2PARS(:)
#endif
!
! unstructured data
!
INTEGER :: NTRI
INTEGER, POINTER :: TRIGP(:,:)
#ifdef W3_PDLIB
INTEGER :: NBND_MAP
INTEGER, POINTER :: INDEX_MAP(:)
INTEGER, POINTER :: MAPSTA_LOC(:)
INTEGER*1, POINTER :: IOBPD_LOC(:,:)
INTEGER*2, POINTER :: IOBP_LOC(:)
INTEGER*1, POINTER :: IOBDP_LOC(:)
INTEGER*1, POINTER :: IOBPA_LOC(:)
#endif
REAL(8), POINTER :: LEN(:,:),SI(:), IEN(:,:)
REAL :: MAXX, MAXY, DXYMAX
REAL, POINTER :: ANGLE(:,:),ANGLE0(:,:)
INTEGER :: COUNTRI,COUNTOT,NNZ, NBEDGE
INTEGER, POINTER :: CCON(:), COUNTCON(:), IE_CELL(:), &
POS_CELL(:), &
IAA(:), JAA(:), POSI(:,:), INDEX_CELL(:), &
I_DIAG(:), JA_IE(:,:,:)
INTEGER*2, POINTER :: IOBP(:)
INTEGER*1, POINTER :: IOBPD(:,:), IOBDP(:), IOBPA(:)
INTEGER, POINTER :: EDGES(:,:), NEIGH(:,:)
REAL(8), POINTER :: TRIA(:)
REAL, POINTER :: CROSSDIFF(:,:)
#ifdef W3_UOST
CHARACTER(LEN=256) :: UOSTFILELOCAL, UOSTFILESHADOW
LOGICAL, ALLOCATABLE :: UOST_LCL_OBSTRUCTED(:,:), UOST_SHD_OBSTRUCTED(:,:)
INTEGER*1, ALLOCATABLE :: UOSTLOCALALPHA(:,:,:,:), UOSTLOCALBETA(:,:,:,:)
INTEGER*1, ALLOCATABLE :: UOSTSHADOWALPHA(:,:,:,:), UOSTSHADOWBETA(:,:,:,:)
REAL*4, ALLOCATABLE :: UOSTCELLSIZE(:,:,:)
REAL :: UOSTABMULTFACTOR = 100
REAL :: UOSTCELLSIZEFACTOR = 1000
REAL :: UOSTLOCALFACTOR = 1
REAL :: UOSTSHADOWFACTOR = 1
LOGICAL :: UOSTENABLED = .true.
#endif
END TYPE GRID
!
TYPE SGRD ! this is the spectral grid with all parameters that vary with freq. and direction
INTEGER :: NK=0, NK2=0, NTH=0, NSPEC=0
INTEGER, POINTER :: MAPWN(:), MAPTH(:)
REAL :: DTH=0., XFR=0., FR1=0., FTE=0., FTF=0., FTWN=0., FTTR=0., &
FTWL=0., FACTI1=0., FACTI2=0., FACHFA=0., FACHFE=0.
REAL, POINTER :: TH(:), ESIN(:), ECOS(:), ES2(:), &
ESC(:), EC2(:), SIG(:), SIG2(:), &
DSIP(:), DSII(:), DDEN(:), DDEN2(:)
LOGICAL :: SINIT=.FALSE.
END TYPE SGRD
!
TYPE NPAR
REAL :: FACP, XREL, XFLT, FXFM, FXPM, &
XFT, XFC, FACSD, FHMAX
#ifdef W3_RWND
REAL :: RWINDC
#endif
#ifdef W3_WCOR
REAL :: WWCOR(2)
#endif
END TYPE NPAR
!
TYPE PROP
#ifdef W3_PR0
REAL :: DUMMY
#endif
#ifdef W3_PR1
REAL :: DUMMY
#endif
#ifdef W3_PR2
REAL :: DTME, CLATMN
#endif
#ifdef W3_PR3
REAL :: WDCG, WDTH
#endif
#ifdef W3_SMC
REAL :: DTMS, Refran
LOGICAL :: FUNO3, FVERG, FSWND, ARCTC
#endif
END TYPE PROP
!
TYPE FLDP
REAL :: DUMMY
#ifdef W3_FLD1
INTEGER :: Tail_ID
REAL :: Tail_Lev, TAIL_TRAN1, TAIL_TRAN2
#endif
#ifdef W3_FLD2
INTEGER :: Tail_ID
REAL :: Tail_Lev, TAIL_TRAN1, TAIL_TRAN2
#endif
END TYPE FLDP
TYPE SFLP
#ifdef W3_FLX0
REAL :: DUMMY
#endif
#ifdef W3_FLX1
REAL :: DUMMY
#endif
#ifdef W3_FLX2
INTEGER :: NITTIN
REAL :: CINXSI
#endif
#ifdef W3_FLX3
INTEGER :: NITTIN, CAP_ID
REAL :: CINXSI, CD_MAX
#endif
#ifdef W3_FLX4
REAL :: FLX4A0
#endif
END TYPE SFLP
!
TYPE SLNP
#ifdef W3_SEED
REAL :: DUMMY
#endif
#ifdef W3_LN0
REAL :: DUMMY
#endif
#ifdef W3_LN1
REAL :: SLNC1, FSPM, FSHF
#endif
END TYPE SLNP
!
TYPE SRCP
REAL :: WWNMEANPTAIL, SSTXFTFTAIL
#ifdef W3_ST1
REAL :: SINC1, SDSC1
#endif
#ifdef W3_ST2
REAL :: ZWIND, FSWELL, SHSTAB, &
OFSTAB, CCNG, CCPS, FFNG, FFPS, &
CDSA0, CDSA1, CDSA2, SDSALN, &
CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, &
XFH, XF1, XF2
#endif
#ifdef W3_ST3
INTEGER :: SSDSISO, SSDSBRFDF
REAL :: AALPHA, BBETA, ZZ0MAX, ZZ0RAT, ZZALP,&
SSINTHP, TTAUWSHELTER, SSWELLF(1:6), &
SSDSC1, SSDSC2, SSDSC3, SSDSBR, &
SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, &
FFXPM, FFXFM, &
SSDSC4, SSDSC5, SSDSC6, DDELTA1, &
DDELTA2, ZZWND
#endif
!
#ifdef W3_ST4
INTEGER :: SSWELLFPAR, SSDSISO, SSDSBRFDF
INTEGER, POINTER :: IKTAB(:,:), SATINDICES(:,:)
REAL, POINTER :: DCKI(:,:), SATWEIGHTS(:,:),CUMULW(:,:),QBI(:,:)
REAL :: AALPHA, BBETA, ZZ0MAX, ZZ0RAT, ZZALP,&
SSINTHP, TTAUWSHELTER, SSWELLF(1:7), &
SSDSC(1:21), SSDSBR, &
SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, &
FFXPM, FFXFM, FFXFA, &
SSDSBRF1, SSDSBRF2, SSDSBINT,SSDSBCK,&
SSDSHCK, SSDSABK, SSDSPBK, SSINBR
REAL :: ZZWND
REAL :: SSDSCOS, SSDSDTH, SSDSBT, SSDSBM(0:4)
#endif
!
#ifdef W3_ST6
REAL :: SIN6A0, SDS6A1, SDS6A2, SWL6B1, &
SIN6WS, SIN6FC
INTEGER :: SDS6P1, SDS6P2
LOGICAL :: SDS6ET, SWL6S6, SWL6CSTB1
#endif
END TYPE SRCP
!
TYPE SNLP
#ifdef W3_NL0
REAL :: DUMMY
#endif
#ifdef W3_NL1
REAL :: SNLC1, LAM, KDCON, KDMN, &
SNLS1, SNLS2, SNLS3
#endif
#ifdef W3_NL2
INTEGER :: IQTPE, NDPTHS
REAL :: NLTAIL
REAL, POINTER :: DPTHNL(:)
#endif
#ifdef W3_NL3
INTEGER :: NFRMIN, NFRMAX, NFRCUT, NTHMAX, &
NTHEXP, NSPMIN, NSPMAX, NSPMX2, &
NQA, SNLNQ
INTEGER, POINTER :: QST1(:,:,:), QST4(:,:,:)
REAL :: SNLMSC, SNLNSC, SNLSFD, SNLSFS
REAL, POINTER :: FRQ(:), XSI(:), &
QST2(:,:,:), QST3(:,:,:), &
QST5(:,:,:), QST6(:,:,:), &
SNLL(:), SNLM(:), SNLT(:), &
SNLCD(:), SNLCS(:)
#endif
#ifdef W3_NL4
INTEGER :: ITSA, IALT
#endif
#ifdef W3_NL5
REAL :: QR5DPT, QR5OML
INTEGER :: QI5DIS, QI5KEV, QI5IPL, QI5PMX
INTEGER(KIND=8) :: QI5NNZ
#endif
#ifdef W3_NLS
INTEGER :: NTHX, NFRX, NSPL, NSPH
REAL :: CNLSA, CNLSC, CNLSFM, &
CNLSC1, CNLSC2, CNLSC3
REAL, POINTER :: SNSST(:,:)
#endif
END TYPE SNLP
!
TYPE SBTP
#ifdef W3_BT0
REAL :: DUMMY
#endif
#ifdef W3_BT1
REAL :: SBTC1
#endif
#ifdef W3_BT4
REAL :: SBTCX(10)
#endif
#ifdef W3_BT8
REAL :: DUMMY
#endif
#ifdef W3_BT9
REAL :: DUMMY
#endif
END TYPE SBTP
!
TYPE SDBP
#ifdef W3_DB0
REAL :: DUMMY
#endif
#ifdef W3_DB1
REAL :: SDBC1, SDBC2
LOGICAL :: FDONLY
REAL :: SDBSC
#endif
END TYPE SDBP
#ifdef W3_UOST
TYPE UOSTP
CHARACTER(LEN=256) :: UOSTFILELOCAL, UOSTFILESHADOW
REAL :: UOSTFACTORLOCAL, UOSTFACTORSHADOW
END TYPE UOSTP
#endif
!
TYPE STRP
#ifdef W3_TR0
REAL :: DUMMY
#endif
#ifdef W3_TR1
REAL :: DUMMY
#endif
END TYPE STRP
!
TYPE SBSP
#ifdef W3_BS0
REAL :: DUMMY
#endif
#ifdef W3_BS1
REAL :: DUMMY
#endif
END TYPE SBSP
!
TYPE SICP
#ifdef W3_IS0
REAL :: DUMMY
#endif
#ifdef W3_IS1
REAL :: IS1C1, IS1C2
#endif
#ifdef W3_IS2
REAL :: IS2C1, IS2C2
#endif
END TYPE SICP
! specific type for unstructured scheme
TYPE SCHM
LOGICAL :: FSN = .FALSE.
LOGICAL :: FSPSI = .FALSE.
LOGICAL :: FSFCT = .FALSE.
LOGICAL :: FSNIMP = .FALSE.
LOGICAL :: FSTOTALIMP = .FALSE.
LOGICAL :: FSTOTALEXP = .FALSE.
LOGICAL :: FSREFRACTION = .FALSE.
LOGICAL :: FSFREQSHIFT = .FALSE.
LOGICAL :: FSSOURCE = .FALSE.
LOGICAL :: FSBCCFL = .FALSE.
LOGICAL :: DO_CHANGE_WLV
REAL(8) :: SOLVERTHR_STP
REAL(8) :: CRIT_DEP_STP
LOGICAL :: B_JGS_TERMINATE_MAXITER
LOGICAL :: B_JGS_TERMINATE_DIFFERENCE
LOGICAL :: B_JGS_TERMINATE_NORM
LOGICAL :: B_JGS_LIMITER
LOGICAL :: B_JGS_USE_JACOBI
LOGICAL :: B_JGS_BLOCK_GAUSS_SEIDEL
INTEGER :: B_JGS_MAXITER
REAL*8 :: B_JGS_PMIN
REAL*8 :: B_JGS_DIFF_THR
REAL*8 :: B_JGS_NORM_THR
INTEGER :: B_JGS_NLEVEL
LOGICAL :: B_JGS_SOURCE_NONLINEAR
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
#ifdef W3_UOST
TYPE(UOSTP) :: UOSTPS
#endif
TYPE(STRP) :: STRPS
TYPE(SBSP) :: SBSPS
TYPE(SICP) :: SICPS
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 :: RSTYPE
INTEGER, POINTER :: ICLOSE
INTEGER, POINTER :: NX, NY, NSEA, NSEAL, TRFLAG
INTEGER, POINTER :: E3DF(:,:), P2MSF(:), US3DF(:), USSPF(:)
REAL, POINTER :: USSP_WN(:)
#ifdef W3_REF1
REAL, POINTER :: REFLC(:,:)
INTEGER, POINTER :: REFLD(:,:)
#endif
INTEGER, POINTER :: NBEDGE
INTEGER, POINTER :: EDGES(:,:), NEIGH(:,:)
!
! Variables for unstructured grids
!
INTEGER, POINTER :: NTRI,COUNTRI,COUNTOT,NNZ
INTEGER :: optionCall = 3 ! take care all other options are basically wrong
INTEGER, POINTER :: TRIGP(:,:)
#ifdef W3_PDLIB
INTEGER, POINTER :: NBND_MAP
INTEGER, POINTER :: INDEX_MAP(:)
INTEGER, POINTER :: MAPSTA_LOC(:)
INTEGER*1, POINTER :: IOBPD_LOC(:,:)
INTEGER*2, POINTER :: IOBP_LOC(:)
INTEGER*1, POINTER :: IOBDP_LOC(:)
INTEGER*1, POINTER :: IOBPA_LOC(:)
#endif
REAL(8), POINTER :: IEN(:,:), LEN(:,:), SI(:)
REAL, POINTER :: ANGLE(:,:),ANGLE0(:,:)
INTEGER, POINTER :: CCON(:), COUNTCON(:), IE_CELL(:), &
POS_CELL(:), &
IAA(:), JAA(:), POSI(:,:), &
I_DIAG(:), JA_IE(:,:,:), &
INDEX_CELL(:)
INTEGER*2, POINTER :: IOBP(:)
INTEGER*1, POINTER :: IOBPD(:,:), IOBDP(:), IOBPA(:)
REAL(8), POINTER :: TRIA(:)
REAL, POINTER :: CROSSDIFF(:,:)
REAL,POINTER :: MAXX, MAXY, DXYMAX
LOGICAL, POINTER :: GUGINIT
!
REAL, POINTER :: FFACBERG
#ifdef W3_REF1
LOGICAL, POINTER :: RREF(:)
REAL, POINTER :: REFPARS(:)
#endif
#ifdef W3_IG1
REAL, POINTER :: IGPARS(:)
#endif
#ifdef W3_IC2
REAL, POINTER :: IC2PARS(:)
#endif
#ifdef W3_IC3
REAL, POINTER :: IC3PARS(:)
#endif
#ifdef W3_IC4
INTEGER, POINTER :: IC4PARS(:)
REAL, POINTER :: IC4_KI(:)
REAL, POINTER :: IC4_FC(:)
#endif
#ifdef W3_IC5
REAL, POINTER :: IC5PARS(:)
#endif
#ifdef W3_IS2
REAL, POINTER :: IS2PARS(:)
#endif
INTEGER, POINTER :: MAPSTA(:,:), MAPST2(:,:), &
MAPFS(:,:), MAPSF(:,:)
!
#ifdef W3_SMC
INTEGER, POINTER :: NCel, NUFc, NVFc, NRLv, MRFct
INTEGER, POINTER :: NGLO, NARC, NBGL, NBAC, NBSMC
INTEGER, POINTER :: NLvCel(:), NLvUFc(:), NLvVFc(:)
INTEGER, POINTER :: IJKCel(:,:), IJKUFc(:,:), IJKVFc(:,:)
INTEGER, POINTER :: ISMCBP(:), ICLBAC(:)
!/ Data duplicated for better performance
INTEGER, POINTER :: IJKCel3(:), IJKCel4(:), &
IJKVFc5(:), IJKVFc6(:), &
IJKUFc5(:), IJKUFc6(:)
!/
#endif
!
#ifdef W3_SEC1
INTEGER, POINTER :: NITERSEC1
#endif
REAL, POINTER :: SX, SY, X0, Y0, DTCFL, DTCFLI, DTMAX, &
DTMIN, DMIN, CTMAX, FICE0, FICEN, &
FICEL, PFMOVE, STEXU, STEYU, STEDU, &
IICEHMIN, IICEHINIT, ICESCALES(:), &
IICEHFAC, IICEHDISP, IICEDDISP, IICEFDISP, &
BTBETA, AAIRCMIN, AAIRGB
REAL(8),POINTER :: GRIDSHIFT ! see notes in WMGHGH
#ifdef W3_RTD
REAL, POINTER :: PoLat, PoLon
REAL, POINTER :: AnglD(:)
LOGICAL, POINTER :: FLAGUNR
#endif
REAL , POINTER :: ZB(:)
REAL , POINTER :: 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
#ifdef W3_SMC
REAL, POINTER :: CTRNX(:), CTRNY(:), CLATF(:)
#endif
REAL , POINTER :: SPCBAC(:,:), ANGARC(:)
DOUBLE PRECISION, 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
#ifdef W3_BT4
REAL, POINTER :: SED_D50(:), SED_PSIC(:)
#endif
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
#ifdef W3_RWND
REAL, POINTER :: RWINDC
#endif
#ifdef W3_WCOR
REAL, POINTER :: WWCOR(:)
#endif
!/
!/ Data aliasses for structure PROP(S)
!/
#ifdef W3_PR2
REAL, POINTER :: DTME, CLATMN
#endif
#ifdef W3_PR3
REAL, POINTER :: WDCG, WDTH
#endif
#ifdef W3_SMC
REAL, POINTER :: DTMS, Refran
LOGICAL, POINTER :: FUNO3, FVERG, FSWND, ARCTC
#endif
!/
!/ Data aliasses for structure FLDP(S)
!/
#ifdef W3_FLD1
INTEGER, POINTER :: TAIL_ID
REAL, POINTER :: TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2
#endif
#ifdef W3_FLD2
INTEGER, POINTER :: TAIL_ID
REAL, POINTER :: TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2
#endif
!/
!/ Data aliasses for structure SFLP(S)
!/
#ifdef W3_FLX2
INTEGER, POINTER :: NITTIN
REAL, POINTER :: CINXSI
#endif
#ifdef W3_FLX3
INTEGER, POINTER :: NITTIN, CAP_ID
REAL, POINTER :: CINXSI, CD_MAX
#endif
#ifdef W3_FLX4
REAL, POINTER :: FLX4A0
#endif
!/
!/ Data aliasses for structure SLNP(S)
!/
#ifdef W3_LN1
REAL, POINTER :: SLNC1, FSPM, FSHF
#endif
!/
!/ Data aliasses for structure SRCP(S)
!/
#ifdef W3_ST1
REAL, POINTER :: SINC1, SDSC1
#endif
#ifdef W3_ST2
REAL, POINTER :: ZWIND, FSWELL, SHSTAB, &
OFSTAB, CCNG, CCPS, FFNG, FFPS, &
CDSA0, CDSA1, CDSA2, SDSALN, &
CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, &
XFH, XF1, XF2
#endif
#ifdef W3_ST3
REAL, POINTER :: ZZWND, AALPHA, BBETA, ZZ0MAX, ZZ0RAT,&
ZZALP, FFXFM, FFXPM, &
SSINTHP, TTAUWSHELTER, SSWELLF(:), &
SSDSC1, SSDSC2, SSDSC3, SSDSBR, &
SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, &
SSDSC4, SSDSC5, SSDSC6, SSDSBT, &
DDELTA1, DDELTA2, &
SSDSCOS, SSDSDTH, SSDSBM(:)
#endif
#ifdef W3_ST4
INTEGER, POINTER :: SSWELLFPAR, SSDSISO,SSDSBRFDF, &
IKTAB(:,:), SATINDICES(:,:),SSDSDIK
REAL, POINTER :: DCKI(:,:), SATWEIGHTS(:,:),CUMULW(:,:),QBI(:,:)
REAL, POINTER :: ZZWND, AALPHA, BBETA, ZZ0MAX, ZZ0RAT,&
ZZALP, FFXFA, &
FFXFM, FFXPM, SSDSBRF1, SSDSBRF2, &
SSDSBINT, SSDSBCK, SSDSHCK, SSDSABK, &
SSDSPBK, SSINBR,SSINTHP,TTAUWSHELTER,&
SSWELLF(:), SSDSC(:), SSDSBR, &
SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, &
SSDSBT, SSDSCOS, SSDSDTH, SSDSBM(:)
#endif
#ifdef W3_ST6
REAL, POINTER :: SIN6A0, SDS6A1, SDS6A2, SWL6B1, &
SIN6WS, SIN6FC
INTEGER, POINTER :: SDS6P1, SDS6P2
LOGICAL, POINTER :: SDS6ET, SWL6S6, SWL6CSTB1
#endif
REAL, POINTER :: WWNMEANPTAIL, SSTXFTFTAIL
!/
!/ Data aliasses for structure SNLP(S)
!/
#ifdef W3_NL1
REAL, POINTER :: SNLC1, LAM, KDCON, KDMN, &
SNLS1, SNLS2, SNLS3
#endif
#ifdef W3_NL2
INTEGER, POINTER :: IQTPE, NDPTHS
REAL, POINTER :: NLTAIL
REAL, POINTER :: DPTHNL(:)
#endif
#ifdef W3_NL3
INTEGER, POINTER :: NFRMIN, NFRMAX, NFRCUT, NTHMAX, &
NTHEXP, NSPMIN, NSPMAX, NSPMX2, &
NQA, SNLNQ
INTEGER, POINTER :: QST1(:,:,:), QST4(:,:,:)
REAL, POINTER :: SNLMSC, SNLNSC, SNLSFD, SNLSFS
REAL, POINTER :: FRQ(:), XSI(:), &
QST2(:,:,:), QST3(:,:,:), &
QST5(:,:,:), QST6(:,:,:), &
SNLL(:), SNLM(:), SNLT(:), &
SNLCD(:), SNLCS(:)
#endif
#ifdef W3_NL4
INTEGER, POINTER :: ITSA, IALT
#endif
#ifdef W3_NL5
REAL, POINTER :: QR5DPT, QR5OML
INTEGER, POINTER :: QI5DIS, QI5KEV, QI5IPL, QI5PMX
INTEGER(KIND=8), POINTER:: QI5NNZ
#endif
#ifdef W3_NLS
INTEGER, POINTER :: NTHX, NFRX, NSPL, NSPH
REAL, POINTER :: CNLSA, CNLSC, CNLSFM, &
CNLSC1, CNLSC2, CNLSC3, SNSST(:,:)
#endif
!/
!/ Data aliasses for structure SBTP(S)
!/
#ifdef W3_BT1
REAL, POINTER :: SBTC1
#endif
#ifdef W3_BT4
REAL, POINTER :: SBTCX(:)
#endif
!/
!/ Data aliasses for structure SDBP(S)
!/
#ifdef W3_DB1
REAL, POINTER :: SDBC1, SDBC2
LOGICAL, POINTER :: FDONLY
REAL, POINTER :: SDBSC
#endif
!/
#ifdef W3_UOST
!/ Data aliases for structure UOSTP(S)
CHARACTER(LEN=:), POINTER :: UOSTFILELOCAL, UOSTFILESHADOW
REAL, POINTER :: UOSTFACTORLOCAL, UOSTFACTORSHADOW
#endif
!/
!/ Data aliasing for structure SCHM(S)
LOGICAL, POINTER :: FSN,FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP
LOGICAL, POINTER :: FSREFRACTION, FSFREQSHIFT, FSSOURCE, FSBCCFL
LOGICAL, POINTER :: DO_CHANGE_WLV
REAL(8), POINTER :: SOLVERTHR_STP
REAL(8), POINTER :: CRIT_DEP_STP
LOGICAL, POINTER :: B_JGS_TERMINATE_MAXITER
LOGICAL, POINTER :: B_JGS_TERMINATE_DIFFERENCE
LOGICAL, POINTER :: B_JGS_TERMINATE_NORM
LOGICAL, POINTER :: B_JGS_LIMITER
LOGICAL, POINTER :: B_JGS_USE_JACOBI
LOGICAL, POINTER :: B_JGS_BLOCK_GAUSS_SEIDEL
INTEGER, POINTER :: B_JGS_MAXITER
REAL(8), POINTER :: B_JGS_PMIN
REAL(8), POINTER :: B_JGS_DIFF_THR
REAL(8), POINTER :: B_JGS_NORM_THR
INTEGER, POINTER :: B_JGS_NLEVEL
LOGICAL, POINTER :: B_JGS_SOURCE_NONLINEAR
!/
!/ Data aliasing for structure SICP(S)
#ifdef W3_IS1
REAL, POINTER :: IS1C1, IS1C2
#endif
!/
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
#ifdef W3_S
USE W3SERVMD, ONLY: STRACE
#endif
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
INTEGER, INTENT(IN) :: NUMBER, NDSE, NDST
INTEGER, INTENT(IN), OPTIONAL :: NAUX
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
INTEGER :: I, NLOW
#ifdef W3_S
INTEGER, SAVE :: IENT = 0
#endif
!/
#ifdef W3_S
CALL STRACE (IENT, 'W3NMOD')
#endif
!
! -------------------------------------------------------------------- /
! 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.
#ifdef W3_NL2
MPARS(I)%SNLPS%NDPTHS = 0
#endif
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 &
#ifdef W3_SMC
, MCel, MUFc, MVFc, MRLv, MBSMC &
, MARC, MBAC, MSPEC &
#endif
)
#ifdef W3_SMC
!!Li A few dimensional numbers for SMC grid.
#endif
!/
!/ +-----------------------------------+
!/ | 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
#ifdef W3_S
USE W3SERVMD, ONLY: STRACE
#endif
!
IMPLICIT NONE
!
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
INTEGER, INTENT(IN) :: IMOD, MX, MY, MSEA, NDSE, NDST
#ifdef W3_SMC
INTEGER, INTENT(IN) :: MCel, MUFc, MVFc, MRLv, MBSMC
INTEGER, INTENT(IN) :: MARC, MBAC, MSPEC
#endif
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
#ifdef W3_SMC
INTEGER :: IARC, IBAC, IBSMC
#endif
#ifdef W3_S
INTEGER, SAVE :: IENT = 0
#endif
!/
#ifdef W3_S
CALL STRACE (IENT, 'W3DIMX')
#endif
!
! -------------------------------------------------------------------- /
! 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
!
IF (GTYPE .NE. UNGTYPE) THEN
ALLOCATE ( GRIDS(IMOD)%ZB(MSEA), &
GRIDS(IMOD)%XGRD(MY,MX), &
GRIDS(IMOD)%YGRD(MY,MX), &
STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
ENDIF
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), &
#ifdef W3_RTD
GRIDS(IMOD)%AnglD(MSEA), &
#endif
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)%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 )
!!/DEBUGINIT WRITE(740+IAPROC,*) 'After alocation of MAPST2, MY=', MY, ' MX=', MX
!!/DEBUGINIT FLUSH(740+IAPROC)
#ifdef W3_BT4
ALLOCATE ( GRIDS(IMOD)%SED_D50(0:MSEA), &
GRIDS(IMOD)%SED_PSIC(0:MSEA),&
STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
#endif
!
#ifdef W3_SMC
ALLOCATE ( GRIDS(IMOD)%NLvCel(0:MRLv), &
GRIDS(IMOD)%NLvUFc(0:MRLv), &
GRIDS(IMOD)%NLvVFc(0:MRLv), &
GRIDS(IMOD)%IJKCel(5, -9:MCel), &
GRIDS(IMOD)%IJKUFc(7,MUFc), &
GRIDS(IMOD)%IJKVFc(8,MVFc), &
GRIDS(IMOD)%CTRNX(-9:MCel), &
GRIDS(IMOD)%CTRNY(-9:MCel), &
GRIDS(IMOD)%CLATF(MVFc), &
STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
ALLOCATE ( GRIDS(IMOD)%IJKCel3(-9:MCel), &
GRIDS(IMOD)%IJKCel4(-9:MCel), &
GRIDS(IMOD)%IJKVFc5(MVFc), &
GRIDS(IMOD)%IJKVFc6(MVFc), &
GRIDS(IMOD)%IJKUFc5(MUFc), &
GRIDS(IMOD)%IJKUFc6(MUFc), &
STAT=ISTAT)
#endif
!
#ifdef W3_SMC
!! Arctic part related variables, declare minimum 1 element.
IARC = MARC
IF( MARC .LE. 1 ) IARC = 1
IBAC = MBAC
IF( MBAC .LE. 1 ) IBAC = 1
IBSMC = MBSMC
IF( MBSMC .LE. 1 ) IBSMC = 1
ALLOCATE ( GRIDS(IMOD)%ICLBAC(IBAC), &
GRIDS(IMOD)%ANGARC(IARC), &
GRIDS(IMOD)%SPCBAC(MSPEC,IBAC), &
GRIDS(IMOD)%ISMCBP(IBSMC), &
STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
#endif
!
#ifdef W3_SMC
!! All SMC grid related varialbes are initialised in case SMC
!! switch is selected but SMCTYPE is not used. JGLi08Mar2021
GRIDS(IMOD)%NLvCel(:) = 0
GRIDS(IMOD)%NLvUFc(:) = 0
GRIDS(IMOD)%NLvVFc(:) = 0
GRIDS(IMOD)%ISMCBP(:) = 0
GRIDS(IMOD)%ICLBAC(:) = 0
GRIDS(IMOD)%IJKCel(:,:) = 0
GRIDS(IMOD)%IJKUFc(:,:) = 0
GRIDS(IMOD)%IJKVFc(:,:) = 0
GRIDS(IMOD)%CTRNX(:) = 0.0
GRIDS(IMOD)%CTRNY(:) = 0.0
GRIDS(IMOD)%CLATF(:) = 0.0
GRIDS(IMOD)%ANGARC(:) = 0.0
#endif
!
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.
!
#ifdef W3_REF1
ALLOCATE ( GRIDS(IMOD)%RREF(4), &
GRIDS(IMOD)%REFPARS(10), &
STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
#endif
!
#ifdef W3_REF1
GRIDS(IMOD)%RREF(:)=.FALSE.
GRIDS(IMOD)%REFPARS(:)=0.
#endif
!
#ifdef W3_REF1
! Memory footprint can be reduced by defining REFLC and REFLD only over nodes
! where reflection can occur.
ALLOCATE ( GRIDS(IMOD)%REFLC(4,0:NSEA), &
GRIDS(IMOD)%REFLD(6,0:NSEA), &
STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
#endif
#ifdef W3_IG1
ALLOCATE ( GRIDS(IMOD)%IGPARS(12), STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
#endif
#ifdef W3_IC2
ALLOCATE ( GRIDS(IMOD)%IC2PARS(9), STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
#endif
#ifdef W3_IC3
ALLOCATE ( GRIDS(IMOD)%IC3PARS(16), STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
#endif
#ifdef W3_IC4
ALLOCATE ( GRIDS(IMOD)%IC4PARS(1), STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
ALLOCATE ( GRIDS(IMOD)%IC4_KI(NIC4), STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
ALLOCATE ( GRIDS(IMOD)%IC4_FC(NIC4), STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
#endif
#ifdef W3_IC5
ALLOCATE ( GRIDS(IMOD)%IC5PARS(9), STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
#endif
#ifdef W3_IS2
ALLOCATE ( GRIDS(IMOD)%IS2PARS(24), STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
#endif
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX)
WRITE (NDST,9001)
#endif
!
#ifdef W3_REF1
GRIDS(IMOD)%REFLC(1:4,0:NSEA)=0.
GRIDS(IMOD)%REFLD(:,:)=0
#endif
#ifdef W3_IG1
GRIDS(IMOD)%IGPARS(:)=0.
#endif
#ifdef W3_IC2
GRIDS(IMOD)%IC2PARS(:)=0.
#endif
#ifdef W3_IS2
GRIDS(IMOD)%IS2PARS(:)=0.
#endif
!
! -------------------------------------------------------------------- /
! 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
#ifdef W3_ST4
USE CONSTANTS, ONLY: RADE
#endif
#ifdef W3_S
USE W3SERVMD, ONLY: STRACE
#endif
!
IMPLICIT NONE
!
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
INTEGER, INTENT(IN) :: IMOD, MK, MTH, NDSE, NDST
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
INTEGER, SAVE :: MK2, MSPEC
#ifdef W3_ST4
INTEGER :: SDSNTH
#endif
#ifdef W3_S
INTEGER, SAVE :: IENT = 0
#endif
!/
#ifdef W3_S
CALL STRACE (IENT, 'W3DIMS')
#endif
!
! -------------------------------------------------------------------- /
! 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 )
SGRDS(IMOD)%MAPWN(:)=0.
SGRDS(IMOD)%MAPTH(:)=0.
SGRDS(IMOD)%TH(:)=0.
SGRDS(IMOD)%ESIN(:)=0.
SGRDS(IMOD)%ECOS(:)=0.
SGRDS(IMOD)%ES2(:)=0.
SGRDS(IMOD)%ESC(:)=0.
SGRDS(IMOD)%EC2(:)=0.
SGRDS(IMOD)%SIG(:)=0.
SGRDS(IMOD)%SIG2(:)=0.
SGRDS(IMOD)%DSIP(:)=0.
SGRDS(IMOD)%DSII(:)=0.
SGRDS(IMOD)%DDEN(:)=0.
SGRDS(IMOD)%DDEN2(:)=0.
#ifdef W3_ST4
ALLOCATE ( MPARS(IMOD)%SRCPS%IKTAB(MK,NDTAB), &
MPARS(IMOD)%SRCPS%DCKI(NKHS,NKD), &
MPARS(IMOD)%SRCPS%QBI(NKHS,NKD), &
STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
SDSNTH = MTH/2-1 !MIN(NINT(SSDSDTH/(DTH*RADE)),MTH/2-1)
ALLOCATE( MPARS(IMOD)%SRCPS%SATINDICES(2*SDSNTH+1,MTH), &
MPARS(IMOD)%SRCPS%SATWEIGHTS(2*SDSNTH+1,MTH), &
MPARS(IMOD)%SRCPS%CUMULW(MSPEC,MSPEC), &
STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
#endif
!
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
#ifdef W3_S
USE W3SERVMD, ONLY: STRACE
#endif
!
IMPLICIT NONE
!
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
INTEGER, INTENT(IN) :: IMOD, NDSE, NDST
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
#ifdef W3_S
INTEGER, SAVE :: IENT = 0
#endif
!/
#ifdef W3_S
CALL STRACE (IENT, 'W3SETG')
#endif
!
! -------------------------------------------------------------------- /
! 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
RSTYPE => GRIDS(IMOD)%RSTYPE
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
!
#ifdef W3_SMC
NCel => GRIDS(IMOD)%NCel
NUFc => GRIDS(IMOD)%NUFc
NVFc => GRIDS(IMOD)%NVFc
NRLv => GRIDS(IMOD)%NRLv
MRFct => GRIDS(IMOD)%MRFct
#endif
!
#ifdef W3_SMC
NGLO => GRIDS(IMOD)%NGLO
NARC => GRIDS(IMOD)%NARC
NBGL => GRIDS(IMOD)%NBGL
NBAC => GRIDS(IMOD)%NBAC
NBSMC => GRIDS(IMOD)%NBSMC
#endif
!
E3DF => GRIDS(IMOD)%E3DF
P2MSF => GRIDS(IMOD)%P2MSF
US3DF => GRIDS(IMOD)%US3DF
USSPF => GRIDS(IMOD)%USSPF
USSP_WN => GRIDS(IMOD)%USSP_WN
#ifdef W3_REF1
REFLC => GRIDS(IMOD)%REFLC
REFLD => GRIDS(IMOD)%REFLD
#endif
FFACBERG => GRIDS(IMOD)%FFACBERG
#ifdef W3_REF1
RREF => GRIDS(IMOD)%RREF
REFPARS=> GRIDS(IMOD)%REFPARS
#endif
#ifdef W3_IG1
IGPARS => GRIDS(IMOD)%IGPARS
#endif
#ifdef W3_IC2
IC2PARS => GRIDS(IMOD)%IC2PARS
#endif
#ifdef W3_IC3
IC3PARS => GRIDS(IMOD)%IC3PARS
#endif
#ifdef W3_IC4
IC4PARS => GRIDS(IMOD)%IC4PARS
IC4_KI => GRIDS(IMOD)%IC4_KI
IC4_FC => GRIDS(IMOD)%IC4_FC
#endif
#ifdef W3_IC5
IC5PARS => GRIDS(IMOD)%IC5PARS
#endif
#ifdef W3_IS2
IS2PARS => GRIDS(IMOD)%IS2PARS
#endif
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
#ifdef W3_SEC1
NITERSEC1 => GRIDS(IMOD)%NITERSEC1
#endif
CTMAX => GRIDS(IMOD)%CTMAX
FICE0 => GRIDS(IMOD)%FICE0
GRIDSHIFT => GRIDS(IMOD)%GRIDSHIFT
CMPRTRCK => GRIDS(IMOD)%CMPRTRCK
#ifdef W3_RTD
PoLat => GRIDS(IMOD)%PoLat
PoLon => GRIDS(IMOD)%PoLon
FLAGUNR => GRIDS(IMOD)%FLAGUNR
#endif
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
ICESCALES => GRIDS(IMOD)%ICESCALES
PFMOVE => GRIDS(IMOD)%PFMOVE
STEXU => GRIDS(IMOD)%STEXU
STEYU => GRIDS(IMOD)%STEYU
STEDU => GRIDS(IMOD)%STEDU
BTBETA => GRIDS(IMOD)%BTBETA
AAIRGB => GRIDS(IMOD)%AAIRGB
AAIRCMIN => GRIDS(IMOD)%AAIRCMIN
!
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
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
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
I_DIAG => GRIDS(IMOD)%I_DIAG
JA_IE => GRIDS(IMOD)%JA_IE
NBEDGE => GRIDS(IMOD)%NBEDGE
EDGES => GRIDS(IMOD)%EDGES
NEIGH => GRIDS(IMOD)%NEIGH
NNZ => GRIDS(IMOD)%NNZ
IOBPD => GRIDS(IMOD)%IOBPD
IOBDP => GRIDS(IMOD)%IOBDP
IOBPA => GRIDS(IMOD)%IOBPA
TRIA => GRIDS(IMOD)%TRIA
CROSSDIFF => GRIDS(IMOD)%CROSSDIFF
MAXX => GRIDS(IMOD)%MAXX
MAXY => GRIDS(IMOD)%MAXY
DXYMAX => GRIDS(IMOD)%DXYMAX
XGRD => GRIDS(IMOD)%XGRD
YGRD => GRIDS(IMOD)%YGRD
ZB => GRIDS(IMOD)%ZB
!
IF ( GINIT ) THEN
!
MAPSTA => GRIDS(IMOD)%MAPSTA
MAPST2 => GRIDS(IMOD)%MAPST2
MAPFS => GRIDS(IMOD)%MAPFS
MAPSF => GRIDS(IMOD)%MAPSF
FLAGST => GRIDS(IMOD)%FLAGST
!
#ifdef W3_RTD
AnglD => GRIDS(IMOD)%AnglD
#endif
CLATS => GRIDS(IMOD)%CLATS
CLATIS => GRIDS(IMOD)%CLATIS
CTHG0S => GRIDS(IMOD)%CTHG0S
TRNX => GRIDS(IMOD)%TRNX
TRNY => GRIDS(IMOD)%TRNY
!
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
!
#ifdef W3_BT4
SED_D50 => GRIDS(IMOD)%SED_D50
SED_PSIC => GRIDS(IMOD)%SED_PSIC
#endif
!
#ifdef W3_SMC
NLvCel => GRIDS(IMOD)%NLvCel
NLvUFc => GRIDS(IMOD)%NLvUFc
NLvVFc => GRIDS(IMOD)%NLvVFc
IJKCel => GRIDS(IMOD)%IJKCel
IJKUFc => GRIDS(IMOD)%IJKUFc
IJKVFc => GRIDS(IMOD)%IJKVFc
ISMCBP => GRIDS(IMOD)%ISMCBP
CTRNX => GRIDS(IMOD)%CTRNX
CTRNY => GRIDS(IMOD)%CTRNY
CLATF => GRIDS(IMOD)%CLATF
IJKCel3 => GRIDS(IMOD)%IJKCel3
IJKCel4 => GRIDS(IMOD)%IJKCel4
IJKVFc5 => GRIDS(IMOD)%IJKVFc5
IJKVFc6 => GRIDS(IMOD)%IJKVFc6
IJKUFc5 => GRIDS(IMOD)%IJKUFc5
IJKUFc6 => GRIDS(IMOD)%IJKUFc6
#endif
!
#ifdef W3_SMC
ICLBAC => GRIDS(IMOD)%ICLBAC
ANGARC => GRIDS(IMOD)%ANGARC
SPCBAC => GRIDS(IMOD)%SPCBAC
#endif
!
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
#ifdef W3_RWND
RWINDC => MPARS(IMOD)%NPARS%RWINDC
#endif
#ifdef W3_WCOR
WWCOR => MPARS(IMOD)%NPARS%WWCOR
#endif
!
! Structure PROPS
!
#ifdef W3_PR2
DTME => MPARS(IMOD)%PROPS%DTME
CLATMN => MPARS(IMOD)%PROPS%CLATMN
#endif
#ifdef W3_PR3
WDCG => MPARS(IMOD)%PROPS%WDCG
WDTH => MPARS(IMOD)%PROPS%WDTH
#endif
#ifdef W3_SMC
DTMS => MPARS(IMOD)%PROPS%DTMS
Refran => MPARS(IMOD)%PROPS%Refran
FUNO3 => MPARS(IMOD)%PROPS%FUNO3
FVERG => MPARS(IMOD)%PROPS%FVERG
FSWND => MPARS(IMOD)%PROPS%FSWND
ARCTC => MPARS(IMOD)%PROPS%ARCTC
#endif
!
! Structure FLDP
!
#ifdef W3_FLD1
TAIL_ID => MPARS(IMOD)%FLDPS%TAIL_ID
TAIL_LEV => MPARS(IMOD)%FLDPS%TAIL_LEV
TAIL_TRAN1 => MPARS(IMOD)%FLDPS%TAIL_TRAN1
TAIL_TRAN2 => MPARS(IMOD)%FLDPS%TAIL_TRAN2
#endif
#ifdef W3_FLD2
TAIL_ID => MPARS(IMOD)%FLDPS%TAIL_ID
TAIL_LEV => MPARS(IMOD)%FLDPS%TAIL_LEV
TAIL_TRAN1 => MPARS(IMOD)%FLDPS%TAIL_TRAN1
TAIL_TRAN2 => MPARS(IMOD)%FLDPS%TAIL_TRAN2
#endif
!
! Structure SFLPS
!
#ifdef W3_FLX2
NITTIN => MPARS(IMOD)%SFLPS%NITTIN
CINXSI => MPARS(IMOD)%SFLPS%CINXSI
#endif
#ifdef W3_FLX3
NITTIN => MPARS(IMOD)%SFLPS%NITTIN
CAP_ID => MPARS(IMOD)%SFLPS%CAP_ID
CINXSI => MPARS(IMOD)%SFLPS%CINXSI
CD_MAX => MPARS(IMOD)%SFLPS%CD_MAX
#endif
#ifdef W3_FLX4
FLX4A0 => MPARS(IMOD)%SFLPS%FLX4A0
#endif
!
! Structure SLNPS
!
#ifdef W3_LN1
SLNC1 => MPARS(IMOD)%SLNPS%SLNC1
FSPM => MPARS(IMOD)%SLNPS%FSPM
FSHF => MPARS(IMOD)%SLNPS%FSHF
#endif
!
! Structure SRCPS
!
WWNMEANPTAIL=> MPARS(IMOD)%SRCPS%WWNMEANPTAIL
SSTXFTFTAIL => MPARS(IMOD)%SRCPS%SSTXFTFTAIL
#ifdef W3_ST1
SINC1 => MPARS(IMOD)%SRCPS%SINC1
SDSC1 => MPARS(IMOD)%SRCPS%SDSC1
#endif
#ifdef W3_ST2
ZWIND => MPARS(IMOD)%SRCPS%ZWIND
FSWELL => MPARS(IMOD)%SRCPS%FSWELL
SHSTAB => MPARS(IMOD)%SRCPS%SHSTAB
OFSTAB => MPARS(IMOD)%SRCPS%OFSTAB
CCNG => MPARS(IMOD)%SRCPS%CCNG
CCPS => MPARS(IMOD)%SRCPS%CCPS
FFNG => MPARS(IMOD)%SRCPS%FFNG
FFPS => MPARS(IMOD)%SRCPS%FFPS
CDSA0 => MPARS(IMOD)%SRCPS%CDSA0
CDSA1 => MPARS(IMOD)%SRCPS%CDSA1
CDSA2 => MPARS(IMOD)%SRCPS%CDSA2
SDSALN => MPARS(IMOD)%SRCPS%SDSALN
CDSB0 => MPARS(IMOD)%SRCPS%CDSB0
CDSB1 => MPARS(IMOD)%SRCPS%CDSB1
CDSB2 => MPARS(IMOD)%SRCPS%CDSB2
CDSB3 => MPARS(IMOD)%SRCPS%CDSB3
FPIMIN => MPARS(IMOD)%SRCPS%FPIMIN
XFH => MPARS(IMOD)%SRCPS%XFH
XF1 => MPARS(IMOD)%SRCPS%XF1
XF2 => MPARS(IMOD)%SRCPS%XF2
#endif
!
#ifdef W3_ST3
ZZWND => MPARS(IMOD)%SRCPS%ZZWND
AALPHA => MPARS(IMOD)%SRCPS%AALPHA
BBETA => MPARS(IMOD)%SRCPS%BBETA
SSINTHP => MPARS(IMOD)%SRCPS%SSINTHP
ZZ0MAX => MPARS(IMOD)%SRCPS%ZZ0MAX
ZZ0RAT => MPARS(IMOD)%SRCPS%ZZ0RAT
ZZALP => MPARS(IMOD)%SRCPS%ZZALP
TTAUWSHELTER => MPARS(IMOD)%SRCPS%TTAUWSHELTER
SSWELLF => MPARS(IMOD)%SRCPS%SSWELLF
SSDSC1 => MPARS(IMOD)%SRCPS%SSDSC1
WWNMEANP => MPARS(IMOD)%SRCPS%WWNMEANP
FFXFM => MPARS(IMOD)%SRCPS%FFXFM
FFXPM => MPARS(IMOD)%SRCPS%FFXPM
DDELTA1 => MPARS(IMOD)%SRCPS%DDELTA1
DDELTA2 => MPARS(IMOD)%SRCPS%DDELTA2
SSTXFTF => MPARS(IMOD)%SRCPS%SSTXFTF
SSTXFTWN => MPARS(IMOD)%SRCPS%SSTXFTWN
#endif
!
#ifdef W3_ST4
ZZWND => MPARS(IMOD)%SRCPS%ZZWND
AALPHA => MPARS(IMOD)%SRCPS%AALPHA
BBETA => MPARS(IMOD)%SRCPS%BBETA
SSINTHP => MPARS(IMOD)%SRCPS%SSINTHP
ZZ0MAX => MPARS(IMOD)%SRCPS%ZZ0MAX
ZZ0RAT => MPARS(IMOD)%SRCPS%ZZ0RAT
ZZALP => MPARS(IMOD)%SRCPS%ZZALP
TTAUWSHELTER => MPARS(IMOD)%SRCPS%TTAUWSHELTER
SSWELLFPAR => MPARS(IMOD)%SRCPS%SSWELLFPAR
SSWELLF => MPARS(IMOD)%SRCPS%SSWELLF
SSDSC => MPARS(IMOD)%SRCPS%SSDSC
SSDSBR => MPARS(IMOD)%SRCPS%SSDSBR
SSDSBT => MPARS(IMOD)%SRCPS%SSDSBT
SSDSBRF1 => MPARS(IMOD)%SRCPS%SSDSBRF1
SSDSBRF2 => MPARS(IMOD)%SRCPS%SSDSBRF2
SSDSBRFDF => MPARS(IMOD)%SRCPS%SSDSBRFDF
SSDSBM => MPARS(IMOD)%SRCPS%SSDSBM
SSDSBCK => MPARS(IMOD)%SRCPS%SSDSBCK
SSDSABK => MPARS(IMOD)%SRCPS%SSDSABK
SSDSPBK => MPARS(IMOD)%SRCPS%SSDSPBK
SSDSHCK => MPARS(IMOD)%SRCPS%SSDSHCK
SSDSBINT => MPARS(IMOD)%SRCPS%SSDSBINT
SSDSP => MPARS(IMOD)%SRCPS%SSDSP
WWNMEANP => MPARS(IMOD)%SRCPS%WWNMEANP
FFXFM => MPARS(IMOD)%SRCPS%FFXFM
FFXFA => MPARS(IMOD)%SRCPS%FFXFA
FFXPM => MPARS(IMOD)%SRCPS%FFXPM
SSDSDTH => MPARS(IMOD)%SRCPS%SSDSDTH
SSTXFTF => MPARS(IMOD)%SRCPS%SSTXFTF
SSTXFTWN => MPARS(IMOD)%SRCPS%SSTXFTWN
SSDSCOS => MPARS(IMOD)%SRCPS%SSDSCOS
SSDSISO => MPARS(IMOD)%SRCPS%SSDSISO
IKTAB => MPARS(IMOD)%SRCPS%IKTAB
DCKI => MPARS(IMOD)%SRCPS%DCKI
QBI => MPARS(IMOD)%SRCPS%QBI
CUMULW => MPARS(IMOD)%SRCPS%CUMULW
SATINDICES => MPARS(IMOD)%SRCPS%SATINDICES
SATWEIGHTS => MPARS(IMOD)%SRCPS%SATWEIGHTS
SSINBR => MPARS(IMOD)%SRCPS%SSINBR
#endif
!
#ifdef W3_ST6
SIN6A0 => MPARS(IMOD)%SRCPS%SIN6A0
SIN6WS => MPARS(IMOD)%SRCPS%SIN6WS
SIN6FC => MPARS(IMOD)%SRCPS%SIN6FC
SDS6ET => MPARS(IMOD)%SRCPS%SDS6ET
SDS6A1 => MPARS(IMOD)%SRCPS%SDS6A1
SDS6P1 => MPARS(IMOD)%SRCPS%SDS6P1
SDS6A2 => MPARS(IMOD)%SRCPS%SDS6A2
SDS6P2 => MPARS(IMOD)%SRCPS%SDS6P2
SWL6S6 => MPARS(IMOD)%SRCPS%SWL6S6
SWL6B1 => MPARS(IMOD)%SRCPS%SWL6B1
SWL6CSTB1 => MPARS(IMOD)%SRCPS%SWL6CSTB1
#endif
!
! Structure SRNLS
!
#ifdef W3_NL1
SNLC1 => MPARS(IMOD)%SNLPS%SNLC1
LAM => MPARS(IMOD)%SNLPS%LAM
KDCON => MPARS(IMOD)%SNLPS%KDCON
KDMN => MPARS(IMOD)%SNLPS%KDMN
SNLS1 => MPARS(IMOD)%SNLPS%SNLS1
SNLS2 => MPARS(IMOD)%SNLPS%SNLS2
SNLS3 => MPARS(IMOD)%SNLPS%SNLS3
#endif
#ifdef W3_NL2
IQTPE => MPARS(IMOD)%SNLPS%IQTPE
NDPTHS => MPARS(IMOD)%SNLPS%NDPTHS
NLTAIL => MPARS(IMOD)%SNLPS%NLTAIL
IF ( NDPTHS .NE. 0 ) DPTHNL => MPARS(IMOD)%SNLPS%DPTHNL
#endif
#ifdef W3_NL3
NFRMIN => MPARS(IMOD)%SNLPS%NFRMIN
NFRMAX => MPARS(IMOD)%SNLPS%NFRMAX
NFRCUT => MPARS(IMOD)%SNLPS%NFRCUT
NTHMAX => MPARS(IMOD)%SNLPS%NTHMAX
NTHEXP => MPARS(IMOD)%SNLPS%NTHEXP
NSPMIN => MPARS(IMOD)%SNLPS%NSPMIN
NSPMAX => MPARS(IMOD)%SNLPS%NSPMAX
NSPMX2 => MPARS(IMOD)%SNLPS%NSPMX2
FRQ => MPARS(IMOD)%SNLPS%FRQ
XSI => MPARS(IMOD)%SNLPS%XSI
NQA => MPARS(IMOD)%SNLPS%NQA
QST1 => MPARS(IMOD)%SNLPS%QST1
QST2 => MPARS(IMOD)%SNLPS%QST2
QST3 => MPARS(IMOD)%SNLPS%QST3
QST4 => MPARS(IMOD)%SNLPS%QST4
QST5 => MPARS(IMOD)%SNLPS%QST5
QST6 => MPARS(IMOD)%SNLPS%QST6
SNLNQ => MPARS(IMOD)%SNLPS%SNLNQ
SNLMSC => MPARS(IMOD)%SNLPS%SNLMSC
SNLNSC => MPARS(IMOD)%SNLPS%SNLNSC
SNLSFD => MPARS(IMOD)%SNLPS%SNLSFD
SNLSFS => MPARS(IMOD)%SNLPS%SNLSFS
SNLL => MPARS(IMOD)%SNLPS%SNLL
SNLM => MPARS(IMOD)%SNLPS%SNLM
SNLT => MPARS(IMOD)%SNLPS%SNLT
SNLCD => MPARS(IMOD)%SNLPS%SNLCD
SNLCS => MPARS(IMOD)%SNLPS%SNLCS
#endif
#ifdef W3_NL4
ITSA => MPARS(IMOD)%SNLPS%ITSA
IALT => MPARS(IMOD)%SNLPS%IALT
#endif
#ifdef W3_NL5
QR5DPT => MPARS(IMOD)%SNLPS%QR5DPT
QR5OML => MPARS(IMOD)%SNLPS%QR5OML
QI5DIS => MPARS(IMOD)%SNLPS%QI5DIS
QI5KEV => MPARS(IMOD)%SNLPS%QI5KEV
QI5NNZ => MPARS(IMOD)%SNLPS%QI5NNZ
QI5IPL => MPARS(IMOD)%SNLPS%QI5IPL
QI5PMX => MPARS(IMOD)%SNLPS%QI5PMX
#endif
#ifdef W3_NLS
NTHX => MPARS(IMOD)%SNLPS%NTHX
NFRX => MPARS(IMOD)%SNLPS%NFRX
NSPL => MPARS(IMOD)%SNLPS%NSPL
NSPH => MPARS(IMOD)%SNLPS%NSPH
SNSST => MPARS(IMOD)%SNLPS%SNSST
CNLSA => MPARS(IMOD)%SNLPS%CNLSA
CNLSC => MPARS(IMOD)%SNLPS%CNLSC
CNLSFM => MPARS(IMOD)%SNLPS%CNLSFM
CNLSC1 => MPARS(IMOD)%SNLPS%CNLSC1
CNLSC2 => MPARS(IMOD)%SNLPS%CNLSC2
CNLSC3 => MPARS(IMOD)%SNLPS%CNLSC3
#endif
!
! Structure SBTPS
!
#ifdef W3_BT1
SBTC1 => MPARS(IMOD)%SBTPS%SBTC1
#endif
#ifdef W3_BT4
SBTCX => MPARS(IMOD)%SBTPS%SBTCX
#endif
!
! Structure SDBPS
!
#ifdef W3_DB1
SDBC1 => MPARS(IMOD)%SDBPS%SDBC1
SDBC2 => MPARS(IMOD)%SDBPS%SDBC2
FDONLY => MPARS(IMOD)%SDBPS%FDONLY
SDBSC => MPARS(IMOD)%SDBPS%SDBSC
#endif
!
!
#ifdef W3_UOST
UOSTFILELOCAL => MPARS(IMOD)%UOSTPS%UOSTFILELOCAL
UOSTFILESHADOW => MPARS(IMOD)%UOSTPS%UOSTFILESHADOW
UOSTFACTORLOCAL => MPARS(IMOD)%UOSTPS%UOSTFACTORLOCAL
UOSTFACTORSHADOW => MPARS(IMOD)%UOSTPS%UOSTFACTORSHADOW
#endif
!
! Structure SICPS
!
#ifdef W3_IS1
IS1C1 => MPARS(IMOD)%SICPS%IS1C1
IS1C2 => MPARS(IMOD)%SICPS%IS1C2
#endif
!
! Structure SCHM
FSBCCFL => MPARS(IMOD)%SCHMS%FSBCCFL
FSN => MPARS(IMOD)%SCHMS%FSN
FSPSI => MPARS(IMOD)%SCHMS%FSPSI
FSFCT => MPARS(IMOD)%SCHMS%FSFCT
FSNIMP => MPARS(IMOD)%SCHMS%FSNIMP
FSTOTALIMP => MPARS(IMOD)%SCHMS%FSTOTALIMP
FSTOTALEXP => MPARS(IMOD)%SCHMS%FSTOTALEXP
FSREFRACTION => MPARS(IMOD)%SCHMS%FSREFRACTION
FSFREQSHIFT => MPARS(IMOD)%SCHMS%FSFREQSHIFT
FSSOURCE => MPARS(IMOD)%SCHMS%FSSOURCE
DO_CHANGE_WLV => MPARS(IMOD)%SCHMS%DO_CHANGE_WLV
SOLVERTHR_STP => MPARS(IMOD)%SCHMS%SOLVERTHR_STP
CRIT_DEP_STP => MPARS(IMOD)%SCHMS%CRIT_DEP_STP
B_JGS_TERMINATE_MAXITER => MPARS(IMOD)%SCHMS%B_JGS_TERMINATE_MAXITER
B_JGS_TERMINATE_DIFFERENCE => MPARS(IMOD)%SCHMS%B_JGS_TERMINATE_DIFFERENCE
B_JGS_TERMINATE_NORM => MPARS(IMOD)%SCHMS%B_JGS_TERMINATE_NORM
B_JGS_LIMITER => MPARS(IMOD)%SCHMS%B_JGS_LIMITER
B_JGS_USE_JACOBI => MPARS(IMOD)%SCHMS%B_JGS_USE_JACOBI
B_JGS_BLOCK_GAUSS_SEIDEL => MPARS(IMOD)%SCHMS%B_JGS_BLOCK_GAUSS_SEIDEL
B_JGS_MAXITER => MPARS(IMOD)%SCHMS%B_JGS_MAXITER
B_JGS_PMIN => MPARS(IMOD)%SCHMS%B_JGS_PMIN
B_JGS_DIFF_THR => MPARS(IMOD)%SCHMS%B_JGS_DIFF_THR
B_JGS_NORM_THR => MPARS(IMOD)%SCHMS%B_JGS_NORM_THR
B_JGS_NLEVEL => MPARS(IMOD)%SCHMS%B_JGS_NLEVEL
B_JGS_SOURCE_NONLINEAR => MPARS(IMOD)%SCHMS%B_JGS_SOURCE_NONLINEAR
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 )
!/
!/ +-----------------------------------+
!/ | 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
#ifdef W3_S
USE W3SERVMD, ONLY: STRACE
#endif
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
INTEGER, INTENT(IN) :: IMOD, NDSE, NDST
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
INTEGER, PARAMETER :: NFD = 4
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(:,:)
#ifdef W3_S
INTEGER, SAVE :: IENT = 0
#endif
!/
#ifdef W3_S
CALL STRACE (IENT, 'W3GNTX')
#endif
!
! -------------------------------------------------------------------- /
! 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 ( SMCTYPE )
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 )
!!Li SMC grid shares the settings with rectilinear grid. JGLi12Oct2020
CASE ( RLGTYPE, SMCTYPE )
CALL W3CGDM( IJG, FLAGLL, ICLOSE, PTILED, QTILED, &
PRANGE, QRANGE, LBI, UBI, LBO, UBO, REAL(XGRD), REAL(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, REAL(XGRD), REAL(YGRD), &
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
#ifdef W3_MEMCHECK
USE MallocInfo_m
#endif
#ifdef W3_S
USE W3SERVMD, ONLY: STRACE
#endif
!
IMPLICIT NONE
!
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
INTEGER, INTENT(IN) :: IMOD, MTRI, MX, COUNTOTA, NNZ, NDSE, NDST
#ifdef W3_MEMCHECK
type(MallInfo_t) :: mallinfos
#endif
INTEGER :: IAPROC = 1
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
#ifdef W3_S
INTEGER, SAVE :: IENT = 0
#endif
!/
#ifdef W3_S
CALL STRACE (IENT, 'W3DIMUG')
#endif
!
! -------------------------------------------------------------------- /
! 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(3,MTRI), &
GRIDS(IMOD)%SI(MX), &
GRIDS(IMOD)%XGRD(1,MX), &
GRIDS(IMOD)%YGRD(1,MX), &
GRIDS(IMOD)%ZB(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)%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)%I_DIAG(NX), &
GRIDS(IMOD)%JA_IE(3,3,MTRI), &
GRIDS(IMOD)%IOBP(MX), &
GRIDS(IMOD)%IOBPD(NTH,MX), &
GRIDS(IMOD)%IOBDP(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
! Note that in the case of lon/lat grids, these quantities do not
! include the spherical coordinate metric (SPHERE=.FALSE.).
!
NTRI = MTRI
COUNTOT=COUNTOTA
GRIDS(IMOD)%GUGINIT = .TRUE.
#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/)
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
#ifdef W3_S
USE W3SERVMD, ONLY : STRACE
#endif
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/
INTEGER :: ISEA, IX, IY, IXY, IXN, IXP, IYN, IYP
INTEGER :: J, K, NEIGH1(0:7)
INTEGER :: ILEV, NLEV
#ifdef W3_S
INTEGER, SAVE :: IENT = 0
#endif
REAL :: TRIX(NY*NX), TRIY(NY*NX), DX, DY, &
COSAVG, SINAVG, THAVG, ANGLES(0:7), CLAT
!/
!/ ------------------------------------------------------------------- /
!/
#ifdef W3_S
CALL STRACE (IENT, 'W3SETREF')
#endif
!
! 1. Preparations --------------------------------------------------- *
!
#ifdef W3_REF1
IF (REFPARS(2).GT.0) RREF(2)=.TRUE.
IF (REFPARS(3).GT.0) RREF(3)=.TRUE.
IF (REFPARS(4).GT.0) RREF(4)=.TRUE.
#endif
!
#ifdef W3_REF1
DO IY=2, NY-1
DO IX=2, NX-1
IF (REFPARS(1).GT.0) RREF(1)=.TRUE.
!No reflection from artificial island on pole.
IF (FLAGLL.AND.(YGRD(IY,IX).GT.85)) RREF(1)=.FALSE.
IF (MAPSTA(IY,IX).GT.0) THEN
!
! Prepares for reflection from subgrid islands
!
IF (RREF(2)) &
REFLC(2,MAPFS(IY,IX))= MAX((1. - TRNX(IY,IX)),(1.-TRNY(IY,IX)))
!
! Prepares for iceberg reflections
!
IF (RREF(4)) &
REFLC(4,MAPFS(IY,IX))= 1.
!
! resolved shoreline reflection
!
IF (RREF(1)) THEN
REFLC(1, MAPFS(IY,IX)) = 0.
REFLD(1:6,MAPFS(IY,IX)) = 0
!
! Search for neighboring coastline. 3 2 1
! around X. These are the neighbors of X: 4 X 0
! 5 6 7
!
!
NEIGH1(0)=8*MAPST2(IY,IX+1)+MAPSTA(IY,IX+1)
NEIGH1(1:3)=8*MAPST2(IY+1,IX+1:IX-1:-1)+MAPSTA(IY+1,IX+1:IX-1:-1)
NEIGH1(4)=8*MAPST2(IY,IX-1)+MAPSTA(IY,IX-1)
NEIGH1(5:7)=8*MAPST2(IY-1,IX-1:IX+1)+MAPSTA(IY-1,IX-1:IX+1)
!
! if one of the surrounding points is land: determines directions ...
!
IF (MINVAL(ABS(NEIGH1)).EQ.0) THEN
IF ( FLAGLL ) THEN
CLAT = COS(YGRD(IY,IX)*DERA)
ELSE
CLAT = 1.
END IF
ANGLES(0)= ATAN2(DYDP(IY,IX),DXDP(IY,IX)*CLAT)
ANGLES(1)= ATAN2(DYDP(IY,IX)+DYDQ(IY,IX),(DXDP(IY,IX)+DXDQ(IY,IX))*CLAT)
ANGLES(2)= ATAN2(DYDQ(IY,IX),DXDQ(IY,IX)*CLAT)
ANGLES(3)= ATAN2(DYDQ(IY,IX)-DYDP(IY,IX),(DXDQ(IY,IX)-DXDP(IY,IX))*CLAT)
ANGLES(4:7)= ANGLES(0:3)+PI
IF ((NEIGH1(0).GE.1).AND.(NEIGH1(4).GE.1)) THEN
REFLD(3,MAPFS(IY,IX))=0
ELSE
IF ((NEIGH1(0).GE.1).OR.(NEIGH1(4).GE.1)) REFLD(3,MAPFS(IY,IX))=1
END IF
IF ((NEIGH1(2).EQ.1).AND.(NEIGH1(6).GE.1)) THEN
REFLD(4,MAPFS(IY,IX))=0
ELSE
IF ((NEIGH1(2).GE.1).OR.(NEIGH1(6).GE.1)) REFLD(4,MAPFS(IY,IX))=1
END IF
!
! Looks for a locally straight coast in all 8 orientations
!
J=0
REFLD(1,MAPFS(IY,IX))=0
COSAVG=0
SINAVG=0
! Shore angle is corrected for grid rotation in w3ref1md.ftn with REFLD(5:6,MAPFS(IY,IX))
REFLD(5,MAPFS(IY,IX))= MOD(NTH+NINT(ANGLES(0)/TPI*NTH),NTH)
REFLD(6,MAPFS(IY,IX))= MOD(NTH+NINT((ANGLES(2)/TPI-0.25)*NTH),NTH)
#endif
#ifdef W3_REFT
IF (IY.EQ.4) THEN
WRITE(6,*) 'POINT (IX,IY):',IX,IY
WRITE(6,*) 'REFT:',NEIGH1(3),NEIGH1(2), NEIGH1(1)
WRITE(6,*) 'REFT:',NEIGH1(4),1, NEIGH1(0)
WRITE(6,*) 'REFT:',NEIGH1(5:7)
WRITE(6,*) 'ANG:',ANGLES(3)*RADE,ANGLES(2)*RADE, ANGLES(1)*RADE
WRITE(6,*) 'ANG:',ANGLES(4)*RADE,1, ANGLES(0) *RADE
WRITE(6,*) 'ANG:',ANGLES(5:7)*RADE
WRITE(6,*) 'REFT:',XGRD(IY+1,IX-1:IX+1), YGRD(IY+1,IX-1:IX+1)
WRITE(6,*) 'REFT:',XGRD(IY,IX-1:IX+1) , YGRD(IY,IX-1:IX+1)
WRITE(6,*) 'REFT:',XGRD(IY-1,IX-1:IX+1), YGRD(IY-1,IX-1:IX+1)
WRITE(6,*) 'REFLD:',REFLD(3:6,MAPFS(IY,IX))
ENDIF
#endif
#ifdef W3_REF1
DO K=0,7
IF (NEIGH1(K).EQ.0.AND.NEIGH1(MOD(K+7,8)).EQ.0 &
.AND.NEIGH1(MOD(K+1,8)).EQ.0 &
.AND.NEIGH1(MOD(K+4,8)).NE.0) THEN
REFLC(1,MAPFS(IY,IX))= REFPARS(1)
!
! Defines direction index for specular reflection (normal to coast)
!
! for example, if we have this layout 1 1 0
! (NB: 1 is sea, 0 is land) 1 X 0
! 1 1 0
!
! then there is only a coastline detection for K=0, giving J=1
! and the final result will be REFLD(1,MAPFS(IY,IX))=1
! Namely, the direction TH(REFLD) is the direction pointing INTO the coast
!
REFLD(2,MAPFS(IY,IX))= 2
COSAVG=COSAVG+COS(ANGLES(K)) !ECOS(1+(K*NTH)/8)
SINAVG=SINAVG+SIN(ANGLES(K)) !ESIN(1+(K*NTH)/8)
J=J+1
ENDIF
END DO
IF (J.GT.0) THEN
IF (J.GT.1) REFLD(2,MAPFS(IY,IX))= 1
THAVG=ATAN2(SINAVG,COSAVG)
#endif
#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3SETREF)
#ifdef W3_REF1
!WRITE (6,*) 'COASTAL REFLECTION:',IX,IY, &
!SINAVG,COSAVG,THAVG/TPI,NINT(THAVG/TPI*NTH),MOD(NTH+NINT(THAVG/TPI*NTH),NTH)
#endif
#endif
#ifdef W3_REF1
REFLD(1,MAPFS(IY,IX))=1+MOD(NTH+NINT(THAVG/TPI*NTH),NTH)
ELSE
! 1 1 1
! Looks for mild corners like 1 1 1
! 1 0 0
DO K=0,7
IF (NEIGH1(K).EQ.0.AND.NEIGH1(MOD(K+1,8)).EQ.0 &
.AND.NEIGH1(MOD(K+4,8)).NE.0) THEN
REFLC(1,MAPFS(IY,IX))= REFPARS(1)
REFLD(1,MAPFS(IY,IX))= 1+MOD((K*NTH+(K+1)*NTH)/16,NTH)
REFLD(2,MAPFS(IY,IX))= 1
ENDIF
END DO
! 1 1 1 1 1 1
! Looks for sharp corners like 1 1 1 but not diagonals like 1 1 1
! 1 0 1 1 1 0
IF (REFLC(1,MAPFS(IY,IX)).LE.0) THEN
DO K=0,7,2
IF ( NEIGH1(K).EQ.0.AND.NEIGH1(MOD(K+4,8)).NE.0) THEN
REFLC(1,MAPFS(IY,IX))= REFPARS(1)
REFLD(1,MAPFS(IY,IX))= 1+(K*NTH)/8
REFLD(2,MAPFS(IY,IX))= 0
!WRITE(6,*) 'NEIGH3:',IX,IY,K,NEIGH1,K*(NTH/8)
END IF
END DO
END IF
END IF
! End of test if surrounding point is land
END IF
#endif
#ifdef W3_REFT
IF (REFLC(1,MAPFS(IY,IX)).GT.0) THEN
WRITE (6,*) 'COAST DIRECTION AT POINT:',IX,IY,' IS ', &
REFLD(:,MAPFS(IY,IX)),TH(REFLD(1,MAPFS(IY,IX)))*360/TPI
ENDIF
#endif
#ifdef W3_REF1
! End of test if local point is sea
END IF
END IF
END DO
END DO
#endif
!
RETURN
!
! Formats
!
!/
!/ End of W3SETREF ----------------------------------------------------- /
!/
END SUBROUTINE W3SETREF
!/
!/ End of module W3GDATMD -------------------------------------------- /
!/
END MODULE W3GDATMD