WAVEWATCH III  beta 0.0.1
w3gdatmd.F90
Go to the documentation of this file.
1 #include "w3macros.h"
2 !/
3 !/ ------------------------------------------------------------------- /
4 !/ Macros for enabling test output
5 !/
6 #define TEST_W3GDATMD___disabled
7 #define TEST_W3GDATMD_W3NMOD___disabled
8 #define TEST_W3GDATMD_W3DIMX___disabled
9 #define TEST_W3GDATMD_W3DIMS___disabled
10 #define TEST_W3GDATMD_W3SETG___disabled
11 #define TEST_W3GDATMD_W3GNTX___disabled
12 #define TEST_W3GDATMD_W3DIMUG___disabled
13 #define TEST_W3GDATMD_W3SETREF___disabled
14 !/
15 !/ ------------------------------------------------------------------- /
16 MODULE w3gdatmd
17  !/
18  !/ +-----------------------------------+
19  !/ | WAVEWATCH III NOAA/NCEP |
20  !/ | H. L. Tolman |
21  !/ ! J. H. Alves !
22  !/ | F. Ardhuin |
23  !/ | FORTRAN 90 |
24  !/ | Last update : 15-Apr-2020 |
25  !/ +-----------------------------------+
26  !/
27  !/ 24-Jun-2005 : Origination. ( version 3.07 )
28  !/ 09-Nov-2005 : Remove soft boundary options. ( version 3.08 )
29  !/ 23-Jun-2006 : Add data for W3SLN1. ( version 3.09 )
30  !/ 18-Jul-2006 : Add input grids. ( version 3.10 )
31  !/ 05-Oct-2006 : Add filter to array pointers. ( version 3.10 )
32  !/ 02-Feb-2007 : Add FLAGST. ( version 3.10 )
33  !/ 14-Apr-2007 : Add Miche style limiter. ( version 3.11 )
34  !/ ( J. H. Alves )
35  !/ 25-Apr-2007 : Adding Battjes-Janssen Sdb. ( version 3.11 )
36  !/ ( J. H. Alves )
37  !/ 06-Aug-2007 : Fixing SLNP !/SEED bug. ( version 3.13 )
38  !/ 18-Sep-2007 : Adding WAM4 source terms. ( version 3.13 )
39  !/ ( F. Ardhuin )
40  !/ 15-Apr-2008 : Clean up for distribution. ( version 3.14 )
41  !/ 27-Jun-2008 : Expand WAM4 variants namelist ( version 3.14 )
42  !/ ( F. Ardhuin )
43  !/ 29-May-2009 : Preparing distribution version. ( version 3.14 )
44  !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 )
45  !/ (W. E. Rogers & T. J. Campbell, NRL)
46  !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 )
47  !/ (W. E. Rogers & T. J. Campbell, NRL)
48  !/ 29-Oct-2010 : Implement unstructured grids ( version 3.14.1 )
49  !/ (A. Roland and F. Ardhuin)
50  !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
51  !/ specify index closure for a grid. ( version 3.14 )
52  !/ (T. J. Campbell, NRL)
53  !/ 23-Dec-2010 : Fix HPFAC and HQFAC by including the COS(YGRD)
54  !/ factor with DXDP and DXDQ terms. ( version 3.14 )
55  !/ (T. J. Campbell, NRL)
56  !/ 05-Apr-2011 : Implement interations for DTMAX < 1s( version 3.14.1 )
57  !/ (F. Ardhuin)
58  !/ 01-Jul-2011 : Movable bed bottom friction BT4 ( version 4.01 )
59  !/ 03-Nov-2011 : Bug fix: GUGINIT initialization ( version 4.04 )
60  !/ 29-Nov-2011 : Adding ST6 source term option. ( version 4.04 )
61  !/ (S. Zieger)
62  !/ 14-Mar-2012 : Add PSIC for BT4 ( version 4.04 )
63  !/ 12-Jun-2012 : Add /RTD option or rotated grid variables.
64  !/ (Jian-Guo Li) ( version 4.06 )
65  !/ 13-Jul-2012 : Move data structures GMD (SNL3) and nonlinear
66  !/ filter (SNLS) from 3.15 (HLT). ( version 4.08 )
67  !/ 03-Sep-2012 : Clean up of UG grids ( version 4.08 )
68  !/ 12-Dec-2012 : Adding SMC grid. JG_Li ( version 4.09 )
69  !/ 16-Sep-2013 : Add Arctic part SMC grid. ( version 4.11 )
70  !/ 11-Nov-2013 : SMC and rotated grid incorporated in the main
71  !/ trunk ( version 4.13 )
72  !/ 16-Nov-2013 : Allows reflection on curvi grids ( version 4.14 )
73  !/ 26-Jul-2013 : Adding IG waves ( version 4.16 )
74  !/ 18-Dec-2013 : Moving FLAGLL into GRID TYPE ( version 4.16 )
75  !/ 11-Jun-2014 : Changed reflection for subgrid ( version 5.01 )
76  !/ 10-Dec-2014 : Add checks for allocate status ( version 5.04 )
77  !/ 21-Aug-2015 : Add SMC FUNO3, FVERG options. JGLi ( version 5.09 )
78  !/ 04-May-2016 : Add IICEDISP GB&FA ( version 5.10 )
79  !/ 20-Jan-2017 : Update to new W3GSRUMD APIs ( version 6.02 )
80  !/ 20-Jan-2017 : Change to preprocessor macros to enable test output.
81  !/ (T.J. Campbell, NRL) ( version 6.02 )
82  !/ 20-Jan-2017 : Change calculation of curvilinear grid metric and
83  !/ derivatives calculations to use W3GSRUMD:W3CGDM.
84  !/ (T.J. Campbell, NRL) ( version 6.02 )
85  !/ 07-Jan-2018 : Generalizes ICE100WIND to ICESCALES ( version 6.04 )
86  !/ 26-Mar-2018 : Add FSWND optional variable. JGLi ( version 6.02 )
87  !/ 05-Jun-2018 : Add PDLIB/DEBUGINIT and implcit scheme parameters
88  !/ for unstructured grids ( version 6.04 )
89  !/ 18-Aug-2018 : S_{ice} IC5 (Q. Liu) ( version 6.06 )
90  !/ 20-Aug-2018: Extra namelist variables for ST6 ( version 6.06)
91  !/ (Q. Liu, UoM)
92  !/ 26-Aug-2018 : UOST (Mentaschi et al. 2015, 2018) ( version 6.06 )
93  !/ 27-Aug-2018 : Add BTBETA parameter ( version 6.06 )
94  !/ 22-Feb-2020 : Add AIRGB and AIRCMIN ( version 7.06 )
95  !/ 15-Apr-2020 : Adds optional opt-out for CFL on BC ( version 7.08 )
96  !/ 06-May-2021 : Add SMCTYPE, ARCTC options. JGLi ( version 7.12 )
97  !/ 07-Jun-2021 : the GKE module (NL5, Q. Liu) ( version 7.12 )
98  !/
99  !/
100  !/ Copyright 2009-2013 National Weather Service (NWS),
101  !/ National Oceanic and Atmospheric Administration. All rights
102  !/ reserved. WAVEWATCH III is a trademark of the NWS.
103  !/ No unauthorized use without permission.
104  !/
105  ! 1. Purpose :
106  !
107  ! Define data structures to set up wave model grids and aliases
108  ! to use individual grids transparently. Also includes subroutines
109  ! to manage data structure and pointing to individual models.
110  ! Definition of grids and model set up.
111  !
112  ! 2. Variables and types :
113  !
114  ! Name Type Scope Description
115  ! ----------------------------------------------------------------
116  ! NGRIDS Int. Public Number of grids, initialized at -1
117  ! to check proper model initialization.
118  ! NAUXGR Int. Public Auxiliary grids.
119  ! IGRID Int. Public Selected spatial grid, init. at -1.
120  ! ISGRD Int. Public Selected spectral grid, init. at -1.
121  ! IPARS Int. Public Selected num. and ph. pars, init. at -1.
122  ! RLGTYPE I.P. Public Named constant for rectilinear grid type
123  ! CLGTYPE I.P. Public Named constant for curvilinear grid type
124  ! UNGTYPE I.P. Public Named constant for Unstructured triangular grid
125  ! SMCTYPE I.P. Public Named constant for unstructured SMC grid type
126  ! FLAGLL Log. Public Flag to indicate coordinate system for all grids
127  ! .TRUE.: Spherical (lon/lat in degrees)
128  ! .FALSE.: Cartesian (meters)
129  ! GRID TYPE Public Data structure defining grid.
130  ! GRIDS GRID Public Array of grids.
131  ! SGRD TYPE Public Data structure defining spectral grid.
132  ! SGRDS GRID Public Array of spectral grids.
133  ! MPAR TYPE Public Data structure with all other model
134  ! parameters.
135  ! MPARS GRID Public Array of MPAR.
136  ! ----------------------------------------------------------------
137  !
138  ! All elements of GRID are aliased to pointers with the same
139  ! name. These pointers are defined as :
140  !
141  ! Name Type Scope Description
142  ! ----------------------------------------------------------------
143  ! GTYPE Int. Public Flag for type of grid
144  ! RLGTYPE: Rectilinear grid
145  ! CLGTYPE: Curvilinear grid
146  ! UNGTYPE: Unstructured triangular grid
147  ! SMCTYPE: Unstructured SMC grid
148  ! RSTYPE Int. Public Integer identifyng restart type
149  ! ICLOSE Int. Public Parameter indicating type of index closure of grid.
150  ! ICLOSE_NONE: No grid closure
151  ! ICLOSE_SMPL: Simple grid closure
152  ! Grid is periodic in the i-index and wraps at
153  ! I=NX+1. In other words, (NX+1,J) => (1,J).
154  ! ICLOSE_TRPL: Tripole grid closure
155  ! Grid is periodic in the i-index and and wraps at
156  ! I=NX+1 and has closure at J=NY+1. In other words,
157  ! (NX+1,J<=NY) => (1,J) and
158  ! (I,NY+1) => (MOD(NX-I+1,NX)+1,NY). The tripole
159  ! closure requires that NX be even.
160  ! NX, NY Int. Public Discrete dimensions of spatial grid.
161  ! NSEA(L) Int. Public Number of sea points (local for MPP).
162  ! NU/VFc Int. Public Number of U/V faces for SMC grid.
163  ! NRLv Int. Public Number of refined levels for SMC grid.
164  ! NGLO Int. Public Number of cells in global part for SMC grid.
165  ! NARC Int. Public Number of cells in Arctic part for SMC grid.
166  ! NBAC Int. Public Number of boundary cells in Arctic part.
167  ! NBGL Int. Public Number of boundary cells in global part.
168  ! NBSMC Int. Public Number of boundary cells for regional SMC grid.
169  ! TRFLAG Int. Public Flag for use of transparencies
170  ! 0: No sub-grid obstacles.
171  ! 1: Obstructions at cell boundaries.
172  ! 2: Obstructions at cell centers.
173  ! 3: Like 1 with continuous ice.
174  ! 4: Like 2 with continuous ice.
175  ! MAPSTA I.A. Public Grid status map.
176  ! MAPST2 I.A. Public Second grid status map.
177  ! MAPxx I.A. Public Storage grid maps.
178  ! IJKCel I.A. Public Cell info array for SMC grid.
179  ! IJKU/VFc I.A. Public U/V-Face arrays for SMC grid.
180  ! NLv* I.A. Public Cell, U/V-Face numbers of refine levels.
181  ! ICLBAC I.A. Public Mapping index for Arctic boundary cells.
182  ! ISMCBP I.A. Public List of SMC grid input boundary cell indexes.
183  ! SX,SY Real Public Spatial (rectilinear) grid increments.
184  ! X0,Y0 Real Public Lower left corner of spatial (rectilinear) grid.
185  ! DTCFL Real Public Maximum CFL time step X-Y propagation.
186  ! DTCFLI Real Public Id. intra-spectral.
187  ! DTMAX Real Public Maximum overall time step.
188  ! DTMIN Real Public Minimum dynamic time step for source
189  ! NITERSEC1 Real Public Number of interations when DTMAX < 1s
190  ! DMIN Real Public Minimum water depth.
191  ! CTMAX Real Public Maximum CFL number for depth refr.
192  ! FICE0/N Real Public Cut-off ice conc. for ice coverage.
193  ! FICEL Real Public Length scale for sea ice damping
194  ! IICEHMIN Real Public Minimum thickness of sea ice
195  ! IICEHDISP Real Public Minimum thickness of sea ice in the dispersion relation before relaxing the conv. criterion
196  ! IICEHFAC Real Public Scale factor for sea ice thickness
197  ! IICEHINIT Real Public Initial value of ice thickness
198  ! ICESCALES R.A. Publ. Scaling coefficient for source terms in the presence of ice
199  ! Default is 1.0, meaning that 100% ice
200  ! concentration result in zero source term
201  ! If set to 0.0, then ice has no direct impact on Sln / Sin / Snl / Sds
202  ! IC3PARS R.A. Public various parameters for use in IC3, handled as
203  ! an array for simplicity
204  ! IC4_KI R.A. Public KI (dissipation rate) values for use in IC4M6
205  ! IC4_FC R.A. Public FC (frequency bin separators) for use in IC4M6
206  ! IC4_CN R.A. Public Coefficients for use in IC4M2
207  ! IC4_FMIN Real Public Minimum frequency below which ki is set to
208  ! some background level dissipation (for S_ice)
209  ! IC4_KIBK Real Public Low, background level dissipation (for S_ice)
210  ! PFMOVE Real Public Tunable parameter in GSE correction
211  ! for moving grids.
212  ! GRIDSHIFT Real Public Grid offset for multi-grid w/SCRIP
213  ! CMPRTRCK Log. Public True for traditional compression of track output
214  ! PoLat/Lon R.A. Public Rotated N-Pole standard latitude/longitude.
215  ! AnglD R.A. Public Rotation angle in degree to turn rotated grid
216  ! back to standard grid. JGLi12Jun2012
217  ! FLAGUNR Log. Public True if rotating directions back to true north
218  ! STEXU Real Public Length-scale (X) for space-time extreme averaging
219  ! STEYU Real Public Length-scale (Y) for space-time extreme averaging
220  ! STEDU Real Public Time-scale for space-time extreme averaging
221  ! ZB R.A. Public Bottom levels on storage grid.
222  ! CLATS(I) R.A. Public (Inverse) cosine of latitude at sea points.
223  ! CTHG0S R.A. Public Constant in great-circle refr. term at sea points.
224  ! TRNX/Y R.A. Public Transparencies in X/Y for sub-grid
225  ! CTRNX/Y R.A. Public Sub-grid transparencies for SMC grid.
226  ! ANGARC R.A. Public Rotation angle in degree for Arctic cells.
227  ! SPCBAC R.A. Public Full 2-D spectra for Arctic boundary cells.
228  ! X/YGRD R.A. Public Spatial grid coordinate arrays.
229  ! SX/SYGRD R.A. Public Spatial grid increment arrays.
230  ! GINIT Log. Public Flag identifying grid initialization.
231  ! FLDRY Log. Public Flag for 'dry' run (IO and data
232  ! processing only).
233  ! FLCx Log. Public Flags for prop. is different spaces.
234  ! FLSOU Log. Public Flag for source term calculation.
235  ! FUNO3 Log. Public Flag for 3rd order UNO3 scheme on SMC grid.
236  ! FVERG Log. Public Flag for 1-2-1 averaging smoothing on SMC grid.
237  ! FSWND Log. Public Flag for sea-point only wind input on SMC grid.
238  ! ARCTC Log. Public Flag to include Arctic polar part on SMC grid.
239  ! FLAGST L.A. Public Flag for source term computations
240  ! for individual grid points.
241  ! IICEDISP Log. Public Flag for use of the ice covered dispertion relation.
242  ! IICESMOOTH Log. Public Flag to smooth the ice covered dispertion relation in broken ice.
243  !
244  !
245  ! GNAME C*30 Public Grid name.
246  ! FILEXT C*13 Public Extension of WAVEWATCH III file names
247  ! default in 'ww3'.
248  ! BTBETA Real Public The constant used for separating wind sea
249  ! and swell when we estimate WBT
250  ! ----------------------------------------------------------------
251  !
252  ! All elements of SGRD are aliased to pointers with the same
253  ! name. These pointers are defined as :
254  !
255  ! Name Type Scope Description
256  ! ----------------------------------------------------------------
257  ! NK Int. Public Number of discrete wavenumbers.
258  ! NK2 Int. Public Extended wavenumber range.
259  ! NTH Int. Public Number of discrete directions.
260  ! NSPEC Int. Public Number of discrete spectral bins.
261  ! MAPxx I.A. Public Spectral maps.
262  ! DTH Real Public Directional increments (radians).
263  ! XFR Real Public Frequency multiplication factor.
264  ! FR1 Real Public Lowest frequency (Hz)
265  ! FTE Real Public Factor in tail integration energy.
266  ! FTF Real Public Id. frequency.
267  ! FTWN Real Public Id. wavenumber.
268  ! FTTR Real Public Id. wave period.
269  ! FTWL Real Public Id. wave length.
270  ! FACTIn Real Public Factors for obtaining integer cut-off
271  ! frequency.
272  ! FACHFx Real Public Factor for tail.
273  ! TH R.A Public Directions (radians).
274  ! ESIN R.A Public Sine of discrete directions.
275  ! ECOS R.A Public Cosine of discrete directions.
276  ! ES2, ESC, EC2
277  ! R.A Public Sine and cosine products
278  ! SIG R.A Public Relative frequencies (invariant
279  ! in grid). (rad)
280  ! SIG2 R.A Public Id. for full 2-D spectrum.
281  ! DSIP R.A Public Frequency bandwidths (prop.) (rad)
282  ! DSII R.A Public Frequency bandwidths (int.) (rad)
283  ! DDEN R.A Public DSII * DTH * SIG (for integration
284  ! based on energy)
285  ! DDEN2 R.A Public Idem, full spectrum.
286  ! SINIT Log. Public Flag identifying grid initialization.
287  ! ----------------------------------------------------------------
288  !
289  ! The structure MPAR contains all other model parameters for
290  ! numerical methods and physical parameterizations. It contains
291  ! itself several structures as outlined below.
292  !
293  ! Name Type Scope Description
294  ! ----------------------------------------------------------------
295  ! PINIT Log. Public Flag identifying initialization.
296  ! NPARS NPAR Public Numerical parameters,
297  ! PROPS PROP Public Parameters propagatrion schemes.
298  ! SFLPS SFLP Public Parameters for flux computation.
299  ! SLNPS SLNP Public Parameters Sln.
300  ! SRCPS SRCP Public Parameters Sin and Sds.
301  ! SNLPS SNLP Public Parameters Snl.
302  ! SBTPS SBTP Public Parameters Sbt.
303  ! SDBPS SDBP Public Parameters Sdb.
304  ! STRPS STRP Public Parameters Str.
305  ! SBSPS SBSP Public Parameters Sbs.
306  ! ----------------------------------------------------------------
307  !
308  ! The structure NPAR contains numerical parameters and is aliased
309  ! as above:
310  !
311  ! Name Type Scope Description
312  ! ----------------------------------------------------------------
313  ! FACP Real Public Constant in maximum par. change in
314  ! dynamic integration scheme (depends
315  ! upon Xp).
316  ! XREL Real Public Id. relative change.
317  ! XFLT Real Public Id. filter level.
318  ! FXFM Real Public Constant for mean frequency in
319  ! cut-off. (!/ST1)
320  ! FXPM Real Public Id. PM.
321  ! XFT Real Public Constant for cut-off freq. (!/ST2)
322  ! XFC Real Public Id.
323  ! FACSD Real Public Constant in seeding algorithm.
324  ! FHMAX Real Public Hs/depth ratio in limiter (!/MLIM)
325  ! RWINDC Real Public Coefficient for current in relative
326  ! wind (!/RWND)
327  ! WWCOR R.A. Public Wind correction factors (!/WCOR)
328  ! ----------------------------------------------------------------
329  !
330  ! The structure PROP contains parameters for the propagation
331  ! schemes and is aliased as above:
332  !
333  ! Name Type Scope Description
334  ! ----------------------------------------------------------------
335  ! DTME Real Public Swell age in disp. corr. (!/PR2)
336  ! CLATMN Real Public Id. minimum cosine of lat. (!/PR2)
337  ! DTMS Real Public Swell age in disp. corr. (!/SMC)
338  !
339  ! WDCG Real Public Factors in width of av. Cg. (!/PR3)
340  ! WDTH Real Public Factors in width of av. Th. (!/PR3)
341  ! ----------------------------------------------------------------
342  !
343  ! The structure SFLP contains parameters for the fluxes
344  ! and is aliased as above:
345  ! ----------------------------------------------------------------
346  ! (!/FLX2)
347  ! NITTIN Int. Public Number of itterations for drag calc.
348  ! CINXSI Real Public Constant in parametric description
349  ! (!/FLX3)
350  ! NITTIN Int. Public Number of itterations for drag calc.
351  ! CAP_ID Int Public Type of cap used.
352  ! CINXSI Real Public Constant in parametric description
353  ! CD_MAX Real Public Cap on Cd.
354  ! (!/FLX4)
355  ! FLX4A0 Real Public Scaling value in parametric description
356  ! ----------------------------------------------------------------
357  !
358  ! The structure SLNP contains parameters for the linear input
359  ! source terms and is aliased as above:
360  !
361  ! ----------------------------------------------------------------
362  ! (!/LN1)
363  ! SLNC1 Real Public Proportionality and other constants in
364  ! input source term.
365  ! FSPM Real Public Factor for fPM in filter.
366  ! FSHF Real Public Factor for fh in filter.
367  ! ----------------------------------------------------------------
368  !
369  ! The structure SRCP contains parameters for the input and dis,
370  ! source terms and is aliased as above:
371  !
372  ! Name Type Scope Description
373  ! ----------------------------------------------------------------
374  ! WWNMEANPTAIL R Public Power of tail for WNMEAN calculation
375  ! SSTXFTFTAIL R Public Tail factor for WNMEAN calculation
376  ! (!/ST1)
377  ! SINC1 Real Public Proportionality and other constants in
378  ! input source term.
379  ! SDSC1 Real Public Combined constant in dissipation
380  ! source term.
381  ! (!/ST2)
382  ! ZWIND Real Public Height at which the wind is defined
383  ! of drag.
384  ! FSWELL Real Public Reduction factor of negative input
385  ! for swell.
386  ! SHSTAB, OFSTAB, CCNG, CCPS, FFNG, FFPS
387  ! Real Public Factors in effective wind speed.
388  ! CDSAn Real Public Constants in high-freq. dis.
389  ! SDSALN Real Public Factor for nondimensional 1-D spectrum.
390  ! CDSBn Real Public Constants in parameterization of PHI.
391  ! XFH Real Public Constant for turbulent length scale.
392  ! XFn Real Public Constants in combining low and high
393  ! frequency dissipation.
394  ! (!/ST3)
395  ! ZZWND Real Public Height at which the wind is defined
396  ! AALPHA Real Public Minimum value of charnock parameter
397  ! BBETA Real Public Wind-wave coupling coefficient
398  ! ZZALP Real Public Wave age tuning coefficient in Sin
399  ! TTAUWSHELTER Real Public Sheltering coefficient for short waves
400  ! ZZ0MAX Real Public Maximum value of air-side roughness
401  ! ZZ0RAT Real Public ratio of roughness for mean and
402  ! oscillatory flows
403  ! SSINTHP Real Public Power in cosine of wind input
404  ! SSWELLF R.A. Public Swell damping coefficients
405  ! SSDSCn Real Public Dissipation parameters
406  ! SSDSBR Real Public Threshold in saturation spectrum for Sds
407  ! SSDSP Real Public Power of B(k) in Sds
408  ! WWNMEANP Real Public Power that defines the mean wavenumber
409  ! in Sds
410  ! SSTXFTF, SSTXFTWN Real Public Tail constants
411  ! SSDSC4, Real Public Threshold shift in saturation diss.
412  ! SSDSC5, Real Public Wave-turbulence dissipation factor
413  ! SSDSC6, Real Public dissipation parameter
414  ! DDELTA1 Real Public Low-frequency dissipation coefficient
415  ! in WAM4
416  ! DDELTA2 Real Public High-frequency dissipation coefficient
417  ! in WAM4
418  ! SSDSDTH Real Public Maximum angular sector for saturation
419  ! spectrum
420  ! SSDSCOS Real Public Power of cosine in saturation integral
421  ! SSDSISO Int. Public Choice of definition of the isotropic
422  ! saturation
423  ! ----------------------------------------------------------------
424  !
425  ! The structure SNLP contains parameters for the nonl. inter.
426  ! source term and is aliased as above:
427  !
428  ! Name Type Scope Description
429  ! ----------------------------------------------------------------
430  ! (!/NL1)
431  ! SNLC1 Real Public Scaled proportionality constant.
432  ! LAM Real Public Factor defining quadruplet.
433  ! KDCON Real Public Conversion factor for relative depth.
434  ! KDMN Real Public Minimum relative depth.
435  ! SNLSn Real Public Constants in shallow water factor.
436  ! IQTPE Int. Public Type of depth treatment
437  ! -2 : Deep water GQM with scaling
438  ! 1 : Deep water DIA
439  ! 2 : Deep water DIA with scaling
440  ! 3 : Finite water depth DIA
441  ! GQNF1 Int. Public Gaussian quadrature resolution
442  ! GQNT1 Int. Public Gaussian quadrature resolution
443  ! GQNNQ_OM2 Int. Public Gaussian quadrature resolution
444  ! GQTHRSAT Real Public Threshold on saturation for SNL calculation
445  ! GQTHRCOU Real Public Threshold for filter on coupling coefficient
446  ! GQAMP R.A. Public Amplification factors
447  ! (!/NL2)
448  ! IQTPE Int. Public Type of depth treatment
449  ! 1 : Deep water
450  ! 2 : Deep water / WAM scaling
451  ! 3 : Finite water depth
452  ! NDPTHS Int. Public Number of depth for which integration
453  ! space needs to be computed.
454  ! NLTAIL Real Public Tail factor for parametric tail.
455  ! DPTHNL R.A. Public Depths corresponding to NDPTHS.
456  ! *** NOTE: This array is not allocated
457  ! in the W3DIMP routine ***
458  ! (!/NL3)
459  ! NFR Int. Public Number of frequencies or wavenumbers
460  ! in discrete spectral space (NFR=>NK).
461  ! NFRMIN Int. Public Minimum discrete frequency in the
462  ! expanded frequency space.
463  ! NFRMAX Int. Public Idem maximum for first part.
464  ! NFRCUT Int. Public Idem maximum for second part.
465  ! NTHMAX Int. Public Extension of directional space.
466  ! NTHEXP Int Public Number of bins in extended dir. space.
467  ! NSPMIN, NSPMAX, NSPMX2
468  ! Int. Public 1D spectral space range.
469  ! FRQ R.A. Public Expanded frequency range (Hz).
470  ! XSI R.A. Public Expanded frequency range (rad/s).
471  ! NQA Int. Public Number of actual quadruplets.
472  ! QST1 I.A. Public Spectral offsets for compuation of
473  ! quadruplet spectral desnities.
474  ! QST2 R.A. Public Idem weights.
475  ! QST3 R.A. Public Proportionality constants and k factors
476  ! in diagonal strength.
477  ! QST4 I.A. Public Spectral offsets for combining of
478  ! interactions and diagonal.
479  ! QST5 R.A. Public Idem weights for interactions.
480  ! QST6 R.A. Public Idem weights for diagonal.
481  ! SNLNQ Int. Public Number of quadruplet definitions.
482  ! SNLMSC Real Public Tuning power 'deep' scaling.
483  ! SNLNSC Real Public Tuning power 'shallow' scaling.
484  ! SNLSFD Real Public 'Deep' nondimensional filer freq.
485  ! SNLSFS Real Public 'Shallow' nondimensional filer freq.
486  ! SNLL R.A. Public Array with lambda for quadruplet.
487  ! SNLM R.A. Public Array with mu for quadruplet.
488  ! SNLT R.A. Public Array with Dtheta for quadruplet.
489  ! SNLCD R.A. Public Array with Cd for quadruplet.
490  ! SNLCS R.A. Public Array with Cs for quadruplet.
491  ! (!/NL4)
492  ! ITSA Int. Public Integer indicating TSA (1) or FBI (0)
493  ! IALT Int. Public Integer determining alternating looping
494  ! (!/NL5)
495  ! QR5DPT Real Public Water depth for the GKE module
496  ! QR5OML Real Public λ cut off value for quasi-resonant quartets
497  ! QI5DIS Int. Public Method to discretize continuous spectrum
498  ! QI5KEV Int. Public GKE (GS13 or J03)
499  ! QI5NNZ Int. Public # of interactive quadruplets
500  ! QI5IPL Int. Public Interp. method to get Câ‚„
501  ! QI5PMX Int. Public Phase mixing related parameter
502  ! (!/NLS)
503  ! NTHX Int. Public Expanded discrete direction range.
504  ! NFRX Int. Public Expanded discrete frequency range.
505  ! NSPL-H Int. Public Range of 1D spectrum.
506  ! SNSST R.A. Public Array with interpolation weights.
507  ! CNLSA Real Public a34 in quadruplet definition.
508  ! CNLSC Real Public C in Snl definition.
509  ! CNLSFM Real Public Maximum relative spectral change.
510  ! CNLSC1/3 Real Public Constant in frequency filter.
511  ! ----------------------------------------------------------------
512  !
513  ! The structure SBTP contains parameters for the bottom friction
514  ! source term and is aliased as above:
515  !
516  ! Name Type Scope Description
517  ! ----------------------------------------------------------------
518  ! SBTC1 Real Public Proportionality constant. (!/BT1)
519  ! SBTCX R.A. Public Parameters for bottom fric. (!/BT4)
520  ! ----------------------------------------------------------------
521  !
522  ! The structure SDBP contains parameters for the depth incduced
523  ! breaking source term and is aliased as above:
524  !
525  ! Name Type Scope Description
526  ! ----------------------------------------------------------------
527  ! SDBC1 Real Public Proportionality constant. (!/DB1)
528  ! SDBC2 Real Public Hmax/d ratio. (!/DB1)
529  ! FDONLY Log. Public Flag for checking depth only (!/DB1)
530  ! otherwise Miche criterion.
531  ! ----------------------------------------------------------------
532  !
533  ! The structure STRP contains parameters for the triad interaction
534  ! source term and is aliased as above:
535  !
536  ! Name Type Scope Description
537  ! ----------------------------------------------------------------
538  ! ----------------------------------------------------------------
539  !
540  ! The structure SBSP contains parameters for the bottom scattering
541  ! source term and is aliased as above:
542  !
543  ! Name Type Scope Description
544  ! ----------------------------------------------------------------
545  ! ----------------------------------------------------------------
546  !
547  ! The structure SICP contains parameters for arbitrary source
548  ! term and is aliased as above:
549  !
550  ! Name Type Scope Description
551  ! ----------------------------------------------------------------
552  ! IS1C1 Real Public Scale factor for icecon. (!/ISx)
553  ! IS1C2 Real Public Offset for ice concentration (!/ISx)
554  ! ----------------------------------------------------------------
555  !
556  ! 3. Subroutines and functions :
557  !
558  ! Name Type Scope Description
559  ! ----------------------------------------------------------------
560  ! W3NMOD Subr. Public Set number of grids.
561  ! W3DIMX Subr. Public Set dimensions of spatial grid.
562  ! W3DIMS Subr. Public Set dimensions of spectral grid.
563  ! W3SETG Subr. Public Point to selected grid / model.
564  ! W3GNTX Subr. Public Construct grid arrays
565  ! ----------------------------------------------------------------
566  !
567  ! 4. Subroutines and functions used :
568  !
569  ! Name Type Module Description
570  ! ----------------------------------------------------------------
571  ! STRACE Subr. W3SERVMD Subroutine tracing.
572  ! EXTCDE Subr. W3SERVMD Abort program with exit code.
573  ! ----------------------------------------------------------------
574  !
575  ! 5. Remarks :
576  !
577  ! - In model versions before 3.06 the parameters in the grid
578  ! structure were stored in the module W3IOGR.
579  ! - No subroutine DIMP is provided, instead, arrays are set
580  ! one-by-one in W3IOGR.
581  !
582  ! 6. Switches :
583  !
584  ! See subroutine documentation.
585  !
586  ! !/PRn Select propagation scheme
587  ! !/SMC UNO2 propagation on SMC grid.
588  !
589  ! !/LNn Select source terms
590  ! !/STn
591  ! !/NLn
592  ! !/BTn
593  ! !/DBn
594  ! !/TRn
595  ! !/BSn
596  ! !/XXn
597  !
598  ! !/S Enable subroutine tracing.
599  !
600  ! 7. Source code :
601  !
602  !/ ------------------------------------------------------------------- /
603  !/
604  !/ Required modules
605  !/
606  USE w3gsrumd
607  !/
608  !/ Specify default accessibility
609  !/
610  PUBLIC
611  !/
612  !/ Module private variable for checking error returns
613  !/
614  INTEGER, PRIVATE :: ISTAT
615  !/
616  !/ Conventional declarations
617  !/
618  INTEGER :: ngrids = -1, igrid = -1, isgrd = -1, &
619  ipars = -1, nauxgr
620  !
621 #ifdef W3_IC4
622  INTEGER, PARAMETER :: nic4=16 , nic42=5
623 #endif
624  INTEGER, PARAMETER :: rlgtype = 1
625  INTEGER, PARAMETER :: clgtype = 2
626  INTEGER, PARAMETER :: ungtype = 3
627  INTEGER, PARAMETER :: smctype = 4
628 
629  INTEGER, PARAMETER :: iclose_none = iclo_none
630  INTEGER, PARAMETER :: iclose_smpl = iclo_smpl
631  INTEGER, PARAMETER :: iclose_trpl = iclo_trpl
632  !
633  ! Dimensions of tables for pre-computing of dissipation
634  !
635 #ifdef W3_ST4
636  INTEGER, PARAMETER :: nkhs=2000, nkd=1300
637  INTEGER, PARAMETER :: ndtab=2000
638 #endif
639  !/
640  !/ Data structures
641  !/
642  !/ Grid type
643  TYPE grid ! this is the geographical grid with all associated parameters
644  INTEGER :: gtype
645  INTEGER :: rstype = -1
646  INTEGER :: iclose
647  INTEGER :: nx, ny, nsea, nseal, trflag
648 #ifdef W3_SEC1
649  INTEGER :: nitersec1
650 #endif
651  INTEGER, POINTER :: mapsta(:,:), mapst2(:,:), &
652  mapfs(:,:), mapsf(:,:)
653  !
654 #ifdef W3_SMC
655  !!Li Cell and face arrays for SMC grid.
656  INTEGER :: ncel, nufc, nvfc, nrlv, mrfct
657  INTEGER :: nglo, narc, nbgl, nbac, nbsmc
658  INTEGER, POINTER :: nlvcel(:), nlvufc(:), nlvvfc(:)
659  INTEGER, POINTER :: ijkcel(:,:), ijkufc(:,:), ijkvfc(:,:)
660  INTEGER, POINTER :: ismcbp(:), iclbac(:)
661 
662  !/ Data duplicated for better performance
663  INTEGER, POINTER :: ijkcel3(:), ijkcel4(:), &
664  ijkvfc5(:), ijkvfc6(:), &
665  ijkufc5(:), ijkufc6(:)
666 #endif
667  !
668  REAL :: sx, sy, x0, y0, dtcfl, dtcfli, dtmax, &
669  dtmin, dmin, ctmax, fice0, ficen, ficel, &
670  pfmove, stexu, steyu, stedu, iicehmin, &
671  iicehinit, icescales(4), iicehfac, iicehdisp, &
672  iiceddisp, iicefdisp, btbeta, aaircmin, aairgb
673 
674  REAL(8) :: gridshift ! see notes in WMGHGH
675 
676 #ifdef W3_RTD
677  REAL :: polat, polon ! Rotated N-Pole lat/lon
678  REAL, POINTER :: angld(:) ! Angle in degree
679  LOGICAL :: flagunr
680 #endif
681 
682  REAL , POINTER :: zb(:) ! BOTTOM GRID, DEFINED ON ISEA
683  REAL , POINTER :: clats(:) ! COS(LAT), DEFINED ON SEA POINTS
684  REAL , POINTER :: clatis(:) ! INVERSE OF COS(LAT) DEFINED ON ISEA
685  REAL , POINTER :: cthg0s(:) ! TAN(Y)/R, DEFINED ON ISEA
686 
687  REAL , POINTER :: trnx(:,:), trny(:,:) ! TRANSPARENCY INFORMATION ON IX,IY
688 #ifdef W3_SMC
689  REAL, POINTER :: ctrnx(:), ctrny(:), clatf(:)
690 #endif
691  REAL , POINTER :: spcbac(:,:), angarc(:)
692  DOUBLE PRECISION, POINTER :: xgrd(:,:), ygrd(:,:) ! X AND Y DEFINED ON IX,IY
693  REAL , POINTER :: dxdp(:,:), dxdq(:,:) ! DX/DP & DX/DQ DEFINED ON IX,IY
694  REAL , POINTER :: dydp(:,:), dydq(:,:) ! DY/DP & DY/DQ DEFINED ON IX,IY
695  REAL , POINTER :: dpdx(:,:), dpdy(:,:) ! DP/DX & DP/DY DEFINED ON IX,IY
696  REAL , POINTER :: dqdx(:,:), dqdy(:,:) ! DQ/DX & DQ/DY DEFINED ON IX,IY
697  REAL , POINTER :: gsqrt(:,:) ! SQRT(G) DEFINED ON IX,IY
698  REAL , POINTER :: hpfac(:,:) ! H_P = SQRT(G_PP) DEFINED ON IX,IY
699  REAL , POINTER :: hqfac(:,:) ! H_Q = SQRT(G_QQ) DEFINED ON IX,IY
700 
701  LOGICAL :: ginit, fldry, flcx, flcy, flcth, flck, flsou, iicedisp,&
702  iicesmooth
703  LOGICAL :: flagll
704  LOGICAL :: cmprtrck
705  LOGICAL, POINTER :: flagst(:)
706  CHARACTER(LEN=30):: gname
707  CHARACTER(LEN=13):: filext
708  LOGICAL :: guginit
709 #ifdef W3_REF1
710  REAL, POINTER :: reflc(:,:) ! reflection coefficient
711  INTEGER, POINTER :: refld(:,:) ! reflection direction
712 #endif
713  INTEGER :: e3df(3,5), p2msf(3), us3df(3), usspf(2) ! freq. indices for 3D output
714  REAL :: ussp_wn(25) !Max set to 25 decay scales.
715  !
716  TYPE(t_gsu) :: gsu ! Grid search utility object
717  !
718  REAL :: ffacberg ! mutiplicative factor for iceberg mask
719 #ifdef W3_BT4
720  REAL, POINTER :: sed_d50(:), sed_psic(:)
721 #endif
722 #ifdef W3_REF1
723  LOGICAL, POINTER :: rref(:)
724  REAL, POINTER :: refpars(:)
725 #endif
726 #ifdef W3_IG1
727  REAL, POINTER :: igpars(:)
728 #endif
729 #ifdef W3_IC2
730  REAL, POINTER :: ic2pars(:)
731 #endif
732 #ifdef W3_IC3
733  REAL, POINTER :: ic3pars(:)
734 #endif
735 #ifdef W3_IC4
736  INTEGER, POINTER :: ic4pars(:)
737  REAL, POINTER :: ic4_ki(:)
738  REAL, POINTER :: ic4_fc(:)
739  REAL, POINTER :: ic4_cn(:)
740  REAL :: ic4_fmin, ic4_kibk
741 #endif
742 #ifdef W3_IC5
743  REAL, POINTER :: ic5pars(:)
744 #endif
745 #ifdef W3_IS2
746  REAL, POINTER :: is2pars(:)
747 #endif
748  !
749  ! unstructured data
750  !
751  INTEGER :: ntri
752  INTEGER, POINTER :: trigp(:,:)
753 #ifdef W3_PDLIB
754  INTEGER :: nbnd_map
755  INTEGER, POINTER :: index_map(:)
756  INTEGER, POINTER :: mapsta_loc(:)
757  INTEGER*1, POINTER :: iobpd_loc(:,:)
758  INTEGER*2, POINTER :: iobp_loc(:)
759  INTEGER*1, POINTER :: iobdp_loc(:)
760  INTEGER*1, POINTER :: iobpa_loc(:)
761 #endif
762 
763  REAL(8), POINTER :: len(:,:),si(:), ien(:,:)
764 
765  REAL :: maxx, maxy, dxymax
766  REAL, POINTER :: angle(:,:),angle0(:,:)
767  INTEGER :: countri,countot,nnz, nbedge
768  INTEGER, POINTER :: ccon(:), countcon(:), ie_cell(:), &
769  pos_cell(:), &
770  iaa(:), jaa(:), posi(:,:), index_cell(:), &
771  i_diag(:), ja_ie(:,:,:)
772  INTEGER*2, POINTER :: iobp(:)
773  INTEGER*1, POINTER :: iobpd(:,:), iobdp(:), iobpa(:)
774  INTEGER, POINTER :: edges(:,:), neigh(:,:)
775  REAL(8), POINTER :: tria(:)
776  REAL, POINTER :: crossdiff(:,:)
777 
778 #ifdef W3_UOST
779  CHARACTER(LEN=256) :: uostfilelocal, uostfileshadow
780  LOGICAL, ALLOCATABLE :: uost_lcl_obstructed(:,:), uost_shd_obstructed(:,:)
781  INTEGER*1, ALLOCATABLE :: uostlocalalpha(:,:,:,:), uostlocalbeta(:,:,:,:)
782  INTEGER*1, ALLOCATABLE :: uostshadowalpha(:,:,:,:), uostshadowbeta(:,:,:,:)
783  real*4, ALLOCATABLE :: uostcellsize(:,:,:)
784  REAL :: uostabmultfactor = 100
785  REAL :: uostcellsizefactor = 1000
786  REAL :: uostlocalfactor = 1
787  REAL :: uostshadowfactor = 1
788  LOGICAL :: uostenabled = .true.
789 #endif
790 
791  END TYPE grid
792  !
793  TYPE sgrd ! this is the spectral grid with all parameters that vary with freq. and direction
794  INTEGER :: nk=0, nk2=0, nth=0, nspec=0
795  INTEGER, POINTER :: mapwn(:), mapth(:)
796  REAL :: dth=0., xfr=0., fr1=0., fte=0., ftf=0., ftwn=0., fttr=0., &
797  ftwl=0., facti1=0., facti2=0., fachfa=0., fachfe=0.
798  REAL, POINTER :: th(:), esin(:), ecos(:), es2(:), &
799  esc(:), ec2(:), sig(:), sig2(:), &
800  dsip(:), dsii(:), dden(:), dden2(:)
801  LOGICAL :: sinit=.false.
802  END TYPE sgrd
803  !
804  TYPE npar
805  REAL :: facp, xrel, xflt, fxfm, fxpm, &
806  xft, xfc, facsd, fhmax
807 #ifdef W3_RWND
808  REAL :: rwindc
809 #endif
810 #ifdef W3_WCOR
811  REAL :: wwcor(2)
812 #endif
813  END TYPE npar
814  !
815  TYPE prop
816 #ifdef W3_PR0
817  REAL :: dummy
818 #endif
819 #ifdef W3_PR1
820  REAL :: dummy
821 #endif
822 #ifdef W3_PR2
823  REAL :: dtme, clatmn
824 #endif
825 #ifdef W3_PR3
826  REAL :: wdcg, wdth
827 #endif
828 #ifdef W3_SMC
829  REAL :: dtms, refran
830  LOGICAL :: funo3, fverg, fswnd, arctc
831 #endif
832  END TYPE prop
833  !
834  TYPE fldp
835  REAL :: dummy
836 #ifdef W3_FLD1
837  INTEGER :: tail_id
838  REAL :: tail_lev, tail_tran1, tail_tran2
839 #endif
840 #ifdef W3_FLD2
841  INTEGER :: tail_id
842  REAL :: tail_lev, tail_tran1, tail_tran2
843 #endif
844  END TYPE fldp
845  TYPE sflp
846 #ifdef W3_FLX0
847  REAL :: dummy
848 #endif
849 #ifdef W3_FLX1
850  REAL :: dummy
851 #endif
852 #ifdef W3_FLX2
853  INTEGER :: nittin
854  REAL :: cinxsi
855 #endif
856 #ifdef W3_FLX3
857  INTEGER :: nittin, cap_id
858  REAL :: cinxsi, cd_max
859 #endif
860 #ifdef W3_FLX4
861  REAL :: flx4a0
862 #endif
863  END TYPE sflp
864  !
865  TYPE slnp
866 #ifdef W3_SEED
867  REAL :: dummy
868 #endif
869 #ifdef W3_LN0
870  REAL :: dummy
871 #endif
872 #ifdef W3_LN1
873  REAL :: slnc1, fspm, fshf
874 #endif
875  END TYPE slnp
876  !
877  TYPE srcp
878  REAL :: wwnmeanptail, sstxftftail
879 #ifdef W3_ST1
880  REAL :: sinc1, sdsc1
881 #endif
882 #ifdef W3_ST2
883  REAL :: zwind, fswell, shstab, &
884  ofstab, ccng, ccps, ffng, ffps, &
885  cdsa0, cdsa1, cdsa2, sdsaln, &
886  cdsb0, cdsb1, cdsb2, cdsb3, fpimin, &
887  xfh, xf1, xf2
888 #endif
889 #ifdef W3_ST3
890  INTEGER :: ssdsiso, ssdsbrfdf
891  REAL :: aalpha, bbeta, zz0max, zz0rat, zzalp,&
892  ssinthp, ttauwshelter, sswellf(1:6), &
893  ssdsc1, ssdsc2, ssdsc3, ssdsbr, &
894  ssdsp, wwnmeanp, sstxftf, sstxftwn, &
895  ffxpm, ffxfm, &
896  ssdsc4, ssdsc5, ssdsc6, ddelta1, &
897  ddelta2, zzwnd
898 #endif
899  !
900 #ifdef W3_ST4
901  INTEGER :: sswellfpar, ssdsiso, ssdsbrfdf
902  INTEGER, POINTER :: iktab(:,:), satindices(:,:)
903  REAL, POINTER :: dcki(:,:), satweights(:,:),cumulw(:,:),qbi(:,:)
904  REAL :: aalpha, bbeta, zz0max, zz0rat, zzalp,&
905  ssinthp, ttauwshelter, sswellf(1:7), &
906  ssdsc(1:21), ssdsbr, sintailpar(1:5),&
907  ssdsp, wwnmeanp, sstxftf, sstxftwn, &
908  ffxpm, ffxfm, ffxfa, &
909  ssdsbrf1, ssdsbrf2, ssdsbint,ssdsbck,&
910  ssdshck, ssdsabk, ssdspbk, ssinbr, &
911  capchnk(1:10)
912  REAL :: zzwnd
913  REAL :: ssdscos, ssdsdth, ssdsbt, ssdsbm(0:4)
914 #endif
915  !
916 #ifdef W3_ST6
917  REAL :: sin6a0, sds6a1, sds6a2, swl6b1, &
918  sin6ws, sin6fc
919  INTEGER :: sds6p1, sds6p2
920  LOGICAL :: sds6et, swl6s6, swl6cstb1
921 #endif
922  END TYPE srcp
923  !
924  TYPE snlp
925 #ifdef W3_NL0
926  REAL :: dummy
927 #endif
928 #ifdef W3_NL1
929  REAL :: snlc1, lam, kdcon, kdmn, &
930  snls1, snls2, snls3
931  INTEGER :: iqtpe, gqnf1, gqnt1, gqnq_om2
932  REAL :: nltail, gqthrsat, gqthrcou, gqamp(4)
933 #endif
934 #ifdef W3_NL2
935  INTEGER :: iqtpe, ndpths
936  REAL :: nltail
937  REAL, POINTER :: dpthnl(:)
938 #endif
939 #ifdef W3_NL3
940  INTEGER :: nfrmin, nfrmax, nfrcut, nthmax, &
941  nthexp, nspmin, nspmax, nspmx2, &
942  nqa, snlnq
943  INTEGER, POINTER :: qst1(:,:,:), qst4(:,:,:)
944  REAL :: snlmsc, snlnsc, snlsfd, snlsfs
945  REAL, POINTER :: frq(:), xsi(:), &
946  qst2(:,:,:), qst3(:,:,:), &
947  qst5(:,:,:), qst6(:,:,:), &
948  snll(:), snlm(:), snlt(:), &
949  snlcd(:), snlcs(:)
950 #endif
951 #ifdef W3_NL4
952  INTEGER :: itsa, ialt
953 #endif
954 #ifdef W3_NL5
955  REAL :: qr5dpt, qr5oml
956  INTEGER :: qi5dis, qi5kev, qi5ipl, qi5pmx
957  INTEGER(KIND=8) :: qi5nnz
958 #endif
959 #ifdef W3_NLS
960  INTEGER :: nthx, nfrx, nspl, nsph
961  REAL :: cnlsa, cnlsc, cnlsfm, &
962  cnlsc1, cnlsc2, cnlsc3
963  REAL, POINTER :: snsst(:,:)
964 #endif
965 
966  END TYPE snlp
967  !
968  TYPE sbtp
969 #ifdef W3_BT0
970  REAL :: dummy
971 #endif
972 #ifdef W3_BT1
973  REAL :: sbtc1
974 #endif
975 #ifdef W3_BT4
976  REAL :: sbtcx(10)
977 #endif
978 #ifdef W3_BT8
979  REAL :: dummy
980 #endif
981 #ifdef W3_BT9
982  REAL :: dummy
983 #endif
984  END TYPE sbtp
985  !
986  TYPE sdbp
987 #ifdef W3_DB0
988  REAL :: dummy
989 #endif
990 #ifdef W3_DB1
991  REAL :: sdbc1, sdbc2
992  LOGICAL :: fdonly
993  REAL :: sdbsc
994 #endif
995  END TYPE sdbp
996 
997 #ifdef W3_UOST
998  TYPE uostp
999  CHARACTER(LEN=256) :: uostfilelocal, uostfileshadow
1000  REAL :: uostfactorlocal, uostfactorshadow
1001  END TYPE uostp
1002 #endif
1003 
1004  !
1005  TYPE strp
1006 #ifdef W3_TR0
1007  REAL :: dummy
1008 #endif
1009 #ifdef W3_TR1
1010  REAL :: dummy
1011 #endif
1012  END TYPE strp
1013  !
1014  TYPE sbsp
1015 #ifdef W3_BS0
1016  REAL :: dummy
1017 #endif
1018 #ifdef W3_BS1
1019  REAL :: dummy
1020 #endif
1021  END TYPE sbsp
1022  !
1023  TYPE sicp
1024 #ifdef W3_IS0
1025  REAL :: dummy
1026 #endif
1027 #ifdef W3_IS1
1028  REAL :: is1c1, is1c2
1029 #endif
1030 #ifdef W3_IS2
1031  REAL :: is2c1, is2c2
1032 #endif
1033  END TYPE sicp
1034 
1035  ! specific type for unstructured scheme
1036  TYPE schm
1037  LOGICAL :: fsn = .false.
1038  LOGICAL :: fspsi = .false.
1039  LOGICAL :: fsfct = .false.
1040  LOGICAL :: fsnimp = .false.
1041  LOGICAL :: fstotalimp = .false.
1042  LOGICAL :: fstotalexp = .false.
1043  LOGICAL :: fsrefraction = .false.
1044  LOGICAL :: fsfreqshift = .false.
1045  LOGICAL :: fssource = .false.
1046  LOGICAL :: fsbccfl = .false.
1047  LOGICAL :: do_change_wlv
1048  REAL(8) :: solverthr_stp
1049  REAL(8) :: crit_dep_stp
1050  LOGICAL :: b_jgs_terminate_maxiter
1051  LOGICAL :: b_jgs_terminate_difference
1052  LOGICAL :: b_jgs_terminate_norm
1053  LOGICAL :: b_jgs_limiter
1054  LOGICAL :: b_jgs_use_jacobi
1055  LOGICAL :: b_jgs_block_gauss_seidel
1056  INTEGER :: b_jgs_maxiter
1057  INTEGER :: b_jgs_limiter_func
1058  real*8 :: b_jgs_pmin
1059  real*8 :: b_jgs_diff_thr
1060  real*8 :: b_jgs_norm_thr
1061  INTEGER :: b_jgs_nlevel
1062  LOGICAL :: b_jgs_source_nonlinear
1063  END TYPE schm
1064  !
1065  !
1066  TYPE mpar
1067  LOGICAL :: pinit
1068  TYPE(npar) :: npars
1069  TYPE(prop) :: props
1070  TYPE(fldp) :: fldps
1071  TYPE(sflp) :: sflps
1072  TYPE(slnp) :: slnps
1073  TYPE(srcp) :: srcps
1074  TYPE(snlp) :: snlps
1075  TYPE(sbtp) :: sbtps
1076  TYPE(sdbp) :: sdbps
1077 #ifdef W3_UOST
1078  TYPE(uostp) :: uostps
1079 #endif
1080  TYPE(strp) :: strps
1081  TYPE(sbsp) :: sbsps
1082  TYPE(sicp) :: sicps
1083  TYPE(schm) :: schms
1084  END TYPE mpar
1085  !/
1086  !/ Data storage
1087  !/
1088  TYPE(grid), TARGET, ALLOCATABLE :: grids(:)
1089  TYPE(sgrd), TARGET, ALLOCATABLE :: sgrds(:)
1090  TYPE(mpar), TARGET, ALLOCATABLE :: mpars(:)
1091  !/
1092  !/ Data aliases for structure GRID(S)
1093  !/
1094  INTEGER, POINTER :: gtype
1095  INTEGER, POINTER :: rstype
1096  INTEGER, POINTER :: iclose
1097  INTEGER, POINTER :: nx, ny, nsea, nseal, trflag
1098  INTEGER, POINTER :: e3df(:,:), p2msf(:), us3df(:), usspf(:)
1099  REAL, POINTER :: ussp_wn(:)
1100 #ifdef W3_REF1
1101  REAL, POINTER :: reflc(:,:)
1102  INTEGER, POINTER :: refld(:,:)
1103 #endif
1104  INTEGER, POINTER :: nbedge
1105  INTEGER, POINTER :: edges(:,:), neigh(:,:)
1106  !
1107  ! Variables for unstructured grids
1108  !
1109  INTEGER, POINTER :: ntri,countri,countot,nnz
1110  INTEGER :: optioncall = 3 ! take care all other options are basically wrong
1111  INTEGER, POINTER :: trigp(:,:)
1112 #ifdef W3_PDLIB
1113  INTEGER, POINTER :: nbnd_map
1114  INTEGER, POINTER :: index_map(:)
1115  INTEGER, POINTER :: mapsta_loc(:)
1116  INTEGER*1, POINTER :: iobpd_loc(:,:)
1117  INTEGER*2, POINTER :: iobp_loc(:)
1118  INTEGER*1, POINTER :: iobdp_loc(:)
1119  INTEGER*1, POINTER :: iobpa_loc(:)
1120 #endif
1121 
1122  REAL(8), POINTER :: ien(:,:), len(:,:), si(:)
1123  REAL, POINTER :: angle(:,:),angle0(:,:)
1124  INTEGER, POINTER :: ccon(:), countcon(:), ie_cell(:), &
1125  pos_cell(:), &
1126  iaa(:), jaa(:), posi(:,:), &
1127  i_diag(:), ja_ie(:,:,:), &
1128  index_cell(:)
1129  INTEGER*2, POINTER :: iobp(:)
1130  INTEGER*1, POINTER :: iobpd(:,:), iobdp(:), iobpa(:)
1131  REAL(8), POINTER :: tria(:)
1132  REAL, POINTER :: crossdiff(:,:)
1133  REAL,POINTER :: maxx, maxy, dxymax
1134  LOGICAL, POINTER :: guginit
1135  !
1136  REAL, POINTER :: ffacberg
1137 #ifdef W3_REF1
1138  LOGICAL, POINTER :: rref(:)
1139  REAL, POINTER :: refpars(:)
1140 #endif
1141 #ifdef W3_IG1
1142  REAL, POINTER :: igpars(:)
1143 #endif
1144 #ifdef W3_IC2
1145  REAL, POINTER :: ic2pars(:)
1146 #endif
1147 #ifdef W3_IC3
1148  REAL, POINTER :: ic3pars(:)
1149 #endif
1150 #ifdef W3_IC4
1151  INTEGER, POINTER :: ic4pars(:)
1152  REAL, POINTER :: ic4_ki(:)
1153  REAL, POINTER :: ic4_fc(:)
1154  REAL, POINTER :: ic4_cn(:)
1155  REAL, POINTER :: ic4_fmin, ic4_kibk
1156 #endif
1157 #ifdef W3_IC5
1158  REAL, POINTER :: ic5pars(:)
1159 #endif
1160 #ifdef W3_IS2
1161  REAL, POINTER :: is2pars(:)
1162 #endif
1163  INTEGER, POINTER :: mapsta(:,:), mapst2(:,:), &
1164  mapfs(:,:), mapsf(:,:)
1165  !
1166 #ifdef W3_SMC
1167  INTEGER, POINTER :: ncel, nufc, nvfc, nrlv, mrfct
1168  INTEGER, POINTER :: nglo, narc, nbgl, nbac, nbsmc
1169  INTEGER, POINTER :: nlvcel(:), nlvufc(:), nlvvfc(:)
1170  INTEGER, POINTER :: ijkcel(:,:), ijkufc(:,:), ijkvfc(:,:)
1171  INTEGER, POINTER :: ismcbp(:), iclbac(:)
1172 
1173  !/ Data duplicated for better performance
1174  INTEGER, POINTER :: ijkcel3(:), ijkcel4(:), &
1175  ijkvfc5(:), ijkvfc6(:), &
1176  ijkufc5(:), ijkufc6(:)
1177  !/
1178 #endif
1179  !
1180 #ifdef W3_SEC1
1181  INTEGER, POINTER :: nitersec1
1182 #endif
1183  REAL, POINTER :: sx, sy, x0, y0, dtcfl, dtcfli, dtmax, &
1184  dtmin, dmin, ctmax, fice0, ficen, &
1185  ficel, pfmove, stexu, steyu, stedu, &
1186  iicehmin, iicehinit, icescales(:), &
1187  iicehfac, iicehdisp, iiceddisp, iicefdisp, &
1188  btbeta, aaircmin, aairgb
1189  REAL(8),POINTER :: gridshift ! see notes in WMGHGH
1190 #ifdef W3_RTD
1191  REAL, POINTER :: polat, polon
1192  REAL, POINTER :: angld(:)
1193  LOGICAL, POINTER :: flagunr
1194 #endif
1195  REAL , POINTER :: zb(:)
1196  REAL , POINTER :: clats(:)
1197  REAL , POINTER :: clatis(:) ! INVERSE OF COS(LAT) DEFINED ON ISEA
1198  REAL , POINTER :: cthg0s(:) ! TAN(Y)/R, DEFINED ON ISEA
1199 
1200  REAL , POINTER :: trnx(:,:), trny(:,:) ! TRANSPARENCY INFORMATION ON IX,IY
1201 #ifdef W3_SMC
1202  REAL, POINTER :: ctrnx(:), ctrny(:), clatf(:)
1203 #endif
1204  REAL , POINTER :: spcbac(:,:), angarc(:)
1205  DOUBLE PRECISION, POINTER :: xgrd(:,:), ygrd(:,:) ! X AND Y DEFINED ON IX,IY
1206  REAL , POINTER :: dxdp(:,:), dxdq(:,:) ! DX/DP & DX/DQ DEFINED ON IX,IY
1207  REAL , POINTER :: dydp(:,:), dydq(:,:) ! DY/DP & DY/DQ DEFINED ON IX,IY
1208  REAL , POINTER :: dpdx(:,:), dpdy(:,:) ! DP/DX & DP/DY DEFINED ON IX,IY
1209  REAL , POINTER :: dqdx(:,:), dqdy(:,:) ! DQ/DX & DQ/DY DEFINED ON IX,IY
1210  REAL , POINTER :: gsqrt(:,:) ! SQRT(G) DEFINED ON IX,IY
1211  REAL , POINTER :: hpfac(:,:) ! H_P = SQRT(G_PP) DEFINED ON IX,IY
1212  REAL , POINTER :: hqfac(:,:) ! H_Q = SQRT(G_QQ) DEFINED ON IX,IY
1213 #ifdef W3_BT4
1214  REAL, POINTER :: sed_d50(:), sed_psic(:)
1215 #endif
1216 
1217  LOGICAL, POINTER :: ginit, fldry, flcx, flcy, flcth, flck, flsou, iicedisp,&
1218  iicesmooth
1219  LOGICAL, POINTER :: flagll
1220  LOGICAL, POINTER :: cmprtrck
1221  LOGICAL, POINTER :: flagst(:)
1222 
1223  CHARACTER(LEN=30), POINTER :: gname
1224  CHARACTER(LEN=13), POINTER :: filext
1225 
1226  TYPE(t_gsu), POINTER :: gsu ! Grid search utility object
1227  !/
1228  !/ Data aliasses for structure SGRD(S)
1229  !/
1230  INTEGER, POINTER :: nk, nk2, nth, nspec
1231  INTEGER, POINTER :: mapwn(:), mapth(:)
1232  REAL, POINTER :: dth, xfr, fr1, fte, ftf, ftwn, fttr, &
1233  ftwl, facti1, facti2, fachfa, fachfe
1234  REAL, POINTER :: th(:), esin(:), ecos(:), es2(:), &
1235  esc(:), ec2(:), sig(:), sig2(:), &
1236  dsip(:), dsii(:), dden(:), dden2(:)
1237  LOGICAL, POINTER :: sinit
1238  !/
1239  !/ Data aliasses for structure MPAR(S)
1240  !/
1241  LOGICAL, POINTER :: pinit
1242  !/
1243  !/ Data aliasses for structure NPAR(S)
1244  !/
1245  REAL, POINTER :: facp, xrel, xflt, fxfm, fxpm, &
1246  xft, xfc, facsd, fhmax
1247 #ifdef W3_RWND
1248  REAL, POINTER :: rwindc
1249 #endif
1250 #ifdef W3_WCOR
1251  REAL, POINTER :: wwcor(:)
1252 #endif
1253  !/
1254  !/ Data aliasses for structure PROP(S)
1255  !/
1256 #ifdef W3_PR2
1257  REAL, POINTER :: dtme, clatmn
1258 #endif
1259 #ifdef W3_PR3
1260  REAL, POINTER :: wdcg, wdth
1261 #endif
1262 #ifdef W3_SMC
1263  REAL, POINTER :: dtms, refran
1264  LOGICAL, POINTER :: funo3, fverg, fswnd, arctc
1265 #endif
1266  !/
1267  !/ Data aliasses for structure FLDP(S)
1268  !/
1269 #ifdef W3_FLD1
1270  INTEGER, POINTER :: tail_id
1271  REAL, POINTER :: tail_lev, tail_tran1, tail_tran2
1272 #endif
1273 #ifdef W3_FLD2
1274  INTEGER, POINTER :: tail_id
1275  REAL, POINTER :: tail_lev, tail_tran1, tail_tran2
1276 #endif
1277  !/
1278  !/ Data aliasses for structure SFLP(S)
1279  !/
1280 #ifdef W3_FLX2
1281  INTEGER, POINTER :: nittin
1282  REAL, POINTER :: cinxsi
1283 #endif
1284 #ifdef W3_FLX3
1285  INTEGER, POINTER :: nittin, cap_id
1286  REAL, POINTER :: cinxsi, cd_max
1287 #endif
1288 #ifdef W3_FLX4
1289  REAL, POINTER :: flx4a0
1290 #endif
1291  !/
1292  !/ Data aliasses for structure SLNP(S)
1293  !/
1294 #ifdef W3_LN1
1295  REAL, POINTER :: slnc1, fspm, fshf
1296 #endif
1297  !/
1298  !/ Data aliasses for structure SRCP(S)
1299  !/
1300 #ifdef W3_ST1
1301  REAL, POINTER :: sinc1, sdsc1
1302 #endif
1303 #ifdef W3_ST2
1304  REAL, POINTER :: zwind, fswell, shstab, &
1305  ofstab, ccng, ccps, ffng, ffps, &
1306  cdsa0, cdsa1, cdsa2, sdsaln, &
1307  cdsb0, cdsb1, cdsb2, cdsb3, fpimin, &
1308  xfh, xf1, xf2
1309 #endif
1310 #ifdef W3_ST3
1311  REAL, POINTER :: zzwnd, aalpha, bbeta, zz0max, zz0rat,&
1312  zzalp, ffxfm, ffxpm, &
1313  ssinthp, ttauwshelter, sswellf(:), &
1314  ssdsc1, ssdsc2, ssdsc3, ssdsbr, &
1315  ssdsp, wwnmeanp, sstxftf, sstxftwn, &
1316  ssdsc4, ssdsc5, ssdsc6, ssdsbt, &
1317  ddelta1, ddelta2, &
1318  ssdscos, ssdsdth, ssdsbm(:)
1319 #endif
1320 #ifdef W3_ST4
1321  INTEGER, POINTER :: sswellfpar, ssdsiso,ssdsbrfdf, &
1322  iktab(:,:), satindices(:,:),ssdsdik
1323  REAL, POINTER :: dcki(:,:), satweights(:,:),cumulw(:,:),qbi(:,:)
1324  REAL, POINTER :: zzwnd, aalpha, bbeta, zz0max, zz0rat,&
1325  zzalp, ffxfa, &
1326  ffxfm, ffxpm, ssdsbrf1, ssdsbrf2, &
1327  ssdsbint, ssdsbck, ssdshck, ssdsabk, &
1328  ssdspbk, ssinbr,ssinthp,ttauwshelter,&
1329  sintailpar(:), sswellf(:), ssdsc(:), ssdsbr, &
1330  ssdsp, wwnmeanp, sstxftf, sstxftwn, &
1331  ssdsbt, ssdscos, ssdsdth, ssdsbm(:), &
1332  capchnk(:)
1333 #endif
1334 #ifdef W3_ST6
1335  REAL, POINTER :: sin6a0, sds6a1, sds6a2, swl6b1, &
1336  sin6ws, sin6fc
1337  INTEGER, POINTER :: sds6p1, sds6p2
1338  LOGICAL, POINTER :: sds6et, swl6s6, swl6cstb1
1339 #endif
1340  REAL, POINTER :: wwnmeanptail, sstxftftail
1341  !/
1342  !/ Data aliasses for structure SNLP(S)
1343  !/
1344 #ifdef W3_NL1
1345  INTEGER, POINTER :: iqtpe, gqnf1, gqnt1, gqnq_om2
1346  REAL, POINTER :: nltail, gqthrsat, gqthrcou, gqamp(:)
1347  REAL, POINTER :: snlc1, lam, kdcon, kdmn, &
1348  snls1, snls2, snls3
1349 #endif
1350 #ifdef W3_NL2
1351  INTEGER, POINTER :: iqtpe, ndpths
1352  REAL, POINTER :: nltail
1353  REAL, POINTER :: dpthnl(:)
1354 #endif
1355 #ifdef W3_NL3
1356  INTEGER, POINTER :: nfrmin, nfrmax, nfrcut, nthmax, &
1357  nthexp, nspmin, nspmax, nspmx2, &
1358  nqa, snlnq
1359  INTEGER, POINTER :: qst1(:,:,:), qst4(:,:,:)
1360  REAL, POINTER :: snlmsc, snlnsc, snlsfd, snlsfs
1361  REAL, POINTER :: frq(:), xsi(:), &
1362  qst2(:,:,:), qst3(:,:,:), &
1363  qst5(:,:,:), qst6(:,:,:), &
1364  snll(:), snlm(:), snlt(:), &
1365  snlcd(:), snlcs(:)
1366 #endif
1367 #ifdef W3_NL4
1368  INTEGER, POINTER :: itsa, ialt
1369 #endif
1370 #ifdef W3_NL5
1371  REAL, POINTER :: qr5dpt, qr5oml
1372  INTEGER, POINTER :: qi5dis, qi5kev, qi5ipl, qi5pmx
1373  INTEGER(KIND=8), POINTER:: qi5nnz
1374 #endif
1375 #ifdef W3_NLS
1376  INTEGER, POINTER :: nthx, nfrx, nspl, nsph
1377  REAL, POINTER :: cnlsa, cnlsc, cnlsfm, &
1378  cnlsc1, cnlsc2, cnlsc3, snsst(:,:)
1379 #endif
1380  !/
1381  !/ Data aliasses for structure SBTP(S)
1382  !/
1383 #ifdef W3_BT1
1384  REAL, POINTER :: sbtc1
1385 #endif
1386 #ifdef W3_BT4
1387  REAL, POINTER :: sbtcx(:)
1388 #endif
1389  !/
1390  !/ Data aliasses for structure SDBP(S)
1391  !/
1392 #ifdef W3_DB1
1393  REAL, POINTER :: sdbc1, sdbc2
1394  LOGICAL, POINTER :: fdonly
1395  REAL, POINTER :: sdbsc
1396 #endif
1397  !/
1398 #ifdef W3_UOST
1399  !/ Data aliases for structure UOSTP(S)
1400  CHARACTER(LEN=:), POINTER :: uostfilelocal, uostfileshadow
1401  REAL, POINTER :: uostfactorlocal, uostfactorshadow
1402 #endif
1403  !/
1404  !/ Data aliasing for structure SCHM(S)
1405  LOGICAL, POINTER :: fsn,fspsi,fsfct,fsnimp,fstotalimp,fstotalexp
1406  LOGICAL, POINTER :: fsrefraction, fsfreqshift, fssource, fsbccfl
1407  LOGICAL, POINTER :: do_change_wlv
1408  REAL(8), POINTER :: solverthr_stp
1409  REAL(8), POINTER :: crit_dep_stp
1410  LOGICAL, POINTER :: b_jgs_terminate_maxiter
1411  LOGICAL, POINTER :: b_jgs_terminate_difference
1412  LOGICAL, POINTER :: b_jgs_terminate_norm
1413  LOGICAL, POINTER :: b_jgs_limiter
1414  LOGICAL, POINTER :: b_jgs_use_jacobi
1415  LOGICAL, POINTER :: b_jgs_block_gauss_seidel
1416  INTEGER, POINTER :: b_jgs_maxiter
1417  INTEGER, POINTER :: b_jgs_limiter_func
1418  REAL(8), POINTER :: b_jgs_pmin
1419  REAL(8), POINTER :: b_jgs_diff_thr
1420  REAL(8), POINTER :: b_jgs_norm_thr
1421  INTEGER, POINTER :: b_jgs_nlevel
1422  LOGICAL, POINTER :: b_jgs_source_nonlinear
1423  !/
1424  !/ Data aliasing for structure SICP(S)
1425 #ifdef W3_IS1
1426  REAL, POINTER :: is1c1, is1c2
1427 #endif
1428  !/
1429 
1430 CONTAINS
1431  !/ ------------------------------------------------------------------- /
1432  SUBROUTINE w3nmod ( NUMBER, NDSE, NDST, NAUX )
1433  !/
1434  !/ +-----------------------------------+
1435  !/ | WAVEWATCH III NOAA/NCEP |
1436  !/ | H. L. Tolman |
1437  !/ | FORTRAN 90 |
1438  !/ | Last update : 10-Dec-2014 !
1439  !/ +-----------------------------------+
1440  !/
1441  !/ 24-Feb-2004 : Origination. ( version 3.06 )
1442  !/ 18-Jul-2006 : Add input grids. ( version 3.10 )
1443  !/ 10-Dec-2014 : Add checks for allocate status ( version 5.04 )
1444  !/
1445  ! 1. Purpose :
1446  !
1447  ! Set up the number of grids to be used.
1448  !
1449  ! 2. Method :
1450  !
1451  ! Store in NGRIDS and allocate GRIDS.
1452  !
1453  ! 3. Parameters :
1454  !
1455  ! Parameter list
1456  ! ----------------------------------------------------------------
1457  ! NUMBER Int. I Number of grids to be used.
1458  ! NDSE Int. I Error output unit number.
1459  ! NDST Int. I Test output unit number.
1460  ! NAUX Int. I Number of auxiliary grids to be used.
1461  ! Grids -NAUX:NUBMER are defined, optional
1462  ! parameters.
1463  ! ----------------------------------------------------------------
1464  !
1465  ! 4. Subroutines used :
1466  !
1467  ! See module documentation.
1468  !
1469  ! 5. Called by :
1470  !
1471  ! Any program that uses this grid structure.
1472  !
1473  ! 6. Error messages :
1474  !
1475  ! - Error checks on previous setting of variable.
1476  !
1477  ! 7. Remarks :
1478  !
1479  ! 8. Structure :
1480  !
1481  ! 9. Switches :
1482  !
1483  ! !/S Enable subroutine tracing.
1484  !
1485  ! 10. Source code :
1486  !
1487  !/ ------------------------------------------------------------------- /
1488  USE w3servmd, ONLY: extcde
1489 #ifdef W3_S
1490  USE w3servmd, ONLY: strace
1491 #endif
1492  !
1493  IMPLICIT NONE
1494  !/
1495  !/ ------------------------------------------------------------------- /
1496  !/ Parameter list
1497  !/
1498  INTEGER, INTENT(IN) :: NUMBER, NDSE, NDST
1499  INTEGER, INTENT(IN), OPTIONAL :: NAUX
1500  !/
1501  !/ ------------------------------------------------------------------- /
1502  !/ Local parameters
1503  !/
1504  INTEGER :: I, NLOW
1505 #ifdef W3_S
1506  INTEGER, SAVE :: IENT = 0
1507  CALL strace (ient, 'W3NMOD')
1508 #endif
1509  !
1510  ! -------------------------------------------------------------------- /
1511  ! 1. Test input and module status
1512  !
1513  IF ( ngrids .NE. -1 ) THEN
1514  WRITE (ndse,1001) ngrids
1515  CALL extcde (1)
1516  END IF
1517  !
1518  IF ( number .LT. 1 ) THEN
1519  WRITE (ndse,1002) number
1520  CALL extcde (2)
1521  END IF
1522  !
1523  IF ( PRESENT(naux) ) THEN
1524  nlow = -naux
1525  ELSE
1526  nlow = 1
1527  END IF
1528  !
1529  IF ( nlow .GT. 1 ) THEN
1530  WRITE (ndse,1003) -nlow
1531  CALL extcde (3)
1532  END IF
1533  !
1534  ! -------------------------------------------------------------------- /
1535  ! 1. Set variable and allocate arrays
1536  !
1537  ngrids = number
1538  nauxgr = - nlow
1539  ALLOCATE ( grids(nlow:number), &
1540  sgrds(nlow:number), &
1541  mpars(nlow:number), &
1542  stat=istat )
1543  check_alloc_status( istat )
1544  !
1545  ! -------------------------------------------------------------------- /
1546  ! 2. Initialize GINIT and SINIT
1547  !
1548  DO i=nlow, number
1549  grids(i)%GINIT = .false.
1550  grids(i)%GUGINIT = .false.
1551  sgrds(i)%SINIT = .false.
1552  mpars(i)%PINIT = .false.
1553 #ifdef W3_NL2
1554  mpars(i)%SNLPS%NDPTHS = 0
1555 #endif
1556  END DO
1557 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3NMOD)
1558  WRITE (ndst,9000) nlow, ngrids
1559 #endif
1560  !
1561  RETURN
1562  !
1563  ! Formats
1564  !
1565 1001 FORMAT (/' *** ERROR W3NMOD : GRIDS ALREADY INITIALIZED *** '/ &
1566  ' NGRIDS = ',i10/)
1567 1002 FORMAT (/' *** ERROR W3NMOD : ILLEGAL NUMBER OF GRIDS *** '/ &
1568  ' NUMBER = ',i10/)
1569 1003 FORMAT (/' *** ERROR W3NMOD : ILLEGAL NUMBER OF AUX GRIDS *** '/&
1570  ' NUMBER = ',i10/)
1571 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3NMOD)
1572 9000 FORMAT (' TEST W3NMOD : SETTING UP FOR GRIDS ',i3, &
1573  ' THROUGH ',i3)
1574 #endif
1575  !/
1576  !/ End of W3NMOD ----------------------------------------------------- /
1577  !/
1578  END SUBROUTINE w3nmod
1579  !/ ------------------------------------------------------------------- /
1580  SUBROUTINE w3dimx ( IMOD, MX, MY, MSEA, NDSE, NDST &
1581 #ifdef W3_SMC
1582  , MCel, MUFc, MVFc, MRLv, MBSMC &
1583  , MARC, MBAC, MSPEC &
1584 #endif
1585  )
1586  !/
1587  !/ +-----------------------------------+
1588  !/ | WAVEWATCH III NOAA/NCEP |
1589  !/ | H. L. Tolman |
1590  !/ | FORTRAN 90 |
1591  !/ | Last update : 10-Dec-2014 |
1592  !/ +-----------------------------------+
1593  !/
1594  !/ 24-Jun-2005 : Origination. ( version 3.07 )
1595  !/ 18-Jul-2006 : Add input grids. ( version 3.10 )
1596  !/ 05-Oct-2006 : Add filter to array pointers. ( version 3.10 )
1597  !/ 02-Feb-2007 : Add FLAGST. ( version 3.10 )
1598  !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 )
1599  !/ (W. E. Rogers & T. J. Campbell, NRL)
1600  !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 )
1601  !/ (W. E. Rogers & T. J. Campbell, NRL)
1602  !/ 30-Oct-2009 : Implement unstructured grids ( version 3.14.1)
1603  !/ 03-Sep-2012 : Clean up of UG grids ( version 4.08 )
1604  !/ 10-Dec-2014 : Add checks for allocate status ( version 5.04 )
1605  !/
1606  ! 1. Purpose :
1607  !
1608  ! Initialize an individual spatial grid at the proper dimensions.
1609  !
1610  ! 2. Method :
1611  !
1612  ! Allocate directly into the structure array GRIDS. Note that
1613  ! this cannot be done through the pointer alias!
1614  !
1615  ! 3. Parameters :
1616  !
1617  ! Parameter list
1618  ! ----------------------------------------------------------------
1619  ! IMOD Int. I Model number to point to.
1620  ! NDSE Int. I Error output unit number.
1621  ! NDST Int. I Test output unit number.
1622  ! MX, MY, MSEA Like NX, NY, NSEA in data structure.
1623  ! ----------------------------------------------------------------
1624  !
1625  ! 4. Subroutines used :
1626  !
1627  ! See module documentation.
1628  !
1629  ! 5. Called by :
1630  !
1631  ! Name Type Module Description
1632  ! ----------------------------------------------------------------
1633  ! W3IOGR Subr. W3IOGRMD Model definition file IO program.
1634  ! WW3_GRID Prog. N/A Model set up program.
1635  ! ----------------------------------------------------------------
1636  !
1637  ! 6. Error messages :
1638  !
1639  ! - Check on input parameters.
1640  ! - Check on previous allocation.
1641  !
1642  ! 7. Remarks :
1643  !
1644  ! - Grid dimensions apre passed through parameter list and then
1645  ! locally stored to assure consistency between allocation and
1646  ! data in structure.
1647  ! - W3SETG needs to be called after allocation to point to
1648  ! proper allocated arrays.
1649  !
1650  ! 8. Structure :
1651  !
1652  ! See source code.
1653  !
1654  ! 9. Switches :
1655  !
1656  ! !/S Enable subroutine tracing.
1657  !
1658  ! 10. Source code :
1659  !
1660  !/ ------------------------------------------------------------------- /
1661  USE w3servmd, ONLY: extcde
1662 #ifdef W3_S
1663  USE w3servmd, ONLY: strace
1664 #endif
1665  !
1666  IMPLICIT NONE
1667  !
1668  !/
1669  !/ ------------------------------------------------------------------- /
1670  !/ Parameter list
1671  !/
1672  INTEGER, INTENT(IN) :: IMOD, MX, MY, MSEA, NDSE, NDST
1673 #ifdef W3_SMC
1674  INTEGER, INTENT(IN) :: MCel, MUFc, MVFc, MRLv, MBSMC
1675  INTEGER, INTENT(IN) :: MARC, MBAC, MSPEC
1676 #endif
1677  !/
1678  !/ ------------------------------------------------------------------- /
1679  !/ Local parameters
1680  !/
1681 #ifdef W3_SMC
1682  INTEGER :: IARC, IBAC, IBSMC
1683 #endif
1684 #ifdef W3_S
1685  INTEGER, SAVE :: IENT = 0
1686  CALL strace (ient, 'W3DIMX')
1687 #endif
1688  !
1689  ! -------------------------------------------------------------------- /
1690  ! 1. Test input and module status
1691  !
1692  IF ( ngrids .EQ. -1 ) THEN
1693  WRITE (ndse,1001)
1694  CALL extcde (1)
1695  END IF
1696  !
1697  IF ( imod.LT.-nauxgr .OR. imod.GT.ngrids ) THEN
1698  WRITE (ndse,1002) imod, -nauxgr, ngrids
1699  CALL extcde (2)
1700  END IF
1701  !
1702  IF ( mx.LT.3 .OR. (my.LT.3.AND.gtype.NE.ungtype) .OR. msea.LT.1 ) THEN
1703  WRITE (ndse,1003) mx, my, msea, gtype
1704  CALL extcde (3)
1705  END IF
1706  !
1707  IF ( grids(imod)%GINIT ) THEN
1708  WRITE (ndse,1004)
1709  CALL extcde (4)
1710  END IF
1711 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX)
1712  WRITE (ndst,9000) imod, mx, my, msea
1713 #endif
1714  !
1715  ! -------------------------------------------------------------------- /
1716  ! 2. Allocate arrays
1717  !
1718  ! NB: Some array start at 0 because MAPFS(IY,IX)=0 for missing points
1719  !
1720  IF (gtype .NE. ungtype) THEN
1721  ALLOCATE ( grids(imod)%ZB(msea), &
1722  grids(imod)%XGRD(my,mx), &
1723  grids(imod)%YGRD(my,mx), &
1724  stat=istat )
1725  check_alloc_status( istat )
1726  ENDIF
1727 
1728  ALLOCATE ( grids(imod)%MAPSTA(my,mx), &
1729  grids(imod)%MAPST2(my,mx), &
1730  grids(imod)%MAPFS(my,mx), &
1731  grids(imod)%MAPSF(msea,3), &
1732  grids(imod)%FLAGST(msea), &
1733 #ifdef W3_RTD
1734  grids(imod)%AnglD(msea), &
1735 #endif
1736  grids(imod)%CLATS(0:msea), &
1737  grids(imod)%CLATIS(0:msea), &
1738  grids(imod)%CTHG0S(0:msea), &
1739  grids(imod)%TRNX(my,mx), &
1740  grids(imod)%TRNY(my,mx), &
1741  grids(imod)%DXDP(my,mx), &
1742  grids(imod)%DXDQ(my,mx), &
1743  grids(imod)%DYDP(my,mx), &
1744  grids(imod)%DYDQ(my,mx), &
1745  grids(imod)%DPDX(my,mx), &
1746  grids(imod)%DPDY(my,mx), &
1747  grids(imod)%DQDX(my,mx), &
1748  grids(imod)%DQDY(my,mx), &
1749  grids(imod)%GSQRT(my,mx), &
1750  grids(imod)%HPFAC(my,mx), &
1751  grids(imod)%HQFAC(my,mx), &
1752  stat=istat )
1753  check_alloc_status( istat )
1754 #ifdef W3_BT4
1755  ALLOCATE ( grids(imod)%SED_D50(0:msea), &
1756  grids(imod)%SED_PSIC(0:msea),&
1757  stat=istat )
1758  check_alloc_status( istat )
1759 #endif
1760  !
1761 #ifdef W3_SMC
1762  ALLOCATE ( grids(imod)%NLvCel(0:mrlv), &
1763  grids(imod)%NLvUFc(0:mrlv), &
1764  grids(imod)%NLvVFc(0:mrlv), &
1765  grids(imod)%IJKCel(4, -9:mcel), &
1766  grids(imod)%IJKUFc(7,mufc), &
1767  grids(imod)%IJKVFc(7,mvfc), &
1768  grids(imod)%CTRNX(-9:mcel), &
1769  grids(imod)%CTRNY(-9:mcel), &
1770  grids(imod)%CLATF(mvfc), &
1771  stat=istat )
1772  check_alloc_status( istat )
1773 
1774  ALLOCATE ( grids(imod)%IJKCel3(-9:mcel), &
1775  grids(imod)%IJKCel4(-9:mcel), &
1776  grids(imod)%IJKVFc5(mvfc), &
1777  grids(imod)%IJKVFc6(mvfc), &
1778  grids(imod)%IJKUFc5(mufc), &
1779  grids(imod)%IJKUFc6(mufc), &
1780  stat=istat)
1781  !! Arctic part related variables, declare minimum 1 element.
1782  iarc = marc
1783  IF( marc .LE. 1 ) iarc = 1
1784  ibac = mbac
1785  IF( mbac .LE. 1 ) ibac = 1
1786  ibsmc = mbsmc
1787  IF( mbsmc .LE. 1 ) ibsmc = 1
1788  ALLOCATE ( grids(imod)%ICLBAC(ibac), &
1789  grids(imod)%ANGARC(iarc), &
1790  grids(imod)%SPCBAC(mspec,ibac), &
1791  grids(imod)%ISMCBP(ibsmc), &
1792  stat=istat )
1793  check_alloc_status( istat )
1794  !! All SMC grid related varialbes are initialised in case SMC
1795  !! switch is selected but SMCTYPE is not used. JGLi08Mar2021
1796  grids(imod)%NLvCel(:) = 0
1797  grids(imod)%NLvUFc(:) = 0
1798  grids(imod)%NLvVFc(:) = 0
1799  grids(imod)%ISMCBP(:) = 0
1800  grids(imod)%ICLBAC(:) = 0
1801  grids(imod)%IJKCel(:,:) = 0
1802  grids(imod)%IJKUFc(:,:) = 0
1803  grids(imod)%IJKVFc(:,:) = 0
1804  grids(imod)%CTRNX(:) = 0.0
1805  grids(imod)%CTRNY(:) = 0.0
1806  grids(imod)%CLATF(:) = 0.0
1807  grids(imod)%ANGARC(:) = 0.0
1808 #endif
1809  !
1810  grids(imod)%FLAGST = .true.
1811  grids(imod)%GINIT = .true.
1812  grids(imod)%MAPSF(:,3)=0.
1813  grids(imod)%CLATS(0)=1.
1814  grids(imod)%CLATIS(0)=1.
1815  grids(imod)%CTHG0S(0)=1.
1816  !
1817 #ifdef W3_REF1
1818  ALLOCATE ( grids(imod)%RREF(4), &
1819  grids(imod)%REFPARS(10), &
1820  stat=istat )
1821  check_alloc_status( istat )
1822  !
1823  grids(imod)%RREF(:)=.false.
1824  grids(imod)%REFPARS(:)=0.
1825  !
1826  ! Memory footprint can be reduced by defining REFLC and REFLD only over nodes
1827  ! where reflection can occur.
1828  ALLOCATE ( grids(imod)%REFLC(4,0:nsea), &
1829  grids(imod)%REFLD(6,0:nsea), &
1830  stat=istat )
1831  check_alloc_status( istat )
1832 #endif
1833 #ifdef W3_IG1
1834  ALLOCATE ( grids(imod)%IGPARS(12), stat=istat )
1835  check_alloc_status( istat )
1836 #endif
1837 #ifdef W3_IC2
1838  ALLOCATE ( grids(imod)%IC2PARS(9), stat=istat )
1839  check_alloc_status( istat )
1840 #endif
1841 #ifdef W3_IC3
1842  ALLOCATE ( grids(imod)%IC3PARS(16), stat=istat )
1843  check_alloc_status( istat )
1844 #endif
1845 
1846 #ifdef W3_IC4
1847  ALLOCATE ( grids(imod)%IC4PARS(1), stat=istat )
1848  check_alloc_status( istat )
1849  ALLOCATE ( grids(imod)%IC4_KI(nic4), stat=istat )
1850  check_alloc_status( istat )
1851  ALLOCATE ( grids(imod)%IC4_FC(nic4), stat=istat )
1852  check_alloc_status( istat )
1853  ALLOCATE ( grids(imod)%IC4_CN(nic42), stat=istat )
1854  check_alloc_status( istat )
1855 #endif
1856 #ifdef W3_IC5
1857  ALLOCATE ( grids(imod)%IC5PARS(9), stat=istat )
1858  check_alloc_status( istat )
1859 #endif
1860 #ifdef W3_IS2
1861  ALLOCATE ( grids(imod)%IS2PARS(24), stat=istat )
1862  check_alloc_status( istat )
1863 #endif
1864 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX)
1865  WRITE (ndst,9001)
1866 #endif
1867  !
1868 #ifdef W3_REF1
1869  grids(imod)%REFLC(1:4,0:nsea)=0.
1870  grids(imod)%REFLD(:,:)=0
1871 #endif
1872 #ifdef W3_IG1
1873  grids(imod)%IGPARS(:)=0.
1874 #endif
1875 #ifdef W3_IC2
1876  grids(imod)%IC2PARS(:)=0.
1877 #endif
1878 #ifdef W3_IS2
1879  grids(imod)%IS2PARS(:)=0.
1880 #endif
1881  !
1882  ! -------------------------------------------------------------------- /
1883  ! 2. Update counters in grid
1884  !
1885  grids(imod)%NX = mx
1886  grids(imod)%NY = my
1887  grids(imod)%NSEA = msea
1888 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX)
1889  WRITE (ndst,9002)
1890 #endif
1891  !
1892  ! -------------------------------------------------------------------- /
1893  ! 3. Point to allocated arrays
1894  !
1895  CALL w3setg ( imod, ndse, ndst )
1896 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX)
1897  WRITE (ndst,9003)
1898 #endif
1899  !
1900  RETURN
1901  !
1902  ! Formats
1903  !
1904 1001 FORMAT (/' *** ERROR W3DIMX : GRIDS NOT INITIALIZED *** '/ &
1905  ' RUN W3NMOD FIRST '/)
1906 1002 FORMAT (/' *** ERROR W3DIMX : ILLEGAL MODEL NUMBER *** '/ &
1907  ' IMOD = ',i10/ &
1908  ' NAUXGR = ',i10/ &
1909  ' NGRIDS = ',i10/)
1910 1003 FORMAT (/' *** ERROR W3DIMX : ILLEGAL GRID DIMENSION(S) *** '/ &
1911  ' INPUT = ',4i10 /)
1912 1004 FORMAT (/' *** ERROR W3DIMX : ARRAY(S) ALREADY ALLOCATED *** ')
1913 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX)
1914 9000 FORMAT (' TEST W3DIMX : MODEL ',i4,' DIM. AT ',2i5,i7)
1915 9001 FORMAT (' TEST W3DIMX : ARRAYS ALLOCATED')
1916 9002 FORMAT (' TEST W3DIMX : DIMENSIONS STORED')
1917 9003 FORMAT (' TEST W3DIMX : POINTERS RESET')
1918 #endif
1919  !/
1920  !/ End of W3DIMX ----------------------------------------------------- /
1921  !/
1922  END SUBROUTINE w3dimx
1923  !/ ------------------------------------------------------------------- /
1924  SUBROUTINE w3dims ( IMOD, MK, MTH, NDSE, NDST )
1925  !/
1926  !/ +-----------------------------------+
1927  !/ | WAVEWATCH III NOAA/NCEP |
1928  !/ | H. L. Tolman |
1929  !/ | FORTRAN 90 |
1930  !/ | Last update : 10-Dec-2014 !
1931  !/ +-----------------------------------+
1932  !/
1933  !/ 19-Feb-2004 : Origination. ( version 3.06 )
1934  !/ 18-Jul-2006 : Add input grids. ( version 3.10 )
1935  !/ 05-Oct-2006 : Add filter to array pointers. ( version 3.10 )
1936  !/ 10-Dec-2014 : Add checks for allocate status ( version 5.04 )
1937  !/
1938  ! 1. Purpose :
1939  !
1940  ! Initialize an individual spatial grid at the proper dimensions.
1941  !
1942  ! 2. Method :
1943  !
1944  ! Allocate directly into the structure array GRIDS. Note that
1945  ! this cannot be done through the pointer alias!
1946  !
1947  ! 3. Parameters :
1948  !
1949  ! Parameter list
1950  ! ----------------------------------------------------------------
1951  ! IMOD Int. I Model number to point to.
1952  ! NDSE Int. I Error output unit number.
1953  ! MK,MTH Int. I Spectral dimensions.
1954  ! NDST Int. I Test output unit number.
1955  ! ----------------------------------------------------------------
1956  !
1957  ! 4. Subroutines used :
1958  !
1959  ! See module documentation.
1960  !
1961  ! 5. Called by :
1962  !
1963  ! Name Type Module Description
1964  ! ----------------------------------------------------------------
1965  ! W3IOGR Subr. W3IOGRMD Model definition file IO program.
1966  ! WW3_GRID Prog. N/A Model set up program.
1967  ! ----------------------------------------------------------------
1968  !
1969  ! 6. Error messages :
1970  !
1971  ! - Check on input parameters.
1972  ! - Check on previous allocation.
1973  !
1974  ! 7. Remarks :
1975  !
1976  ! - Grid dimensions apre passed through parameter list and then
1977  ! locally stored to assure consistency between allocation and
1978  ! data in structure.
1979  ! - W3SETG needs to be called after allocation to point to
1980  ! proper allocated arrays.
1981  !
1982  ! 8. Structure :
1983  !
1984  ! See source code.
1985  !
1986  ! 9. Switches :
1987  !
1988  ! !/S Enable subroutine tracing.
1989  !
1990  ! 10. Source code :
1991  !
1992  !/ ------------------------------------------------------------------- /
1993  USE w3servmd, ONLY: extcde
1994 #ifdef W3_ST4
1995  USE constants, ONLY: rade
1996 #endif
1997 #ifdef W3_S
1998  USE w3servmd, ONLY: strace
1999 #endif
2000  !
2001  IMPLICIT NONE
2002  !
2003  !/
2004  !/ ------------------------------------------------------------------- /
2005  !/ Parameter list
2006  !/
2007  INTEGER, INTENT(IN) :: IMOD, MK, MTH, NDSE, NDST
2008  !/
2009  !/ ------------------------------------------------------------------- /
2010  !/ Local parameters
2011  !/
2012  INTEGER, SAVE :: MK2, MSPEC
2013 #ifdef W3_ST4
2014  INTEGER :: SDSNTH
2015 #endif
2016 #ifdef W3_S
2017  INTEGER, SAVE :: IENT = 0
2018  CALL strace (ient, 'W3DIMS')
2019 #endif
2020  !
2021  ! -------------------------------------------------------------------- /
2022  ! 1. Test input and module status
2023  !
2024  IF ( ngrids .EQ. -1 ) THEN
2025  WRITE (ndse,1001)
2026  CALL extcde (1)
2027  END IF
2028  !
2029  IF ( imod.LT.-nauxgr .OR. imod.GT.ngrids ) THEN
2030  WRITE (ndse,1002) imod, -nauxgr, ngrids
2031  CALL extcde (2)
2032  END IF
2033  !
2034  IF ( mk.LT.3 .OR. mth.LT.4 ) THEN
2035  WRITE (ndse,1003) mk, mth
2036  CALL extcde (3)
2037  END IF
2038  !
2039  IF ( sgrds(imod)%SINIT ) THEN
2040  WRITE (ndse,1004)
2041  CALL extcde (4)
2042  END IF
2043  !
2044  mk2 = mk + 2
2045  mspec = mk * mth
2046 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS)
2047  WRITE (ndst,9000) imod, mth, mk, mk2, mspec
2048 #endif
2049  !
2050  ! -------------------------------------------------------------------- /
2051  ! 2. Allocate arrays
2052  !
2053  ALLOCATE ( sgrds(imod)%MAPWN(mspec+mth), &
2054  sgrds(imod)%MAPTH(mspec+mth), &
2055  sgrds(imod)%TH(mth), &
2056  sgrds(imod)%ESIN(mspec+mth), &
2057  sgrds(imod)%ECOS(mspec+mth), &
2058  sgrds(imod)%ES2(mspec+mth), &
2059  sgrds(imod)%ESC(mspec+mth), &
2060  sgrds(imod)%EC2(mspec+mth), &
2061  sgrds(imod)%SIG(0:mk+1), &
2062  sgrds(imod)%SIG2(mspec), &
2063  sgrds(imod)%DSIP(0:mk+1), &
2064  sgrds(imod)%DSII(mk), &
2065  sgrds(imod)%DDEN(mk), &
2066  sgrds(imod)%DDEN2(mspec), &
2067  stat=istat )
2068  check_alloc_status( istat )
2069  sgrds(imod)%MAPWN(:)=0.
2070  sgrds(imod)%MAPTH(:)=0.
2071  sgrds(imod)%TH(:)=0.
2072  sgrds(imod)%ESIN(:)=0.
2073  sgrds(imod)%ECOS(:)=0.
2074  sgrds(imod)%ES2(:)=0.
2075  sgrds(imod)%ESC(:)=0.
2076  sgrds(imod)%EC2(:)=0.
2077  sgrds(imod)%SIG(:)=0.
2078  sgrds(imod)%SIG2(:)=0.
2079  sgrds(imod)%DSIP(:)=0.
2080  sgrds(imod)%DSII(:)=0.
2081  sgrds(imod)%DDEN(:)=0.
2082  sgrds(imod)%DDEN2(:)=0.
2083 #ifdef W3_ST4
2084  ALLOCATE ( mpars(imod)%SRCPS%IKTAB(mk,ndtab), &
2085  mpars(imod)%SRCPS%DCKI(nkhs,nkd), &
2086  mpars(imod)%SRCPS%QBI(nkhs,nkd), &
2087  stat=istat )
2088  check_alloc_status( istat )
2089  mpars(imod)%SRCPS%IKTAB(:,:)=0.
2090  mpars(imod)%SRCPS%DCKI(:,:)=0.
2091  mpars(imod)%SRCPS%QBI(:,:)=0.
2092  sdsnth = mth/2-1 !MIN(NINT(SSDSDTH/(DTH*RADE)),MTH/2-1)
2093  ALLOCATE( mpars(imod)%SRCPS%SATINDICES(2*sdsnth+1,mth), &
2094  mpars(imod)%SRCPS%SATWEIGHTS(2*sdsnth+1,mth), &
2095  mpars(imod)%SRCPS%CUMULW(mspec,mspec), &
2096  stat=istat )
2097  check_alloc_status( istat )
2098  mpars(imod)%SRCPS%SATINDICES(:,:)=0.
2099  mpars(imod)%SRCPS%SATWEIGHTS(:,:)=0.
2100  mpars(imod)%SRCPS%CUMULW(:,:)=0.
2101 #endif
2102  !
2103  sgrds(imod)%SINIT = .true.
2104 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS)
2105  WRITE (ndst,9001)
2106 #endif
2107  !
2108  ! -------------------------------------------------------------------- /
2109  ! 3. Point to allocated arrays
2110  !
2111  CALL w3setg ( imod, ndse, ndst )
2112 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS)
2113  WRITE (ndst,9002)
2114 #endif
2115  !
2116  ! -------------------------------------------------------------------- /
2117  ! 4. Update counters in grid
2118  !
2119  nk = mk
2120  nk2 = mk + 2
2121  nth = mth
2122  nspec = mk * mth
2123 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS)
2124  WRITE (ndst,9003)
2125 #endif
2126  !
2127  RETURN
2128  !
2129  ! Formats
2130  !
2131 1001 FORMAT (/' *** ERROR W3DIMS : GRIDS NOT INITIALIZED *** '/ &
2132  ' RUN W3NMOD FIRST '/)
2133 1002 FORMAT (/' *** ERROR W3DIMS : ILLEGAL MODEL NUMBER *** '/ &
2134  ' IMOD = ',i10/ &
2135  ' NAUXGR = ',i10/ &
2136  ' NGRIDS = ',i10/)
2137 1003 FORMAT (/' *** ERROR W3DIMS : ILLEGAL GRID DIMENSION(S) *** '/ &
2138  ' INPUT = ',4i10/)
2139 1004 FORMAT (/' *** ERROR W3DIMS : ARRAY(S) ALREADY ALLOCATED *** ')
2140 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS)
2141 9000 FORMAT (' TEST W3DIMS : MODEL ',i4,' DIM. AT ',3i5,i7)
2142 9001 FORMAT (' TEST W3DIMS : ARRAYS ALLOCATED')
2143 9002 FORMAT (' TEST W3DIMS : POINTERS RESET')
2144 9003 FORMAT (' TEST W3DIMS : DIMENSIONS STORED')
2145 #endif
2146  !/
2147  !/ End of W3DIMS ----------------------------------------------------- /
2148  !/
2149  END SUBROUTINE w3dims
2150  !/ ------------------------------------------------------------------- /
2151  SUBROUTINE w3setg ( IMOD, NDSE, NDST )
2152  !/
2153  !/ +-----------------------------------+
2154  !/ | WAVEWATCH III NOAA/NCEP |
2155  !/ | H. L. Tolman |
2156  !/ ! J. H. Alves !
2157  !/ | FORTRAN 90 |
2158  !/ | Last update : 03-Sep-2012 |
2159  !/ +-----------------------------------+
2160  !/
2161  !/ 24-Jun-2005 : Origination. ( version 3.07 )
2162  !/ 09-Nov-2005 : Remove soft boundary options. ( version 3.08 )
2163  !/ 23-Jun-2006 : Add data for W3SLN1. ( version 3.09 )
2164  !/ 18-Jul-2006 : Add input grids. ( version 3.10 )
2165  !/ 05-Oct-2006 : Add filter to array pointers. ( version 3.10 )
2166  !/ 02-Feb-2007 : Add FLAGST. ( version 3.10 )
2167  !/ 14-Apr-2007 : Add Miche style limiter. ( version 3.11 )
2168  !/ ( J. H. Alves )
2169  !/ 25-Apr-2007 : Adding Battjes-Janssen Sdb. ( version 3.11 )
2170  !/ ( J. H. Alves )
2171  !/ 18-Sep-2007 : Adding WAM4 source terms. ( version 3.13 )
2172  !/ ( F. Ardhuin )
2173  !/ 27-Jun-2008 : Expand WAM4 variants namelist ( version 3.14 )
2174  !/ ( F. Ardhuin )
2175  !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 )
2176  !/ (W. E. Rogers & T. J. Campbell, NRL)
2177  !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 )
2178  !/ (W. E. Rogers & T. J. Campbell, NRL)
2179  !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
2180  !/ specify index closure for a grid. ( version 3.14 )
2181  !/ (T. J. Campbell, NRL)
2182  !/ 13-Jul-2012 : Move data structures GMD (SNL3) and nonlinear
2183  !/ filter (SNLS) from 3.15 (HLT). ( version 4.08 )
2184  !/ 03-Sep-2012 : Clean up of UG grids ( version 4.08 )
2185  !/
2186  ! 1. Purpose :
2187  !
2188  ! Select one of the WAVEWATCH III grids / models.
2189  !
2190  ! 2. Method :
2191  !
2192  ! Point pointers to the proper variables in the proper element of
2193  ! the GRIDS array.
2194  !
2195  ! 3. Parameters :
2196  !
2197  ! Parameter list
2198  ! ----------------------------------------------------------------
2199  ! IMOD Int. I Model number to point to.
2200  ! NDSE Int. I Error output unit number.
2201  ! NDST Int. I Test output unit number.
2202  ! ----------------------------------------------------------------
2203  !
2204  ! 4. Subroutines used :
2205  !
2206  ! See module documentation.
2207  !
2208  ! 5. Called by :
2209  !
2210  ! Many subroutines in eth WAVEWATCH system.
2211  !
2212  ! 6. Error messages :
2213  !
2214  ! Checks on parameter list IMOD.
2215  !
2216  ! 7. Remarks :
2217  !
2218  ! 8. Structure :
2219  !
2220  ! 9. Switches :
2221  !
2222  ! !/PRn Select propagation scheme
2223  !
2224  ! !/STn Select source terms
2225  ! !/NLn
2226  ! !/BTn
2227  !
2228  ! !/S Enable subroutine tracing.
2229  !
2230  ! 10. Source code :
2231  !
2232  !/ ------------------------------------------------------------------- /
2233  USE w3servmd, ONLY: extcde
2234 #ifdef W3_S
2235  USE w3servmd, ONLY: strace
2236 #endif
2237  !
2238  IMPLICIT NONE
2239  !
2240  !/
2241  !/ ------------------------------------------------------------------- /
2242  !/ Parameter list
2243  !/
2244  INTEGER, INTENT(IN) :: IMOD, NDSE, NDST
2245  !/
2246  !/ ------------------------------------------------------------------- /
2247  !/ Local parameters
2248  !/
2249 #ifdef W3_S
2250  INTEGER, SAVE :: IENT = 0
2251  CALL strace (ient, 'W3SETG')
2252 #endif
2253  !
2254  ! -------------------------------------------------------------------- /
2255  ! 1. Test input and module status
2256  !
2257  IF ( ngrids .EQ. -1 ) THEN
2258  WRITE (ndse,1001)
2259  CALL extcde (1)
2260  END IF
2261  !
2262  IF ( imod.LT.-nauxgr .OR. imod.GT.ngrids ) THEN
2263  WRITE (ndse,1002) imod, -nauxgr, ngrids
2264  CALL extcde (2)
2265  END IF
2266 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3SETG)
2267  WRITE (ndst,9000) imod
2268 #endif
2269  !
2270  ! -------------------------------------------------------------------- /
2271  ! 2. Set model numbers
2272  !
2273  igrid = imod
2274  isgrd = imod
2275  ipars = imod
2276  !
2277  ! -------------------------------------------------------------------- /
2278  ! 3. Set pointers in structure GRID
2279  !
2280  gtype => grids(imod)%GTYPE
2281  rstype => grids(imod)%RSTYPE
2282  iclose => grids(imod)%ICLOSE
2283  !
2284  nx => grids(imod)%NX
2285  ny => grids(imod)%NY
2286  nsea => grids(imod)%NSEA
2287  nseal => grids(imod)%NSEAL
2288  trflag => grids(imod)%TRFLAG
2289  flagll => grids(imod)%FLAGLL
2290  !
2291 #ifdef W3_SMC
2292  ncel => grids(imod)%NCel
2293  nufc => grids(imod)%NUFc
2294  nvfc => grids(imod)%NVFc
2295  nrlv => grids(imod)%NRLv
2296  mrfct => grids(imod)%MRFct
2297  nglo => grids(imod)%NGLO
2298  narc => grids(imod)%NARC
2299  nbgl => grids(imod)%NBGL
2300  nbac => grids(imod)%NBAC
2301  nbsmc => grids(imod)%NBSMC
2302 #endif
2303  !
2304  e3df => grids(imod)%E3DF
2305  p2msf => grids(imod)%P2MSF
2306  us3df => grids(imod)%US3DF
2307  usspf => grids(imod)%USSPF
2308  ussp_wn => grids(imod)%USSP_WN
2309  ffacberg => grids(imod)%FFACBERG
2310 #ifdef W3_REF1
2311  reflc => grids(imod)%REFLC
2312  refld => grids(imod)%REFLD
2313  rref => grids(imod)%RREF
2314  refpars=> grids(imod)%REFPARS
2315 #endif
2316 #ifdef W3_IG1
2317  igpars => grids(imod)%IGPARS
2318 #endif
2319 #ifdef W3_IC2
2320  ic2pars => grids(imod)%IC2PARS
2321 #endif
2322 #ifdef W3_IC3
2323  ic3pars => grids(imod)%IC3PARS
2324 #endif
2325 #ifdef W3_IC4
2326  ic4pars => grids(imod)%IC4PARS
2327  ic4_ki => grids(imod)%IC4_KI
2328  ic4_fc => grids(imod)%IC4_FC
2329  ic4_cn => grids(imod)%IC4_CN
2330  ic4_fmin => grids(imod)%IC4_FMIN
2331  ic4_kibk => grids(imod)%IC4_KIBK
2332 #endif
2333 #ifdef W3_IC5
2334  ic5pars => grids(imod)%IC5PARS
2335 #endif
2336 #ifdef W3_IS2
2337  is2pars => grids(imod)%IS2PARS
2338 #endif
2339  sx => grids(imod)%SX
2340  sy => grids(imod)%SY
2341  x0 => grids(imod)%X0
2342  y0 => grids(imod)%Y0
2343  !
2344  dtcfl => grids(imod)%DTCFL
2345  dtcfli => grids(imod)%DTCFLI
2346  dtmax => grids(imod)%DTMAX
2347  dtmin => grids(imod)%DTMIN
2348  dmin => grids(imod)%DMIN
2349 #ifdef W3_SEC1
2350  nitersec1 => grids(imod)%NITERSEC1
2351 #endif
2352  ctmax => grids(imod)%CTMAX
2353  fice0 => grids(imod)%FICE0
2354  gridshift => grids(imod)%GRIDSHIFT
2355  cmprtrck => grids(imod)%CMPRTRCK
2356 #ifdef W3_RTD
2357  polat => grids(imod)%PoLat
2358  polon => grids(imod)%PoLon
2359  flagunr => grids(imod)%FLAGUNR
2360 #endif
2361  ficen => grids(imod)%FICEN
2362  ficel => grids(imod)%FICEL
2363  iicehmin => grids(imod)%IICEHMIN
2364  iicehdisp => grids(imod)%IICEHDISP
2365  iicefdisp => grids(imod)%IICEFDISP
2366  iiceddisp => grids(imod)%IICEDDISP
2367  iicehfac => grids(imod)%IICEHFAC
2368  iicehinit => grids(imod)%IICEHINIT
2369  icescales => grids(imod)%ICESCALES
2370  pfmove => grids(imod)%PFMOVE
2371  stexu => grids(imod)%STEXU
2372  steyu => grids(imod)%STEYU
2373  stedu => grids(imod)%STEDU
2374  btbeta => grids(imod)%BTBETA
2375  aairgb => grids(imod)%AAIRGB
2376  aaircmin => grids(imod)%AAIRCMIN
2377  !
2378  ginit => grids(imod)%GINIT
2379  guginit => grids(imod)%GUGINIT
2380  fldry => grids(imod)%FLDRY
2381  flcx => grids(imod)%FLCX
2382  flcy => grids(imod)%FLCY
2383  flcth => grids(imod)%FLCTH
2384  flck => grids(imod)%FLCK
2385  flsou => grids(imod)%FLSOU
2386  iicedisp => grids(imod)%IICEDISP
2387  iicesmooth => grids(imod)%IICESMOOTH
2388  !
2389  gname => grids(imod)%GNAME
2390  filext => grids(imod)%FILEXT
2391  trigp => grids(imod)%TRIGP
2392  ntri => grids(imod)%NTRI
2393  countri => grids(imod)%COUNTRI
2394  si => grids(imod)%SI
2395  countot => grids(imod)%COUNTOT
2396  ien => grids(imod)%IEN
2397  len => grids(imod)%LEN
2398  angle => grids(imod)%ANGLE
2399  angle0 => grids(imod)%ANGLE0
2400  ccon => grids(imod)%CCON
2401  countcon => grids(imod)%COUNTCON
2402  index_cell => grids(imod)%INDEX_CELL
2403  ie_cell => grids(imod)%IE_CELL
2404  pos_cell => grids(imod)%POS_CELL
2405  iobp => grids(imod)%IOBP
2406  iaa => grids(imod)%IAA
2407  jaa => grids(imod)%JAA
2408  posi => grids(imod)%POSI
2409  i_diag => grids(imod)%I_DIAG
2410  ja_ie => grids(imod)%JA_IE
2411  nbedge => grids(imod)%NBEDGE
2412  edges => grids(imod)%EDGES
2413  neigh => grids(imod)%NEIGH
2414  nnz => grids(imod)%NNZ
2415  iobpd => grids(imod)%IOBPD
2416  iobdp => grids(imod)%IOBDP
2417  iobpa => grids(imod)%IOBPA
2418  tria => grids(imod)%TRIA
2419  crossdiff => grids(imod)%CROSSDIFF
2420  maxx => grids(imod)%MAXX
2421  maxy => grids(imod)%MAXY
2422  dxymax => grids(imod)%DXYMAX
2423  xgrd => grids(imod)%XGRD
2424  ygrd => grids(imod)%YGRD
2425  zb => grids(imod)%ZB
2426  !
2427  IF ( ginit ) THEN
2428  !
2429  mapsta => grids(imod)%MAPSTA
2430  mapst2 => grids(imod)%MAPST2
2431  mapfs => grids(imod)%MAPFS
2432  mapsf => grids(imod)%MAPSF
2433  flagst => grids(imod)%FLAGST
2434  !
2435 #ifdef W3_RTD
2436  angld => grids(imod)%AnglD
2437 #endif
2438  clats => grids(imod)%CLATS
2439  clatis => grids(imod)%CLATIS
2440  cthg0s => grids(imod)%CTHG0S
2441  trnx => grids(imod)%TRNX
2442  trny => grids(imod)%TRNY
2443  !
2444  dxdp => grids(imod)%DXDP
2445  dxdq => grids(imod)%DXDQ
2446  dydp => grids(imod)%DYDP
2447  dydq => grids(imod)%DYDQ
2448  dpdx => grids(imod)%DPDX
2449  dpdy => grids(imod)%DPDY
2450  dqdx => grids(imod)%DQDX
2451  dqdy => grids(imod)%DQDY
2452  gsqrt => grids(imod)%GSQRT
2453  hpfac => grids(imod)%HPFAC
2454  hqfac => grids(imod)%HQFAC
2455  !
2456 #ifdef W3_BT4
2457  sed_d50 => grids(imod)%SED_D50
2458  sed_psic => grids(imod)%SED_PSIC
2459 #endif
2460  !
2461 #ifdef W3_SMC
2462  nlvcel => grids(imod)%NLvCel
2463  nlvufc => grids(imod)%NLvUFc
2464  nlvvfc => grids(imod)%NLvVFc
2465  ijkcel => grids(imod)%IJKCel
2466  ijkufc => grids(imod)%IJKUFc
2467  ijkvfc => grids(imod)%IJKVFc
2468  ismcbp => grids(imod)%ISMCBP
2469  ctrnx => grids(imod)%CTRNX
2470  ctrny => grids(imod)%CTRNY
2471  clatf => grids(imod)%CLATF
2472 
2473  ijkcel3 => grids(imod)%IJKCel3
2474  ijkcel4 => grids(imod)%IJKCel4
2475  ijkvfc5 => grids(imod)%IJKVFc5
2476  ijkvfc6 => grids(imod)%IJKVFc6
2477  ijkufc5 => grids(imod)%IJKUFc5
2478  ijkufc6 => grids(imod)%IJKUFc6
2479  iclbac => grids(imod)%ICLBAC
2480  angarc => grids(imod)%ANGARC
2481  spcbac => grids(imod)%SPCBAC
2482 #endif
2483  !
2484  gsu => grids(imod)%GSU
2485  !
2486  END IF
2487  !
2488  ! -------------------------------------------------------------------- /
2489  ! 4. Set pointers in structure SGRD
2490  !
2491  nk => sgrds(imod)%NK
2492  nk2 => sgrds(imod)%NK2
2493  nth => sgrds(imod)%NTH
2494  nspec => sgrds(imod)%NSPEC
2495  !
2496  dth => sgrds(imod)%DTH
2497  xfr => sgrds(imod)%XFR
2498  fr1 => sgrds(imod)%FR1
2499  fte => sgrds(imod)%FTE
2500  ftf => sgrds(imod)%FTF
2501  ftwn => sgrds(imod)%FTWN
2502  fttr => sgrds(imod)%FTTR
2503  ftwl => sgrds(imod)%FTWL
2504  facti1 => sgrds(imod)%FACTI1
2505  facti2 => sgrds(imod)%FACTI2
2506  fachfa => sgrds(imod)%FACHFA
2507  fachfe => sgrds(imod)%FACHFE
2508  !
2509  sinit => sgrds(imod)%SINIT
2510  !
2511  IF ( sinit ) THEN
2512  !
2513  mapwn => sgrds(imod)%MAPWN
2514  mapth => sgrds(imod)%MAPTH
2515  !
2516  th => sgrds(imod)%TH
2517  esin => sgrds(imod)%ESIN
2518  ecos => sgrds(imod)%ECOS
2519  es2 => sgrds(imod)%ES2
2520  esc => sgrds(imod)%ESC
2521  ec2 => sgrds(imod)%EC2
2522  sig => sgrds(imod)%SIG
2523  sig2 => sgrds(imod)%SIG2
2524  dsip => sgrds(imod)%DSIP
2525  dsii => sgrds(imod)%DSII
2526  dden => sgrds(imod)%DDEN
2527  dden2 => sgrds(imod)%DDEN2
2528  !
2529  END IF
2530  !
2531  ! -------------------------------------------------------------------- /
2532  ! 5. Set pointers in structure MPAR
2533  !
2534  pinit => mpars(imod)%PINIT
2535  !
2536  ! Structure NPARS
2537  !
2538  facp => mpars(imod)%NPARS%FACP
2539  xrel => mpars(imod)%NPARS%XREL
2540  xflt => mpars(imod)%NPARS%XFLT
2541  fxfm => mpars(imod)%NPARS%FXFM
2542  fxpm => mpars(imod)%NPARS%FXPM
2543  xft => mpars(imod)%NPARS%XFT
2544  xfc => mpars(imod)%NPARS%XFC
2545  facsd => mpars(imod)%NPARS%FACSD
2546  fhmax => mpars(imod)%NPARS%FHMAX
2547 #ifdef W3_RWND
2548  rwindc => mpars(imod)%NPARS%RWINDC
2549 #endif
2550 #ifdef W3_WCOR
2551  wwcor => mpars(imod)%NPARS%WWCOR
2552 #endif
2553  !
2554  ! Structure PROPS
2555  !
2556 #ifdef W3_PR2
2557  dtme => mpars(imod)%PROPS%DTME
2558  clatmn => mpars(imod)%PROPS%CLATMN
2559 #endif
2560 #ifdef W3_PR3
2561  wdcg => mpars(imod)%PROPS%WDCG
2562  wdth => mpars(imod)%PROPS%WDTH
2563 #endif
2564 #ifdef W3_SMC
2565  dtms => mpars(imod)%PROPS%DTMS
2566  refran => mpars(imod)%PROPS%Refran
2567  funo3 => mpars(imod)%PROPS%FUNO3
2568  fverg => mpars(imod)%PROPS%FVERG
2569  fswnd => mpars(imod)%PROPS%FSWND
2570  arctc => mpars(imod)%PROPS%ARCTC
2571 #endif
2572  !
2573  ! Structure FLDP
2574  !
2575 #ifdef W3_FLD1
2576  tail_id => mpars(imod)%FLDPS%TAIL_ID
2577  tail_lev => mpars(imod)%FLDPS%TAIL_LEV
2578  tail_tran1 => mpars(imod)%FLDPS%TAIL_TRAN1
2579  tail_tran2 => mpars(imod)%FLDPS%TAIL_TRAN2
2580 #endif
2581 #ifdef W3_FLD2
2582  tail_id => mpars(imod)%FLDPS%TAIL_ID
2583  tail_lev => mpars(imod)%FLDPS%TAIL_LEV
2584  tail_tran1 => mpars(imod)%FLDPS%TAIL_TRAN1
2585  tail_tran2 => mpars(imod)%FLDPS%TAIL_TRAN2
2586 #endif
2587  !
2588  ! Structure SFLPS
2589  !
2590 #ifdef W3_FLX2
2591  nittin => mpars(imod)%SFLPS%NITTIN
2592  cinxsi => mpars(imod)%SFLPS%CINXSI
2593 #endif
2594 #ifdef W3_FLX3
2595  nittin => mpars(imod)%SFLPS%NITTIN
2596  cap_id => mpars(imod)%SFLPS%CAP_ID
2597  cinxsi => mpars(imod)%SFLPS%CINXSI
2598  cd_max => mpars(imod)%SFLPS%CD_MAX
2599 #endif
2600 #ifdef W3_FLX4
2601  flx4a0 => mpars(imod)%SFLPS%FLX4A0
2602 #endif
2603  !
2604  ! Structure SLNPS
2605  !
2606 #ifdef W3_LN1
2607  slnc1 => mpars(imod)%SLNPS%SLNC1
2608  fspm => mpars(imod)%SLNPS%FSPM
2609  fshf => mpars(imod)%SLNPS%FSHF
2610 #endif
2611  !
2612  ! Structure SRCPS
2613  !
2614  wwnmeanptail=> mpars(imod)%SRCPS%WWNMEANPTAIL
2615  sstxftftail => mpars(imod)%SRCPS%SSTXFTFTAIL
2616 #ifdef W3_ST1
2617  sinc1 => mpars(imod)%SRCPS%SINC1
2618  sdsc1 => mpars(imod)%SRCPS%SDSC1
2619 #endif
2620 #ifdef W3_ST2
2621  zwind => mpars(imod)%SRCPS%ZWIND
2622  fswell => mpars(imod)%SRCPS%FSWELL
2623  shstab => mpars(imod)%SRCPS%SHSTAB
2624  ofstab => mpars(imod)%SRCPS%OFSTAB
2625  ccng => mpars(imod)%SRCPS%CCNG
2626  ccps => mpars(imod)%SRCPS%CCPS
2627  ffng => mpars(imod)%SRCPS%FFNG
2628  ffps => mpars(imod)%SRCPS%FFPS
2629  cdsa0 => mpars(imod)%SRCPS%CDSA0
2630  cdsa1 => mpars(imod)%SRCPS%CDSA1
2631  cdsa2 => mpars(imod)%SRCPS%CDSA2
2632  sdsaln => mpars(imod)%SRCPS%SDSALN
2633  cdsb0 => mpars(imod)%SRCPS%CDSB0
2634  cdsb1 => mpars(imod)%SRCPS%CDSB1
2635  cdsb2 => mpars(imod)%SRCPS%CDSB2
2636  cdsb3 => mpars(imod)%SRCPS%CDSB3
2637  fpimin => mpars(imod)%SRCPS%FPIMIN
2638  xfh => mpars(imod)%SRCPS%XFH
2639  xf1 => mpars(imod)%SRCPS%XF1
2640  xf2 => mpars(imod)%SRCPS%XF2
2641 #endif
2642  !
2643 #ifdef W3_ST3
2644  zzwnd => mpars(imod)%SRCPS%ZZWND
2645  aalpha => mpars(imod)%SRCPS%AALPHA
2646  bbeta => mpars(imod)%SRCPS%BBETA
2647  ssinthp => mpars(imod)%SRCPS%SSINTHP
2648  zz0max => mpars(imod)%SRCPS%ZZ0MAX
2649  zz0rat => mpars(imod)%SRCPS%ZZ0RAT
2650  zzalp => mpars(imod)%SRCPS%ZZALP
2651  ttauwshelter => mpars(imod)%SRCPS%TTAUWSHELTER
2652  sswellf => mpars(imod)%SRCPS%SSWELLF
2653  ssdsc1 => mpars(imod)%SRCPS%SSDSC1
2654  wwnmeanp => mpars(imod)%SRCPS%WWNMEANP
2655  ffxfm => mpars(imod)%SRCPS%FFXFM
2656  ffxpm => mpars(imod)%SRCPS%FFXPM
2657  ddelta1 => mpars(imod)%SRCPS%DDELTA1
2658  ddelta2 => mpars(imod)%SRCPS%DDELTA2
2659  sstxftf => mpars(imod)%SRCPS%SSTXFTF
2660  sstxftwn => mpars(imod)%SRCPS%SSTXFTWN
2661 #endif
2662  !
2663 #ifdef W3_ST4
2664  zzwnd => mpars(imod)%SRCPS%ZZWND
2665  aalpha => mpars(imod)%SRCPS%AALPHA
2666  bbeta => mpars(imod)%SRCPS%BBETA
2667  ssinthp => mpars(imod)%SRCPS%SSINTHP
2668  zz0max => mpars(imod)%SRCPS%ZZ0MAX
2669  zz0rat => mpars(imod)%SRCPS%ZZ0RAT
2670  zzalp => mpars(imod)%SRCPS%ZZALP
2671  ttauwshelter => mpars(imod)%SRCPS%TTAUWSHELTER
2672  sintailpar => mpars(imod)%SRCPS%SINTAILPAR
2673  capchnk => mpars(imod)%SRCPS%CAPCHNK
2674  sswellfpar => mpars(imod)%SRCPS%SSWELLFPAR
2675  sswellf => mpars(imod)%SRCPS%SSWELLF
2676  ssdsc => mpars(imod)%SRCPS%SSDSC
2677  ssdsbr => mpars(imod)%SRCPS%SSDSBR
2678  ssdsbt => mpars(imod)%SRCPS%SSDSBT
2679  ssdsbrf1 => mpars(imod)%SRCPS%SSDSBRF1
2680  ssdsbrf2 => mpars(imod)%SRCPS%SSDSBRF2
2681  ssdsbrfdf => mpars(imod)%SRCPS%SSDSBRFDF
2682  ssdsbm => mpars(imod)%SRCPS%SSDSBM
2683  ssdsbck => mpars(imod)%SRCPS%SSDSBCK
2684  ssdsabk => mpars(imod)%SRCPS%SSDSABK
2685  ssdspbk => mpars(imod)%SRCPS%SSDSPBK
2686  ssdshck => mpars(imod)%SRCPS%SSDSHCK
2687  ssdsbint => mpars(imod)%SRCPS%SSDSBINT
2688  ssdsp => mpars(imod)%SRCPS%SSDSP
2689  wwnmeanp => mpars(imod)%SRCPS%WWNMEANP
2690  ffxfm => mpars(imod)%SRCPS%FFXFM
2691  ffxfa => mpars(imod)%SRCPS%FFXFA
2692  ffxpm => mpars(imod)%SRCPS%FFXPM
2693  ssdsdth => mpars(imod)%SRCPS%SSDSDTH
2694  sstxftf => mpars(imod)%SRCPS%SSTXFTF
2695  sstxftwn => mpars(imod)%SRCPS%SSTXFTWN
2696  ssdscos => mpars(imod)%SRCPS%SSDSCOS
2697  ssdsiso => mpars(imod)%SRCPS%SSDSISO
2698  iktab => mpars(imod)%SRCPS%IKTAB
2699  dcki => mpars(imod)%SRCPS%DCKI
2700  qbi => mpars(imod)%SRCPS%QBI
2701  cumulw => mpars(imod)%SRCPS%CUMULW
2702  satindices => mpars(imod)%SRCPS%SATINDICES
2703  satweights => mpars(imod)%SRCPS%SATWEIGHTS
2704  ssinbr => mpars(imod)%SRCPS%SSINBR
2705 #endif
2706  !
2707 #ifdef W3_ST6
2708  sin6a0 => mpars(imod)%SRCPS%SIN6A0
2709  sin6ws => mpars(imod)%SRCPS%SIN6WS
2710  sin6fc => mpars(imod)%SRCPS%SIN6FC
2711  sds6et => mpars(imod)%SRCPS%SDS6ET
2712  sds6a1 => mpars(imod)%SRCPS%SDS6A1
2713  sds6p1 => mpars(imod)%SRCPS%SDS6P1
2714  sds6a2 => mpars(imod)%SRCPS%SDS6A2
2715  sds6p2 => mpars(imod)%SRCPS%SDS6P2
2716  swl6s6 => mpars(imod)%SRCPS%SWL6S6
2717  swl6b1 => mpars(imod)%SRCPS%SWL6B1
2718  swl6cstb1 => mpars(imod)%SRCPS%SWL6CSTB1
2719 #endif
2720  !
2721  ! Structure SRNLS
2722  !
2723 #ifdef W3_NL1
2724  snlc1 => mpars(imod)%SNLPS%SNLC1
2725  lam => mpars(imod)%SNLPS%LAM
2726  kdcon => mpars(imod)%SNLPS%KDCON
2727  kdmn => mpars(imod)%SNLPS%KDMN
2728  snls1 => mpars(imod)%SNLPS%SNLS1
2729  snls2 => mpars(imod)%SNLPS%SNLS2
2730  snls3 => mpars(imod)%SNLPS%SNLS3
2731  iqtpe => mpars(imod)%SNLPS%IQTPE
2732  gqnf1 => mpars(imod)%SNLPS%GQNF1
2733  gqnt1 => mpars(imod)%SNLPS%GQNT1
2734  gqnq_om2 => mpars(imod)%SNLPS%GQNQ_OM2
2735  nltail => mpars(imod)%SNLPS%NLTAIL
2736  gqthrsat => mpars(imod)%SNLPS%GQTHRSAT
2737  gqthrcou=> mpars(imod)%SNLPS%GQTHRCOU
2738  gqamp=> mpars(imod)%SNLPS%GQAMP
2739 #endif
2740 #ifdef W3_NL2
2741  iqtpe => mpars(imod)%SNLPS%IQTPE
2742  ndpths => mpars(imod)%SNLPS%NDPTHS
2743  nltail => mpars(imod)%SNLPS%NLTAIL
2744  IF ( ndpths .NE. 0 ) dpthnl => mpars(imod)%SNLPS%DPTHNL
2745 #endif
2746 #ifdef W3_NL3
2747  nfrmin => mpars(imod)%SNLPS%NFRMIN
2748  nfrmax => mpars(imod)%SNLPS%NFRMAX
2749  nfrcut => mpars(imod)%SNLPS%NFRCUT
2750  nthmax => mpars(imod)%SNLPS%NTHMAX
2751  nthexp => mpars(imod)%SNLPS%NTHEXP
2752  nspmin => mpars(imod)%SNLPS%NSPMIN
2753  nspmax => mpars(imod)%SNLPS%NSPMAX
2754  nspmx2 => mpars(imod)%SNLPS%NSPMX2
2755  frq => mpars(imod)%SNLPS%FRQ
2756  xsi => mpars(imod)%SNLPS%XSI
2757  nqa => mpars(imod)%SNLPS%NQA
2758  qst1 => mpars(imod)%SNLPS%QST1
2759  qst2 => mpars(imod)%SNLPS%QST2
2760  qst3 => mpars(imod)%SNLPS%QST3
2761  qst4 => mpars(imod)%SNLPS%QST4
2762  qst5 => mpars(imod)%SNLPS%QST5
2763  qst6 => mpars(imod)%SNLPS%QST6
2764  snlnq => mpars(imod)%SNLPS%SNLNQ
2765  snlmsc => mpars(imod)%SNLPS%SNLMSC
2766  snlnsc => mpars(imod)%SNLPS%SNLNSC
2767  snlsfd => mpars(imod)%SNLPS%SNLSFD
2768  snlsfs => mpars(imod)%SNLPS%SNLSFS
2769  snll => mpars(imod)%SNLPS%SNLL
2770  snlm => mpars(imod)%SNLPS%SNLM
2771  snlt => mpars(imod)%SNLPS%SNLT
2772  snlcd => mpars(imod)%SNLPS%SNLCD
2773  snlcs => mpars(imod)%SNLPS%SNLCS
2774 #endif
2775 #ifdef W3_NL4
2776  itsa => mpars(imod)%SNLPS%ITSA
2777  ialt => mpars(imod)%SNLPS%IALT
2778 #endif
2779 #ifdef W3_NL5
2780  qr5dpt => mpars(imod)%SNLPS%QR5DPT
2781  qr5oml => mpars(imod)%SNLPS%QR5OML
2782  qi5dis => mpars(imod)%SNLPS%QI5DIS
2783  qi5kev => mpars(imod)%SNLPS%QI5KEV
2784  qi5nnz => mpars(imod)%SNLPS%QI5NNZ
2785  qi5ipl => mpars(imod)%SNLPS%QI5IPL
2786  qi5pmx => mpars(imod)%SNLPS%QI5PMX
2787 #endif
2788 #ifdef W3_NLS
2789  nthx => mpars(imod)%SNLPS%NTHX
2790  nfrx => mpars(imod)%SNLPS%NFRX
2791  nspl => mpars(imod)%SNLPS%NSPL
2792  nsph => mpars(imod)%SNLPS%NSPH
2793  snsst => mpars(imod)%SNLPS%SNSST
2794  cnlsa => mpars(imod)%SNLPS%CNLSA
2795  cnlsc => mpars(imod)%SNLPS%CNLSC
2796  cnlsfm => mpars(imod)%SNLPS%CNLSFM
2797  cnlsc1 => mpars(imod)%SNLPS%CNLSC1
2798  cnlsc2 => mpars(imod)%SNLPS%CNLSC2
2799  cnlsc3 => mpars(imod)%SNLPS%CNLSC3
2800 #endif
2801  !
2802  ! Structure SBTPS
2803  !
2804 #ifdef W3_BT1
2805  sbtc1 => mpars(imod)%SBTPS%SBTC1
2806 #endif
2807 #ifdef W3_BT4
2808  sbtcx => mpars(imod)%SBTPS%SBTCX
2809 #endif
2810  !
2811  ! Structure SDBPS
2812  !
2813 #ifdef W3_DB1
2814  sdbc1 => mpars(imod)%SDBPS%SDBC1
2815  sdbc2 => mpars(imod)%SDBPS%SDBC2
2816  fdonly => mpars(imod)%SDBPS%FDONLY
2817  sdbsc => mpars(imod)%SDBPS%SDBSC
2818 #endif
2819  !
2820  !
2821 #ifdef W3_UOST
2822  uostfilelocal => mpars(imod)%UOSTPS%UOSTFILELOCAL
2823  uostfileshadow => mpars(imod)%UOSTPS%UOSTFILESHADOW
2824  uostfactorlocal => mpars(imod)%UOSTPS%UOSTFACTORLOCAL
2825  uostfactorshadow => mpars(imod)%UOSTPS%UOSTFACTORSHADOW
2826 #endif
2827  !
2828  ! Structure SICPS
2829  !
2830 #ifdef W3_IS1
2831  is1c1 => mpars(imod)%SICPS%IS1C1
2832  is1c2 => mpars(imod)%SICPS%IS1C2
2833 #endif
2834  !
2835  ! Structure SCHM
2836  fsbccfl => mpars(imod)%SCHMS%FSBCCFL
2837  fsn => mpars(imod)%SCHMS%FSN
2838  fspsi => mpars(imod)%SCHMS%FSPSI
2839  fsfct => mpars(imod)%SCHMS%FSFCT
2840  fsnimp => mpars(imod)%SCHMS%FSNIMP
2841  fstotalimp => mpars(imod)%SCHMS%FSTOTALIMP
2842  fstotalexp => mpars(imod)%SCHMS%FSTOTALEXP
2843  fsrefraction => mpars(imod)%SCHMS%FSREFRACTION
2844  fsfreqshift => mpars(imod)%SCHMS%FSFREQSHIFT
2845  fssource => mpars(imod)%SCHMS%FSSOURCE
2846  do_change_wlv => mpars(imod)%SCHMS%DO_CHANGE_WLV
2847  solverthr_stp => mpars(imod)%SCHMS%SOLVERTHR_STP
2848  crit_dep_stp => mpars(imod)%SCHMS%CRIT_DEP_STP
2849  b_jgs_terminate_maxiter => mpars(imod)%SCHMS%B_JGS_TERMINATE_MAXITER
2850  b_jgs_terminate_difference => mpars(imod)%SCHMS%B_JGS_TERMINATE_DIFFERENCE
2851  b_jgs_terminate_norm => mpars(imod)%SCHMS%B_JGS_TERMINATE_NORM
2852  b_jgs_limiter => mpars(imod)%SCHMS%B_JGS_LIMITER
2853  b_jgs_use_jacobi => mpars(imod)%SCHMS%B_JGS_USE_JACOBI
2854  b_jgs_block_gauss_seidel => mpars(imod)%SCHMS%B_JGS_BLOCK_GAUSS_SEIDEL
2855  b_jgs_maxiter => mpars(imod)%SCHMS%B_JGS_MAXITER
2856  b_jgs_limiter_func => mpars(imod)%SCHMS%B_JGS_LIMITER_FUNC
2857  b_jgs_pmin => mpars(imod)%SCHMS%B_JGS_PMIN
2858  b_jgs_diff_thr => mpars(imod)%SCHMS%B_JGS_DIFF_THR
2859  b_jgs_norm_thr => mpars(imod)%SCHMS%B_JGS_NORM_THR
2860  b_jgs_nlevel => mpars(imod)%SCHMS%B_JGS_NLEVEL
2861  b_jgs_source_nonlinear => mpars(imod)%SCHMS%B_JGS_SOURCE_NONLINEAR
2862  RETURN
2863  !
2864  ! Formats
2865  !
2866 1001 FORMAT (/' *** ERROR W3SETG : GRIDS NOT INITIALIZED *** '/ &
2867  ' RUN W3NMOD FIRST '/)
2868 1002 FORMAT (/' *** ERROR W3SETG : ILLEGAL MODEL NUMBER *** '/ &
2869  ' IMOD = ',i10/ &
2870  ' NAUXGR = ',i10/ &
2871  ' NGRIDS = ',i10/)
2872 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3SETG)
2873 9000 FORMAT (' TEST W3SETG : GRID/MODEL ',i4,' SELECTED')
2874 #endif
2875  !/
2876  !/ End of W3SETG ----------------------------------------------------- /
2877  !/
2878  END SUBROUTINE w3setg
2879  !/ ------------------------------------------------------------------- /
2880  SUBROUTINE w3gntx ( IMOD, NDSE, NDST )
2881  !/
2882  !/ +-----------------------------------+
2883  !/ | WAVEWATCH-III NOAA/NCEP |
2884  !/ | T. J. Campbell |
2885  !/ | FORTRAN 90 |
2886  !/ | Last update : 20-Jul-2011 |
2887  !/ +-----------------------------------+
2888  !/
2889  !/ 30-Oct-2009 : Origination. ( version 3.13 )
2890  !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
2891  !/ specify index closure for a grid. ( version 3.14 )
2892  !/ (T. J. Campbell, NRL)
2893  !/ 23-Dec-2010 : Fix HPFAC and HQFAC by including the COS(YGRD)
2894  !/ factor with DXDP and DXDQ terms. ( version 3.14 )
2895  !/ (T. J. Campbell, NRL)
2896  !/ 20-Jul-2011 : HPFAC and HQFAC are now calculated using W3DIST.
2897  !/ Result should be very similar except near pole.
2898  !/ Due to precision issues, HPFAC and HQFAC revert
2899  !/ to SX and SY in case of regular grids.
2900  !/ (W. E. Rogers, NRL) ( version 3.14 )
2901  !/ 20-Jan-2017 : Update to new W3GSRUMD APIs ( version 6.02 )
2902  !/ 20-Jan-2017 : Change calculation of curvilinear grid metric and
2903  !/ derivatives calculations to use W3GSRUMD:W3CGDM.
2904  !/ (T.J. Campbell, NRL) ( version 6.02 )
2905  !/
2906  ! 1. Purpose :
2907  !
2908  ! Construct required spatial grid quantities for curvilinear grids.
2909  !
2910  ! 2. Method :
2911  !
2912  ! 3. Parameters :
2913  !
2914  ! Parameter list
2915  ! ----------------------------------------------------------------
2916  ! IMOD Int. I Model number to point to.
2917  ! NDSE Int. I Error output unit number.
2918  ! ----------------------------------------------------------------
2919  !
2920  ! 4. Subroutines used :
2921  !
2922  ! See module documentation.
2923  !
2924  ! 5. Called by :
2925  !
2926  ! Any program that uses this grid structure.
2927  !
2928  ! 6. Error messages :
2929  !
2930  ! - Check on previous initialization of grids.
2931  !
2932  ! 7. Remarks :
2933  !
2934  ! 8. Structure :
2935  !
2936  ! 9. Switches :
2937  !
2938  ! !/S Enable subroutine tracing.
2939  !
2940  ! 10. Source code :
2941  !
2942  !/ ------------------------------------------------------------------- /
2943  USE w3servmd, ONLY: extcde
2944 #ifdef W3_S
2945  USE w3servmd, ONLY: strace
2946 #endif
2947  !
2948  IMPLICIT NONE
2949  !/
2950  !/ ------------------------------------------------------------------- /
2951  !/ Parameter list
2952  !/
2953  INTEGER, INTENT(IN) :: IMOD, NDSE, NDST
2954  !/
2955  !/ ------------------------------------------------------------------- /
2956  !/ Local parameters
2957  !/
2958  INTEGER, PARAMETER :: NFD = 4
2959  LOGICAL, PARAMETER :: PTILED = .false.
2960  LOGICAL, PARAMETER :: QTILED = .false.
2961  LOGICAL, PARAMETER :: IJG = .false.
2962  LOGICAL, PARAMETER :: SPHERE = .false.
2963  INTEGER :: PRANGE(2), QRANGE(2)
2964  INTEGER :: LBI(2), UBI(2), LBO(2), UBO(2), ISTAT
2965  REAL , ALLOCATABLE :: COSA(:,:)
2966 #ifdef W3_S
2967  INTEGER, SAVE :: IENT = 0
2968  CALL strace (ient, 'W3GNTX')
2969 #endif
2970  !
2971  ! -------------------------------------------------------------------- /
2972  ! 1. Test input and module status
2973  !
2974  IF ( ngrids .EQ. -1 ) THEN
2975  WRITE (ndse,1001)
2976  CALL extcde (1)
2977  END IF
2978  !
2979  IF ( imod.LT.-nauxgr .OR. imod.GT.ngrids ) THEN
2980  WRITE (ndse,1002) imod, -nauxgr, ngrids
2981  CALL extcde (2)
2982  END IF
2983  !
2984  SELECT CASE ( grids(imod)%GTYPE )
2985  CASE ( rlgtype )
2986  CASE ( clgtype )
2987  CASE ( smctype )
2988  CASE DEFAULT
2989  WRITE (ndse,1003) grids(imod)%GTYPE
2990  CALL extcde (3)
2991  END SELECT
2992 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
2993  WRITE (ndst,9000) imod
2994 #endif
2995  !
2996  ! -------------------------------------------------------------------- /
2997  ! 2. Create grid search utility object
2998  !
2999  grids(imod)%GSU = w3gsuc( ijg, flagll, grids(imod)%ICLOSE, &
3000  grids(imod)%XGRD, grids(imod)%YGRD )
3001 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
3002  CALL w3gsup(grids(imod)%GSU, ndst)
3003  WRITE (ndst,9001)
3004 #endif
3005  !
3006  ! -------------------------------------------------------------------- /
3007  ! 3. Reset grid pointers
3008  !
3009  CALL w3setg ( imod, ndse, ndst )
3010 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
3011  WRITE (ndst,9002)
3012 #endif
3013  !
3014  ! -------------------------------------------------------------------- /
3015  ! 4. Construct curvilinear grid derivatives and metric
3016  ! Note that in the case of lon/lat grids, these quantities do not
3017  ! include the spherical coordinate metric (SPHERE=.FALSE.).
3018  !
3019 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
3020  ALLOCATE ( cosa(ny,nx), stat=istat )
3021  check_alloc_status( istat )
3022 #endif
3023  prange = (/ 1,nx/)
3024  qrange = (/ 1,ny/)
3025  lbi = (/ 1, 1/)
3026  ubi = (/ny,nx/)
3027  lbo = (/ 1, 1/)
3028  ubo = (/ny,nx/)
3029  SELECT CASE ( gtype )
3030  !!Li SMC grid shares the settings with rectilinear grid. JGLi12Oct2020
3031  CASE ( rlgtype, smctype )
3032  CALL w3cgdm( ijg, flagll, iclose, ptiled, qtiled, &
3033  prange, qrange, lbi, ubi, lbo, ubo, real(xgrd), real(ygrd), &
3034  nfd=nfd, sphere=sphere, dx=sx, dy=sy, &
3035  dxdp=dxdp, dydp=dydp, dxdq=dxdq, dydq=dydq, &
3036  dpdx=dpdx, dpdy=dpdy, dqdx=dqdx, dqdy=dqdy, &
3037  hpfc=hpfac, hqfc=hqfac, gsqr=gsqrt, &
3038 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
3039  cosa=cosa, &
3040 #endif
3041  rc=istat )
3042  IF ( istat.NE.0 ) THEN
3043  WRITE (ndse,1004) gtype
3044  CALL extcde (4)
3045  END IF
3046  CASE ( clgtype )
3047  CALL w3cgdm( ijg, flagll, iclose, ptiled, qtiled, &
3048  prange, qrange, lbi, ubi, lbo, ubo, real(xgrd), real(ygrd), &
3049  nfd=nfd, sphere=sphere, &
3050  dxdp=dxdp, dydp=dydp, dxdq=dxdq, dydq=dydq, &
3051  dpdx=dpdx, dpdy=dpdy, dqdx=dqdx, dqdy=dqdy, &
3052  hpfc=hpfac, hqfc=hqfac, gsqr=gsqrt, &
3053 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
3054  cosa=cosa, &
3055 #endif
3056  rc=istat )
3057  IF ( istat.NE.0 ) THEN
3058  WRITE (ndse,1004) gtype
3059  CALL extcde (4)
3060  END IF
3061  END SELECT
3062  !
3063 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
3064  WRITE(ndst,'(A,2E14.6)')'HPFAC MIN/MAX:',minval(hpfac),maxval(hpfac)
3065  WRITE(ndst,'(A,2E14.6)')'HQFAC MIN/MAX:',minval(hqfac),maxval(hqfac)
3066  WRITE(ndst,'(A,2E14.6)')'GSQRT MIN/MAX:',minval(gsqrt),maxval(gsqrt)
3067  WRITE(ndst,'(A,2E14.6)')'DXDP MIN/MAX:',minval(dxdp),maxval(dxdp)
3068  WRITE(ndst,'(A,2E14.6)')'DYDP MIN/MAX:',minval(dydp),maxval(dydp)
3069  WRITE(ndst,'(A,2E14.6)')'DXDQ MIN/MAX:',minval(dxdq),maxval(dxdq)
3070  WRITE(ndst,'(A,2E14.6)')'DYDQ MIN/MAX:',minval(dydq),maxval(dydq)
3071  WRITE(ndst,'(A,2E14.6)')'DPDX MIN/MAX:',minval(dpdx),maxval(dpdx)
3072  WRITE(ndst,'(A,2E14.6)')'DPDY MIN/MAX:',minval(dpdy),maxval(dpdy)
3073  WRITE(ndst,'(A,2E14.6)')'DQDX MIN/MAX:',minval(dqdx),maxval(dqdx)
3074  WRITE(ndst,'(A,2E14.6)')'DQDY MIN/MAX:',minval(dqdy),maxval(dqdy)
3075  WRITE(ndst,'(A,2E14.6)')'COSA MIN/MAX:',minval(cosa),maxval(cosa)
3076  WRITE (ndst,9003)
3077  DEALLOCATE ( cosa, stat=istat )
3078  check_dealloc_status( istat )
3079 #endif
3080  !
3081  ! Formats
3082  !
3083 1001 FORMAT (/' *** ERROR W3GNTX : GRIDS NOT INITIALIZED *** '/ &
3084  ' RUN W3NMOD FIRST '/)
3085 1002 FORMAT (/' *** ERROR W3GNTX : ILLEGAL MODEL NUMBER *** '/ &
3086  ' IMOD = ',i10/ &
3087  ' NAUXGR = ',i10/ &
3088  ' NGRIDS = ',i10/)
3089 1003 FORMAT (/' *** ERROR W3GNTX : UNSUPPORTED TYPE OF GRID *** '/ &
3090  ' GTYPE = ',i10/)
3091 1004 FORMAT (/' *** ERROR W3GNTX : ERROR OCCURED IN W3CGDM *** '/ &
3092  ' GTYPE = ',i10/)
3093  !
3094 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX)
3095 9000 FORMAT (' TEST W3GNTX : MODEL ',i4)
3096 9001 FORMAT (' TEST W3GNTX : SEARCH OBJECT CREATED')
3097 9002 FORMAT (' TEST W3GNTX : POINTERS RESET')
3098 9003 FORMAT (' TEST W3GNTX : GRID ARRAYS CONSTRUCTED')
3099 #endif
3100  !/
3101  !/ End of W3GNTX ----------------------------------------------------- /
3102  !/
3103  END SUBROUTINE w3gntx
3104  !/ ------------------------------------------------------------------- /
3105  SUBROUTINE w3dimug ( IMOD, MTRI, MX, COUNTOTA, NNZ, NDSE, NDST )
3106  !/
3107  !/ +-----------------------------------+
3108  !/ | WAVEWATCH-III NOAA/NCEP |
3109  !/ | F.ardhuin |
3110  !/ | FORTRAN 90 |
3111  !/ | Last update : 15-Mar-2007 !
3112  !/ +-----------------------------------+
3113  !/
3114  !/ 15-Mar-2007 : Origination. ( version 3.14 )
3115  !/ 11-May-2015 : Updates to 2-ways nestings for UG ( version 5.08 )
3116  !/
3117  ! 1. Purpose :
3118  !
3119  ! Initialize an individual spatial grid at the proper dimensions.
3120  !
3121  ! 2. Method :
3122  !
3123  ! Allocate directly into the structure array GRIDS. Note that
3124  ! this cannot be done through the pointer alias!
3125  !
3126  ! 3. Parameters :
3127  !
3128  ! Parameter list
3129  ! ----------------------------------------------------------------
3130  ! IMOD Int. I Model number to point to.
3131  ! NDSE Int. I Error output unit number.
3132  ! NDST Int. I Test output unit number.
3133  ! MX, MTRI, MSEA Like NX, NTRI, NSEA in data structure.
3134  ! ----------------------------------------------------------------
3135  !
3136  ! 4. Subroutines used :
3137  !
3138  ! See module documentation.
3139  !
3140  ! 5. Called by :
3141  !
3142  ! Name Type Module Description
3143  ! ----------------------------------------------------------------
3144  ! W3IOGR Subr. W3IOGRMD Model definition file IO program.
3145  ! WW3_GRID Prog. N/A Model set up program.
3146  ! ----------------------------------------------------------------
3147  !
3148  ! 6. Error messages :
3149  !
3150  ! - Check on input parameters.
3151  ! - Check on previous allocation.
3152  !
3153  ! 7. Remarks :
3154  !
3155  ! - Grid dimensions apre passed through parameter list and then
3156  ! locally stored to assure consistency between allocation and
3157  ! data in structure.
3158  ! - W3SETG needs to be called after allocation to point to
3159  ! proper allocated arrays.
3160  !
3161  ! 8. Structure :
3162  !
3163  ! See source code.
3164  !
3165  ! 9. Switches :
3166  !
3167  ! !/S Enable subroutine tracing.
3168  !
3169  ! 10. Source code :
3170  !
3171  !/ ------------------------------------------------------------------- /
3172  USE w3servmd, ONLY: extcde
3173 #ifdef W3_S
3174  USE w3servmd, ONLY: strace
3175 #endif
3176  !
3177  IMPLICIT NONE
3178  !
3179  !/
3180  !/ ------------------------------------------------------------------- /
3181  !/ Parameter list
3182  !/
3183  INTEGER, INTENT(IN) :: IMOD, MTRI, MX, COUNTOTA, NNZ, NDSE, NDST
3184  INTEGER :: IAPROC = 1
3185  !/
3186  !/ ------------------------------------------------------------------- /
3187  !/ Local parameters
3188  !/
3189 #ifdef W3_S
3190  INTEGER, SAVE :: IENT = 0
3191  CALL strace (ient, 'W3DIMUG')
3192 #endif
3193  !
3194  ! -------------------------------------------------------------------- /
3195  ! 1. Test input and module status
3196  !
3197  IF ( ngrids .EQ. -1 ) THEN
3198  WRITE (ndse,1001)
3199  CALL extcde (1)
3200  END IF
3201  !
3202  IF ( imod.LT.-nauxgr .OR. imod.GT.ngrids ) THEN
3203  WRITE (ndse,1002) imod, ngrids
3204  CALL extcde (2)
3205  END IF
3206  IF ( grids(imod)%GUGINIT ) THEN
3207  WRITE (ndse,1004)
3208  CALL extcde (4)
3209  END IF
3210  !
3211 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG)
3212  WRITE (ndst,9000) imod, mx, mtri
3213 #endif
3214  !
3215  ! -------------------------------------------------------------------- /
3216  ! 2. Allocate arrays
3217  !
3218  ALLOCATE ( grids(imod)%TRIGP(3,mtri), &
3219  grids(imod)%SI(mx), &
3220  grids(imod)%XGRD(1,mx), &
3221  grids(imod)%YGRD(1,mx), &
3222  grids(imod)%ZB(mx), &
3223  grids(imod)%TRIA(mtri), &
3224  grids(imod)%CROSSDIFF(6,mtri), &
3225  grids(imod)%IEN(mtri,6), &
3226  grids(imod)%LEN(mtri,3), &
3227  grids(imod)%ANGLE(mtri,3), &
3228  grids(imod)%ANGLE0(mtri,3), &
3229  grids(imod)%CCON(mx), &
3230  grids(imod)%COUNTCON(mx), &
3231  grids(imod)%INDEX_CELL(mx+1), &
3232  grids(imod)%IE_CELL(countota), &
3233  grids(imod)%POS_CELL(countota), &
3234  grids(imod)%IAA(nx+1), &
3235  grids(imod)%JAA(nnz), &
3236  grids(imod)%POSI(3,countota), &
3237  grids(imod)%I_DIAG(nx), &
3238  grids(imod)%JA_IE(3,3,mtri), &
3239  grids(imod)%IOBP(mx), &
3240  grids(imod)%IOBPD(nth,mx), &
3241  grids(imod)%IOBDP(mx), &
3242  grids(imod)%IOBPA(mx), &
3243  stat=istat )
3244  check_alloc_status( istat )
3245  !
3246  grids(imod)%IOBP(:)=1
3247 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG)
3248  WRITE (ndst,9001)
3249 #endif
3250  !
3251  !some segmentation troubles can appear, they are related with the allocation of
3252  !normal(1st dimension) and the nesting of the triangulated grid.
3253  ! -------------------------------------------------------------------- /
3254  ! 3. Point to allocated arrays
3255  !
3256  CALL w3setg ( imod, ndse, ndst )
3257 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG)
3258  WRITE (ndst,9002)
3259 #endif
3260  !
3261  ! -------------------------------------------------------------------- /
3262  ! 4. Update counters in grid
3263  ! Note that in the case of lon/lat grids, these quantities do not
3264  ! include the spherical coordinate metric (SPHERE=.FALSE.).
3265  !
3266  ntri = mtri
3267  countot=countota
3268  grids(imod)%GUGINIT = .true.
3269 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG)
3270  WRITE (ndst,9003)
3271 #endif
3272  RETURN
3273  !
3274  ! Formats
3275  !
3276 1001 FORMAT (/' *** ERROR W3DIMUG : GRIDS NOT INITIALIZED *** '/ &
3277  ' RUN W3NMOD FIRST '/)
3278 1002 FORMAT (/' *** ERROR W3DIMUG : ILLEGAL MODEL NUMBER *** '/ &
3279  ' IMOD = ',i10/ &
3280  ' NGRIDS = ',i10/)
3281 1004 FORMAT (/' *** ERROR W3DIMUG : ARRAY(S) ALREADY ALLOCATED *** ')
3282 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG)
3283 9000 FORMAT (' TEST W3DIMUG: MODEL ',i4,' DIM. AT ',2i5,i7)
3284 9001 FORMAT (' TEST W3DIMUG : ARRAYS ALLOCATED')
3285 9002 FORMAT (' TEST W3DIMUG : POINTERS RESET')
3286 9003 FORMAT (' TEST W3DIMUG : DIMENSIONS STORED')
3287 #endif
3288  !/
3289  !/ End of W3DIMUG ----------------------------------------------------- /
3290  !/
3291  END SUBROUTINE w3dimug
3292  !/ ------------------------------------------------------------------- /
3293  SUBROUTINE w3setref
3294  !/
3295  !/ +-----------------------------------+
3296  !/ | WAVEWATCH III NOAA/NCEP |
3297  !/ | F. Ardhuin |
3298  !/ | FORTRAN 90 |
3299  !/ | Last update : 13-Nov-2013 |
3300  !/ +-----------------------------------+
3301  !/
3302  !/ 13-Nov-2013 : Origination. ( version 4.13 )
3303  !/
3304  ! 1. Purpose :
3305  !
3306  ! Update reflection directions at shoreline.
3307  !
3308  ! 2. Method :
3309  !
3310  !
3311  ! 3. Parameters :
3312  !
3313  ! Parameter list
3314  ! ----------------------------------------------------------------
3315  ! None
3316  ! ----------------------------------------------------------------
3317  !
3318  ! 4. Subroutines used :
3319  !
3320  ! See module documentation.
3321  !
3322  ! 5. Called by :
3323  !
3324  ! Name Type Module Description
3325  ! ----------------------------------------------------------------
3326  ! WW3_GRID Prog. WW3_GRID Grid preprocessor
3327  ! W3ULEV Subr. W3UPDTMD Water level update
3328  ! ----------------------------------------------------------------
3329  !
3330  ! 6. Error messages :
3331  !
3332  ! None.
3333  !
3334  ! 7. Remarks :
3335  !
3336  ! 8. Structure :
3337  !
3338  ! See source code.
3339  !
3340  ! 9. Switches :
3341  !
3342  ! !/S Enable subroutine tracing.
3343  !
3344  ! 10. Source code :
3345  !
3346  !/ ------------------------------------------------------------------- /
3347  USE constants
3348 #ifdef W3_S
3349  USE w3servmd, ONLY : strace
3350 #endif
3351  !
3352  IMPLICIT NONE
3353  !/
3354  !/ ------------------------------------------------------------------- /
3355  !/
3356  INTEGER :: ISEA, IX, IY, IXY, IXN, IXP, IYN, IYP
3357  INTEGER :: J, K, NEIGH1(0:7)
3358  INTEGER :: ILEV, NLEV
3359 #ifdef W3_S
3360  INTEGER, SAVE :: IENT = 0
3361 #endif
3362 
3363  REAL :: TRIX(NY*NX), TRIY(NY*NX), DX, DY, &
3364  COSAVG, SINAVG, THAVG, ANGLES(0:7), CLAT
3365  !/
3366  !/ ------------------------------------------------------------------- /
3367  !/
3368 #ifdef W3_S
3369  CALL strace (ient, 'W3SETREF')
3370 #endif
3371  !
3372  ! 1. Preparations --------------------------------------------------- *
3373  !
3374 #ifdef W3_REF1
3375  IF (refpars(2).GT.0) rref(2)=.true.
3376  IF (refpars(3).GT.0) rref(3)=.true.
3377  IF (refpars(4).GT.0) rref(4)=.true.
3378  !
3379  DO iy=2, ny-1
3380  DO ix=2, nx-1
3381  IF (refpars(1).GT.0) rref(1)=.true.
3382  !No reflection from artificial island on pole.
3383  IF (flagll.AND.(ygrd(iy,ix).GT.85)) rref(1)=.false.
3384  IF (mapsta(iy,ix).GT.0) THEN
3385  !
3386  ! Prepares for reflection from subgrid islands
3387  !
3388  IF (rref(2)) &
3389  reflc(2,mapfs(iy,ix))= max((1. - trnx(iy,ix)),(1.-trny(iy,ix)))
3390  !
3391  ! Prepares for iceberg reflections
3392  !
3393  IF (rref(4)) &
3394  reflc(4,mapfs(iy,ix))= 1.
3395  !
3396  ! resolved shoreline reflection
3397  !
3398  IF (rref(1)) THEN
3399  reflc(1, mapfs(iy,ix)) = 0.
3400  refld(1:6,mapfs(iy,ix)) = 0
3401  !
3402  ! Search for neighboring coastline. 3 2 1
3403  ! around X. These are the neighbors of X: 4 X 0
3404  ! 5 6 7
3405  !
3406  !
3407  neigh1(0)=8*mapst2(iy,ix+1)+mapsta(iy,ix+1)
3408  neigh1(1:3)=8*mapst2(iy+1,ix+1:ix-1:-1)+mapsta(iy+1,ix+1:ix-1:-1)
3409  neigh1(4)=8*mapst2(iy,ix-1)+mapsta(iy,ix-1)
3410  neigh1(5:7)=8*mapst2(iy-1,ix-1:ix+1)+mapsta(iy-1,ix-1:ix+1)
3411  !
3412  ! if one of the surrounding points is land: determines directions ...
3413  !
3414  IF (minval(abs(neigh1)).EQ.0) THEN
3415  IF ( flagll ) THEN
3416  clat = cos(ygrd(iy,ix)*dera)
3417  ELSE
3418  clat = 1.
3419  END IF
3420  angles(0)= atan2(dydp(iy,ix),dxdp(iy,ix)*clat)
3421  angles(1)= atan2(dydp(iy,ix)+dydq(iy,ix),(dxdp(iy,ix)+dxdq(iy,ix))*clat)
3422  angles(2)= atan2(dydq(iy,ix),dxdq(iy,ix)*clat)
3423  angles(3)= atan2(dydq(iy,ix)-dydp(iy,ix),(dxdq(iy,ix)-dxdp(iy,ix))*clat)
3424  angles(4:7)= angles(0:3)+pi
3425  IF ((neigh1(0).GE.1).AND.(neigh1(4).GE.1)) THEN
3426  refld(3,mapfs(iy,ix))=0
3427  ELSE
3428  IF ((neigh1(0).GE.1).OR.(neigh1(4).GE.1)) refld(3,mapfs(iy,ix))=1
3429  END IF
3430  IF ((neigh1(2).EQ.1).AND.(neigh1(6).GE.1)) THEN
3431  refld(4,mapfs(iy,ix))=0
3432  ELSE
3433  IF ((neigh1(2).GE.1).OR.(neigh1(6).GE.1)) refld(4,mapfs(iy,ix))=1
3434  END IF
3435  !
3436  ! Looks for a locally straight coast in all 8 orientations
3437  !
3438  j=0
3439  refld(1,mapfs(iy,ix))=0
3440  cosavg=0
3441  sinavg=0
3442  ! Shore angle is corrected for grid rotation in w3ref1md.ftn with REFLD(5:6,MAPFS(IY,IX))
3443  refld(5,mapfs(iy,ix))= mod(nth+nint(angles(0)/tpi*nth),nth)
3444  refld(6,mapfs(iy,ix))= mod(nth+nint((angles(2)/tpi-0.25)*nth),nth)
3445 #endif
3446 #ifdef W3_REFT
3447  IF (iy.EQ.4) THEN
3448  WRITE(6,*) 'POINT (IX,IY):',ix,iy
3449  WRITE(6,*) 'REFT:',neigh1(3),neigh1(2), neigh1(1)
3450  WRITE(6,*) 'REFT:',neigh1(4),1, neigh1(0)
3451  WRITE(6,*) 'REFT:',neigh1(5:7)
3452  WRITE(6,*) 'ANG:',angles(3)*rade,angles(2)*rade, angles(1)*rade
3453  WRITE(6,*) 'ANG:',angles(4)*rade,1, angles(0) *rade
3454  WRITE(6,*) 'ANG:',angles(5:7)*rade
3455  WRITE(6,*) 'REFT:',xgrd(iy+1,ix-1:ix+1), ygrd(iy+1,ix-1:ix+1)
3456  WRITE(6,*) 'REFT:',xgrd(iy,ix-1:ix+1) , ygrd(iy,ix-1:ix+1)
3457  WRITE(6,*) 'REFT:',xgrd(iy-1,ix-1:ix+1), ygrd(iy-1,ix-1:ix+1)
3458  WRITE(6,*) 'REFLD:',refld(3:6,mapfs(iy,ix))
3459  ENDIF
3460 #endif
3461 #ifdef W3_REF1
3462  DO k=0,7
3463  IF (neigh1(k).EQ.0.AND.neigh1(mod(k+7,8)).EQ.0 &
3464  .AND.neigh1(mod(k+1,8)).EQ.0 &
3465  .AND.neigh1(mod(k+4,8)).NE.0) THEN
3466  reflc(1,mapfs(iy,ix))= refpars(1)
3467  !
3468  ! Defines direction index for specular reflection (normal to coast)
3469  !
3470  ! for example, if we have this layout 1 1 0
3471  ! (NB: 1 is sea, 0 is land) 1 X 0
3472  ! 1 1 0
3473  !
3474  ! then there is only a coastline detection for K=0, giving J=1
3475  ! and the final result will be REFLD(1,MAPFS(IY,IX))=1
3476  ! Namely, the direction TH(REFLD) is the direction pointing INTO the coast
3477  !
3478  refld(2,mapfs(iy,ix))= 2
3479  cosavg=cosavg+cos(angles(k)) !ECOS(1+(K*NTH)/8)
3480  sinavg=sinavg+sin(angles(k)) !ESIN(1+(K*NTH)/8)
3481  j=j+1
3482  ENDIF
3483  END DO
3484  IF (j.GT.0) THEN
3485  IF (j.GT.1) refld(2,mapfs(iy,ix))= 1
3486  thavg=atan2(sinavg,cosavg)
3487  refld(1,mapfs(iy,ix))=1+mod(nth+nint(thavg/tpi*nth),nth)
3488  ELSE
3489 
3490  ! 1 1 1
3491  ! Looks for mild corners like 1 1 1
3492  ! 1 0 0
3493  DO k=0,7
3494  IF (neigh1(k).EQ.0.AND.neigh1(mod(k+1,8)).EQ.0 &
3495  .AND.neigh1(mod(k+4,8)).NE.0) THEN
3496  reflc(1,mapfs(iy,ix))= refpars(1)
3497  refld(1,mapfs(iy,ix))= 1+mod((k*nth+(k+1)*nth)/16,nth)
3498  refld(2,mapfs(iy,ix))= 1
3499  ENDIF
3500  END DO
3501  ! 1 1 1 1 1 1
3502  ! Looks for sharp corners like 1 1 1 but not diagonals like 1 1 1
3503  ! 1 0 1 1 1 0
3504  IF (reflc(1,mapfs(iy,ix)).LE.0) THEN
3505  DO k=0,7,2
3506  IF ( neigh1(k).EQ.0.AND.neigh1(mod(k+4,8)).NE.0) THEN
3507  reflc(1,mapfs(iy,ix))= refpars(1)
3508  refld(1,mapfs(iy,ix))= 1+(k*nth)/8
3509  refld(2,mapfs(iy,ix))= 0
3510  !WRITE(6,*) 'NEIGH3:',IX,IY,K,NEIGH1,K*(NTH/8)
3511  END IF
3512  END DO
3513  END IF
3514  END IF
3515  ! End of test if surrounding point is land
3516  END IF
3517 #endif
3518 #ifdef W3_REFT
3519  IF (reflc(1,mapfs(iy,ix)).GT.0) THEN
3520  WRITE (6,*) 'COAST DIRECTION AT POINT:',ix,iy,' IS ', &
3521  refld(:,mapfs(iy,ix)),th(refld(1,mapfs(iy,ix)))*360/tpi
3522  ENDIF
3523 #endif
3524 #ifdef W3_REF1
3525  ! End of test if local point is sea
3526  END IF
3527  END IF
3528  END DO
3529  END DO
3530 #endif
3531  !
3532  RETURN
3533  !
3534  ! Formats
3535  !
3536  !/
3537  !/ End of W3SETREF ----------------------------------------------------- /
3538  !/
3539  END SUBROUTINE w3setref
3540 
3541  !/
3542  !/ End of module W3GDATMD -------------------------------------------- /
3543  !/
3544 END MODULE w3gdatmd
w3gdatmd::qr5oml
real, pointer qr5oml
Definition: w3gdatmd.F90:1371
w3gdatmd::ssdsc4
real, pointer ssdsc4
Definition: w3gdatmd.F90:1311
w3gdatmd::sdbc1
real, pointer sdbc1
Definition: w3gdatmd.F90:1393
w3gdatmd::ssdsc1
real, pointer ssdsc1
Definition: w3gdatmd.F90:1311
w3gdatmd::nk
integer, pointer nk
Definition: w3gdatmd.F90:1230
w3gdatmd::xflt
real, pointer xflt
Definition: w3gdatmd.F90:1245
w3gdatmd::ddelta2
real, pointer ddelta2
Definition: w3gdatmd.F90:1311
w3gdatmd::kdmn
real, pointer kdmn
Definition: w3gdatmd.F90:1347
w3gdatmd::nic42
integer, parameter nic42
Definition: w3gdatmd.F90:622
w3gdatmd::esc
real, dimension(:), pointer esc
Definition: w3gdatmd.F90:1234
w3gdatmd::iiceddisp
real, pointer iiceddisp
Definition: w3gdatmd.F90:1183
w3gdatmd::trigp
integer, dimension(:,:), pointer trigp
Definition: w3gdatmd.F90:1111
w3gdatmd::nseal
integer, pointer nseal
Definition: w3gdatmd.F90:1097
constants::pi
real, parameter pi
PI Value of Pi.
Definition: constants.F90:71
w3gdatmd::snlcs
real, dimension(:), pointer snlcs
Definition: w3gdatmd.F90:1361
w3gdatmd::sds6p2
integer, pointer sds6p2
Definition: w3gdatmd.F90:1337
w3gdatmd::funo3
logical, pointer funo3
Definition: w3gdatmd.F90:1264
w3gdatmd::do_change_wlv
logical, pointer do_change_wlv
Definition: w3gdatmd.F90:1407
w3gdatmd::nitersec1
integer, pointer nitersec1
Definition: w3gdatmd.F90:1181
w3gdatmd::iaa
integer, dimension(:), pointer iaa
Definition: w3gdatmd.F90:1124
w3gdatmd::wwcor
real, dimension(:), pointer wwcor
Definition: w3gdatmd.F90:1251
w3gdatmd::tail_id
integer, pointer tail_id
Definition: w3gdatmd.F90:1270
w3gdatmd::ndtab
integer, parameter ndtab
Definition: w3gdatmd.F90:637
w3gdatmd::ssinbr
real, pointer ssinbr
Definition: w3gdatmd.F90:1324
w3gdatmd::dth
real, pointer dth
Definition: w3gdatmd.F90:1232
w3gdatmd::frq
real, dimension(:), pointer frq
Definition: w3gdatmd.F90:1361
w3gdatmd::ygrd
double precision, dimension(:,:), pointer ygrd
Definition: w3gdatmd.F90:1205
w3gdatmd::swl6s6
logical, pointer swl6s6
Definition: w3gdatmd.F90:1338
w3gdatmd::gsu
type(t_gsu), pointer gsu
Definition: w3gdatmd.F90:1226
w3gdatmd::sstxftftail
real, pointer sstxftftail
Definition: w3gdatmd.F90:1340
w3gdatmd::sswellfpar
integer, pointer sswellfpar
Definition: w3gdatmd.F90:1321
w3gdatmd::snlmsc
real, pointer snlmsc
Definition: w3gdatmd.F90:1360
w3gdatmd::fspsi
logical, pointer fspsi
Definition: w3gdatmd.F90:1405
w3gdatmd::qi5ipl
integer, pointer qi5ipl
Definition: w3gdatmd.F90:1372
w3gdatmd::nspec
integer, pointer nspec
Definition: w3gdatmd.F90:1230
w3gdatmd::clatis
real, dimension(:), pointer clatis
Definition: w3gdatmd.F90:1197
w3gdatmd::is1c2
real, pointer is1c2
Definition: w3gdatmd.F90:1426
w3gdatmd::cd_max
real, pointer cd_max
Definition: w3gdatmd.F90:1286
w3gdatmd::ssdsbrfdf
integer, pointer ssdsbrfdf
Definition: w3gdatmd.F90:1321
w3gdatmd::flagunr
logical, pointer flagunr
Definition: w3gdatmd.F90:1193
w3gdatmd::sgrds
type(sgrd), dimension(:), allocatable, target sgrds
Definition: w3gdatmd.F90:1089
w3gdatmd::wwnmeanp
real, pointer wwnmeanp
Definition: w3gdatmd.F90:1311
w3gdatmd::sbtp
Definition: w3gdatmd.F90:968
w3gdatmd::nfrmax
integer, pointer nfrmax
Definition: w3gdatmd.F90:1356
w3gdatmd::ssdsbck
real, pointer ssdsbck
Definition: w3gdatmd.F90:1324
w3gdatmd::trnx
real, dimension(:,:), pointer trnx
Definition: w3gdatmd.F90:1200
w3gdatmd::zb
real, dimension(:), pointer zb
Definition: w3gdatmd.F90:1195
w3gdatmd::ddelta1
real, pointer ddelta1
Definition: w3gdatmd.F90:1311
w3gdatmd::sstxftwn
real, pointer sstxftwn
Definition: w3gdatmd.F90:1311
w3gdatmd::dxdq
real, dimension(:,:), pointer dxdq
Definition: w3gdatmd.F90:1206
w3gdatmd::ccps
real, pointer ccps
Definition: w3gdatmd.F90:1304
w3gdatmd::fswnd
logical, pointer fswnd
Definition: w3gdatmd.F90:1264
w3gdatmd::uostp
Definition: w3gdatmd.F90:998
constants::dera
real, parameter dera
DERA Conversion factor from degrees to radians.
Definition: constants.F90:77
w3gdatmd::ssdsc5
real, pointer ssdsc5
Definition: w3gdatmd.F90:1311
w3gdatmd::sdsc1
real, pointer sdsc1
Definition: w3gdatmd.F90:1301
w3gdatmd::flagst
logical, dimension(:), pointer flagst
Definition: w3gdatmd.F90:1221
w3gdatmd::ungtype
integer, parameter ungtype
Definition: w3gdatmd.F90:626
w3gdatmd::dmin
real, pointer dmin
Definition: w3gdatmd.F90:1183
w3gdatmd::ntri
integer, pointer ntri
Definition: w3gdatmd.F90:1109
w3gdatmd::p2msf
integer, dimension(:), pointer p2msf
Definition: w3gdatmd.F90:1098
w3gdatmd::ssdsdik
integer, pointer ssdsdik
Definition: w3gdatmd.F90:1321
w3gdatmd::mapsta_loc
integer, dimension(:), pointer mapsta_loc
Definition: w3gdatmd.F90:1115
w3gdatmd::fxfm
real, pointer fxfm
Definition: w3gdatmd.F90:1245
w3gdatmd::sed_d50
real, dimension(:), pointer sed_d50
Definition: w3gdatmd.F90:1214
w3gdatmd::iktab
integer, dimension(:,:), pointer iktab
Definition: w3gdatmd.F90:1321
w3gdatmd::ftwl
real, pointer ftwl
Definition: w3gdatmd.F90:1232
w3gdatmd::maxx
real, pointer maxx
Definition: w3gdatmd.F90:1133
w3gdatmd::mrfct
integer, pointer mrfct
Definition: w3gdatmd.F90:1167
w3gdatmd::ccng
real, pointer ccng
Definition: w3gdatmd.F90:1304
w3gdatmd::ssdsc
real, dimension(:), pointer ssdsc
Definition: w3gdatmd.F90:1324
w3gdatmd::rlgtype
integer, parameter rlgtype
Definition: w3gdatmd.F90:624
w3gdatmd::neigh
integer, dimension(:,:), pointer neigh
Definition: w3gdatmd.F90:1105
w3gdatmd::grid
Definition: w3gdatmd.F90:643
w3gdatmd::flx4a0
real, pointer flx4a0
Definition: w3gdatmd.F90:1289
w3gdatmd::is1c1
real, pointer is1c1
Definition: w3gdatmd.F90:1426
w3gdatmd::ctrny
real, dimension(:), pointer ctrny
Definition: w3gdatmd.F90:1202
w3gdatmd::nspl
integer, pointer nspl
Definition: w3gdatmd.F90:1376
w3gdatmd::mapth
integer, dimension(:), pointer mapth
Definition: w3gdatmd.F90:1231
w3gdatmd::b_jgs_diff_thr
real(8), pointer b_jgs_diff_thr
Definition: w3gdatmd.F90:1419
w3gdatmd::ic4_cn
real, dimension(:), pointer ic4_cn
Definition: w3gdatmd.F90:1154
w3gdatmd::cumulw
real, dimension(:,:), pointer cumulw
Definition: w3gdatmd.F90:1323
w3gdatmd::ijkvfc
integer, dimension(:,:), pointer ijkvfc
Definition: w3gdatmd.F90:1170
w3gdatmd::sdbp
Definition: w3gdatmd.F90:986
w3gdatmd::edges
integer, dimension(:,:), pointer edges
Definition: w3gdatmd.F90:1105
w3gdatmd::ie_cell
integer, dimension(:), pointer ie_cell
Definition: w3gdatmd.F90:1124
w3gdatmd::fsn
logical, pointer fsn
Definition: w3gdatmd.F90:1405
w3gdatmd::ofstab
real, pointer ofstab
Definition: w3gdatmd.F90:1304
w3gdatmd::iobpd_loc
integer *1, dimension(:,:), pointer iobpd_loc
Definition: w3gdatmd.F90:1116
w3gdatmd::sinit
logical, pointer sinit
Definition: w3gdatmd.F90:1237
w3gdatmd::cdsa2
real, pointer cdsa2
Definition: w3gdatmd.F90:1304
w3gdatmd::qst3
real, dimension(:,:,:), pointer qst3
Definition: w3gdatmd.F90:1361
w3gdatmd::reflc
real, dimension(:,:), pointer reflc
Definition: w3gdatmd.F90:1101
w3gdatmd::sds6a1
real, pointer sds6a1
Definition: w3gdatmd.F90:1335
w3gsrumd
Definition: w3gsrumd.F90:17
w3gdatmd::sig
real, dimension(:), pointer sig
Definition: w3gdatmd.F90:1234
w3gdatmd::xgrd
double precision, dimension(:,:), pointer xgrd
Definition: w3gdatmd.F90:1205
w3gdatmd::qst2
real, dimension(:,:,:), pointer qst2
Definition: w3gdatmd.F90:1361
w3gsrumd::iclo_smpl
integer, parameter, public iclo_smpl
Definition: w3gsrumd.F90:315
w3gdatmd::sy
real, pointer sy
Definition: w3gdatmd.F90:1183
w3gdatmd::cdsb3
real, pointer cdsb3
Definition: w3gdatmd.F90:1304
w3gdatmd::sgrd
Definition: w3gdatmd.F90:793
w3gdatmd::ffxfa
real, pointer ffxfa
Definition: w3gdatmd.F90:1324
w3gdatmd::b_jgs_pmin
real(8), pointer b_jgs_pmin
Definition: w3gdatmd.F90:1418
w3gdatmd::flck
logical, pointer flck
Definition: w3gdatmd.F90:1217
w3gdatmd::fsrefraction
logical, pointer fsrefraction
Definition: w3gdatmd.F90:1406
w3gdatmd::gqnf1
integer, pointer gqnf1
Definition: w3gdatmd.F90:1345
w3gdatmd::nspmax
integer, pointer nspmax
Definition: w3gdatmd.F90:1356
w3gdatmd::ic5pars
real, dimension(:), pointer ic5pars
Definition: w3gdatmd.F90:1158
w3gdatmd::i_diag
integer, dimension(:), pointer i_diag
Definition: w3gdatmd.F90:1124
w3gdatmd::angle0
real, dimension(:,:), pointer angle0
Definition: w3gdatmd.F90:1123
w3gdatmd::wwnmeanptail
real, pointer wwnmeanptail
Definition: w3gdatmd.F90:1340
w3gdatmd::ffng
real, pointer ffng
Definition: w3gdatmd.F90:1304
w3gdatmd::nlvvfc
integer, dimension(:), pointer nlvvfc
Definition: w3gdatmd.F90:1169
w3gdatmd::satweights
real, dimension(:,:), pointer satweights
Definition: w3gdatmd.F90:1323
w3gdatmd::snls2
real, pointer snls2
Definition: w3gdatmd.F90:1347
w3gdatmd::sbtc1
real, pointer sbtc1
Definition: w3gdatmd.F90:1384
w3gdatmd::fachfe
real, pointer fachfe
Definition: w3gdatmd.F90:1232
w3gdatmd::dcki
real, dimension(:,:), pointer dcki
Definition: w3gdatmd.F90:1323
w3gdatmd::ecos
real, dimension(:), pointer ecos
Definition: w3gdatmd.F90:1234
constants::rade
real, parameter rade
RADE Conversion factor from radians to degrees.
Definition: constants.F90:76
w3gdatmd::ssdsbrf1
real, pointer ssdsbrf1
Definition: w3gdatmd.F90:1324
w3gdatmd::grids
type(grid), dimension(:), allocatable, target grids
Definition: w3gdatmd.F90:1088
w3gdatmd::strp
Definition: w3gdatmd.F90:1005
w3gdatmd::xf1
real, pointer xf1
Definition: w3gdatmd.F90:1304
w3gdatmd::dden2
real, dimension(:), pointer dden2
Definition: w3gdatmd.F90:1234
w3gdatmd::gqthrsat
real, pointer gqthrsat
Definition: w3gdatmd.F90:1346
w3gdatmd::snll
real, dimension(:), pointer snll
Definition: w3gdatmd.F90:1361
w3gdatmd::ssdsabk
real, pointer ssdsabk
Definition: w3gdatmd.F90:1324
w3gdatmd::clatf
real, dimension(:), pointer clatf
Definition: w3gdatmd.F90:1202
w3gdatmd::gname
character(len=30), pointer gname
Definition: w3gdatmd.F90:1223
w3gdatmd::ny
integer, pointer ny
Definition: w3gdatmd.F90:1097
w3gdatmd::zzwnd
real, pointer zzwnd
Definition: w3gdatmd.F90:1311
w3gdatmd::dydq
real, dimension(:,:), pointer dydq
Definition: w3gdatmd.F90:1207
w3gdatmd::fhmax
real, pointer fhmax
Definition: w3gdatmd.F90:1245
w3gdatmd::nltail
real, pointer nltail
Definition: w3gdatmd.F90:1346
w3gdatmd::snsst
real, dimension(:,:), pointer snsst
Definition: w3gdatmd.F90:1377
w3gdatmd::iclbac
integer, dimension(:), pointer iclbac
Definition: w3gdatmd.F90:1171
w3gdatmd::fssource
logical, pointer fssource
Definition: w3gdatmd.F90:1406
w3gdatmd::nbedge
integer, pointer nbedge
Definition: w3gdatmd.F90:1104
w3gdatmd::iobp_loc
integer *2, dimension(:), pointer iobp_loc
Definition: w3gdatmd.F90:1117
w3gdatmd::qst6
real, dimension(:,:,:), pointer qst6
Definition: w3gdatmd.F90:1361
w3gdatmd::swl6cstb1
logical, pointer swl6cstb1
Definition: w3gdatmd.F90:1338
w3gdatmd::fswell
real, pointer fswell
Definition: w3gdatmd.F90:1304
w3gdatmd::dsip
real, dimension(:), pointer dsip
Definition: w3gdatmd.F90:1234
w3gdatmd::iobpa
integer *1, dimension(:), pointer iobpa
Definition: w3gdatmd.F90:1130
w3gdatmd::fpimin
real, pointer fpimin
Definition: w3gdatmd.F90:1304
w3gdatmd::ssdsbt
real, pointer ssdsbt
Definition: w3gdatmd.F90:1311
w3gdatmd::ssdsbrf2
real, pointer ssdsbrf2
Definition: w3gdatmd.F90:1324
w3gdatmd::prop
Definition: w3gdatmd.F90:815
w3gdatmd::cmprtrck
logical, pointer cmprtrck
Definition: w3gdatmd.F90:1220
w3gdatmd::tail_tran1
real, pointer tail_tran1
Definition: w3gdatmd.F90:1271
w3gdatmd::countot
integer, pointer countot
Definition: w3gdatmd.F90:1109
w3gdatmd::b_jgs_maxiter
integer, pointer b_jgs_maxiter
Definition: w3gdatmd.F90:1416
w3gdatmd::snlsfd
real, pointer snlsfd
Definition: w3gdatmd.F90:1360
w3gdatmd::iobdp_loc
integer *1, dimension(:), pointer iobdp_loc
Definition: w3gdatmd.F90:1118
w3gdatmd::sin6fc
real, pointer sin6fc
Definition: w3gdatmd.F90:1335
w3gdatmd::th
real, dimension(:), pointer th
Definition: w3gdatmd.F90:1234
w3gdatmd::iclose_none
integer, parameter iclose_none
Definition: w3gdatmd.F90:629
w3gdatmd::spcbac
real, dimension(:,:), pointer spcbac
Definition: w3gdatmd.F90:1204
w3gdatmd::crit_dep_stp
real(8), pointer crit_dep_stp
Definition: w3gdatmd.F90:1409
w3gdatmd::fxpm
real, pointer fxpm
Definition: w3gdatmd.F90:1245
w3gdatmd::solverthr_stp
real(8), pointer solverthr_stp
Definition: w3gdatmd.F90:1408
w3gdatmd::ismcbp
integer, dimension(:), pointer ismcbp
Definition: w3gdatmd.F90:1171
w3gdatmd::ijkufc5
integer, dimension(:), pointer ijkufc5
Definition: w3gdatmd.F90:1174
w3gdatmd::w3dimx
subroutine w3dimx(IMOD, MX, MY, MSEA, NDSE, NDST ifdef W3_SMC
Definition: w3gdatmd.F90:1582
w3gdatmd::tail_tran2
real, pointer tail_tran2
Definition: w3gdatmd.F90:1271
w3gdatmd::hqfac
real, dimension(:,:), pointer hqfac
Definition: w3gdatmd.F90:1212
w3gdatmd::ussp_wn
real, dimension(:), pointer ussp_wn
Definition: w3gdatmd.F90:1099
w3gdatmd::cnlsc2
real, pointer cnlsc2
Definition: w3gdatmd.F90:1377
w3gdatmd::b_jgs_terminate_difference
logical, pointer b_jgs_terminate_difference
Definition: w3gdatmd.F90:1411
w3gdatmd::nglo
integer, pointer nglo
Definition: w3gdatmd.F90:1168
w3gdatmd::w3setg
subroutine w3setg(IMOD, NDSE, NDST)
Definition: w3gdatmd.F90:2152
w3gdatmd::ffxfm
real, pointer ffxfm
Definition: w3gdatmd.F90:1311
w3gdatmd::xrel
real, pointer xrel
Definition: w3gdatmd.F90:1245
w3gdatmd::zzalp
real, pointer zzalp
Definition: w3gdatmd.F90:1311
w3gdatmd::slnc1
real, pointer slnc1
Definition: w3gdatmd.F90:1295
w3gdatmd::zz0rat
real, pointer zz0rat
Definition: w3gdatmd.F90:1311
w3gdatmd::iicehdisp
real, pointer iicehdisp
Definition: w3gdatmd.F90:1183
w3gdatmd::sdbsc
real, pointer sdbsc
Definition: w3gdatmd.F90:1395
w3gdatmd::b_jgs_source_nonlinear
logical, pointer b_jgs_source_nonlinear
Definition: w3gdatmd.F90:1422
w3gdatmd::ialt
integer, pointer ialt
Definition: w3gdatmd.F90:1368
w3gdatmd::xfc
real, pointer xfc
Definition: w3gdatmd.F90:1245
w3gdatmd::nthexp
integer, pointer nthexp
Definition: w3gdatmd.F90:1356
w3gdatmd::nspmx2
integer, pointer nspmx2
Definition: w3gdatmd.F90:1356
w3gdatmd::qst1
integer, dimension(:,:,:), pointer qst1
Definition: w3gdatmd.F90:1359
w3gdatmd::nbsmc
integer, pointer nbsmc
Definition: w3gdatmd.F90:1168
w3gdatmd::nufc
integer, pointer nufc
Definition: w3gdatmd.F90:1167
w3gdatmd::len
real(8), dimension(:,:), pointer len
Definition: w3gdatmd.F90:1122
w3gdatmd::rref
logical, dimension(:), pointer rref
Definition: w3gdatmd.F90:1138
w3gdatmd::nkd
integer, parameter nkd
Definition: w3gdatmd.F90:636
w3gdatmd::fachfa
real, pointer fachfa
Definition: w3gdatmd.F90:1232
w3gdatmd::clatmn
real, pointer clatmn
Definition: w3gdatmd.F90:1257
w3gdatmd::w3dims
subroutine w3dims(IMOD, MK, MTH, NDSE, NDST)
Definition: w3gdatmd.F90:1925
w3gdatmd::es2
real, dimension(:), pointer es2
Definition: w3gdatmd.F90:1234
w3gdatmd::sstxftf
real, pointer sstxftf
Definition: w3gdatmd.F90:1311
w3gdatmd::rstype
integer, pointer rstype
Definition: w3gdatmd.F90:1095
w3gdatmd::xsi
real, dimension(:), pointer xsi
Definition: w3gdatmd.F90:1361
w3gdatmd::dqdy
real, dimension(:,:), pointer dqdy
Definition: w3gdatmd.F90:1209
w3gdatmd::mapfs
integer, dimension(:,:), pointer mapfs
Definition: w3gdatmd.F90:1163
w3gdatmd::cdsb0
real, pointer cdsb0
Definition: w3gdatmd.F90:1304
w3gdatmd::snlnsc
real, pointer snlnsc
Definition: w3gdatmd.F90:1360
w3gdatmd::esin
real, dimension(:), pointer esin
Definition: w3gdatmd.F90:1234
w3gdatmd::ssdspbk
real, pointer ssdspbk
Definition: w3gdatmd.F90:1324
w3gdatmd::iicesmooth
logical, pointer iicesmooth
Definition: w3gdatmd.F90:1217
w3gdatmd::nsph
integer, pointer nsph
Definition: w3gdatmd.F90:1376
w3gdatmd::ssdsp
real, pointer ssdsp
Definition: w3gdatmd.F90:1311
w3gdatmd::aaircmin
real, pointer aaircmin
Definition: w3gdatmd.F90:1183
w3gdatmd::bbeta
real, pointer bbeta
Definition: w3gdatmd.F90:1311
w3gdatmd::nvfc
integer, pointer nvfc
Definition: w3gdatmd.F90:1167
w3gsrumd::iclo_none
integer, parameter, public iclo_none
Definition: w3gsrumd.F90:314
w3gdatmd::refld
integer, dimension(:,:), pointer refld
Definition: w3gdatmd.F90:1102
w3gdatmd::sed_psic
real, dimension(:), pointer sed_psic
Definition: w3gdatmd.F90:1214
w3gdatmd::b_jgs_block_gauss_seidel
logical, pointer b_jgs_block_gauss_seidel
Definition: w3gdatmd.F90:1415
w3gdatmd::dtms
real, pointer dtms
Definition: w3gdatmd.F90:1263
w3gdatmd::polat
real, pointer polat
Definition: w3gdatmd.F90:1191
w3gdatmd::cdsa1
real, pointer cdsa1
Definition: w3gdatmd.F90:1304
w3gdatmd::x0
real, pointer x0
Definition: w3gdatmd.F90:1183
w3gdatmd::nk2
integer, pointer nk2
Definition: w3gdatmd.F90:1230
w3gdatmd::nsea
integer, pointer nsea
Definition: w3gdatmd.F90:1097
w3gdatmd::fldp
Definition: w3gdatmd.F90:834
w3gdatmd::sdsaln
real, pointer sdsaln
Definition: w3gdatmd.F90:1304
w3gdatmd::nbnd_map
integer, pointer nbnd_map
Definition: w3gdatmd.F90:1113
w3gdatmd::sds6a2
real, pointer sds6a2
Definition: w3gdatmd.F90:1335
w3gdatmd::dydp
real, dimension(:,:), pointer dydp
Definition: w3gdatmd.F90:1207
w3gdatmd::clgtype
integer, parameter clgtype
Definition: w3gdatmd.F90:625
w3gdatmd::index_map
integer, dimension(:), pointer index_map
Definition: w3gdatmd.F90:1114
w3gdatmd::dtme
real, pointer dtme
Definition: w3gdatmd.F90:1257
w3servmd
Definition: w3servmd.F90:3
w3gdatmd::uostfilelocal
character(len=:), pointer uostfilelocal
Definition: w3gdatmd.F90:1400
w3gdatmd::ssdsbm
real, dimension(:), pointer ssdsbm
Definition: w3gdatmd.F90:1311
w3gdatmd::refran
real, pointer refran
Definition: w3gdatmd.F90:1263
w3gdatmd::dxdp
real, dimension(:,:), pointer dxdp
Definition: w3gdatmd.F90:1206
w3gdatmd::b_jgs_nlevel
integer, pointer b_jgs_nlevel
Definition: w3gdatmd.F90:1421
w3gdatmd::gqnt1
integer, pointer gqnt1
Definition: w3gdatmd.F90:1345
w3gdatmd::dsii
real, dimension(:), pointer dsii
Definition: w3gdatmd.F90:1234
w3gdatmd::iicehmin
real, pointer iicehmin
Definition: w3gdatmd.F90:1183
w3gdatmd::nbac
integer, pointer nbac
Definition: w3gdatmd.F90:1168
w3gdatmd::facsd
real, pointer facsd
Definition: w3gdatmd.F90:1245
w3gdatmd::lam
real, pointer lam
Definition: w3gdatmd.F90:1347
w3gdatmd::trflag
integer, pointer trflag
Definition: w3gdatmd.F90:1097
w3gdatmd::nthmax
integer, pointer nthmax
Definition: w3gdatmd.F90:1356
w3gdatmd::ja_ie
integer, dimension(:,:,:), pointer ja_ie
Definition: w3gdatmd.F90:1124
w3gdatmd::tria
real(8), dimension(:), pointer tria
Definition: w3gdatmd.F90:1131
w3gdatmd::fsfct
logical, pointer fsfct
Definition: w3gdatmd.F90:1405
w3gdatmd::dtmin
real, pointer dtmin
Definition: w3gdatmd.F90:1183
w3gdatmd::flcth
logical, pointer flcth
Definition: w3gdatmd.F90:1217
w3gdatmd::gqnq_om2
integer, pointer gqnq_om2
Definition: w3gdatmd.F90:1345
w3gdatmd::cdsb1
real, pointer cdsb1
Definition: w3gdatmd.F90:1304
w3gdatmd::ffxpm
real, pointer ffxpm
Definition: w3gdatmd.F90:1311
w3gdatmd::nth
integer, pointer nth
Definition: w3gdatmd.F90:1230
w3gdatmd::nthx
integer, pointer nthx
Definition: w3gdatmd.F90:1376
w3gdatmd::qst5
real, dimension(:,:,:), pointer qst5
Definition: w3gdatmd.F90:1361
w3gdatmd::xf2
real, pointer xf2
Definition: w3gdatmd.F90:1304
w3gdatmd::qi5nnz
integer(kind=8), pointer qi5nnz
Definition: w3gdatmd.F90:1373
w3gdatmd::fttr
real, pointer fttr
Definition: w3gdatmd.F90:1232
w3gdatmd::ijkvfc5
integer, dimension(:), pointer ijkvfc5
Definition: w3gdatmd.F90:1174
w3gdatmd::cdsa0
real, pointer cdsa0
Definition: w3gdatmd.F90:1304
w3gdatmd::clats
real, dimension(:), pointer clats
Definition: w3gdatmd.F90:1196
w3gdatmd::w3dimug
subroutine w3dimug(IMOD, MTRI, MX, COUNTOTA, NNZ, NDSE, NDST)
Definition: w3gdatmd.F90:3106
w3gdatmd::ien
real(8), dimension(:,:), pointer ien
Definition: w3gdatmd.F90:1122
w3gdatmd::sicp
Definition: w3gdatmd.F90:1023
w3gdatmd::ssdsbint
real, pointer ssdsbint
Definition: w3gdatmd.F90:1324
w3gdatmd::sbsp
Definition: w3gdatmd.F90:1014
w3gdatmd::schm
Definition: w3gdatmd.F90:1036
w3gdatmd::satindices
integer, dimension(:,:), pointer satindices
Definition: w3gdatmd.F90:1321
w3gdatmd::crossdiff
real, dimension(:,:), pointer crossdiff
Definition: w3gdatmd.F90:1132
w3gdatmd::iicedisp
logical, pointer iicedisp
Definition: w3gdatmd.F90:1217
w3gdatmd::iicehfac
real, pointer iicehfac
Definition: w3gdatmd.F90:1183
w3gdatmd::flsou
logical, pointer flsou
Definition: w3gdatmd.F90:1217
w3gdatmd::angarc
real, dimension(:), pointer angarc
Definition: w3gdatmd.F90:1204
w3gdatmd::itsa
integer, pointer itsa
Definition: w3gdatmd.F90:1368
w3gdatmd::mapsf
integer, dimension(:,:), pointer mapsf
Definition: w3gdatmd.F90:1163
w3gdatmd::swl6b1
real, pointer swl6b1
Definition: w3gdatmd.F90:1335
w3gdatmd::dpdx
real, dimension(:,:), pointer dpdx
Definition: w3gdatmd.F90:1208
w3gdatmd::btbeta
real, pointer btbeta
Definition: w3gdatmd.F90:1183
w3gdatmd::gsqrt
real, dimension(:,:), pointer gsqrt
Definition: w3gdatmd.F90:1210
w3gdatmd::fsnimp
logical, pointer fsnimp
Definition: w3gdatmd.F90:1405
w3gdatmd::cinxsi
real, pointer cinxsi
Definition: w3gdatmd.F90:1282
w3gdatmd::nbgl
integer, pointer nbgl
Definition: w3gdatmd.F90:1168
w3gdatmd::optioncall
integer optioncall
Definition: w3gdatmd.F90:1110
w3gdatmd::us3df
integer, dimension(:), pointer us3df
Definition: w3gdatmd.F90:1098
w3gdatmd::igrid
integer igrid
Definition: w3gdatmd.F90:618
w3gdatmd::sds6et
logical, pointer sds6et
Definition: w3gdatmd.F90:1338
w3gdatmd::npar
Definition: w3gdatmd.F90:804
w3gdatmd::ffps
real, pointer ffps
Definition: w3gdatmd.F90:1304
w3gdatmd::fsbccfl
logical, pointer fsbccfl
Definition: w3gdatmd.F90:1406
w3gdatmd::smctype
integer, parameter smctype
Definition: w3gdatmd.F90:627
w3gdatmd::cthg0s
real, dimension(:), pointer cthg0s
Definition: w3gdatmd.F90:1198
w3gdatmd::ijkvfc6
integer, dimension(:), pointer ijkvfc6
Definition: w3gdatmd.F90:1174
w3gdatmd::snlsfs
real, pointer snlsfs
Definition: w3gdatmd.F90:1360
w3gdatmd::facp
real, pointer facp
Definition: w3gdatmd.F90:1245
w3gdatmd::snlnq
integer, pointer snlnq
Definition: w3gdatmd.F90:1356
w3gdatmd::b_jgs_limiter
logical, pointer b_jgs_limiter
Definition: w3gdatmd.F90:1413
w3gdatmd::srcp
Definition: w3gdatmd.F90:877
w3gdatmd::isgrd
integer isgrd
Definition: w3gdatmd.F90:618
w3gdatmd::cdsb2
real, pointer cdsb2
Definition: w3gdatmd.F90:1304
w3gdatmd::countri
integer, pointer countri
Definition: w3gdatmd.F90:1109
w3gdatmd::iobpd
integer *1, dimension(:,:), pointer iobpd
Definition: w3gdatmd.F90:1130
w3gdatmd::w3setref
subroutine w3setref
Definition: w3gdatmd.F90:3294
w3gdatmd::nnz
integer, pointer nnz
Definition: w3gdatmd.F90:1109
w3gdatmd::ijkufc6
integer, dimension(:), pointer ijkufc6
Definition: w3gdatmd.F90:1174
w3gdatmd::sig2
real, dimension(:), pointer sig2
Definition: w3gdatmd.F90:1234
w3gdatmd::snls3
real, pointer snls3
Definition: w3gdatmd.F90:1347
w3gdatmd::pinit
logical, pointer pinit
Definition: w3gdatmd.F90:1241
w3gdatmd::mpar
Definition: w3gdatmd.F90:1066
w3gdatmd::iclose
integer, pointer iclose
Definition: w3gdatmd.F90:1096
w3gdatmd::fstotalexp
logical, pointer fstotalexp
Definition: w3gdatmd.F90:1405
w3gdatmd::nfrx
integer, pointer nfrx
Definition: w3gdatmd.F90:1376
w3gdatmd::fshf
real, pointer fshf
Definition: w3gdatmd.F90:1295
w3gdatmd::slnp
Definition: w3gdatmd.F90:865
w3gdatmd::jaa
integer, dimension(:), pointer jaa
Definition: w3gdatmd.F90:1124
w3gdatmd::fr1
real, pointer fr1
Definition: w3gdatmd.F90:1232
w3gdatmd::b_jgs_limiter_func
integer, pointer b_jgs_limiter_func
Definition: w3gdatmd.F90:1417
w3gdatmd::stexu
real, pointer stexu
Definition: w3gdatmd.F90:1183
w3gdatmd::kdcon
real, pointer kdcon
Definition: w3gdatmd.F90:1347
w3gdatmd::dpthnl
real, dimension(:), pointer dpthnl
Definition: w3gdatmd.F90:1353
w3gdatmd::ttauwshelter
real, pointer ttauwshelter
Definition: w3gdatmd.F90:1311
w3gdatmd::gqamp
real, dimension(:), pointer gqamp
Definition: w3gdatmd.F90:1346
w3gdatmd::xft
real, pointer xft
Definition: w3gdatmd.F90:1245
constants::tpi
real, parameter tpi
TPI 2*Pi.
Definition: constants.F90:72
w3gdatmd::cnlsc1
real, pointer cnlsc1
Definition: w3gdatmd.F90:1377
w3gdatmd::dpdy
real, dimension(:,:), pointer dpdy
Definition: w3gdatmd.F90:1208
w3gdatmd::maxy
real, pointer maxy
Definition: w3gdatmd.F90:1133
w3gdatmd::ficen
real, pointer ficen
Definition: w3gdatmd.F90:1183
w3gdatmd::ijkcel
integer, dimension(:,:), pointer ijkcel
Definition: w3gdatmd.F90:1170
w3gdatmd::ijkcel4
integer, dimension(:), pointer ijkcel4
Definition: w3gdatmd.F90:1174
w3servmd::strace
subroutine strace(IENT, SNAME)
Definition: w3servmd.F90:148
w3gdatmd::facti2
real, pointer facti2
Definition: w3gdatmd.F90:1232
w3gdatmd::gtype
integer, pointer gtype
Definition: w3gdatmd.F90:1094
w3gdatmd::mapwn
integer, dimension(:), pointer mapwn
Definition: w3gdatmd.F90:1231
w3gdatmd::iobdp
integer *1, dimension(:), pointer iobdp
Definition: w3gdatmd.F90:1130
w3gdatmd::sintailpar
real, dimension(:), pointer sintailpar
Definition: w3gdatmd.F90:1324
w3gdatmd::nkhs
integer, parameter nkhs
Definition: w3gdatmd.F90:636
w3gdatmd::w3nmod
subroutine w3nmod(NUMBER, NDSE, NDST, NAUX)
Definition: w3gdatmd.F90:1433
w3gdatmd::qi5kev
integer, pointer qi5kev
Definition: w3gdatmd.F90:1372
w3gdatmd::wdcg
real, pointer wdcg
Definition: w3gdatmd.F90:1260
w3gdatmd::xfr
real, pointer xfr
Definition: w3gdatmd.F90:1232
w3gdatmd::rwindc
real, pointer rwindc
Definition: w3gdatmd.F90:1248
w3gdatmd::ic4pars
integer, dimension(:), pointer ic4pars
Definition: w3gdatmd.F90:1151
w3gdatmd::flcy
logical, pointer flcy
Definition: w3gdatmd.F90:1217
w3gdatmd::sflp
Definition: w3gdatmd.F90:845
w3gdatmd::fdonly
logical, pointer fdonly
Definition: w3gdatmd.F90:1394
w3gdatmd::fverg
logical, pointer fverg
Definition: w3gdatmd.F90:1264
w3gdatmd::iobpa_loc
integer *1, dimension(:), pointer iobpa_loc
Definition: w3gdatmd.F90:1119
w3gdatmd::y0
real, pointer y0
Definition: w3gdatmd.F90:1183
w3gdatmd::sin6ws
real, pointer sin6ws
Definition: w3gdatmd.F90:1335
w3gdatmd::fldry
logical, pointer fldry
Definition: w3gdatmd.F90:1217
w3gdatmd::b_jgs_terminate_norm
logical, pointer b_jgs_terminate_norm
Definition: w3gdatmd.F90:1412
w3gdatmd::ssinthp
real, pointer ssinthp
Definition: w3gdatmd.F90:1311
w3gdatmd::fte
real, pointer fte
Definition: w3gdatmd.F90:1232
w3gdatmd::stedu
real, pointer stedu
Definition: w3gdatmd.F90:1183
w3gdatmd::ssdsiso
integer, pointer ssdsiso
Definition: w3gdatmd.F90:1321
w3gdatmd::aairgb
real, pointer aairgb
Definition: w3gdatmd.F90:1183
w3gdatmd::sds6p1
integer, pointer sds6p1
Definition: w3gdatmd.F90:1337
w3gdatmd::snls1
real, pointer snls1
Definition: w3gdatmd.F90:1347
w3gdatmd::ic2pars
real, dimension(:), pointer ic2pars
Definition: w3gdatmd.F90:1145
w3gdatmd::uostfactorshadow
real, pointer uostfactorshadow
Definition: w3gdatmd.F90:1401
w3gdatmd::dxymax
real, pointer dxymax
Definition: w3gdatmd.F90:1133
w3gdatmd::ccon
integer, dimension(:), pointer ccon
Definition: w3gdatmd.F90:1124
w3gdatmd::hpfac
real, dimension(:,:), pointer hpfac
Definition: w3gdatmd.F90:1211
w3gdatmd::snlp
Definition: w3gdatmd.F90:924
w3gdatmd::qbi
real, dimension(:,:), pointer qbi
Definition: w3gdatmd.F90:1323
w3gdatmd::iobp
integer *2, dimension(:), pointer iobp
Definition: w3gdatmd.F90:1129
w3gsrumd::iclo_trpl
integer, parameter, public iclo_trpl
Definition: w3gsrumd.F90:319
w3gdatmd::guginit
logical, pointer guginit
Definition: w3gdatmd.F90:1134
w3gdatmd::si
real(8), dimension(:), pointer si
Definition: w3gdatmd.F90:1122
w3gdatmd::sx
real, pointer sx
Definition: w3gdatmd.F90:1183
w3gdatmd::ffacberg
real, pointer ffacberg
Definition: w3gdatmd.F90:1136
w3gdatmd::icescales
real, dimension(:), pointer icescales
Definition: w3gdatmd.F90:1183
w3gdatmd::flcx
logical, pointer flcx
Definition: w3gdatmd.F90:1217
w3gdatmd::uostfileshadow
character(len=:), pointer uostfileshadow
Definition: w3gdatmd.F90:1400
w3gdatmd::narc
integer, pointer narc
Definition: w3gdatmd.F90:1168
constants
Define some much-used constants for global use (all defined as PARAMETER).
Definition: constants.F90:20
w3gdatmd::sbtcx
real, dimension(:), pointer sbtcx
Definition: w3gdatmd.F90:1387
w3gdatmd::qi5dis
integer, pointer qi5dis
Definition: w3gdatmd.F90:1372
w3gdatmd::ijkcel3
integer, dimension(:), pointer ijkcel3
Definition: w3gdatmd.F90:1174
w3gdatmd::b_jgs_use_jacobi
logical, pointer b_jgs_use_jacobi
Definition: w3gdatmd.F90:1414
w3gdatmd::shstab
real, pointer shstab
Definition: w3gdatmd.F90:1304
w3gdatmd::ic3pars
real, dimension(:), pointer ic3pars
Definition: w3gdatmd.F90:1148
w3gdatmd::nittin
integer, pointer nittin
Definition: w3gdatmd.F90:1281
w3gdatmd::dden
real, dimension(:), pointer dden
Definition: w3gdatmd.F90:1234
w3gdatmd
Definition: w3gdatmd.F90:16
w3gdatmd::sswellf
real, dimension(:), pointer sswellf
Definition: w3gdatmd.F90:1311
w3gdatmd::ipars
integer ipars
Definition: w3gdatmd.F90:618
w3gdatmd::iclose_trpl
integer, parameter iclose_trpl
Definition: w3gdatmd.F90:631
w3gdatmd::arctc
logical, pointer arctc
Definition: w3gdatmd.F90:1264
w3gdatmd::ssdscos
real, pointer ssdscos
Definition: w3gdatmd.F90:1311
w3gdatmd::b_jgs_terminate_maxiter
logical, pointer b_jgs_terminate_maxiter
Definition: w3gdatmd.F90:1410
w3gdatmd::ic4_ki
real, dimension(:), pointer ic4_ki
Definition: w3gdatmd.F90:1152
w3gdatmd::igpars
real, dimension(:), pointer igpars
Definition: w3gdatmd.F90:1142
w3gdatmd::refpars
real, dimension(:), pointer refpars
Definition: w3gdatmd.F90:1139
w3gdatmd::ndpths
integer, pointer ndpths
Definition: w3gdatmd.F90:1351
w3gdatmd::angle
real, dimension(:,:), pointer angle
Definition: w3gdatmd.F90:1123
w3gdatmd::steyu
real, pointer steyu
Definition: w3gdatmd.F90:1183
w3gdatmd::b_jgs_norm_thr
real(8), pointer b_jgs_norm_thr
Definition: w3gdatmd.F90:1420
w3gdatmd::dtcfli
real, pointer dtcfli
Definition: w3gdatmd.F90:1183
w3gdatmd::snlt
real, dimension(:), pointer snlt
Definition: w3gdatmd.F90:1361
w3gdatmd::pfmove
real, pointer pfmove
Definition: w3gdatmd.F90:1183
w3gdatmd::sinc1
real, pointer sinc1
Definition: w3gdatmd.F90:1301
w3gdatmd::zwind
real, pointer zwind
Definition: w3gdatmd.F90:1304
w3gdatmd::gridshift
real(8), pointer gridshift
Definition: w3gdatmd.F90:1189
w3gdatmd::ncel
integer, pointer ncel
Definition: w3gdatmd.F90:1167
w3gsrumd::w3gsup
subroutine, public w3gsup(GSU, IUNIT, LFULL)
Definition: w3gsrumd.F90:885
w3gdatmd::aalpha
real, pointer aalpha
Definition: w3gdatmd.F90:1311
w3gdatmd::ficel
real, pointer ficel
Definition: w3gdatmd.F90:1183
w3gdatmd::angld
real, dimension(:), pointer angld
Definition: w3gdatmd.F90:1192
w3gdatmd::cap_id
integer, pointer cap_id
Definition: w3gdatmd.F90:1285
w3gdatmd::capchnk
real, dimension(:), pointer capchnk
Definition: w3gdatmd.F90:1324
w3gdatmd::countcon
integer, dimension(:), pointer countcon
Definition: w3gdatmd.F90:1124
w3gdatmd::nfrcut
integer, pointer nfrcut
Definition: w3gdatmd.F90:1356
w3gdatmd::ftf
real, pointer ftf
Definition: w3gdatmd.F90:1232
w3gdatmd::qst4
integer, dimension(:,:,:), pointer qst4
Definition: w3gdatmd.F90:1359
w3gdatmd::ssdsdth
real, pointer ssdsdth
Definition: w3gdatmd.F90:1311
w3gdatmd::index_cell
integer, dimension(:), pointer index_cell
Definition: w3gdatmd.F90:1124
w3gdatmd::qi5pmx
integer, pointer qi5pmx
Definition: w3gdatmd.F90:1372
w3gdatmd::nqa
integer, pointer nqa
Definition: w3gdatmd.F90:1356
w3gdatmd::is2pars
real, dimension(:), pointer is2pars
Definition: w3gdatmd.F90:1161
w3gdatmd::tail_lev
real, pointer tail_lev
Definition: w3gdatmd.F90:1271
w3gdatmd::nlvufc
integer, dimension(:), pointer nlvufc
Definition: w3gdatmd.F90:1169
w3gdatmd::ic4_kibk
real, pointer ic4_kibk
Definition: w3gdatmd.F90:1155
w3gdatmd::facti1
real, pointer facti1
Definition: w3gdatmd.F90:1232
w3gdatmd::ssdsc6
real, pointer ssdsc6
Definition: w3gdatmd.F90:1311
w3gdatmd::qr5dpt
real, pointer qr5dpt
Definition: w3gdatmd.F90:1371
w3gdatmd::nrlv
integer, pointer nrlv
Definition: w3gdatmd.F90:1167
w3gdatmd::w3gntx
subroutine w3gntx(IMOD, NDSE, NDST)
Definition: w3gdatmd.F90:2881
w3gdatmd::iqtpe
integer, pointer iqtpe
Definition: w3gdatmd.F90:1345
w3gdatmd::ssdshck
real, pointer ssdshck
Definition: w3gdatmd.F90:1324
w3gdatmd::cnlsc
real, pointer cnlsc
Definition: w3gdatmd.F90:1377
w3gdatmd::cnlsa
real, pointer cnlsa
Definition: w3gdatmd.F90:1377
w3gdatmd::nx
integer, pointer nx
Definition: w3gdatmd.F90:1097
w3gdatmd::ic4_fmin
real, pointer ic4_fmin
Definition: w3gdatmd.F90:1155
w3gdatmd::ngrids
integer ngrids
Definition: w3gdatmd.F90:618
w3gdatmd::ctmax
real, pointer ctmax
Definition: w3gdatmd.F90:1183
w3gdatmd::fsfreqshift
logical, pointer fsfreqshift
Definition: w3gdatmd.F90:1406
w3gdatmd::fice0
real, pointer fice0
Definition: w3gdatmd.F90:1183
w3gdatmd::ic4_fc
real, dimension(:), pointer ic4_fc
Definition: w3gdatmd.F90:1153
w3gdatmd::cnlsc3
real, pointer cnlsc3
Definition: w3gdatmd.F90:1377
w3gdatmd::fspm
real, pointer fspm
Definition: w3gdatmd.F90:1295
w3gdatmd::nlvcel
integer, dimension(:), pointer nlvcel
Definition: w3gdatmd.F90:1169
w3gdatmd::mpars
type(mpar), dimension(:), allocatable, target mpars
Definition: w3gdatmd.F90:1090
w3gdatmd::ec2
real, dimension(:), pointer ec2
Definition: w3gdatmd.F90:1234
w3gdatmd::sdbc2
real, pointer sdbc2
Definition: w3gdatmd.F90:1393
w3gdatmd::zz0max
real, pointer zz0max
Definition: w3gdatmd.F90:1311
w3gdatmd::usspf
integer, dimension(:), pointer usspf
Definition: w3gdatmd.F90:1098
w3gdatmd::dtcfl
real, pointer dtcfl
Definition: w3gdatmd.F90:1183
w3gdatmd::ijkufc
integer, dimension(:,:), pointer ijkufc
Definition: w3gdatmd.F90:1170
w3gdatmd::iclose_smpl
integer, parameter iclose_smpl
Definition: w3gdatmd.F90:630
w3gdatmd::fstotalimp
logical, pointer fstotalimp
Definition: w3gdatmd.F90:1405
w3gdatmd::pos_cell
integer, dimension(:), pointer pos_cell
Definition: w3gdatmd.F90:1124
w3gdatmd::ftwn
real, pointer ftwn
Definition: w3gdatmd.F90:1232
w3gdatmd::snlc1
real, pointer snlc1
Definition: w3gdatmd.F90:1347
w3gdatmd::ginit
logical, pointer ginit
Definition: w3gdatmd.F90:1217
w3gdatmd::e3df
integer, dimension(:,:), pointer e3df
Definition: w3gdatmd.F90:1098
w3gdatmd::nauxgr
integer nauxgr
Definition: w3gdatmd.F90:618
w3gdatmd::iicefdisp
real, pointer iicefdisp
Definition: w3gdatmd.F90:1183
w3gdatmd::cnlsfm
real, pointer cnlsfm
Definition: w3gdatmd.F90:1377
w3gdatmd::dqdx
real, dimension(:,:), pointer dqdx
Definition: w3gdatmd.F90:1209
w3gdatmd::mapsta
integer, dimension(:,:), pointer mapsta
Definition: w3gdatmd.F90:1163
w3gdatmd::uostfactorlocal
real, pointer uostfactorlocal
Definition: w3gdatmd.F90:1401
w3gdatmd::xfh
real, pointer xfh
Definition: w3gdatmd.F90:1304
w3gdatmd::snlm
real, dimension(:), pointer snlm
Definition: w3gdatmd.F90:1361
w3gdatmd::iicehinit
real, pointer iicehinit
Definition: w3gdatmd.F90:1183
w3gdatmd::polon
real, pointer polon
Definition: w3gdatmd.F90:1191
w3gdatmd::sin6a0
real, pointer sin6a0
Definition: w3gdatmd.F90:1335
w3gdatmd::trny
real, dimension(:,:), pointer trny
Definition: w3gdatmd.F90:1200
w3gdatmd::mapst2
integer, dimension(:,:), pointer mapst2
Definition: w3gdatmd.F90:1163
w3gdatmd::ssdsc3
real, pointer ssdsc3
Definition: w3gdatmd.F90:1311
w3gsrumd::t_gsu
Definition: w3gsrumd.F90:325
w3gdatmd::nic4
integer, parameter nic4
Definition: w3gdatmd.F90:622
w3gdatmd::ssdsc2
real, pointer ssdsc2
Definition: w3gdatmd.F90:1311
w3gdatmd::nspmin
integer, pointer nspmin
Definition: w3gdatmd.F90:1356
w3gdatmd::nfrmin
integer, pointer nfrmin
Definition: w3gdatmd.F90:1356
w3gdatmd::dtmax
real, pointer dtmax
Definition: w3gdatmd.F90:1183
w3gdatmd::gqthrcou
real, pointer gqthrcou
Definition: w3gdatmd.F90:1346
w3gdatmd::posi
integer, dimension(:,:), pointer posi
Definition: w3gdatmd.F90:1124
w3gdatmd::snlcd
real, dimension(:), pointer snlcd
Definition: w3gdatmd.F90:1361
w3gdatmd::ctrnx
real, dimension(:), pointer ctrnx
Definition: w3gdatmd.F90:1202
w3gdatmd::flagll
logical, pointer flagll
Definition: w3gdatmd.F90:1219
w3gdatmd::wdth
real, pointer wdth
Definition: w3gdatmd.F90:1260
w3gdatmd::filext
character(len=13), pointer filext
Definition: w3gdatmd.F90:1224
w3gdatmd::ssdsbr
real, pointer ssdsbr
Definition: w3gdatmd.F90:1311