#include "w3macros.h" !/ !/ ------------------------------------------------------------------- / !/ Macros for enabling test output !/ #define TEST_W3GDATMD___disabled #define TEST_W3GDATMD_W3NMOD___disabled #define TEST_W3GDATMD_W3DIMX___disabled #define TEST_W3GDATMD_W3DIMS___disabled #define TEST_W3GDATMD_W3SETG___disabled #define TEST_W3GDATMD_W3GNTX___disabled #define TEST_W3GDATMD_W3DIMUG___disabled #define TEST_W3GDATMD_W3SETREF___disabled !/ !/ ------------------------------------------------------------------- / MODULE W3GDATMD !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ ! J. H. Alves ! !/ | F. Ardhuin | !/ | FORTRAN 90 | !/ | Last update : 05-Jun-2018 | !/ +-----------------------------------+ !/ !/ 24-Jun-2005 : Origination. ( version 3.07 ) !/ 09-Nov-2005 : Remove soft boundary options. ( version 3.08 ) !/ 23-Jun-2006 : Add data for W3SLN1. ( version 3.09 ) !/ 18-Jul-2006 : Add input grids. ( version 3.10 ) !/ 05-Oct-2006 : Add filter to array pointers. ( version 3.10 ) !/ 02-Feb-2007 : Add FLAGST. ( version 3.10 ) !/ 14-Apr-2007 : Add Miche style limiter. ( version 3.11 ) !/ ( J. H. Alves ) !/ 25-Apr-2007 : Adding Battjes-Janssen Sdb. ( version 3.11 ) !/ ( J. H. Alves ) !/ 06-Aug-2007 : Fixing SLNP !/SEED bug. ( version 3.13 ) !/ 18-Sep-2007 : Adding WAM4 source terms. ( version 3.13 ) !/ ( F. Ardhuin ) !/ 15-Apr-2008 : Clean up for distribution. ( version 3.14 ) !/ 27-Jun-2008 : Expand WAM4 variants namelist ( version 3.14 ) !/ ( F. Ardhuin ) !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) !/ (W. E. Rogers & T. J. Campbell, NRL) !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 ) !/ (W. E. Rogers & T. J. Campbell, NRL) !/ 29-Oct-2010 : Implement unstructured grids ( version 3.14.1 ) !/ (A. Roland and F. Ardhuin) !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to !/ specify index closure for a grid. ( version 3.14 ) !/ (T. J. Campbell, NRL) !/ 23-Dec-2010 : Fix HPFAC and HQFAC by including the COS(YGRD) !/ factor with DXDP and DXDQ terms. ( version 3.14 ) !/ (T. J. Campbell, NRL) !/ 05-Apr-2011 : Implement interations for DTMAX < 1s( version 3.14.1 ) !/ (F. Ardhuin) !/ 01-Jul-2011 : Movable bed bottom friction BT4 ( version 4.01 ) !/ 03-Nov-2011 : Bug fix: GUGINIT initialization ( version 4.04 ) !/ 29-Nov-2011 : Adding ST6 source term option. ( version 4.04 ) !/ (S. Zieger) !/ 14-Mar-2012 : Add PSIC for BT4 ( version 4.04 ) !/ 12-Jun-2012 : Add /RTD option or rotated grid variables. !/ (Jian-Guo Li) ( version 4.06 ) !/ 13-Jul-2012 : Move data structures GMD (SNL3) and nonlinear !/ filter (SNLS) from 3.15 (HLT). ( version 4.08 ) !/ 03-Sep-2012 : Clean up of UG grids ( version 4.08 ) !/ 12-Dec-2012 : Adding SMC grid. JG_Li ( version 4.09 ) !/ 16-Sep-2013 : Add Arctic part SMC grid. ( version 4.11 ) !/ 11-Nov-2013 : SMC and rotated grid incorporated in the main !/ trunk ( version 4.13 ) !/ 16-Nov-2013 : Allows reflection on curvi grids ( version 4.14 ) !/ 26-Jul-2013 : Adding IG waves ( version 4.16 ) !/ 18-Dec-2013 : Moving FLAGLL into GRID TYPE ( version 4.16 ) !/ 11-Jun-2014 : Changed reflection for subgrid ( version 5.01 ) !/ 10-Dec-2014 : Add checks for allocate status ( version 5.04 ) !/ 21-Aug-2015 : Add SMC FUNO3, FVERG options. JGLi ( version 5.09 ) !/ 04-May-2016 : Add IICEDISP GB&FA ( version 5.10 ) !/ 20-Jan-2017 : Update to new W3GSRUMD APIs ( version 6.02 ) !/ 20-Jan-2017 : Change to preprocessor macros to enable test output. !/ (T.J. Campbell, NRL) ( version 6.02 ) !/ 20-Jan-2017 : Change calculation of curvilinear grid metric and !/ derivatives calculations to use W3GSRUMD:W3CGDM. !/ (T.J. Campbell, NRL) ( version 6.02 ) !/ 07-Jan-2018 : Generalizes ICE100WIND to ICESCALES ( version 6.04 ) !/ 26-Mar-2018 : Add FSWND optional variable. JGLi ( version 6.02 ) !/ 05-Jun-2018 : Add PDLIB/DEBUGINIT and implcit scheme parameters !/ for unstructured grids ( version 6.04 ) !/ 18-Aug-2018 : S_{ice} IC5 (Q. Liu) ( version 6.06 ) !/ 20-Aug-2018: Extra namelist variables for ST6 ( version 6.06) !/ (Q. Liu, UoM) !/ 26-Aug-2018 : UOST (Mentaschi et al. 2015, 2018) ( version 6.06 ) !/ 27-Aug-2018 : Add BTBETA parameter ( version 6.06 ) !/ !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights !/ reserved. WAVEWATCH III is a trademark of the NWS. !/ No unauthorized use without permission. !/ ! 1. Purpose : ! ! Define data structures to set up wave model grids and aliases ! to use individual grids transparently. Also includes subroutines ! to manage data structure and pointing to individual models. ! Definition of grids and model set up. ! ! 2. Variables and types : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! NGRIDS Int. Public Number of grids, initialized at -1 ! to check proper model initialization. ! NAUXGR Int. Public Auxiliary grids. ! IGRID Int. Public Selected spatial grid, init. at -1. ! ISGRD Int. Public Selected spectral grid, init. at -1. ! IPARS Int. Public Selected num. and ph. pars, init. at -1. ! RLGTYPE I.P. Public Named constant for rectilinear grid type ! CLGTYPE I.P. Public Named constant for curvilinear grid type ! FLAGLL Log. Public Flag to indicate coordinate system for all grids ! .TRUE.: Spherical (lon/lat in degrees) ! .FALSE.: Cartesian (meters) ! GRID TYPE Public Data structure defining grid. ! GRIDS GRID Public Array of grids. ! SGRD TYPE Public Data structure defining spectral grid. ! SGRDS GRID Public Array of spectral grids. ! MPAR TYPE Public Data structure with all other model ! parameters. ! MPARS GRID Public Array of MPAR. ! ---------------------------------------------------------------- ! ! All elements of GRID are aliased to pointers with the same ! name. These pointers are defined as : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! GTYPE Int. Public Flag for type of grid ! RLGTYPE: Rectilinear grid ! CLGTYPE: Curvilinear grid ! UNGTYPE: Unstructured triangular grid ! RSTYPE Int. Public Integer identifyng restart type ! ICLOSE Int. Public Parameter indicating type of index closure of grid. ! ICLOSE_NONE: No grid closure ! ICLOSE_SMPL: Simple grid closure ! Grid is periodic in the i-index and wraps at ! I=NX+1. In other words, (NX+1,J) => (1,J). ! ICLOSE_TRPL: Tripole grid closure ! Grid is periodic in the i-index and and wraps at ! I=NX+1 and has closure at J=NY+1. In other words, ! (NX+1,J<=NY) => (1,J) and ! (I,NY+1) => (MOD(NX-I+1,NX)+1,NY). The tripole ! closure requires that NX be even. ! NX, NY Int. Public Discrete dimensions of spatial grid. ! NSEA(L) Int. Public Number of sea points (local for MPP). ! NU/VFc Int. Public Number of U/V faces for SMC grid. ! NRLv Int. Public Number of refined levels for SMC grid. ! NGLO Int. Public Number of cells in global part for SMC grid. ! NARC Int. Public Number of cells in Arctic part for SMC grid. ! NBAC Int. Public Number of boundary cells in Arctic part. ! NBGL Int. Public Number of boundary cells in global part. ! TRFLAG Int. Public Flag for use of transparencies ! 0: No sub-grid obstacles. ! 1: Obstructions at cell boundaries. ! 2: Obstructions at cell centers. ! 3: Like 1 with continuous ice. ! 4: Like 2 with continuous ice. ! MAPSTA I.A. Public Grid status map. ! MAPST2 I.A. Public Second grid status map. ! MAPxx I.A. Public Storage grid maps. ! IJKCel I.A. Public Cell info array for SMC grid. ! IJKU/VFc I.A. Public U/V-Face arrays for SMC grid. ! NLv* I.A. Public Cell, U/V-Face numbers of refine levels. ! ICLBAC I.A. Public Mapping index for Arctic boundary cells. ! SX,SY Real Public Spatial (rectilinear) grid increments. ! X0,Y0 Real Public Lower left corner of spatial (rectilinear) grid. ! DTCFL Real Public Maximum CFL time step X-Y propagation. ! DTCFLI Real Public Id. intra-spectral. ! DTMAX Real Public Maximum overall time step. ! DTMIN Real Public Minimum dynamic time step for source ! NITERSEC1 Real Public Number of interations when DTMAX < 1s ! DMIN Real Public Minimum water depth. ! CTMAX Real Public Maximum CFL number for depth refr. ! FICE0/N Real Public Cut-off ice conc. for ice coverage. ! FICEL Real Public Length scale for sea ice damping ! IICEHMIN Real Public Minimum thickness of sea ice ! IICEHDISP Real Public Minimum thickness of sea ice in the dispersion relation before relaxing the conv. criterion ! IICEHFAC Real Public Scale factor for sea ice thickness ! IICEHINIT Real Public Initial value of ice thickness ! ICESCALES R.A. Publ. Scaling coefficient for source terms in the presence of ice ! Default is 1.0, meaning that 100% ice ! concentration result in zero source term ! If set to 0.0, then ice has no direct impact on Sln / Sin / Snl / Sds ! IC3PARS R.A. Public various parameters for use in IC4, handled as ! an array for simplicity ! IC4_KI R.A. Public KI (dissipation rate) values for use in IC4 ! IC4_FC R.A. Public FC (frequency bin separators) for use in IC4 ! PFMOVE Real Public Tunable parameter in GSE correction ! for moving grids. ! GRIDSHIFT Real Public Grid offset for multi-grid w/SCRIP ! CMPRTRCK Log. Public True for traditional compression of track output ! PoLat/Lon R.A. Public Rotated N-Pole standard latitude/longitude. ! AnglD R.A. Public Rotation angle in degree to turn rotated grid ! back to standard grid. JGLi12Jun2012 ! FLAGUNR Log. Public True if rotating directions back to true north ! STEXU Real Public Length-scale (X) for space-time extreme averaging ! STEYU Real Public Length-scale (Y) for space-time extreme averaging ! STEDU Real Public Time-scale for space-time extreme averaging ! ZB R.A. Public Bottom levels on storage grid. ! CLATS(I) R.A. Public (Inverse) cosine of latitude at sea points. ! CTHG0S R.A. Public Constant in great-circle refr. term at sea points. ! TRNX/Y R.A. Public Transparencies in X/Y for sub-grid ! CTRNX/Y R.A. Public Sub-grid transparencies for SMC grid. ! ANGARC R.A. Public Rotation angle in degree for Arctic cells. ! SPCBAC R.A. Public Full 2-D spectra for Arctic boundary cells. ! X/YGRD R.A. Public Spatial grid coordinate arrays. ! SX/SYGRD R.A. Public Spatial grid increment arrays. ! GINIT Log. Public Flag identifying grid initialization. ! FLDRY Log. Public Flag for 'dry' run (IO and data ! processing only). ! FLCx Log. Public Flags for prop. is different spaces. ! FLSOU Log. Public Flag for source term calcualtion. ! FUNO3 Log. Public Flag for 3rd order UNO3 scheme on SMC grid. ! FVERG Log. Public Flag for 1-2-1 averaging smoothing on SMC grid. ! FSWND Log. Public Flag for sea-point only wind input on SMC grid. ! FLAGST L.A. Public Flag for source term computations ! for individual grid points. ! IICEDISP Log. Public Flag for use of the ice covered dispertion relation. ! IICESMOOTH Log. Public Flag to smooth the ice covered dispertion relation in broken ice. ! ! ! GNAME C*30 Public Grid name. ! FILEXT C*13 Public Extension of WAVEWATCH III file names ! default in 'ww3'. ! BTBETA Real Public The constant used for separating wind sea ! and swell when we estimate WBT ! ---------------------------------------------------------------- ! ! All elements of SGRD are aliased to pointers with the same ! name. These pointers are defined as : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! NK Int. Public Number of discrete wavenumbers. ! NK2 Int. Public Extended wavenumber range. ! NTH Int. Public Number of discrete directions. ! NSPEC Int. Public Number of discrete spectral bins. ! MAPxx I.A. Public Spectral maps. ! DTH Real Public Directional increments (radians). ! XFR Real Public Frequency multiplication factor. ! FR1 Real Public Lowest frequency (Hz) ! FTE Real Public Factor in tail integration energy. ! FTF Real Public Id. frequency. ! FTWN Real Public Id. wavenumber. ! FTTR Real Public Id. wave period. ! FTWL Real Public Id. wave length. ! FACTIn Real Public Factors for obtaining integer cut-off ! frequency. ! FACHFx Real Public Factor for tail. ! TH R.A Public Directions (radians). ! ESIN R.A Public Sine of discrete directions. ! ECOS R.A Public Cosine of discrete directions. ! ES2, ESC, EC2 ! R.A Public Sine and cosine products ! SIG R.A Public Relative frequencies (invariant ! in grid). (rad) ! SIG2 R.A Public Id. for full 2-D spectrum. ! DSIP R.A Public Frequency bandwidths (prop.) (rad) ! DSII R.A Public Frequency bandwidths (int.) (rad) ! DDEN R.A Public DSII * DTH * SIG (for integration ! based on energy) ! DDEN2 R.A Public Idem, full spectrum. ! SINIT Log. Public Flag identifying grid initialization. ! ---------------------------------------------------------------- ! ! The structure MPAR contains all other model parameters for ! numerical methods and physical parameterizations. It contains ! itself several structures as outlined below. ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! PINIT Log. Public Flag identifying initialization. ! NPARS NPAR Public Numerical parameters, ! PROPS PROP Public Parameters propagatrion schemes. ! SFLPS SFLP Public Parameters for flux computation. ! SLNPS SLNP Public Parameters Sln. ! SRCPS SRCP Public Parameters Sin and Sds. ! SNLPS SNLP Public Parameters Snl. ! SBTPS SBTP Public Parameters Sbt. ! SDBPS SDBP Public Parameters Sdb. ! STRPS STRP Public Parameters Str. ! SBSPS SBSP Public Parameters Sbs. ! SXXPS SXXP Public Parameters Sxx. ! ---------------------------------------------------------------- ! ! The structure NPAR contains numerical parameters and is aliased ! as above: ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! FACP Real Public Constant in maximum par. change in ! dynamic integration scheme (depends ! upon Xp). ! XREL Real Public Id. relative change. ! XFLT Real Public Id. filter level. ! FXFM Real Public Constant for mean frequency in ! cut-off. (!/ST1) ! FXPM Real Public Id. PM. ! XFT Real Public Constant for cut-off freq. (!/ST2) ! XFC Real Public Id. ! FACSD Real Public Constant in seeding algorithm. ! FHMAX Real Public Hs/depth ratio in limiter (!/MLIM) ! RWINDC Real Public Coefficient for current in relative ! wind (!/RWND) ! WWCOR R.A. Public Wind correction factors (!/WCOR) ! ---------------------------------------------------------------- ! ! The structure PROP contains parameters for the propagation ! schemes and is aliased as above: ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! DTME Real Public Swell age in disp. corr. (!/PR2) ! CLATMN Real Public Id. minimum cosine of lat. (!/PR2) ! ! WDCG Real Public Factors in width of av. Cg. (!/PR3) ! WDTH Real Public Factors in width of av. Th. (!/PR3) ! ---------------------------------------------------------------- ! ! The structure SFLP contains parameters for the fluxes ! and is aliased as above: ! ---------------------------------------------------------------- ! (!/FLX2) ! NITTIN Int. Public Number of itterations for drag calc. ! CINXSI Real Public Constant in parametric description ! (!/FLX3) ! NITTIN Int. Public Number of itterations for drag calc. ! CAP_ID Int Public Type of cap used. ! CINXSI Real Public Constant in parametric description ! CD_MAX Real Public Cap on Cd. ! (!/FLX4) ! FLX4A0 Real Public Scaling value in parametric description ! ---------------------------------------------------------------- ! ! The structure SLNP contains parameters for the linear input ! source terms and is aliased as above: ! ! ---------------------------------------------------------------- ! (!/LN1) ! SLNC1 Real Public Proportionality and other constants in ! input source term. ! FSPM Real Public Factor for fPM in filter. ! FSHF Real Public Factor for fh in filter. ! ---------------------------------------------------------------- ! ! The structure SRCP contains parameters for the input and dis, ! source terms and is aliased as above: ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! WWNMEANPTAIL R Public Power of tail for WNMEAN calculation ! SSTXFTFTAIL R Public Tail factor for WNMEAN calculation ! (!/ST1) ! SINC1 Real Public Proportionality and other constants in ! input source term. ! SDSC1 Real Public Combined constant in dissipation ! source term. ! (!/ST2) ! ZWIND Real Public Height at which the wind is defined ! of drag. ! FSWELL Real Public Reduction factor of negative input ! for swell. ! SHSTAB, OFSTAB, CCNG, CCPS, FFNG, FFPS ! Real Public Factors in effective wind speed. ! CDSAn Real Public Constants in high-freq. dis. ! SDSALN Real Public Factor for nondimensional 1-D spectrum. ! CDSBn Real Public Constants in parameterization of PHI. ! XFH Real Public Constant for turbulent length scale. ! XFn Real Public Constants in combining low and high ! frequency dissipation. ! (!/ST3) ! ZZWND Real Public Height at which the wind is defined ! AALPHA Real Public Minimum value of charnock parameter ! BBETA Real Public Wind-wave coupling coefficient ! ZZALP Real Public Wave age tuning coefficient in Sin ! TTAUWSHELTER Real Public Sheltering coefficient for short waves ! ZZ0MAX Real Public Maximum value of air-side roughness ! ZZ0RAT Real Public ratio of roughness for mean and ! oscillatory flows ! SSINTHP Real Public Power in cosine of wind input ! SSWELLF R.A. Public Swell damping coefficients ! SSDSCn Real Public Dissipation parameters ! SSDSBR Real Public Threshold in saturation spectrum for Sds ! SSDSP Real Public Power of B(k) in Sds ! WWNMEANP Real Public Power that defines the mean wavenumber ! in Sds ! SSTXFTF, SSTXFTWN Real Public Tail constants ! SSDSC4, Real Public Threshold shift in saturation diss. ! SSDSC5, Real Public Wave-turbulence dissipation factor ! SSDSC6, Real Public dissipation parameter ! DDELTA1 Real Public Low-frequency dissipation coefficient ! in WAM4 ! DDELTA2 Real Public High-frequency dissipation coefficient ! in WAM4 ! SSDSDTH Real Public Maximum angular sector for saturation ! spectrum ! SSDSCOS Real Public Power of cosine in saturation integral ! SSDSISO Int. Public Choice of definition of the isotropic ! saturation ! ---------------------------------------------------------------- ! ! The structure SNLP contains parameters for the nonl. inter. ! source term and is aliased as above: ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! (!/NL1) ! SNLC1 Real Public Scaled proportionality constant. ! LAM Real Public Factor defining quadruplet. ! KDCON Real Public Conversion factor for relative depth. ! KDMN Real Public Minimum relative depth. ! SNLSn Real Public Constants in shallow water factor. ! (!/NL2) ! IQTPE Int. Public Type of depth treatment ! 1 : Deep water ! 2 : Deep water / WAM scaling ! 3 : Finite water depth ! NDPTHS Int. Public Number of depth for which integration ! space needs to be computed. ! NLTAIL Real Public Tail factor for parametric tail. ! DPTHNL R.A. Public Depths corresponding to NDPTHS. ! *** NOTE: This array is not allocated ! in the W3DIMP routine *** ! (!/NL3) ! NFR Int. Public Number of frequencies or wavenumbers ! in discrete spectral space (NFR=>NK). ! NFRMIN Int. Public Minimum discrete frequency in the ! expanded frequency space. ! NFRMAX Int. Public Idem maximum for first part. ! NFRCUT Int. Public Idem maximum for second part. ! NTHMAX Int. Public Extension of directional space. ! NTHEXP Int Public Number of bins in extended dir. space. ! NSPMIN, NSPMAX, NSPMX2 ! Int. Public 1D spectral space range. ! FRQ R.A. Public Expanded frequency range (Hz). ! XSI R.A. Public Expanded frequency range (rad/s). ! NQA Int. Public Number of actual quadruplets. ! QST1 I.A. Public Spectral offsets for compuation of ! quadruplet spectral desnities. ! QST2 R.A. Public Idem weights. ! QST3 R.A. Public Proportionality constants and k factors ! in diagonal strength. ! QST4 I.A. Public Spectral offsets for combining of ! interactions and diagonal. ! QST5 R.A. Public Idem weights for interactions. ! QST6 R.A. Public Idem weights for diagonal. ! SNLNQ Int. Public Number of quadruplet definitions. ! SNLMSC Real Public Tuning power 'deep' scaling. ! SNLNSC Real Public Tuning power 'shallow' scaling. ! SNLSFD Real Public 'Deep' nondimensional filer freq. ! SNLSFS Real Public 'Shallow' nondimensional filer freq. ! SNLL R.A. Public Array with lambda for quadruplet. ! SNLM R.A. Public Array with mu for quadruplet. ! SNLT R.A. Public Array with Dtheta for quadruplet. ! SNLCD R.A. Public Array with Cd for quadruplet. ! SNLCS R.A. Public Array with Cs for quadruplet. ! (!/NL4) ! ITSA Int. Public Integer indicating TSA (1) or FBI (0) ! IALT Int. Public Integer determining alternating looping ! (!/NLS) ! NTHX Int. Public Expanded discrete direction range. ! NFRX Int. Public Expanded discrete frequency range. ! NSPL-H Int. Public Range of 1D spectrum. ! SNSST R.A. Public Array with interpolation weights. ! CNLSA Real Public a34 in quadruplet definition. ! CNLSC Real Public C in Snl definition. ! CNLSFM Real Public Maximum relative spectral change. ! CNLSC1/3 Real Public Constant in frequency filter. ! ---------------------------------------------------------------- ! ! The structure SBTP contains parameters for the bottom friction ! source term and is aliased as above: ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! SBTC1 Real Public Proportionality constant. (!/BT1) ! SBTCX R.A. Public Parameters for bottom fric. (!/BT4) ! ---------------------------------------------------------------- ! ! The structure SDBP contains parameters for the depth incduced ! breaking source term and is aliased as above: ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! SDBC1 Real Public Proportionality constant. (!/DB1) ! SDBC2 Real Public Hmax/d ratio. (!/DB1) ! FDONLY Log. Public Flag for checking depth only (!/DB1) ! otherwise Miche criterion. ! ---------------------------------------------------------------- ! ! The structure STRP contains parameters for the triad interaction ! source term and is aliased as above: ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! The structure SBSP contains parameters for the bottom scattering ! source term and is aliased as above: ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! The structure SICP contains parameters for arbitrary source ! term and is aliased as above: ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! IS1C1 Real Public Scale factor for icecon. (!/ISx) ! IS1C2 Real Public Offset for ice concentration (!/ISx) ! ---------------------------------------------------------------- ! ! The structure SXXP contains parameters for arbitrary source ! term and is aliased as above: ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! 3. Subroutines and functions : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! W3NMOD Subr. Public Set number of grids. ! W3DIMX Subr. Public Set dimensions of spatial grid. ! W3DIMS Subr. Public Set dimensions of spectral grid. ! W3SETG Subr. Public Point to selected grid / model. ! W3GNTX Subr. Public Construct grid arrays ! ---------------------------------------------------------------- ! ! 4. Subroutines and functions used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! EXTCDE Subr. W3SERVMD Abort program with exit code. ! ---------------------------------------------------------------- ! ! 5. Remarks : ! ! - In model versions before 3.06 the parameters in the grid ! structure were stored in the module W3IOGR. ! - No subroutine DIMP is provided, instead, arrays are set ! one-by-one in W3IOGR. ! ! 6. Switches : ! ! See subroutine documentation. ! ! !/PRn Select propagation scheme ! !/SMC UNO2 propagation on SMC grid. ! ! !/LNn Select source terms ! !/STn ! !/NLn ! !/BTn ! !/DBn ! !/TRn ! !/BSn ! !/XXn ! ! !/S Enable subroutine tracing. ! ! 7. Source code : ! !/ ------------------------------------------------------------------- / !/ !/ Required modules !/ USE W3GSRUMD !/ !/ Specify default accessibility !/ PUBLIC !/ !/ Module private variable for checking error returns !/ INTEGER, PRIVATE :: ISTAT !/ !/ Conventional declarations !/ INTEGER :: NGRIDS = -1, IGRID = -1, ISGRD = -1, & IPARS = -1, NAUXGR ! !/IC4 INTEGER, PARAMETER :: NIC4=10 INTEGER, PARAMETER :: RLGTYPE = 1 INTEGER, PARAMETER :: CLGTYPE = 2 INTEGER, PARAMETER :: UNGTYPE = 3 INTEGER, PARAMETER :: ICLOSE_NONE = ICLO_NONE INTEGER, PARAMETER :: ICLOSE_SMPL = ICLO_SMPL INTEGER, PARAMETER :: ICLOSE_TRPL = ICLO_TRPL ! ! Dimensions of tables for pre-computing of dissipation ! !/ST4 INTEGER, PARAMETER :: NKHS=2000, NKD=1300 !/ST4 INTEGER, PARAMETER :: NDTAB=2000 !/ !/ Data structures !/ !/ Grid type TYPE GRID ! this is the geographical grid with all associated parameters INTEGER :: GTYPE INTEGER :: RSTYPE = -1 INTEGER :: ICLOSE INTEGER :: NX, NY, NSEA, NSEAL, TRFLAG !/SEC1 INTEGER :: NITERSEC1 INTEGER, POINTER :: MAPSTA(:,:), MAPST2(:,:), & MAPFS(:,:), MAPSF(:,:) ! !/SMC !!Li Cell and face arrays for SMC grid. !/SMC INTEGER :: NCel, NUFc, NVFc, NRLv, MRFct !/SMC INTEGER, POINTER :: NLvCel(:), NLvUFc(:), NLvVFc(:) !/SMC INTEGER, POINTER :: IJKCel(:,:), IJKUFc(:,:), IJKVFc(:,:) ! !/ARC INTEGER :: NGLO, NARC, NBGL, NBAC !/ARC INTEGER, POINTER :: ICLBAC(:) ! REAL :: SX, SY, X0, Y0, DTCFL, DTCFLI, DTMAX, & DTMIN, DMIN, CTMAX, FICE0, FICEN, FICEL, & PFMOVE, STEXU, STEYU, STEDU, IICEHMIN, & IICEHINIT, ICESCALES(4), IICEHFAC, IICEHDISP, & IICEDDISP, IICEFDISP, BTBETA REAL(8) :: GRIDSHIFT ! see notes in WMGHGH !/RTD REAL :: PoLat, PoLon ! Rotated N-Pole lat/lon !/RTD REAL, POINTER :: AnglD(:) ! Angle in degree !/RTD LOGICAL :: FLAGUNR REAL , POINTER :: ZB(:) ! BOTTOM GRID, DEFINED ON ISEA REAL , POINTER :: CLATS(:) ! COS(LAT), DEFINED ON SEA POINTS REAL , POINTER :: CLATIS(:) ! INVERSE OF COS(LAT) DEFINED ON ISEA REAL , POINTER :: CTHG0S(:) ! TAN(Y)/R, DEFINED ON ISEA REAL , POINTER :: TRNX(:,:), TRNY(:,:) ! TRANSPARENCY INFORMATION ON IX,IY !/SMC REAL, POINTER :: CTRNX(:), CTRNY(:), CLATF(:) REAL, POINTER :: SPCBAC(:,:), ANGARC(:) REAL , POINTER :: XGRD(:,:), YGRD(:,:) ! X AND Y DEFINED ON IX,IY REAL , POINTER :: DXDP(:,:), DXDQ(:,:) ! DX/DP & DX/DQ DEFINED ON IX,IY REAL , POINTER :: DYDP(:,:), DYDQ(:,:) ! DY/DP & DY/DQ DEFINED ON IX,IY REAL , POINTER :: DPDX(:,:), DPDY(:,:) ! DP/DX & DP/DY DEFINED ON IX,IY REAL , POINTER :: DQDX(:,:), DQDY(:,:) ! DQ/DX & DQ/DY DEFINED ON IX,IY REAL , POINTER :: GSQRT(:,:) ! SQRT(G) DEFINED ON IX,IY REAL , POINTER :: HPFAC(:,:) ! H_P = SQRT(G_PP) DEFINED ON IX,IY REAL , POINTER :: HQFAC(:,:) ! H_Q = SQRT(G_QQ) DEFINED ON IX,IY LOGICAL :: GINIT, FLDRY, FLCX, FLCY, FLCTH, FLCK, FLSOU, IICEDISP,& IICESMOOTH LOGICAL :: FLAGLL LOGICAL :: CMPRTRCK LOGICAL, POINTER :: FLAGST(:) CHARACTER(LEN=30):: GNAME CHARACTER(LEN=13):: FILEXT LOGICAL :: GUGINIT !/REF1 REAL, POINTER :: REFLC(:,:) ! reflection coefficient !/REF1 INTEGER, POINTER :: REFLD(:,:) ! reflection direction INTEGER :: E3DF(3,5), P2MSF(3), US3DF(3), USSPF(2) ! freq. indices for 3D output REAL :: USSP_WN(25) !Max set to 25 decay scales. ! TYPE(T_GSU) :: GSU ! Grid search utility object ! REAL :: FFACBERG ! mutiplicative factor for iceberg mask !/BT4 REAL, POINTER :: SED_D50(:), SED_PSIC(:) !/REF1 LOGICAL, POINTER :: RREF(:) !/REF1 REAL, POINTER :: REFPARS(:) !/IG1 REAL, POINTER :: IGPARS(:) !/IC2 REAL, POINTER :: IC2PARS(:) !/IC3 REAL, POINTER :: IC3PARS(:) !/IC4 INTEGER, POINTER :: IC4PARS(:) !/IC4 REAL, POINTER :: IC4_KI(:) !/IC4 REAL, POINTER :: IC4_FC(:) !/IC5 REAL, POINTER :: IC5PARS(:) !/IS2 REAL, POINTER :: IS2PARS(:) ! ! unstructured data ! INTEGER :: NTRI DOUBLE PRECISION, POINTER :: XYB(:,:) INTEGER, POINTER :: TRIGP(:,:) !/PDLIB INTEGER :: NBND_MAP !/PDLIB INTEGER, POINTER :: INDEX_MAP(:) !/PDLIB INTEGER, POINTER :: MAPSTA_LOC(:) REAL(8), POINTER :: LEN(:,:),SI(:), IEN(:,:) REAL :: MAXX, MAXY, DXYMAX REAL, POINTER :: ANGLE(:,:),ANGLE0(:,:) INTEGER :: COUNTRI,COUNTOT,NNZ, NBEDGE INTEGER, POINTER :: CCON(:), COUNTCON(:), IE_CELL(:), & POS_CELL(:), IOBP(:), IOBPD(:,:), IOBDP(:), IOBPA(:), & !/PDLIB IOBPD_loc(:,:), IOBP_loc(:), & IAA(:), JAA(:), POSI(:,:), INDEX_CELL(:), & I_DIAG(:), JA_IE(:,:,:) INTEGER, POINTER :: EDGES(:,:), NEIGH(:,:) REAL(8), POINTER :: TRIA(:) REAL, POINTER :: CROSSDIFF(:,:) !/UOST CHARACTER(LEN=256) :: UOSTFILELOCAL, UOSTFILESHADOW !/UOST LOGICAL, ALLOCATABLE :: UOST_LCL_OBSTRUCTED(:,:), UOST_SHD_OBSTRUCTED(:,:) !/UOST INTEGER*1, ALLOCATABLE :: UOSTLOCALALPHA(:,:,:,:), UOSTLOCALBETA(:,:,:,:) !/UOST INTEGER*1, ALLOCATABLE :: UOSTSHADOWALPHA(:,:,:,:), UOSTSHADOWBETA(:,:,:,:) !/UOST REAL*4, ALLOCATABLE :: UOSTCELLSIZE(:,:,:) !/UOST REAL :: UOSTABMULTFACTOR = 100 !/UOST REAL :: UOSTCELLSIZEFACTOR = 1000 !/UOST REAL :: UOSTLOCALFACTOR = 1 !/UOST REAL :: UOSTSHADOWFACTOR = 1 !/UOST LOGICAL :: UOSTENABLED = .true. END TYPE GRID ! TYPE SGRD ! this is the spectral grid with all parameters that vary with freq. and direction INTEGER :: NK=0, NK2=0, NTH=0, NSPEC=0 INTEGER, POINTER :: MAPWN(:), MAPTH(:) REAL :: DTH=0., XFR=0., FR1=0., FTE=0., FTF=0., FTWN=0., FTTR=0., & FTWL=0., FACTI1=0., FACTI2=0., FACHFA=0., FACHFE=0. REAL, POINTER :: TH(:), ESIN(:), ECOS(:), ES2(:), & ESC(:), EC2(:), SIG(:), SIG2(:), & DSIP(:), DSII(:), DDEN(:), DDEN2(:) LOGICAL :: SINIT=.FALSE. END TYPE SGRD ! TYPE NPAR REAL :: FACP, XREL, XFLT, FXFM, FXPM, & XFT, XFC, FACSD, FHMAX !/RWND REAL :: RWINDC !/WCOR REAL :: WWCOR(2) END TYPE NPAR ! TYPE PROP !/PR0 REAL :: DUMMY !/PR1 REAL :: DUMMY !/PR2 REAL :: DTME, CLATMN !/PR3 REAL :: WDCG, WDTH !/SMC REAL :: DTME, CLATMN, Refran !/SMC LOGICAL :: FUNO3, FVERG, FSWND END TYPE PROP ! TYPE FLDP REAL :: DUMMY !/FLD1 INTEGER :: Tail_ID !/FLD1 REAL :: Tail_Lev, TAIL_TRAN1, TAIL_TRAN2 !/FLD2 INTEGER :: Tail_ID !/FLD2 REAL :: Tail_Lev, TAIL_TRAN1, TAIL_TRAN2 END TYPE FLDP TYPE SFLP !/FLX0 REAL :: DUMMY !/FLX1 REAL :: DUMMY !/FLX2 INTEGER :: NITTIN !/FLX2 REAL :: CINXSI !/FLX3 INTEGER :: NITTIN, CAP_ID !/FLX3 REAL :: CINXSI, CD_MAX !/FLX4 REAL :: FLX4A0 !/FLXX REAL :: DUMMY END TYPE SFLP ! TYPE SLNP !/SEED REAL :: DUMMY !/LN0 REAL :: DUMMY !/LN1 REAL :: SLNC1, FSPM, FSHF !/LNX REAL :: DUMMY END TYPE SLNP ! TYPE SRCP REAL :: WWNMEANPTAIL, SSTXFTFTAIL !/ST1 REAL :: SINC1, SDSC1 !/ST2 REAL :: ZWIND, FSWELL, SHSTAB, & !/ST2 OFSTAB, CCNG, CCPS, FFNG, FFPS, & !/ST2 CDSA0, CDSA1, CDSA2, SDSALN, & !/ST2 CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, & !/ST2 XFH, XF1, XF2 !/ST3 INTEGER :: SSDSISO, SSDSBRFDF !/ST3 REAL :: AALPHA, BBETA, ZZ0MAX, ZZ0RAT, ZZALP,& !/ST3 SSINTHP, TTAUWSHELTER, SSWELLF(1:6), & !/ST3 SSDSC1, SSDSC2, SSDSC3, SSDSBR, & !/ST3 SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, & !/ST3 FFXPM, FFXFM, & !/ST3 SSDSC4, SSDSC5, SSDSC6, DDELTA1, & !/ST3 DDELTA2, ZZWND ! !/ST4 INTEGER :: SSWELLFPAR, SSDSISO, SSDSBRFDF !/ST4 INTEGER, POINTER :: IKTAB(:,:), SATINDICES(:,:) !/ST4 REAL, POINTER :: DCKI(:,:), SATWEIGHTS(:,:),CUMULW(:,:),QBI(:,:) !/ST4 REAL :: AALPHA, BBETA, ZZ0MAX, ZZ0RAT, ZZALP,& !/ST4 SSINTHP, TTAUWSHELTER, SSWELLF(1:7), & !/ST4 SSDSC(1:11), SSDSBR, & !/ST4 SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, & !/ST4 FFXPM, FFXFM, FFXFA, FFXFI, FFXFD, & !/ST4 SSDSBRF1, SSDSBRF2, SSDSBINT,SSDSBCK,& !/ST4 SSDSHCK, SSDSABK, SSDSPBK, SSINBR !/ST4 REAL :: ZZWND !/ST4 REAL :: SSDSCOS, SSDSDTH, SSDSBR2, SSDSBM(0:4) ! !/ST6 REAL :: SIN6A0, SDS6A1, SDS6A2, SWL6B1, & !/ST6 SIN6WS, SIN6FC !/ST6 INTEGER :: SDS6P1, SDS6P2 !/ST6 LOGICAL :: SDS6ET, SWL6S6, SWL6CSTB1 ! !/STX REAL :: DUMMY END TYPE SRCP ! TYPE SNLP !/NL0 REAL :: DUMMY !/NL1 REAL :: SNLC1, LAM, KDCON, KDMN, & !/NL1 SNLS1, SNLS2, SNLS3 !/NL2 INTEGER :: IQTPE, NDPTHS !/NL2 REAL :: NLTAIL !/NL2 REAL, POINTER :: DPTHNL(:) !/NL3 INTEGER :: NFRMIN, NFRMAX, NFRCUT, NTHMAX, & !/NL3 NTHEXP, NSPMIN, NSPMAX, NSPMX2, & !/NL3 NQA, SNLNQ !/NL3 INTEGER, POINTER :: QST1(:,:,:), QST4(:,:,:) !/NL3 REAL :: SNLMSC, SNLNSC, SNLSFD, SNLSFS !/NL3 REAL, POINTER :: FRQ(:), XSI(:), & !/NL3 QST2(:,:,:), QST3(:,:,:), & !/NL3 QST5(:,:,:), QST6(:,:,:), & !/NL3 SNLL(:), SNLM(:), SNLT(:), & !/NL3 SNLCD(:), SNLCS(:) !/NL4 INTEGER :: ITSA, IALT !/NLX REAL :: DUMMY !/NLS INTEGER :: NTHX, NFRX, NSPL, NSPH !/NLS REAL :: CNLSA, CNLSC, CNLSFM, & !/NLS CNLSC1, CNLSC2, CNLSC3 !/NLS REAL, POINTER :: SNSST(:,:) END TYPE SNLP ! TYPE SBTP !/BTX REAL :: DUMMY !/BT0 REAL :: DUMMY !/BT1 REAL :: SBTC1 !/BT4 REAL :: SBTCX(10) !/BT8 REAL :: DUMMY !/BT9 REAL :: DUMMY END TYPE SBTP ! TYPE SDBP !/DB0 REAL :: DUMMY !/DB1 REAL :: SDBC1, SDBC2 !/DB1 LOGICAL :: FDONLY !/DBX REAL :: DUMMY END TYPE SDBP !/UOST TYPE UOSTP !/UOST CHARACTER(LEN=256) :: UOSTFILELOCAL, UOSTFILESHADOW !/UOST REAL :: UOSTFACTORLOCAL, UOSTFACTORSHADOW !/UOST END TYPE UOSTP ! TYPE STRP !/TR0 REAL :: DUMMY !/TR1 REAL :: DUMMY !/TRX REAL :: DUMMY END TYPE STRP ! TYPE SBSP !/BS0 REAL :: DUMMY !/BS1 REAL :: DUMMY !/BSX REAL :: DUMMY END TYPE SBSP ! TYPE SICP !/IS0 REAL :: DUMMY !/IS1 REAL :: IS1C1, IS1C2 !/IS2 REAL :: IS2C1, IS2C2 END TYPE SICP ! TYPE SXXP !/XX0 REAL :: DUMMY !/XXX REAL :: DUMMY END TYPE SXXP ! specific type for unstructured scheme TYPE SCHM LOGICAL :: FSN = .FALSE. LOGICAL :: FSPSI = .FALSE. LOGICAL :: FSFCT = .FALSE. LOGICAL :: FSNIMP = .FALSE. LOGICAL :: FSTOTALIMP = .FALSE. LOGICAL :: FSTOTALEXP = .FALSE. LOGICAL :: FSREFRACTION = .FALSE. LOGICAL :: FSFREQSHIFT = .FALSE. LOGICAL :: FSSOURCE = .FALSE. LOGICAL :: DO_CHANGE_WLV REAL(8) :: SOLVERTHR_STP REAL(8) :: CRIT_DEP_STP LOGICAL :: B_JGS_TERMINATE_MAXITER LOGICAL :: B_JGS_TERMINATE_DIFFERENCE LOGICAL :: B_JGS_TERMINATE_NORM LOGICAL :: B_JGS_LIMITER LOGICAL :: B_JGS_USE_JACOBI LOGICAL :: B_JGS_BLOCK_GAUSS_SEIDEL INTEGER :: B_JGS_MAXITER REAL*8 :: B_JGS_PMIN REAL*8 :: B_JGS_DIFF_THR REAL*8 :: B_JGS_NORM_THR INTEGER :: B_JGS_NLEVEL LOGICAL :: B_JGS_SOURCE_NONLINEAR END TYPE SCHM ! ! TYPE MPAR LOGICAL :: PINIT TYPE(NPAR) :: NPARS TYPE(PROP) :: PROPS TYPE(FLDP) :: FLDPS TYPE(SFLP) :: SFLPS TYPE(SLNP) :: SLNPS TYPE(SRCP) :: SRCPS TYPE(SNLP) :: SNLPS TYPE(SBTP) :: SBTPS TYPE(SDBP) :: SDBPS !/UOST TYPE(UOSTP) :: UOSTPS TYPE(STRP) :: STRPS TYPE(SBSP) :: SBSPS TYPE(SICP) :: SICPS TYPE(SXXP) :: SXXPS TYPE(SCHM) :: SCHMS END TYPE MPAR !/ !/ Data storage !/ TYPE(GRID), TARGET, ALLOCATABLE :: GRIDS(:) TYPE(SGRD), TARGET, ALLOCATABLE :: SGRDS(:) TYPE(MPAR), TARGET, ALLOCATABLE :: MPARS(:) !/ !/ Data aliases for structure GRID(S) !/ INTEGER, POINTER :: GTYPE INTEGER, POINTER :: RSTYPE INTEGER, POINTER :: ICLOSE INTEGER, POINTER :: NX, NY, NSEA, NSEAL, TRFLAG INTEGER, POINTER :: E3DF(:,:), P2MSF(:), US3DF(:), USSPF(:) REAL, POINTER :: USSP_WN(:) !/REF1 REAL, POINTER :: REFLC(:,:) !/REF1 INTEGER, POINTER :: REFLD(:,:) INTEGER, POINTER :: NBEDGE INTEGER, POINTER :: EDGES(:,:), NEIGH(:,:) ! ! Variables for unstructured grids ! INTEGER, POINTER :: NTRI,COUNTRI,COUNTOT,NNZ INTEGER :: optionCall = 3 ! take care all other options are basically wrong ! XYB may not be necessary now that we have XGRD and YGRD ! but these XGRD and YGRD should probably be double precision DOUBLE PRECISION, POINTER :: XYB(:,:) INTEGER, POINTER :: TRIGP(:,:) !/PDLIB INTEGER, POINTER :: NBND_MAP !/PDLIB INTEGER, POINTER :: INDEX_MAP(:) !/PDLIB INTEGER, POINTER :: MAPSTA_LOC(:) REAL(8), POINTER :: IEN(:,:), LEN(:,:), SI(:) REAL, POINTER :: ANGLE(:,:),ANGLE0(:,:) INTEGER, POINTER :: CCON(:), COUNTCON(:), IE_CELL(:), & POS_CELL(:), IOBP(:), IOBPD(:,:), IOBDP(:), IOBPA(:), & !/PDLIB IOBPD_loc(:,:), IOBP_loc(:), & IAA(:), JAA(:), POSI(:,:), & I_DIAG(:), JA_IE(:,:,:), & INDEX_CELL(:) REAL(8), POINTER :: TRIA(:) REAL, POINTER :: CROSSDIFF(:,:) REAL,POINTER :: MAXX, MAXY, DXYMAX LOGICAL, POINTER :: GUGINIT ! REAL, POINTER :: FFACBERG !/REF1 LOGICAL, POINTER :: RREF(:) !/REF1 REAL, POINTER :: REFPARS(:) !/IG1 REAL, POINTER :: IGPARS(:) !/IC2 REAL, POINTER :: IC2PARS(:) !/IC3 REAL, POINTER :: IC3PARS(:) !/IC4 INTEGER, POINTER :: IC4PARS(:) !/IC4 REAL, POINTER :: IC4_KI(:) !/IC4 REAL, POINTER :: IC4_FC(:) !/IC5 REAL, POINTER :: IC5PARS(:) !/IS2 REAL, POINTER :: IS2PARS(:) INTEGER, POINTER :: MAPSTA(:,:), MAPST2(:,:), & MAPFS(:,:), MAPSF(:,:) ! !/SMC INTEGER, POINTER :: NCel, NUFc, NVFc, NRLv, MRFct !/SMC INTEGER, POINTER :: NLvCel(:), NLvUFc(:), NLvVFc(:) !/SMC INTEGER, POINTER :: IJKCel(:,:), IJKUFc(:,:), IJKVFc(:,:) ! !/ARC INTEGER, POINTER :: NGLO, NARC, NBGL, NBAC !/ARC INTEGER, POINTER :: ICLBAC(:) ! !/SEC1 INTEGER, POINTER :: NITERSEC1 REAL, POINTER :: SX, SY, X0, Y0, DTCFL, DTCFLI, DTMAX, & DTMIN, DMIN, CTMAX, FICE0, FICEN, & FICEL, PFMOVE, STEXU, STEYU, STEDU, & IICEHMIN, IICEHINIT, ICESCALES(:), & IICEHFAC, IICEHDISP, IICEDDISP, IICEFDISP, & BTBETA REAL(8),POINTER :: GRIDSHIFT ! see notes in WMGHGH !/RTD REAL, POINTER :: PoLat, PoLon !/RTD REAL, POINTER :: AnglD(:) !/RTD LOGICAL, POINTER :: FLAGUNR REAL, POINTER :: ZB(:), CLATS(:) REAL , POINTER :: CLATIS(:) ! INVERSE OF COS(LAT) DEFINED ON ISEA REAL , POINTER :: CTHG0S(:) ! TAN(Y)/R, DEFINED ON ISEA REAL , POINTER :: TRNX(:,:), TRNY(:,:) ! TRANSPARENCY INFORMATION ON IX,IY !/SMC REAL, POINTER :: CTRNX(:), CTRNY(:), CLATF(:) REAL, POINTER :: SPCBAC(:,:), ANGARC(:) REAL , POINTER :: XGRD(:,:), YGRD(:,:) ! X AND Y DEFINED ON IX,IY REAL , POINTER :: DXDP(:,:), DXDQ(:,:) ! DX/DP & DX/DQ DEFINED ON IX,IY REAL , POINTER :: DYDP(:,:), DYDQ(:,:) ! DY/DP & DY/DQ DEFINED ON IX,IY REAL , POINTER :: DPDX(:,:), DPDY(:,:) ! DP/DX & DP/DY DEFINED ON IX,IY REAL , POINTER :: DQDX(:,:), DQDY(:,:) ! DQ/DX & DQ/DY DEFINED ON IX,IY REAL , POINTER :: GSQRT(:,:) ! SQRT(G) DEFINED ON IX,IY REAL , POINTER :: HPFAC(:,:) ! H_P = SQRT(G_PP) DEFINED ON IX,IY REAL , POINTER :: HQFAC(:,:) ! H_Q = SQRT(G_QQ) DEFINED ON IX,IY !/BT4 REAL, POINTER :: SED_D50(:), SED_PSIC(:) LOGICAL, POINTER :: GINIT, FLDRY, FLCX, FLCY, FLCTH, FLCK, FLSOU, IICEDISP,& IICESMOOTH LOGICAL, POINTER :: FLAGLL LOGICAL, POINTER :: CMPRTRCK LOGICAL, POINTER :: FLAGST(:) CHARACTER(LEN=30), POINTER :: GNAME CHARACTER(LEN=13), POINTER :: FILEXT TYPE(T_GSU), POINTER :: GSU ! Grid search utility object !/ !/ Data aliasses for structure SGRD(S) !/ INTEGER, POINTER :: NK, NK2, NTH, NSPEC INTEGER, POINTER :: MAPWN(:), MAPTH(:) REAL, POINTER :: DTH, XFR, FR1, FTE, FTF, FTWN, FTTR, & FTWL, FACTI1, FACTI2, FACHFA, FACHFE REAL, POINTER :: TH(:), ESIN(:), ECOS(:), ES2(:), & ESC(:), EC2(:), SIG(:), SIG2(:), & DSIP(:), DSII(:), DDEN(:), DDEN2(:) LOGICAL, POINTER :: SINIT !/ !/ Data aliasses for structure MPAR(S) !/ LOGICAL, POINTER :: PINIT !/ !/ Data aliasses for structure NPAR(S) !/ REAL, POINTER :: FACP, XREL, XFLT, FXFM, FXPM, & XFT, XFC, FACSD, FHMAX !/RWND REAL, POINTER :: RWINDC !/WCOR REAL, POINTER :: WWCOR(:) !/ !/ Data aliasses for structure PROP(S) !/ !/PR2 REAL, POINTER :: DTME, CLATMN !/PR3 REAL, POINTER :: WDCG, WDTH !/SMC REAL, POINTER :: DTME, CLATMN, Refran !/SMC LOGICAL, POINTER :: FUNO3, FVERG, FSWND !/ !/ Data aliasses for structure FLDP(S) !/ !/FLD1 INTEGER, POINTER :: TAIL_ID !/FLD1 REAL, POINTER :: TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 !/FLD2 INTEGER, POINTER :: TAIL_ID !/FLD2 REAL, POINTER :: TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 !/ !/ Data aliasses for structure SFLP(S) !/ !/FLX2 INTEGER, POINTER :: NITTIN !/FLX2 REAL, POINTER :: CINXSI !/FLX3 INTEGER, POINTER :: NITTIN, CAP_ID !/FLX3 REAL, POINTER :: CINXSI, CD_MAX !/FLX4 REAL, POINTER :: FLX4A0 !/ !/ Data aliasses for structure SLNP(S) !/ !/LN1 REAL, POINTER :: SLNC1, FSPM, FSHF !/ !/ Data aliasses for structure SRCP(S) !/ !/ST1 REAL, POINTER :: SINC1, SDSC1 !/ST2 REAL, POINTER :: ZWIND, FSWELL, SHSTAB, & !/ST2 OFSTAB, CCNG, CCPS, FFNG, FFPS, & !/ST2 CDSA0, CDSA1, CDSA2, SDSALN, & !/ST2 CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, & !/ST2 XFH, XF1, XF2 !/ST3 REAL, POINTER :: ZZWND, AALPHA, BBETA, ZZ0MAX, ZZ0RAT,& !/ST3 ZZALP, FFXFM, FFXPM, & !/ST3 SSINTHP, TTAUWSHELTER, SSWELLF(:), & !/ST3 SSDSC1, SSDSC2, SSDSC3, SSDSBR, & !/ST3 SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, & !/ST3 SSDSC4, SSDSC5, SSDSC6, SSDSBR2, & !/ST3 DDELTA1, DDELTA2, & !/ST3 SSDSCOS, SSDSDTH, SSDSBM(:) !/ST4 INTEGER, POINTER :: SSWELLFPAR, SSDSISO,SSDSBRFDF, & !/ST4 IKTAB(:,:), SATINDICES(:,:),SSDSDIK !/ST4 REAL, POINTER :: DCKI(:,:), SATWEIGHTS(:,:),CUMULW(:,:),QBI(:,:) !/ST4 REAL, POINTER :: ZZWND, AALPHA, BBETA, ZZ0MAX, ZZ0RAT,& !/ST4 ZZALP, FFXFA, FFXFI, FFXFD, & !/ST4 FFXFM, FFXPM, SSDSBRF1, SSDSBRF2, & !/ST4 SSDSBINT, SSDSBCK, SSDSHCK, SSDSABK, & !/ST4 SSDSPBK, SSINBR,SSINTHP,TTAUWSHELTER,& !/ST4 SSWELLF(:), SSDSC(:), SSDSBR, & !/ST4 SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, & !/ST4 SSDSBR2, SSDSCOS, SSDSDTH, SSDSBM(:) !/ST6 REAL, POINTER :: SIN6A0, SDS6A1, SDS6A2, SWL6B1, & !/ST6 SIN6WS, SIN6FC !/ST6 INTEGER, POINTER :: SDS6P1, SDS6P2 !/ST6 LOGICAL, POINTER :: SDS6ET, SWL6S6, SWL6CSTB1 REAL, POINTER :: WWNMEANPTAIL, SSTXFTFTAIL !/ !/ Data aliasses for structure SNLP(S) !/ !/NL1 REAL, POINTER :: SNLC1, LAM, KDCON, KDMN, & !/NL1 SNLS1, SNLS2, SNLS3 !/NL2 INTEGER, POINTER :: IQTPE, NDPTHS !/NL2 REAL, POINTER :: NLTAIL !/NL2 REAL, POINTER :: DPTHNL(:) !/NL3 INTEGER, POINTER :: NFRMIN, NFRMAX, NFRCUT, NTHMAX, & !/NL3 NTHEXP, NSPMIN, NSPMAX, NSPMX2, & !/NL3 NQA, SNLNQ !/NL3 INTEGER, POINTER :: QST1(:,:,:), QST4(:,:,:) !/NL3 REAL, POINTER :: SNLMSC, SNLNSC, SNLSFD, SNLSFS !/NL3 REAL, POINTER :: FRQ(:), XSI(:), & !/NL3 QST2(:,:,:), QST3(:,:,:), & !/NL3 QST5(:,:,:), QST6(:,:,:), & !/NL3 SNLL(:), SNLM(:), SNLT(:), & !/NL3 SNLCD(:), SNLCS(:) !/NL4 INTEGER, POINTER :: ITSA, IALT !/NLS INTEGER, POINTER :: NTHX, NFRX, NSPL, NSPH !/NLS REAL, POINTER :: CNLSA, CNLSC, CNLSFM, & !/NLS CNLSC1, CNLSC2, CNLSC3, SNSST(:,:) !/ !/ Data aliasses for structure SBTP(S) !/ !/BT1 REAL, POINTER :: SBTC1 !/BT4 REAL, POINTER :: SBTCX(:) !/ !/ Data aliasses for structure SDBP(S) !/ !/DB1 REAL, POINTER :: SDBC1, SDBC2 !/DB1 LOGICAL, POINTER :: FDONLY !/ !/UOST!/ Data aliases for structure UOSTP(S) !/UOST CHARACTER(LEN=:), POINTER :: UOSTFILELOCAL, UOSTFILESHADOW !/UOST REAL, POINTER :: UOSTFACTORLOCAL, UOSTFACTORSHADOW !/ !/ Data aliasing for structure SCHM(S) LOGICAL, POINTER :: FSN,FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP LOGICAL, POINTER :: FSREFRACTION, FSFREQSHIFT, FSSOURCE LOGICAL, POINTER :: DO_CHANGE_WLV REAL(8), POINTER :: SOLVERTHR_STP REAL(8), POINTER :: CRIT_DEP_STP LOGICAL, POINTER :: B_JGS_TERMINATE_MAXITER LOGICAL, POINTER :: B_JGS_TERMINATE_DIFFERENCE LOGICAL, POINTER :: B_JGS_TERMINATE_NORM LOGICAL, POINTER :: B_JGS_LIMITER LOGICAL, POINTER :: B_JGS_USE_JACOBI LOGICAL, POINTER :: B_JGS_BLOCK_GAUSS_SEIDEL INTEGER, POINTER :: B_JGS_MAXITER REAL(8), POINTER :: B_JGS_PMIN REAL(8), POINTER :: B_JGS_DIFF_THR REAL(8), POINTER :: B_JGS_NORM_THR INTEGER, POINTER :: B_JGS_NLEVEL LOGICAL, POINTER :: B_JGS_SOURCE_NONLINEAR !/ !/ Data aliasing for structure SICP(S) !/IS1 REAL, POINTER :: IS1C1, IS1C2 !/ CONTAINS !/ ------------------------------------------------------------------- / SUBROUTINE W3NMOD ( NUMBER, NDSE, NDST, NAUX ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 10-Dec-2014 ! !/ +-----------------------------------+ !/ !/ 24-Feb-2004 : Origination. ( version 3.06 ) !/ 18-Jul-2006 : Add input grids. ( version 3.10 ) !/ 10-Dec-2014 : Add checks for allocate status ( version 5.04 ) !/ ! 1. Purpose : ! ! Set up the number of grids to be used. ! ! 2. Method : ! ! Store in NGRIDS and allocate GRIDS. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! NUMBER Int. I Number of grids to be used. ! NDSE Int. I Error output unit number. ! NDST Int. I Test output unit number. ! NAUX Int. I Number of auxiliary grids to be used. ! Grids -NAUX:NUBMER are defined, optional ! parameters. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! See module documentation. ! ! 5. Called by : ! ! Any program that uses this grid structure. ! ! 6. Error messages : ! ! - Error checks on previous setting of variable. ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY: EXTCDE !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: NUMBER, NDSE, NDST INTEGER, INTENT(IN), OPTIONAL :: NAUX !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: I, NLOW !/S INTEGER, SAVE :: IENT = 0 !/ !/S CALL STRACE (IENT, 'W3NMOD') ! ! -------------------------------------------------------------------- / ! 1. Test input and module status ! IF ( NGRIDS .NE. -1 ) THEN WRITE (NDSE,1001) NGRIDS CALL EXTCDE (1) END IF ! IF ( NUMBER .LT. 1 ) THEN WRITE (NDSE,1002) NUMBER CALL EXTCDE (2) END IF ! IF ( PRESENT(NAUX) ) THEN NLOW = -NAUX ELSE NLOW = 1 END IF ! IF ( NLOW .GT. 1 ) THEN WRITE (NDSE,1003) -NLOW CALL EXTCDE (3) END IF ! ! -------------------------------------------------------------------- / ! 1. Set variable and allocate arrays ! NGRIDS = NUMBER NAUXGR = - NLOW ALLOCATE ( GRIDS(NLOW:NUMBER), & SGRDS(NLOW:NUMBER), & MPARS(NLOW:NUMBER), & STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ! ! -------------------------------------------------------------------- / ! 2. Initialize GINIT and SINIT ! DO I=NLOW, NUMBER GRIDS(I)%GINIT = .FALSE. GRIDS(I)%GUGINIT = .FALSE. SGRDS(I)%SINIT = .FALSE. MPARS(I)%PINIT = .FALSE. !/NL2 MPARS(I)%SNLPS%NDPTHS = 0 END DO #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3NMOD) WRITE (NDST,9000) NLOW, NGRIDS #endif ! RETURN ! ! Formats ! 1001 FORMAT (/' *** ERROR W3NMOD : GRIDS ALREADY INITIALIZED *** '/ & ' NGRIDS = ',I10/) 1002 FORMAT (/' *** ERROR W3NMOD : ILLEGAL NUMBER OF GRIDS *** '/ & ' NUMBER = ',I10/) 1003 FORMAT (/' *** ERROR W3NMOD : ILLEGAL NUMBER OF AUX GRIDS *** '/& ' NUMBER = ',I10/) #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3NMOD) 9000 FORMAT (' TEST W3NMOD : SETTING UP FOR GRIDS ',I3, & ' THROUGH ',I3) #endif !/ !/ End of W3NMOD ----------------------------------------------------- / !/ END SUBROUTINE W3NMOD !/ ------------------------------------------------------------------- / SUBROUTINE W3DIMX ( IMOD, MX, MY, MSEA, NDSE, NDST & !/SMC , MCel, MUFc, MVFc, MRLv & !/ARC , MARC, MBAC, MSPEC & ) !/SMC !!Li A few dimensional numbers for SMC grid. !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 10-Dec-2014 | !/ +-----------------------------------+ !/ !/ 24-Jun-2005 : Origination. ( version 3.07 ) !/ 18-Jul-2006 : Add input grids. ( version 3.10 ) !/ 05-Oct-2006 : Add filter to array pointers. ( version 3.10 ) !/ 02-Feb-2007 : Add FLAGST. ( version 3.10 ) !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) !/ (W. E. Rogers & T. J. Campbell, NRL) !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 ) !/ (W. E. Rogers & T. J. Campbell, NRL) !/ 30-Oct-2009 : Implement unstructured grids ( version 3.14.1) !/ 03-Sep-2012 : Clean up of UG grids ( version 4.08 ) !/ 10-Dec-2014 : Add checks for allocate status ( version 5.04 ) !/ ! 1. Purpose : ! ! Initialize an individual spatial grid at the proper dimensions. ! ! 2. Method : ! ! Allocate directly into the structure array GRIDS. Note that ! this cannot be done through the pointer alias! ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number to point to. ! NDSE Int. I Error output unit number. ! NDST Int. I Test output unit number. ! MX, MY, MSEA Like NX, NY, NSEA in data structure. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! See module documentation. ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3IOGR Subr. W3IOGRMD Model definition file IO program. ! WW3_GRID Prog. N/A Model set up program. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! - Check on input parameters. ! - Check on previous allocation. ! ! 7. Remarks : ! ! - Grid dimensions apre passed through parameter list and then ! locally stored to assure consistency between allocation and ! data in structure. ! - W3SETG needs to be called after allocation to point to ! proper allocated arrays. ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY: EXTCDE !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD, MX, MY, MSEA, NDSE, NDST !/SMC INTEGER, INTENT(IN) :: MCel, MUFc, MVFc, MRLv !/ARC INTEGER, INTENT(IN) :: MARC, MBAC, MSPEC !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ !/S INTEGER, SAVE :: IENT = 0 !/ !/S CALL STRACE (IENT, 'W3DIMX') ! ! -------------------------------------------------------------------- / ! 1. Test input and module status ! IF ( NGRIDS .EQ. -1 ) THEN WRITE (NDSE,1001) CALL EXTCDE (1) END IF ! IF ( IMOD.LT.-NAUXGR .OR. IMOD.GT.NGRIDS ) THEN WRITE (NDSE,1002) IMOD, -NAUXGR, NGRIDS CALL EXTCDE (2) END IF ! IF ( MX.LT.3 .OR. (MY.LT.3.AND.GTYPE.NE.UNGTYPE) .OR. MSEA.LT.1 ) THEN WRITE (NDSE,1003) MX, MY, MSEA, GTYPE CALL EXTCDE (3) END IF ! IF ( GRIDS(IMOD)%GINIT ) THEN WRITE (NDSE,1004) CALL EXTCDE (4) END IF #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX) WRITE (NDST,9000) IMOD, MX, MY, MSEA #endif ! ! -------------------------------------------------------------------- / ! 2. Allocate arrays ! ! NB: Some array start at 0 because MAPFS(IY,IX)=0 for missing points ! ALLOCATE ( GRIDS(IMOD)%MAPSTA(MY,MX), & GRIDS(IMOD)%MAPST2(MY,MX), & GRIDS(IMOD)%MAPFS(MY,MX), & GRIDS(IMOD)%MAPSF(MSEA,3), & GRIDS(IMOD)%FLAGST(MSEA), & !/RTD GRIDS(IMOD)%AnglD(MSEA), & GRIDS(IMOD)%ZB(MSEA), & GRIDS(IMOD)%CLATS(0:MSEA), & GRIDS(IMOD)%CLATIS(0:MSEA), & GRIDS(IMOD)%CTHG0S(0:MSEA), & GRIDS(IMOD)%TRNX(MY,MX), & GRIDS(IMOD)%TRNY(MY,MX), & GRIDS(IMOD)%XGRD(MY,MX), & GRIDS(IMOD)%YGRD(MY,MX), & GRIDS(IMOD)%DXDP(MY,MX), & GRIDS(IMOD)%DXDQ(MY,MX), & GRIDS(IMOD)%DYDP(MY,MX), & GRIDS(IMOD)%DYDQ(MY,MX), & GRIDS(IMOD)%DPDX(MY,MX), & GRIDS(IMOD)%DPDY(MY,MX), & GRIDS(IMOD)%DQDX(MY,MX), & GRIDS(IMOD)%DQDY(MY,MX), & GRIDS(IMOD)%GSQRT(MY,MX), & GRIDS(IMOD)%HPFAC(MY,MX), & GRIDS(IMOD)%HQFAC(MY,MX), & STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) !!/DEBUGINIT WRITE(740+IAPROC,*) 'After alocation of MAPST2, MY=', MY, ' MX=', MX !!/DEBUGINIT FLUSH(740+IAPROC) !/BT4 ALLOCATE ( GRIDS(IMOD)%SED_D50(0:MSEA), & !/BT4 GRIDS(IMOD)%SED_PSIC(0:MSEA),& !/BT4 STAT=ISTAT ) !/BT4 CHECK_ALLOC_STATUS ( ISTAT ) ! !/SMC ALLOCATE ( GRIDS(IMOD)%NLvCel(0:MRLv), & !/SMC GRIDS(IMOD)%NLvUFc(0:MRLv), & !/SMC GRIDS(IMOD)%NLvVFc(0:MRLv), & !/SMC GRIDS(IMOD)%IJKCel(5, -9:MCel), & !/SMC GRIDS(IMOD)%IJKUFc(7,MUFc), & !/SMC GRIDS(IMOD)%IJKVFc(8,MVFc), & !/SMC GRIDS(IMOD)%CTRNX(-9:MCel), & !/SMC GRIDS(IMOD)%CTRNY(-9:MCel), & !/SMC GRIDS(IMOD)%CLATF(MVFc), & !/SMC STAT=ISTAT ) !/SMC CHECK_ALLOC_STATUS ( ISTAT ) ! !/ARC ALLOCATE ( GRIDS(IMOD)%ICLBAC(MBAC), & !/ARC GRIDS(IMOD)%ANGARC(MARC), & !/ARC GRIDS(IMOD)%SPCBAC(MSPEC,MBAC), & !/ARC STAT=ISTAT ) !/ARC CHECK_ALLOC_STATUS ( ISTAT ) ! GRIDS(IMOD)%FLAGST = .TRUE. GRIDS(IMOD)%GINIT = .TRUE. GRIDS(IMOD)%MAPSF(:,3)=0. GRIDS(IMOD)%CLATS(0)=1. GRIDS(IMOD)%CLATIS(0)=1. GRIDS(IMOD)%CTHG0S(0)=1. ! !/REF1 ALLOCATE ( GRIDS(IMOD)%RREF(4), & !/REF1 GRIDS(IMOD)%REFPARS(10), & !/REF1 STAT=ISTAT ) !/REF1 CHECK_ALLOC_STATUS ( ISTAT ) !/REF1! Memory footprint can be reduced by defining REFLC and REFLD only over nodes !/REF1! where reflection can occur. !/REF1 ALLOCATE ( GRIDS(IMOD)%REFLC(4,0:NSEA), & !/REF1 GRIDS(IMOD)%REFLD(6,0:NSEA), & !/REF1 STAT=ISTAT ) !/REF1 CHECK_ALLOC_STATUS ( ISTAT ) !/IG1 ALLOCATE ( GRIDS(IMOD)%IGPARS(12), STAT=ISTAT ) !/IG1 CHECK_ALLOC_STATUS ( ISTAT ) !/IC2 ALLOCATE ( GRIDS(IMOD)%IC2PARS(9), STAT=ISTAT ) !/IC2 CHECK_ALLOC_STATUS ( ISTAT ) !/IC3 ALLOCATE ( GRIDS(IMOD)%IC3PARS(16), STAT=ISTAT ) !/IC3 CHECK_ALLOC_STATUS ( ISTAT ) !/IC4 ALLOCATE ( GRIDS(IMOD)%IC4PARS(1), STAT=ISTAT ) !/IC4 CHECK_ALLOC_STATUS ( ISTAT ) !/IC4 ALLOCATE ( GRIDS(IMOD)%IC4_KI(NIC4), STAT=ISTAT ) !/IC4 CHECK_ALLOC_STATUS ( ISTAT ) !/IC4 ALLOCATE ( GRIDS(IMOD)%IC4_FC(NIC4), STAT=ISTAT ) !/IC4 CHECK_ALLOC_STATUS ( ISTAT ) !/IC5 ALLOCATE ( GRIDS(IMOD)%IC5PARS(8), STAT=ISTAT ) !/IC5 CHECK_ALLOC_STATUS ( ISTAT ) !/IS2 ALLOCATE ( GRIDS(IMOD)%IS2PARS(24), STAT=ISTAT ) !/IS2 CHECK_ALLOC_STATUS ( ISTAT ) #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX) WRITE (NDST,9001) #endif ! !/REF1 GRIDS(IMOD)%REFLC(1:4,0:NSEA)=0. !/REF1 GRIDS(IMOD)%REFLD(:,:)=0 !/IG1 GRIDS(IMOD)%IGPARS(:)=0. !/IC2 GRIDS(IMOD)%IC2PARS(:)=0. !/IS2 GRIDS(IMOD)%IS2PARS(:)=0. ! ! -------------------------------------------------------------------- / ! 2. Update counters in grid ! GRIDS(IMOD)%NX = MX GRIDS(IMOD)%NY = MY GRIDS(IMOD)%NSEA = MSEA #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX) WRITE (NDST,9002) #endif ! ! -------------------------------------------------------------------- / ! 3. Point to allocated arrays ! CALL W3SETG ( IMOD, NDSE, NDST ) #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX) WRITE (NDST,9003) #endif ! RETURN ! ! Formats ! 1001 FORMAT (/' *** ERROR W3DIMX : GRIDS NOT INITIALIZED *** '/ & ' RUN W3NMOD FIRST '/) 1002 FORMAT (/' *** ERROR W3DIMX : ILLEGAL MODEL NUMBER *** '/ & ' IMOD = ',I10/ & ' NAUXGR = ',I10/ & ' NGRIDS = ',I10/) 1003 FORMAT (/' *** ERROR W3DIMX : ILLEGAL GRID DIMENSION(S) *** '/ & ' INPUT = ',4I10 /) 1004 FORMAT (/' *** ERROR W3DIMX : ARRAY(S) ALREADY ALLOCATED *** ') #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMX) 9000 FORMAT (' TEST W3DIMX : MODEL ',I4,' DIM. AT ',2I5,I7) 9001 FORMAT (' TEST W3DIMX : ARRAYS ALLOCATED') 9002 FORMAT (' TEST W3DIMX : DIMENSIONS STORED') 9003 FORMAT (' TEST W3DIMX : POINTERS RESET') #endif !/ !/ End of W3DIMX ----------------------------------------------------- / !/ END SUBROUTINE W3DIMX !/ ------------------------------------------------------------------- / SUBROUTINE W3DIMS ( IMOD, MK, MTH, NDSE, NDST ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 10-Dec-2014 ! !/ +-----------------------------------+ !/ !/ 19-Feb-2004 : Origination. ( version 3.06 ) !/ 18-Jul-2006 : Add input grids. ( version 3.10 ) !/ 05-Oct-2006 : Add filter to array pointers. ( version 3.10 ) !/ 10-Dec-2014 : Add checks for allocate status ( version 5.04 ) !/ ! 1. Purpose : ! ! Initialize an individual spatial grid at the proper dimensions. ! ! 2. Method : ! ! Allocate directly into the structure array GRIDS. Note that ! this cannot be done through the pointer alias! ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number to point to. ! NDSE Int. I Error output unit number. ! MK,MTH Int. I Spectral dimensions. ! NDST Int. I Test output unit number. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! See module documentation. ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3IOGR Subr. W3IOGRMD Model definition file IO program. ! WW3_GRID Prog. N/A Model set up program. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! - Check on input parameters. ! - Check on previous allocation. ! ! 7. Remarks : ! ! - Grid dimensions apre passed through parameter list and then ! locally stored to assure consistency between allocation and ! data in structure. ! - W3SETG needs to be called after allocation to point to ! proper allocated arrays. ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY: EXTCDE !/ST4 USE CONSTANTS, ONLY: RADE !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD, MK, MTH, NDSE, NDST !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER, SAVE :: MK2, MSPEC !/ST4 INTEGER :: SDSNTH !/S INTEGER, SAVE :: IENT = 0 !/ !/S CALL STRACE (IENT, 'W3DIMS') ! ! -------------------------------------------------------------------- / ! 1. Test input and module status ! IF ( NGRIDS .EQ. -1 ) THEN WRITE (NDSE,1001) CALL EXTCDE (1) END IF ! IF ( IMOD.LT.-NAUXGR .OR. IMOD.GT.NGRIDS ) THEN WRITE (NDSE,1002) IMOD, -NAUXGR, NGRIDS CALL EXTCDE (2) END IF ! IF ( MK.LT.3 .OR. MTH.LT.4 ) THEN WRITE (NDSE,1003) MK, MTH CALL EXTCDE (3) END IF ! IF ( SGRDS(IMOD)%SINIT ) THEN WRITE (NDSE,1004) CALL EXTCDE (4) END IF ! MK2 = MK + 2 MSPEC = MK * MTH #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS) WRITE (NDST,9000) IMOD, MTH, MK, MK2, MSPEC #endif ! ! -------------------------------------------------------------------- / ! 2. Allocate arrays ! ALLOCATE ( SGRDS(IMOD)%MAPWN(MSPEC+MTH), & SGRDS(IMOD)%MAPTH(MSPEC+MTH), & SGRDS(IMOD)%TH(MTH), & SGRDS(IMOD)%ESIN(MSPEC+MTH), & SGRDS(IMOD)%ECOS(MSPEC+MTH), & SGRDS(IMOD)%ES2(MSPEC+MTH), & SGRDS(IMOD)%ESC(MSPEC+MTH), & SGRDS(IMOD)%EC2(MSPEC+MTH), & SGRDS(IMOD)%SIG(0:MK+1), & SGRDS(IMOD)%SIG2(MSPEC), & SGRDS(IMOD)%DSIP(0:MK+1), & SGRDS(IMOD)%DSII(MK), & SGRDS(IMOD)%DDEN(MK), & SGRDS(IMOD)%DDEN2(MSPEC), & STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) SGRDS(IMOD)%MAPWN(:)=0. SGRDS(IMOD)%MAPTH(:)=0. SGRDS(IMOD)%TH(:)=0. SGRDS(IMOD)%ESIN(:)=0. SGRDS(IMOD)%ECOS(:)=0. SGRDS(IMOD)%ES2(:)=0. SGRDS(IMOD)%ESC(:)=0. SGRDS(IMOD)%EC2(:)=0. SGRDS(IMOD)%SIG(:)=0. SGRDS(IMOD)%SIG2(:)=0. SGRDS(IMOD)%DSIP(:)=0. SGRDS(IMOD)%DSII(:)=0. SGRDS(IMOD)%DDEN(:)=0. SGRDS(IMOD)%DDEN2(:)=0. !/ST4 ALLOCATE ( MPARS(IMOD)%SRCPS%IKTAB(MK,NDTAB), & !/ST4 MPARS(IMOD)%SRCPS%DCKI(NKHS,NKD), & !/ST4 MPARS(IMOD)%SRCPS%QBI(NKHS,NKD), & !/ST4 STAT=ISTAT ) !/ST4 CHECK_ALLOC_STATUS ( ISTAT ) !/ST4 SDSNTH = MTH/2-1 !MIN(NINT(SSDSDTH/(DTH*RADE)),MTH/2-1) !/ST4 ALLOCATE( MPARS(IMOD)%SRCPS%SATINDICES(2*SDSNTH+1,MTH), & !/ST4 MPARS(IMOD)%SRCPS%SATWEIGHTS(2*SDSNTH+1,MTH), & !/ST4 MPARS(IMOD)%SRCPS%CUMULW(MSPEC,MSPEC), & !/ST4 STAT=ISTAT ) !/ST4 CHECK_ALLOC_STATUS ( ISTAT ) ! SGRDS(IMOD)%SINIT = .TRUE. #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS) WRITE (NDST,9001) #endif ! ! -------------------------------------------------------------------- / ! 3. Point to allocated arrays ! CALL W3SETG ( IMOD, NDSE, NDST ) #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS) WRITE (NDST,9002) #endif ! ! -------------------------------------------------------------------- / ! 4. Update counters in grid ! NK = MK NK2 = MK + 2 NTH = MTH NSPEC = MK * MTH #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS) WRITE (NDST,9003) #endif ! RETURN ! ! Formats ! 1001 FORMAT (/' *** ERROR W3DIMS : GRIDS NOT INITIALIZED *** '/ & ' RUN W3NMOD FIRST '/) 1002 FORMAT (/' *** ERROR W3DIMS : ILLEGAL MODEL NUMBER *** '/ & ' IMOD = ',I10/ & ' NAUXGR = ',I10/ & ' NGRIDS = ',I10/) 1003 FORMAT (/' *** ERROR W3DIMS : ILLEGAL GRID DIMENSION(S) *** '/ & ' INPUT = ',4I10/) 1004 FORMAT (/' *** ERROR W3DIMS : ARRAY(S) ALREADY ALLOCATED *** ') #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMS) 9000 FORMAT (' TEST W3DIMS : MODEL ',I4,' DIM. AT ',3I5,I7) 9001 FORMAT (' TEST W3DIMS : ARRAYS ALLOCATED') 9002 FORMAT (' TEST W3DIMS : POINTERS RESET') 9003 FORMAT (' TEST W3DIMS : DIMENSIONS STORED') #endif !/ !/ End of W3DIMS ----------------------------------------------------- / !/ END SUBROUTINE W3DIMS !/ ------------------------------------------------------------------- / SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ ! J. H. Alves ! !/ | FORTRAN 90 | !/ | Last update : 03-Sep-2012 | !/ +-----------------------------------+ !/ !/ 24-Jun-2005 : Origination. ( version 3.07 ) !/ 09-Nov-2005 : Remove soft boundary options. ( version 3.08 ) !/ 23-Jun-2006 : Add data for W3SLN1. ( version 3.09 ) !/ 18-Jul-2006 : Add input grids. ( version 3.10 ) !/ 05-Oct-2006 : Add filter to array pointers. ( version 3.10 ) !/ 02-Feb-2007 : Add FLAGST. ( version 3.10 ) !/ 14-Apr-2007 : Add Miche style limiter. ( version 3.11 ) !/ ( J. H. Alves ) !/ 25-Apr-2007 : Adding Battjes-Janssen Sdb. ( version 3.11 ) !/ ( J. H. Alves ) !/ 18-Sep-2007 : Adding WAM4 source terms. ( version 3.13 ) !/ ( F. Ardhuin ) !/ 27-Jun-2008 : Expand WAM4 variants namelist ( version 3.14 ) !/ ( F. Ardhuin ) !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) !/ (W. E. Rogers & T. J. Campbell, NRL) !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 ) !/ (W. E. Rogers & T. J. Campbell, NRL) !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to !/ specify index closure for a grid. ( version 3.14 ) !/ (T. J. Campbell, NRL) !/ 13-Jul-2012 : Move data structures GMD (SNL3) and nonlinear !/ filter (SNLS) from 3.15 (HLT). ( version 4.08 ) !/ 03-Sep-2012 : Clean up of UG grids ( version 4.08 ) !/ ! 1. Purpose : ! ! Select one of the WAVEWATCH III grids / models. ! ! 2. Method : ! ! Point pointers to the proper variables in the proper element of ! the GRIDS array. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number to point to. ! NDSE Int. I Error output unit number. ! NDST Int. I Test output unit number. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! See module documentation. ! ! 5. Called by : ! ! Many subroutines in eth WAVEWATCH system. ! ! 6. Error messages : ! ! Checks on parameter list IMOD. ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/PRn Select propagation scheme ! ! !/STn Select source terms ! !/NLn ! !/BTn ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY: EXTCDE !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD, NDSE, NDST !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ !/S INTEGER, SAVE :: IENT = 0 !/ !/S CALL STRACE (IENT, 'W3SETG') ! ! -------------------------------------------------------------------- / ! 1. Test input and module status ! IF ( NGRIDS .EQ. -1 ) THEN WRITE (NDSE,1001) CALL EXTCDE (1) END IF ! IF ( IMOD.LT.-NAUXGR .OR. IMOD.GT.NGRIDS ) THEN WRITE (NDSE,1002) IMOD, -NAUXGR, NGRIDS CALL EXTCDE (2) END IF #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3SETG) WRITE (NDST,9000) IMOD #endif ! ! -------------------------------------------------------------------- / ! 2. Set model numbers ! IGRID = IMOD ISGRD = IMOD IPARS = IMOD ! ! -------------------------------------------------------------------- / ! 3. Set pointers in structure GRID ! GTYPE => GRIDS(IMOD)%GTYPE RSTYPE => GRIDS(IMOD)%RSTYPE ICLOSE => GRIDS(IMOD)%ICLOSE ! NX => GRIDS(IMOD)%NX NY => GRIDS(IMOD)%NY NSEA => GRIDS(IMOD)%NSEA NSEAL => GRIDS(IMOD)%NSEAL TRFLAG => GRIDS(IMOD)%TRFLAG FLAGLL => GRIDS(IMOD)%FLAGLL ! !/SMC NCel => GRIDS(IMOD)%NCel !/SMC NUFc => GRIDS(IMOD)%NUFc !/SMC NVFc => GRIDS(IMOD)%NVFc !/SMC NRLv => GRIDS(IMOD)%NRLv !/SMC MRFct => GRIDS(IMOD)%MRFct ! !/ARC NGLO => GRIDS(IMOD)%NGLO !/ARC NARC => GRIDS(IMOD)%NARC !/ARC NBGL => GRIDS(IMOD)%NBGL !/ARC NBAC => GRIDS(IMOD)%NBAC ! E3DF => GRIDS(IMOD)%E3DF P2MSF => GRIDS(IMOD)%P2MSF US3DF => GRIDS(IMOD)%US3DF USSPF => GRIDS(IMOD)%USSPF USSP_WN => GRIDS(IMOD)%USSP_WN !/REF1 REFLC => GRIDS(IMOD)%REFLC !/REF1 REFLD => GRIDS(IMOD)%REFLD FFACBERG => GRIDS(IMOD)%FFACBERG !/REF1 RREF => GRIDS(IMOD)%RREF !/REF1 REFPARS=> GRIDS(IMOD)%REFPARS !/IG1 IGPARS => GRIDS(IMOD)%IGPARS !/IC2 IC2PARS => GRIDS(IMOD)%IC2PARS !/IC3 IC3PARS => GRIDS(IMOD)%IC3PARS !/IC4 IC4PARS => GRIDS(IMOD)%IC4PARS !/IC4 IC4_KI => GRIDS(IMOD)%IC4_KI !/IC4 IC4_FC => GRIDS(IMOD)%IC4_FC !/IC5 IC5PARS => GRIDS(IMOD)%IC5PARS !/IS2 IS2PARS => GRIDS(IMOD)%IS2PARS SX => GRIDS(IMOD)%SX SY => GRIDS(IMOD)%SY X0 => GRIDS(IMOD)%X0 Y0 => GRIDS(IMOD)%Y0 ! DTCFL => GRIDS(IMOD)%DTCFL DTCFLI => GRIDS(IMOD)%DTCFLI DTMAX => GRIDS(IMOD)%DTMAX DTMIN => GRIDS(IMOD)%DTMIN DMIN => GRIDS(IMOD)%DMIN !/SEC1 NITERSEC1 => GRIDS(IMOD)%NITERSEC1 CTMAX => GRIDS(IMOD)%CTMAX FICE0 => GRIDS(IMOD)%FICE0 GRIDSHIFT => GRIDS(IMOD)%GRIDSHIFT CMPRTRCK => GRIDS(IMOD)%CMPRTRCK !/RTD PoLat => GRIDS(IMOD)%PoLat !/RTD PoLon => GRIDS(IMOD)%PoLon !/RTD FLAGUNR => GRIDS(IMOD)%FLAGUNR FICEN => GRIDS(IMOD)%FICEN FICEL => GRIDS(IMOD)%FICEL IICEHMIN => GRIDS(IMOD)%IICEHMIN IICEHDISP => GRIDS(IMOD)%IICEHDISP IICEFDISP => GRIDS(IMOD)%IICEFDISP IICEDDISP => GRIDS(IMOD)%IICEDDISP IICEHFAC => GRIDS(IMOD)%IICEHFAC IICEHINIT => GRIDS(IMOD)%IICEHINIT ICESCALES => GRIDS(IMOD)%ICESCALES PFMOVE => GRIDS(IMOD)%PFMOVE STEXU => GRIDS(IMOD)%STEXU STEYU => GRIDS(IMOD)%STEYU STEDU => GRIDS(IMOD)%STEDU BTBETA => GRIDS(IMOD)%BTBETA ! GINIT => GRIDS(IMOD)%GINIT GUGINIT => GRIDS(IMOD)%GUGINIT FLDRY => GRIDS(IMOD)%FLDRY FLCX => GRIDS(IMOD)%FLCX FLCY => GRIDS(IMOD)%FLCY FLCTH => GRIDS(IMOD)%FLCTH FLCK => GRIDS(IMOD)%FLCK FLSOU => GRIDS(IMOD)%FLSOU IICEDISP => GRIDS(IMOD)%IICEDISP IICESMOOTH => GRIDS(IMOD)%IICESMOOTH ! GNAME => GRIDS(IMOD)%GNAME FILEXT => GRIDS(IMOD)%FILEXT XYB => GRIDS(IMOD)%XYB TRIGP => GRIDS(IMOD)%TRIGP !/PDLIB NBND_MAP => GRIDS(IMOD)%NBND_MAP !/PDLIB INDEX_MAP => GRIDS(IMOD)%INDEX_MAP !/PDLIB MAPSTA_LOC => GRIDS(IMOD)%MAPSTA_LOC NTRI => GRIDS(IMOD)%NTRI COUNTRI => GRIDS(IMOD)%COUNTRI SI => GRIDS(IMOD)%SI COUNTOT => GRIDS(IMOD)%COUNTOT IEN => GRIDS(IMOD)%IEN LEN => GRIDS(IMOD)%LEN ANGLE => GRIDS(IMOD)%ANGLE ANGLE0 => GRIDS(IMOD)%ANGLE0 CCON => GRIDS(IMOD)%CCON COUNTCON => GRIDS(IMOD)%COUNTCON INDEX_CELL => GRIDS(IMOD)%INDEX_CELL IE_CELL => GRIDS(IMOD)%IE_CELL POS_CELL => GRIDS(IMOD)%POS_CELL IOBP => GRIDS(IMOD)%IOBP IAA => GRIDS(IMOD)%IAA JAA => GRIDS(IMOD)%JAA POSI => GRIDS(IMOD)%POSI I_DIAG => GRIDS(IMOD)%I_DIAG JA_IE => GRIDS(IMOD)%JA_IE NBEDGE => GRIDS(IMOD)%NBEDGE EDGES => GRIDS(IMOD)%EDGES NEIGH => GRIDS(IMOD)%NEIGH NNZ => GRIDS(IMOD)%NNZ IOBPD => GRIDS(IMOD)%IOBPD IOBDP => GRIDS(IMOD)%IOBDP IOBPA => GRIDS(IMOD)%IOBPA !/PDLIB IOBP_loc => GRIDS(IMOD)%IOBP_loc !/PDLIB IOBPD_loc => GRIDS(IMOD)%IOBPD_loc TRIA => GRIDS(IMOD)%TRIA CROSSDIFF => GRIDS(IMOD)%CROSSDIFF MAXX => GRIDS(IMOD)%MAXX MAXY => GRIDS(IMOD)%MAXY DXYMAX => GRIDS(IMOD)%DXYMAX ! IF ( GINIT ) THEN ! MAPSTA => GRIDS(IMOD)%MAPSTA MAPST2 => GRIDS(IMOD)%MAPST2 MAPFS => GRIDS(IMOD)%MAPFS MAPSF => GRIDS(IMOD)%MAPSF FLAGST => GRIDS(IMOD)%FLAGST ! !/RTD AnglD => GRIDS(IMOD)%AnglD ZB => GRIDS(IMOD)%ZB CLATS => GRIDS(IMOD)%CLATS CLATIS => GRIDS(IMOD)%CLATIS CTHG0S => GRIDS(IMOD)%CTHG0S TRNX => GRIDS(IMOD)%TRNX TRNY => GRIDS(IMOD)%TRNY ! XGRD => GRIDS(IMOD)%XGRD YGRD => GRIDS(IMOD)%YGRD DXDP => GRIDS(IMOD)%DXDP DXDQ => GRIDS(IMOD)%DXDQ DYDP => GRIDS(IMOD)%DYDP DYDQ => GRIDS(IMOD)%DYDQ DPDX => GRIDS(IMOD)%DPDX DPDY => GRIDS(IMOD)%DPDY DQDX => GRIDS(IMOD)%DQDX DQDY => GRIDS(IMOD)%DQDY GSQRT => GRIDS(IMOD)%GSQRT HPFAC => GRIDS(IMOD)%HPFAC HQFAC => GRIDS(IMOD)%HQFAC ! !/BT4 SED_D50 => GRIDS(IMOD)%SED_D50 !/BT4 SED_PSIC => GRIDS(IMOD)%SED_PSIC ! !/SMC NLvCel => GRIDS(IMOD)%NLvCel !/SMC NLvUFc => GRIDS(IMOD)%NLvUFc !/SMC NLvVFc => GRIDS(IMOD)%NLvVFc !/SMC IJKCel => GRIDS(IMOD)%IJKCel !/SMC IJKUFc => GRIDS(IMOD)%IJKUFc !/SMC IJKVFc => GRIDS(IMOD)%IJKVFc !/SMC CTRNX => GRIDS(IMOD)%CTRNX !/SMC CTRNY => GRIDS(IMOD)%CTRNY !/SMC CLATF => GRIDS(IMOD)%CLATF ! !/ARC ICLBAC => GRIDS(IMOD)%ICLBAC !/ARC ANGARC => GRIDS(IMOD)%ANGARC !/ARC SPCBAC => GRIDS(IMOD)%SPCBAC ! GSU => GRIDS(IMOD)%GSU ! END IF ! ! -------------------------------------------------------------------- / ! 4. Set pointers in structure SGRD ! NK => SGRDS(IMOD)%NK NK2 => SGRDS(IMOD)%NK2 NTH => SGRDS(IMOD)%NTH NSPEC => SGRDS(IMOD)%NSPEC ! DTH => SGRDS(IMOD)%DTH XFR => SGRDS(IMOD)%XFR FR1 => SGRDS(IMOD)%FR1 FTE => SGRDS(IMOD)%FTE FTF => SGRDS(IMOD)%FTF FTWN => SGRDS(IMOD)%FTWN FTTR => SGRDS(IMOD)%FTTR FTWL => SGRDS(IMOD)%FTWL FACTI1 => SGRDS(IMOD)%FACTI1 FACTI2 => SGRDS(IMOD)%FACTI2 FACHFA => SGRDS(IMOD)%FACHFA FACHFE => SGRDS(IMOD)%FACHFE ! SINIT => SGRDS(IMOD)%SINIT ! IF ( SINIT ) THEN ! MAPWN => SGRDS(IMOD)%MAPWN MAPTH => SGRDS(IMOD)%MAPTH ! TH => SGRDS(IMOD)%TH ESIN => SGRDS(IMOD)%ESIN ECOS => SGRDS(IMOD)%ECOS ES2 => SGRDS(IMOD)%ES2 ESC => SGRDS(IMOD)%ESC EC2 => SGRDS(IMOD)%EC2 SIG => SGRDS(IMOD)%SIG SIG2 => SGRDS(IMOD)%SIG2 DSIP => SGRDS(IMOD)%DSIP DSII => SGRDS(IMOD)%DSII DDEN => SGRDS(IMOD)%DDEN DDEN2 => SGRDS(IMOD)%DDEN2 ! END IF ! ! -------------------------------------------------------------------- / ! 5. Set pointers in structure MPAR ! PINIT => MPARS(IMOD)%PINIT ! ! Structure NPARS ! FACP => MPARS(IMOD)%NPARS%FACP XREL => MPARS(IMOD)%NPARS%XREL XFLT => MPARS(IMOD)%NPARS%XFLT FXFM => MPARS(IMOD)%NPARS%FXFM FXPM => MPARS(IMOD)%NPARS%FXPM XFT => MPARS(IMOD)%NPARS%XFT XFC => MPARS(IMOD)%NPARS%XFC FACSD => MPARS(IMOD)%NPARS%FACSD FHMAX => MPARS(IMOD)%NPARS%FHMAX !/RWND RWINDC => MPARS(IMOD)%NPARS%RWINDC !/WCOR WWCOR => MPARS(IMOD)%NPARS%WWCOR ! ! Structure PROPS ! !/PR2 DTME => MPARS(IMOD)%PROPS%DTME !/PR2 CLATMN => MPARS(IMOD)%PROPS%CLATMN !/PR3 WDCG => MPARS(IMOD)%PROPS%WDCG !/PR3 WDTH => MPARS(IMOD)%PROPS%WDTH !/SMC DTME => MPARS(IMOD)%PROPS%DTME !/SMC CLATMN => MPARS(IMOD)%PROPS%CLATMN !/SMC Refran => MPARS(IMOD)%PROPS%Refran !/SMC FUNO3 => MPARS(IMOD)%PROPS%FUNO3 !/SMC FVERG => MPARS(IMOD)%PROPS%FVERG !/SMC FSWND => MPARS(IMOD)%PROPS%FSWND ! ! Structure FLDP ! !/FLD1 TAIL_ID => MPARS(IMOD)%FLDPS%TAIL_ID !/FLD1 TAIL_LEV => MPARS(IMOD)%FLDPS%TAIL_LEV !/FLD1 TAIL_TRAN1 => MPARS(IMOD)%FLDPS%TAIL_TRAN1 !/FLD1 TAIL_TRAN2 => MPARS(IMOD)%FLDPS%TAIL_TRAN2 !/FLD2 TAIL_ID => MPARS(IMOD)%FLDPS%TAIL_ID !/FLD2 TAIL_LEV => MPARS(IMOD)%FLDPS%TAIL_LEV !/FLD2 TAIL_TRAN1 => MPARS(IMOD)%FLDPS%TAIL_TRAN1 !/FLD2 TAIL_TRAN2 => MPARS(IMOD)%FLDPS%TAIL_TRAN2 ! ! Structure SFLPS ! !/FLX2 NITTIN => MPARS(IMOD)%SFLPS%NITTIN !/FLX2 CINXSI => MPARS(IMOD)%SFLPS%CINXSI !/FLX3 NITTIN => MPARS(IMOD)%SFLPS%NITTIN !/FLX3 CAP_ID => MPARS(IMOD)%SFLPS%CAP_ID !/FLX3 CINXSI => MPARS(IMOD)%SFLPS%CINXSI !/FLX3 CD_MAX => MPARS(IMOD)%SFLPS%CD_MAX !/FLX4 FLX4A0 => MPARS(IMOD)%SFLPS%FLX4A0 ! ! Structure SLNPS ! !/LN1 SLNC1 => MPARS(IMOD)%SLNPS%SLNC1 !/LN1 FSPM => MPARS(IMOD)%SLNPS%FSPM !/LN1 FSHF => MPARS(IMOD)%SLNPS%FSHF ! ! Structure SRCPS ! WWNMEANPTAIL=> MPARS(IMOD)%SRCPS%WWNMEANPTAIL SSTXFTFTAIL => MPARS(IMOD)%SRCPS%SSTXFTFTAIL !/ST1 SINC1 => MPARS(IMOD)%SRCPS%SINC1 !/ST1 SDSC1 => MPARS(IMOD)%SRCPS%SDSC1 !/ST2 ZWIND => MPARS(IMOD)%SRCPS%ZWIND !/ST2 FSWELL => MPARS(IMOD)%SRCPS%FSWELL !/ST2 SHSTAB => MPARS(IMOD)%SRCPS%SHSTAB !/ST2 OFSTAB => MPARS(IMOD)%SRCPS%OFSTAB !/ST2 CCNG => MPARS(IMOD)%SRCPS%CCNG !/ST2 CCPS => MPARS(IMOD)%SRCPS%CCPS !/ST2 FFNG => MPARS(IMOD)%SRCPS%FFNG !/ST2 FFPS => MPARS(IMOD)%SRCPS%FFPS !/ST2 CDSA0 => MPARS(IMOD)%SRCPS%CDSA0 !/ST2 CDSA1 => MPARS(IMOD)%SRCPS%CDSA1 !/ST2 CDSA2 => MPARS(IMOD)%SRCPS%CDSA2 !/ST2 SDSALN => MPARS(IMOD)%SRCPS%SDSALN !/ST2 CDSB0 => MPARS(IMOD)%SRCPS%CDSB0 !/ST2 CDSB1 => MPARS(IMOD)%SRCPS%CDSB1 !/ST2 CDSB2 => MPARS(IMOD)%SRCPS%CDSB2 !/ST2 CDSB3 => MPARS(IMOD)%SRCPS%CDSB3 !/ST2 FPIMIN => MPARS(IMOD)%SRCPS%FPIMIN !/ST2 XFH => MPARS(IMOD)%SRCPS%XFH !/ST2 XF1 => MPARS(IMOD)%SRCPS%XF1 !/ST2 XF2 => MPARS(IMOD)%SRCPS%XF2 ! !/ST3 ZZWND => MPARS(IMOD)%SRCPS%ZZWND !/ST3 AALPHA => MPARS(IMOD)%SRCPS%AALPHA !/ST3 BBETA => MPARS(IMOD)%SRCPS%BBETA !/ST3 SSINTHP => MPARS(IMOD)%SRCPS%SSINTHP !/ST3 ZZ0MAX => MPARS(IMOD)%SRCPS%ZZ0MAX !/ST3 ZZ0RAT => MPARS(IMOD)%SRCPS%ZZ0RAT !/ST3 ZZALP => MPARS(IMOD)%SRCPS%ZZALP !/ST3 TTAUWSHELTER => MPARS(IMOD)%SRCPS%TTAUWSHELTER !/ST3 SSWELLF => MPARS(IMOD)%SRCPS%SSWELLF !/ST3 SSDSC1 => MPARS(IMOD)%SRCPS%SSDSC1 !/ST3 WWNMEANP => MPARS(IMOD)%SRCPS%WWNMEANP !/ST3 FFXFM => MPARS(IMOD)%SRCPS%FFXFM !/ST3 FFXPM => MPARS(IMOD)%SRCPS%FFXPM !/ST3 DDELTA1 => MPARS(IMOD)%SRCPS%DDELTA1 !/ST3 DDELTA2 => MPARS(IMOD)%SRCPS%DDELTA2 !/ST3 SSTXFTF => MPARS(IMOD)%SRCPS%SSTXFTF !/ST3 SSTXFTWN => MPARS(IMOD)%SRCPS%SSTXFTWN ! !/ST4 ZZWND => MPARS(IMOD)%SRCPS%ZZWND !/ST4 AALPHA => MPARS(IMOD)%SRCPS%AALPHA !/ST4 BBETA => MPARS(IMOD)%SRCPS%BBETA !/ST4 SSINTHP => MPARS(IMOD)%SRCPS%SSINTHP !/ST4 ZZ0MAX => MPARS(IMOD)%SRCPS%ZZ0MAX !/ST4 ZZ0RAT => MPARS(IMOD)%SRCPS%ZZ0RAT !/ST4 ZZALP => MPARS(IMOD)%SRCPS%ZZALP !/ST4 TTAUWSHELTER => MPARS(IMOD)%SRCPS%TTAUWSHELTER !/ST4 SSWELLFPAR => MPARS(IMOD)%SRCPS%SSWELLFPAR !/ST4 SSWELLF => MPARS(IMOD)%SRCPS%SSWELLF !/ST4 SSDSC => MPARS(IMOD)%SRCPS%SSDSC !/ST4 SSDSBR => MPARS(IMOD)%SRCPS%SSDSBR !/ST4 SSDSBR2 => MPARS(IMOD)%SRCPS%SSDSBR2 !/ST4 SSDSBRF1 => MPARS(IMOD)%SRCPS%SSDSBRF1 !/ST4 SSDSBRF2 => MPARS(IMOD)%SRCPS%SSDSBRF2 !/ST4 SSDSBRFDF => MPARS(IMOD)%SRCPS%SSDSBRFDF !/ST4 SSDSBM => MPARS(IMOD)%SRCPS%SSDSBM !/ST4 SSDSBCK => MPARS(IMOD)%SRCPS%SSDSBCK !/ST4 SSDSABK => MPARS(IMOD)%SRCPS%SSDSABK !/ST4 SSDSPBK => MPARS(IMOD)%SRCPS%SSDSPBK !/ST4 SSDSHCK => MPARS(IMOD)%SRCPS%SSDSHCK !/ST4 SSDSBINT => MPARS(IMOD)%SRCPS%SSDSBINT !/ST4 SSDSP => MPARS(IMOD)%SRCPS%SSDSP !/ST4 WWNMEANP => MPARS(IMOD)%SRCPS%WWNMEANP !/ST4 FFXFM => MPARS(IMOD)%SRCPS%FFXFM !/ST4 FFXFA => MPARS(IMOD)%SRCPS%FFXFA !/ST4 FFXFI => MPARS(IMOD)%SRCPS%FFXFI !/ST4 FFXFD => MPARS(IMOD)%SRCPS%FFXFD !/ST4 FFXPM => MPARS(IMOD)%SRCPS%FFXPM !/ST4 SSDSDTH => MPARS(IMOD)%SRCPS%SSDSDTH !/ST4 SSTXFTF => MPARS(IMOD)%SRCPS%SSTXFTF !/ST4 SSTXFTWN => MPARS(IMOD)%SRCPS%SSTXFTWN !/ST4 SSDSCOS => MPARS(IMOD)%SRCPS%SSDSCOS !/ST4 SSDSISO => MPARS(IMOD)%SRCPS%SSDSISO !/ST4 IKTAB => MPARS(IMOD)%SRCPS%IKTAB !/ST4 DCKI => MPARS(IMOD)%SRCPS%DCKI !/ST4 QBI => MPARS(IMOD)%SRCPS%QBI !/ST4 CUMULW => MPARS(IMOD)%SRCPS%CUMULW !/ST4 SATINDICES => MPARS(IMOD)%SRCPS%SATINDICES !/ST4 SATWEIGHTS => MPARS(IMOD)%SRCPS%SATWEIGHTS !/ST4 SSINBR => MPARS(IMOD)%SRCPS%SSINBR ! !/ST6 SIN6A0 => MPARS(IMOD)%SRCPS%SIN6A0 !/ST6 SIN6WS => MPARS(IMOD)%SRCPS%SIN6WS !/ST6 SIN6FC => MPARS(IMOD)%SRCPS%SIN6FC !/ST6 SDS6ET => MPARS(IMOD)%SRCPS%SDS6ET !/ST6 SDS6A1 => MPARS(IMOD)%SRCPS%SDS6A1 !/ST6 SDS6P1 => MPARS(IMOD)%SRCPS%SDS6P1 !/ST6 SDS6A2 => MPARS(IMOD)%SRCPS%SDS6A2 !/ST6 SDS6P2 => MPARS(IMOD)%SRCPS%SDS6P2 !/ST6 SWL6S6 => MPARS(IMOD)%SRCPS%SWL6S6 !/ST6 SWL6B1 => MPARS(IMOD)%SRCPS%SWL6B1 !/ST6 SWL6CSTB1 => MPARS(IMOD)%SRCPS%SWL6CSTB1 ! ! Structure SRNLS ! !/NL1 SNLC1 => MPARS(IMOD)%SNLPS%SNLC1 !/NL1 LAM => MPARS(IMOD)%SNLPS%LAM !/NL1 KDCON => MPARS(IMOD)%SNLPS%KDCON !/NL1 KDMN => MPARS(IMOD)%SNLPS%KDMN !/NL1 SNLS1 => MPARS(IMOD)%SNLPS%SNLS1 !/NL1 SNLS2 => MPARS(IMOD)%SNLPS%SNLS2 !/NL1 SNLS3 => MPARS(IMOD)%SNLPS%SNLS3 !/NL2 IQTPE => MPARS(IMOD)%SNLPS%IQTPE !/NL2 NDPTHS => MPARS(IMOD)%SNLPS%NDPTHS !/NL2 NLTAIL => MPARS(IMOD)%SNLPS%NLTAIL !/NL2 IF ( NDPTHS .NE. 0 ) DPTHNL => MPARS(IMOD)%SNLPS%DPTHNL !/NL3 NFRMIN => MPARS(IMOD)%SNLPS%NFRMIN !/NL3 NFRMAX => MPARS(IMOD)%SNLPS%NFRMAX !/NL3 NFRCUT => MPARS(IMOD)%SNLPS%NFRCUT !/NL3 NTHMAX => MPARS(IMOD)%SNLPS%NTHMAX !/NL3 NTHEXP => MPARS(IMOD)%SNLPS%NTHEXP !/NL3 NSPMIN => MPARS(IMOD)%SNLPS%NSPMIN !/NL3 NSPMAX => MPARS(IMOD)%SNLPS%NSPMAX !/NL3 NSPMX2 => MPARS(IMOD)%SNLPS%NSPMX2 !/NL3 FRQ => MPARS(IMOD)%SNLPS%FRQ !/NL3 XSI => MPARS(IMOD)%SNLPS%XSI !/NL3 NQA => MPARS(IMOD)%SNLPS%NQA !/NL3 QST1 => MPARS(IMOD)%SNLPS%QST1 !/NL3 QST2 => MPARS(IMOD)%SNLPS%QST2 !/NL3 QST3 => MPARS(IMOD)%SNLPS%QST3 !/NL3 QST4 => MPARS(IMOD)%SNLPS%QST4 !/NL3 QST5 => MPARS(IMOD)%SNLPS%QST5 !/NL3 QST6 => MPARS(IMOD)%SNLPS%QST6 !/NL3 SNLNQ => MPARS(IMOD)%SNLPS%SNLNQ !/NL3 SNLMSC => MPARS(IMOD)%SNLPS%SNLMSC !/NL3 SNLNSC => MPARS(IMOD)%SNLPS%SNLNSC !/NL3 SNLSFD => MPARS(IMOD)%SNLPS%SNLSFD !/NL3 SNLSFS => MPARS(IMOD)%SNLPS%SNLSFS !/NL3 SNLL => MPARS(IMOD)%SNLPS%SNLL !/NL3 SNLM => MPARS(IMOD)%SNLPS%SNLM !/NL3 SNLT => MPARS(IMOD)%SNLPS%SNLT !/NL3 SNLCD => MPARS(IMOD)%SNLPS%SNLCD !/NL3 SNLCS => MPARS(IMOD)%SNLPS%SNLCS !/NL4 ITSA => MPARS(IMOD)%SNLPS%ITSA !/NL4 IALT => MPARS(IMOD)%SNLPS%IALT !/NLS NTHX => MPARS(IMOD)%SNLPS%NTHX !/NLS NFRX => MPARS(IMOD)%SNLPS%NFRX !/NLS NSPL => MPARS(IMOD)%SNLPS%NSPL !/NLS NSPH => MPARS(IMOD)%SNLPS%NSPH !/NLS SNSST => MPARS(IMOD)%SNLPS%SNSST !/NLS CNLSA => MPARS(IMOD)%SNLPS%CNLSA !/NLS CNLSC => MPARS(IMOD)%SNLPS%CNLSC !/NLS CNLSFM => MPARS(IMOD)%SNLPS%CNLSFM !/NLS CNLSC1 => MPARS(IMOD)%SNLPS%CNLSC1 !/NLS CNLSC2 => MPARS(IMOD)%SNLPS%CNLSC2 !/NLS CNLSC3 => MPARS(IMOD)%SNLPS%CNLSC3 ! ! Structure SBTPS ! !/BT1 SBTC1 => MPARS(IMOD)%SBTPS%SBTC1 !/BT4 SBTCX => MPARS(IMOD)%SBTPS%SBTCX ! ! Structure SDBPS ! !/DB1 SDBC1 => MPARS(IMOD)%SDBPS%SDBC1 !/DB1 SDBC2 => MPARS(IMOD)%SDBPS%SDBC2 !/DB1 FDONLY => MPARS(IMOD)%SDBPS%FDONLY ! ! !/UOST UOSTFILELOCAL => MPARS(IMOD)%UOSTPS%UOSTFILELOCAL !/UOST UOSTFILESHADOW => MPARS(IMOD)%UOSTPS%UOSTFILESHADOW !/UOST UOSTFACTORLOCAL => MPARS(IMOD)%UOSTPS%UOSTFACTORLOCAL !/UOST UOSTFACTORSHADOW => MPARS(IMOD)%UOSTPS%UOSTFACTORSHADOW ! ! Structure SICPS ! !/IS1 IS1C1 => MPARS(IMOD)%SICPS%IS1C1 !/IS1 IS1C2 => MPARS(IMOD)%SICPS%IS1C2 ! ! Structure SCHM FSN => MPARS(IMOD)%SCHMS%FSN FSPSI => MPARS(IMOD)%SCHMS%FSPSI FSFCT => MPARS(IMOD)%SCHMS%FSFCT FSNIMP => MPARS(IMOD)%SCHMS%FSNIMP FSTOTALIMP => MPARS(IMOD)%SCHMS%FSTOTALIMP FSTOTALEXP => MPARS(IMOD)%SCHMS%FSTOTALEXP FSREFRACTION => MPARS(IMOD)%SCHMS%FSREFRACTION FSFREQSHIFT => MPARS(IMOD)%SCHMS%FSFREQSHIFT FSSOURCE => MPARS(IMOD)%SCHMS%FSSOURCE DO_CHANGE_WLV => MPARS(IMOD)%SCHMS%DO_CHANGE_WLV SOLVERTHR_STP => MPARS(IMOD)%SCHMS%SOLVERTHR_STP CRIT_DEP_STP => MPARS(IMOD)%SCHMS%CRIT_DEP_STP B_JGS_TERMINATE_MAXITER => MPARS(IMOD)%SCHMS%B_JGS_TERMINATE_MAXITER B_JGS_TERMINATE_DIFFERENCE => MPARS(IMOD)%SCHMS%B_JGS_TERMINATE_DIFFERENCE B_JGS_TERMINATE_NORM => MPARS(IMOD)%SCHMS%B_JGS_TERMINATE_NORM B_JGS_LIMITER => MPARS(IMOD)%SCHMS%B_JGS_LIMITER B_JGS_USE_JACOBI => MPARS(IMOD)%SCHMS%B_JGS_USE_JACOBI B_JGS_BLOCK_GAUSS_SEIDEL => MPARS(IMOD)%SCHMS%B_JGS_BLOCK_GAUSS_SEIDEL B_JGS_MAXITER => MPARS(IMOD)%SCHMS%B_JGS_MAXITER B_JGS_PMIN => MPARS(IMOD)%SCHMS%B_JGS_PMIN B_JGS_DIFF_THR => MPARS(IMOD)%SCHMS%B_JGS_DIFF_THR B_JGS_NORM_THR => MPARS(IMOD)%SCHMS%B_JGS_NORM_THR B_JGS_NLEVEL => MPARS(IMOD)%SCHMS%B_JGS_NLEVEL B_JGS_SOURCE_NONLINEAR => MPARS(IMOD)%SCHMS%B_JGS_SOURCE_NONLINEAR RETURN ! ! Formats ! 1001 FORMAT (/' *** ERROR W3SETG : GRIDS NOT INITIALIZED *** '/ & ' RUN W3NMOD FIRST '/) 1002 FORMAT (/' *** ERROR W3SETG : ILLEGAL MODEL NUMBER *** '/ & ' IMOD = ',I10/ & ' NAUXGR = ',I10/ & ' NGRIDS = ',I10/) #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3SETG) 9000 FORMAT (' TEST W3SETG : GRID/MODEL ',I4,' SELECTED') #endif !/ !/ End of W3SETG ----------------------------------------------------- / !/ END SUBROUTINE W3SETG !/ ------------------------------------------------------------------- / SUBROUTINE W3GNTX ( IMOD, NDSE, NDST ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH-III NOAA/NCEP | !/ | T. J. Campbell | !/ | FORTRAN 90 | !/ | Last update : 20-Jul-2011 | !/ +-----------------------------------+ !/ !/ 30-Oct-2009 : Origination. ( version 3.13 ) !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to !/ specify index closure for a grid. ( version 3.14 ) !/ (T. J. Campbell, NRL) !/ 23-Dec-2010 : Fix HPFAC and HQFAC by including the COS(YGRD) !/ factor with DXDP and DXDQ terms. ( version 3.14 ) !/ (T. J. Campbell, NRL) !/ 20-Jul-2011 : HPFAC and HQFAC are now calculated using W3DIST. !/ Result should be very similar except near pole. !/ Due to precision issues, HPFAC and HQFAC revert !/ to SX and SY in case of regular grids. !/ (W. E. Rogers, NRL) ( version 3.14 ) !/ 20-Jan-2017 : Update to new W3GSRUMD APIs ( version 6.02 ) !/ 20-Jan-2017 : Change calculation of curvilinear grid metric and !/ derivatives calculations to use W3GSRUMD:W3CGDM. !/ (T.J. Campbell, NRL) ( version 6.02 ) !/ ! 1. Purpose : ! ! Construct required spatial grid quantities for curvilinear grids. ! ! 2. Method : ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number to point to. ! NDSE Int. I Error output unit number. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! See module documentation. ! ! 5. Called by : ! ! Any program that uses this grid structure. ! ! 6. Error messages : ! ! - Check on previous initialization of grids. ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY: EXTCDE !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD, NDSE, NDST !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER, PARAMETER :: NFD = 4 LOGICAL, PARAMETER :: PTILED = .FALSE. LOGICAL, PARAMETER :: QTILED = .FALSE. LOGICAL, PARAMETER :: IJG = .FALSE. LOGICAL, PARAMETER :: SPHERE = .FALSE. INTEGER :: PRANGE(2), QRANGE(2) INTEGER :: LBI(2), UBI(2), LBO(2), UBO(2), ISTAT REAL , ALLOCATABLE :: COSA(:,:) !/S INTEGER, SAVE :: IENT = 0 !/ !/S CALL STRACE (IENT, 'W3GNTX') ! ! -------------------------------------------------------------------- / ! 1. Test input and module status ! IF ( NGRIDS .EQ. -1 ) THEN WRITE (NDSE,1001) CALL EXTCDE (1) END IF ! IF ( IMOD.LT.-NAUXGR .OR. IMOD.GT.NGRIDS ) THEN WRITE (NDSE,1002) IMOD, -NAUXGR, NGRIDS CALL EXTCDE (2) END IF ! SELECT CASE ( GRIDS(IMOD)%GTYPE ) CASE ( RLGTYPE ) CASE ( CLGTYPE ) CASE DEFAULT WRITE (NDSE,1003) GRIDS(IMOD)%GTYPE CALL EXTCDE (3) END SELECT #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX) WRITE (NDST,9000) IMOD #endif ! ! -------------------------------------------------------------------- / ! 2. Create grid search utility object ! GRIDS(IMOD)%GSU = W3GSUC( IJG, FLAGLL, GRIDS(IMOD)%ICLOSE, & GRIDS(IMOD)%XGRD, GRIDS(IMOD)%YGRD ) #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX) CALL W3GSUP(GRIDS(IMOD)%GSU, NDST) WRITE (NDST,9001) #endif ! ! -------------------------------------------------------------------- / ! 3. Reset grid pointers ! CALL W3SETG ( IMOD, NDSE, NDST ) #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX) WRITE (NDST,9002) #endif ! ! -------------------------------------------------------------------- / ! 4. Construct curvilinear grid derivatives and metric ! Note that in the case of lon/lat grids, these quantities do not ! include the spherical coordinate metric (SPHERE=.FALSE.). ! #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX) ALLOCATE ( COSA(NY,NX), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) #endif PRANGE = (/ 1,NX/) QRANGE = (/ 1,NY/) LBI = (/ 1, 1/) UBI = (/NY,NX/) LBO = (/ 1, 1/) UBO = (/NY,NX/) SELECT CASE ( GTYPE ) CASE ( RLGTYPE ) CALL W3CGDM( IJG, FLAGLL, ICLOSE, PTILED, QTILED, & PRANGE, QRANGE, LBI, UBI, LBO, UBO, XGRD, YGRD, & NFD=NFD, SPHERE=SPHERE, DX=SX, DY=SY, & DXDP=DXDP, DYDP=DYDP, DXDQ=DXDQ, DYDQ=DYDQ, & DPDX=DPDX, DPDY=DPDY, DQDX=DQDX, DQDY=DQDY, & HPFC=HPFAC, HQFC=HQFAC, GSQR=GSQRT, & #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX) COSA=COSA, & #endif RC=ISTAT ) IF ( ISTAT.NE.0 ) THEN WRITE (NDSE,1004) GTYPE CALL EXTCDE (4) END IF CASE ( CLGTYPE ) CALL W3CGDM( IJG, FLAGLL, ICLOSE, PTILED, QTILED, & PRANGE, QRANGE, LBI, UBI, LBO, UBO, XGRD, YGRD, & NFD=NFD, SPHERE=SPHERE, & DXDP=DXDP, DYDP=DYDP, DXDQ=DXDQ, DYDQ=DYDQ, & DPDX=DPDX, DPDY=DPDY, DQDX=DQDX, DQDY=DQDY, & HPFC=HPFAC, HQFC=HQFAC, GSQR=GSQRT, & #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX) COSA=COSA, & #endif RC=ISTAT ) IF ( ISTAT.NE.0 ) THEN WRITE (NDSE,1004) GTYPE CALL EXTCDE (4) END IF END SELECT ! #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX) WRITE(NDST,'(A,2E14.6)')'HPFAC MIN/MAX:',MINVAL(HPFAC),MAXVAL(HPFAC) WRITE(NDST,'(A,2E14.6)')'HQFAC MIN/MAX:',MINVAL(HQFAC),MAXVAL(HQFAC) WRITE(NDST,'(A,2E14.6)')'GSQRT MIN/MAX:',MINVAL(GSQRT),MAXVAL(GSQRT) WRITE(NDST,'(A,2E14.6)')'DXDP MIN/MAX:',MINVAL(DXDP),MAXVAL(DXDP) WRITE(NDST,'(A,2E14.6)')'DYDP MIN/MAX:',MINVAL(DYDP),MAXVAL(DYDP) WRITE(NDST,'(A,2E14.6)')'DXDQ MIN/MAX:',MINVAL(DXDQ),MAXVAL(DXDQ) WRITE(NDST,'(A,2E14.6)')'DYDQ MIN/MAX:',MINVAL(DYDQ),MAXVAL(DYDQ) WRITE(NDST,'(A,2E14.6)')'DPDX MIN/MAX:',MINVAL(DPDX),MAXVAL(DPDX) WRITE(NDST,'(A,2E14.6)')'DPDY MIN/MAX:',MINVAL(DPDY),MAXVAL(DPDY) WRITE(NDST,'(A,2E14.6)')'DQDX MIN/MAX:',MINVAL(DQDX),MAXVAL(DQDX) WRITE(NDST,'(A,2E14.6)')'DQDY MIN/MAX:',MINVAL(DQDY),MAXVAL(DQDY) WRITE(NDST,'(A,2E14.6)')'COSA MIN/MAX:',MINVAL(COSA),MAXVAL(COSA) WRITE (NDST,9003) DEALLOCATE ( COSA, STAT=ISTAT ) CHECK_DEALLOC_STATUS ( ISTAT ) #endif ! ! Formats ! 1001 FORMAT (/' *** ERROR W3GNTX : GRIDS NOT INITIALIZED *** '/ & ' RUN W3NMOD FIRST '/) 1002 FORMAT (/' *** ERROR W3GNTX : ILLEGAL MODEL NUMBER *** '/ & ' IMOD = ',I10/ & ' NAUXGR = ',I10/ & ' NGRIDS = ',I10/) 1003 FORMAT (/' *** ERROR W3GNTX : UNSUPPORTED TYPE OF GRID *** '/ & ' GTYPE = ',I10/) 1004 FORMAT (/' *** ERROR W3GNTX : ERROR OCCURED IN W3CGDM *** '/ & ' GTYPE = ',I10/) ! #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX) 9000 FORMAT (' TEST W3GNTX : MODEL ',I4) 9001 FORMAT (' TEST W3GNTX : SEARCH OBJECT CREATED') 9002 FORMAT (' TEST W3GNTX : POINTERS RESET') 9003 FORMAT (' TEST W3GNTX : GRID ARRAYS CONSTRUCTED') #endif !/ !/ End of W3GNTX ----------------------------------------------------- / !/ END SUBROUTINE W3GNTX !/ ------------------------------------------------------------------- / SUBROUTINE W3DIMUG ( IMOD, MTRI, MX, COUNTOTA, NNZ, NDSE, NDST ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH-III NOAA/NCEP | !/ | F.ardhuin | !/ | FORTRAN 90 | !/ | Last update : 15-Mar-2007 ! !/ +-----------------------------------+ !/ !/ 15-Mar-2007 : Origination. ( version 3.14 ) !/ 11-May-2015 : Updates to 2-ways nestings for UG ( version 5.08 ) !/ ! 1. Purpose : ! ! Initialize an individual spatial grid at the proper dimensions. ! ! 2. Method : ! ! Allocate directly into the structure array GRIDS. Note that ! this cannot be done through the pointer alias! ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! IMOD Int. I Model number to point to. ! NDSE Int. I Error output unit number. ! NDST Int. I Test output unit number. ! MX, MTRI, MSEA Like NX, NTRI, NSEA in data structure. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! See module documentation. ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3IOGR Subr. W3IOGRMD Model definition file IO program. ! WW3_GRID Prog. N/A Model set up program. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! - Check on input parameters. ! - Check on previous allocation. ! ! 7. Remarks : ! ! - Grid dimensions apre passed through parameter list and then ! locally stored to assure consistency between allocation and ! data in structure. ! - W3SETG needs to be called after allocation to point to ! proper allocated arrays. ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY: EXTCDE !/MEMCHECK USE MallocInfo_m !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD, MTRI, MX, COUNTOTA, NNZ, NDSE, NDST !/MEMCHECK type(MallInfo_t) :: mallinfos INTEGER :: IAPROC = 1 !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ !/S INTEGER, SAVE :: IENT = 0 !/ !/S CALL STRACE (IENT, 'W3DIMUG') ! ! -------------------------------------------------------------------- / ! 1. Test input and module status ! IF ( NGRIDS .EQ. -1 ) THEN WRITE (NDSE,1001) CALL EXTCDE (1) END IF ! IF ( IMOD.LT.-NAUXGR .OR. IMOD.GT.NGRIDS ) THEN WRITE (NDSE,1002) IMOD, NGRIDS CALL EXTCDE (2) END IF IF ( GRIDS(IMOD)%GUGINIT ) THEN WRITE (NDSE,1004) CALL EXTCDE (4) END IF ! #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG) WRITE (NDST,9000) IMOD, MX, MTRI #endif !/MEMCHECK WRITE(740+IAPROC,*) 'memcheck_____:', 'WW3_UG_ALLOCATE SECTION 1' !/MEMCHECK call getMallocInfo(mallinfos) !/MEMCHECK call printMallInfo(IAPROC,mallInfos) ! ! -------------------------------------------------------------------- / ! 2. Allocate arrays ! ALLOCATE ( GRIDS(IMOD)%TRIGP(MTRI,3), & GRIDS(IMOD)%XYB(MX,3), & GRIDS(IMOD)%SI(MX), & GRIDS(IMOD)%TRIA(MTRI), & GRIDS(IMOD)%CROSSDIFF(6,MTRI), & GRIDS(IMOD)%IEN(MTRI,6), & GRIDS(IMOD)%LEN(MTRI,3), & GRIDS(IMOD)%ANGLE(MTRI,3), & GRIDS(IMOD)%ANGLE0(MTRI,3), & GRIDS(IMOD)%CCON(MX), & GRIDS(IMOD)%COUNTCON(MX), & GRIDS(IMOD)%INDEX_CELL(MX+1), & GRIDS(IMOD)%IE_CELL(COUNTOTA), & GRIDS(IMOD)%POS_CELL(COUNTOTA), & GRIDS(IMOD)%IAA(NX+1), & GRIDS(IMOD)%JAA(NNZ), & GRIDS(IMOD)%POSI(3,COUNTOTA), & GRIDS(IMOD)%I_DIAG(NX), & GRIDS(IMOD)%JA_IE(3,3,MTRI), & GRIDS(IMOD)%IOBP(MX), & GRIDS(IMOD)%IOBPD(NTH,MX), & GRIDS(IMOD)%IOBDP(MX), & GRIDS(IMOD)%IOBPA(MX), & STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ! GRIDS(IMOD)%IOBP(:)=1 #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG) WRITE (NDST,9001) #endif ! !some segmentation troubles can appear, they are related with the allocation of !normal(1st dimension) and the nesting of the triangulated grid. ! -------------------------------------------------------------------- / ! 3. Point to allocated arrays ! CALL W3SETG ( IMOD, NDSE, NDST ) #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG) WRITE (NDST,9002) #endif ! ! -------------------------------------------------------------------- / ! 4. Update counters in grid ! Note that in the case of lon/lat grids, these quantities do not ! include the spherical coordinate metric (SPHERE=.FALSE.). ! NTRI = MTRI COUNTOT=COUNTOTA GRIDS(IMOD)%GUGINIT = .TRUE. #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG) WRITE (NDST,9003) #endif !/MEMCHECK WRITE(740+IAPROC,*) 'memcheck_____:', 'WW3_UG_ALLOCATE SECTION 2' !/MEMCHECK call getMallocInfo(mallinfos) !/MEMCHECK call printMallInfo(IAPROC,mallInfos) RETURN ! ! Formats ! 1001 FORMAT (/' *** ERROR W3DIMUG : GRIDS NOT INITIALIZED *** '/ & ' RUN W3NMOD FIRST '/) 1002 FORMAT (/' *** ERROR W3DIMUG : ILLEGAL MODEL NUMBER *** '/ & ' IMOD = ',I10/ & ' NGRIDS = ',I10/) 1004 FORMAT (/' *** ERROR W3DIMUG : ARRAY(S) ALREADY ALLOCATED *** ') #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3DIMUG) 9000 FORMAT (' TEST W3DIMUG: MODEL ',I4,' DIM. AT ',2I5,I7) 9001 FORMAT (' TEST W3DIMUG : ARRAYS ALLOCATED') 9002 FORMAT (' TEST W3DIMUG : POINTERS RESET') 9003 FORMAT (' TEST W3DIMUG : DIMENSIONS STORED') #endif !/ !/ End of W3DIMUG ----------------------------------------------------- / !/ END SUBROUTINE W3DIMUG !/ ------------------------------------------------------------------- / SUBROUTINE W3SETREF !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | F. Ardhuin | !/ | FORTRAN 90 | !/ | Last update : 13-Nov-2013 | !/ +-----------------------------------+ !/ !/ 13-Nov-2013 : Origination. ( version 4.13 ) !/ ! 1. Purpose : ! ! Update reflection directions at shoreline. ! ! 2. Method : ! ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! None ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! See module documentation. ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! WW3_GRID Prog. WW3_GRID Grid preprocessor ! W3ULEV Subr. W3UPDTMD Water level update ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! None. ! ! 7. Remarks : ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE CONSTANTS !/S USE W3SERVMD, ONLY : STRACE ! IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ INTEGER :: ISEA, IX, IY, IXY, IXN, IXP, IYN, IYP INTEGER :: J, K, NEIGH1(0:7) INTEGER :: ILEV, NLEV !/S INTEGER, SAVE :: IENT = 0 REAL :: TRIX(NY*NX), TRIY(NY*NX), DX, DY, & COSAVG, SINAVG, THAVG, ANGLES(0:7), CLAT !/ !/ ------------------------------------------------------------------- / !/ !/S CALL STRACE (IENT, 'W3SETREF') ! ! 1. Preparations --------------------------------------------------- * ! !/REF1 RREF=.FALSE. !JDM initializing to false helps with b4b mod_defs !/REF1 IF (REFPARS(2).GT.0) RREF(2)=.TRUE. !/REF1 IF (REFPARS(3).GT.0) RREF(3)=.TRUE. !/REF1 IF (REFPARS(4).GT.0) RREF(4)=.TRUE. ! !/REF1 DO IY=2, NY-1 !/REF1 DO IX=2, NX-1 !/REF1 IF (REFPARS(1).GT.0) RREF(1)=.TRUE. !/REF1!No reflection from artificial island on pole. !/REF1 IF (FLAGLL.AND.(YGRD(IY,IX).GT.85)) RREF(1)=.FALSE. !/REF1 IF (MAPSTA(IY,IX).GT.0) THEN !/REF1! !/REF1! Prepares for reflection from subgrid islands !/REF1! !/REF1 IF (RREF(2)) & !/REF1 REFLC(2,MAPFS(IY,IX))= MAX((1. - TRNX(IY,IX)),(1.-TRNY(IY,IX))) !/REF1! !/REF1! Prepares for iceberg reflections !/REF1! !/REF1 IF (RREF(4)) & !/REF1 REFLC(4,MAPFS(IY,IX))= 1. !/REF1! !/REF1! resolved shoreline reflection !/REF1! !/REF1 IF (RREF(1)) THEN !/REF1 REFLC(1, MAPFS(IY,IX)) = 0. !/REF1 REFLD(1:6,MAPFS(IY,IX)) = 0 !/REF1! !/REF1! Search for neighboring coastline. 3 2 1 !/REF1! around X. These are the neighbors of X: 4 X 0 !/REF1! 5 6 7 !/REF1! !/REF1! !/REF1 NEIGH1(0)=8*MAPST2(IY,IX+1)+MAPSTA(IY,IX+1) !/REF1 NEIGH1(1:3)=8*MAPST2(IY+1,IX+1:IX-1:-1)+MAPSTA(IY+1,IX+1:IX-1:-1) !/REF1 NEIGH1(4)=8*MAPST2(IY,IX-1)+MAPSTA(IY,IX-1) !/REF1 NEIGH1(5:7)=8*MAPST2(IY-1,IX-1:IX+1)+MAPSTA(IY-1,IX-1:IX+1) !/REF1! !/REF1! if one of the surrounding points is land: determines directions ... !/REF1! !/REF1 IF (MINVAL(ABS(NEIGH1)).EQ.0) THEN !/REF1 IF ( FLAGLL ) THEN !/REF1 CLAT = COS(YGRD(IY,IX)*DERA) !/REF1 ELSE !/REF1 CLAT = 1. !/REF1 END IF !/REF1 ANGLES(0)= ATAN2(DYDP(IY,IX),DXDP(IY,IX)*CLAT) !/REF1 ANGLES(1)= ATAN2(DYDP(IY,IX)+DYDQ(IY,IX),(DXDP(IY,IX)+DXDQ(IY,IX))*CLAT) !/REF1 ANGLES(2)= ATAN2(DYDQ(IY,IX),DXDQ(IY,IX)*CLAT) !/REF1 ANGLES(3)= ATAN2(DYDQ(IY,IX)-DYDP(IY,IX),(DXDQ(IY,IX)-DXDP(IY,IX))*CLAT) !/REF1 ANGLES(4:7)= ANGLES(0:3)+PI !/REF1 IF ((NEIGH1(0).GE.1).AND.(NEIGH1(4).GE.1)) THEN !/REF1 REFLD(3,MAPFS(IY,IX))=0 !/REF1 ELSE !/REF1 IF ((NEIGH1(0).GE.1).OR.(NEIGH1(4).GE.1)) REFLD(3,MAPFS(IY,IX))=1 !/REF1 END IF !/REF1 IF ((NEIGH1(2).EQ.1).AND.(NEIGH1(6).GE.1)) THEN !/REF1 REFLD(4,MAPFS(IY,IX))=0 !/REF1 ELSE !/REF1 IF ((NEIGH1(2).GE.1).OR.(NEIGH1(6).GE.1)) REFLD(4,MAPFS(IY,IX))=1 !/REF1 END IF !/REF1! !/REF1! Looks for a locally straight coast in all 8 orientations !/REF1! !/REF1 J=0 !/REF1 REFLD(1,MAPFS(IY,IX))=0 !/REF1 COSAVG=0 !/REF1 SINAVG=0 !/REF1! Shore angle is corrected for grid rotation in w3ref1md.ftn with REFLD(5:6,MAPFS(IY,IX)) !/REF1 REFLD(5,MAPFS(IY,IX))= MOD(NTH+NINT(ANGLES(0)/TPI*NTH),NTH) !/REF1 REFLD(6,MAPFS(IY,IX))= MOD(NTH+NINT((ANGLES(2)/TPI-0.25)*NTH),NTH) !/REFT IF (IY.EQ.4) THEN !/REFT WRITE(6,*) 'POINT (IX,IY):',IX,IY !/REFT WRITE(6,*) 'REFT:',NEIGH1(3),NEIGH1(2), NEIGH1(1) !/REFT WRITE(6,*) 'REFT:',NEIGH1(4),1, NEIGH1(0) !/REFT WRITE(6,*) 'REFT:',NEIGH1(5:7) !/REFT WRITE(6,*) 'ANG:',ANGLES(3)*RADE,ANGLES(2)*RADE, ANGLES(1)*RADE !/REFT WRITE(6,*) 'ANG:',ANGLES(4)*RADE,1, ANGLES(0) *RADE !/REFT WRITE(6,*) 'ANG:',ANGLES(5:7)*RADE !/REFT WRITE(6,*) 'REFT:',XGRD(IY+1,IX-1:IX+1), YGRD(IY+1,IX-1:IX+1) !/REFT WRITE(6,*) 'REFT:',XGRD(IY,IX-1:IX+1) , YGRD(IY,IX-1:IX+1) !/REFT WRITE(6,*) 'REFT:',XGRD(IY-1,IX-1:IX+1), YGRD(IY-1,IX-1:IX+1) !/REFT WRITE(6,*) 'REFLD:',REFLD(3:6,MAPFS(IY,IX)) !/REFT ENDIF !/REF1 DO K=0,7 !/REF1 IF (NEIGH1(K).EQ.0.AND.NEIGH1(MOD(K+7,8)).EQ.0 & !/REF1 .AND.NEIGH1(MOD(K+1,8)).EQ.0 & !/REF1 .AND.NEIGH1(MOD(K+4,8)).NE.0) THEN !/REF1 REFLC(1,MAPFS(IY,IX))= REFPARS(1) !/REF1! !/REF1! Defines direction index for specular reflection (normal to coast) !/REF1! !/REF1! for example, if we have this layout 1 1 0 !/REF1! (NB: 1 is sea, 0 is land) 1 X 0 !/REF1! 1 1 0 !/REF1! !/REF1! then there is only a coastline detection for K=0, giving J=1 !/REF1! and the final result will be REFLD(1,MAPFS(IY,IX))=1 !/REF1! Namely, the direction TH(REFLD) is the direction pointing INTO the coast !/REF1! !/REF1 REFLD(2,MAPFS(IY,IX))= 2 !/REF1 COSAVG=COSAVG+COS(ANGLES(K)) !ECOS(1+(K*NTH)/8) !/REF1 SINAVG=SINAVG+SIN(ANGLES(K)) !ESIN(1+(K*NTH)/8) !/REF1 J=J+1 !/REF1 ENDIF !/REF1 END DO !/REF1 IF (J.GT.0) THEN !/REF1 IF (J.GT.1) REFLD(2,MAPFS(IY,IX))= 1 !/REF1 THAVG=ATAN2(SINAVG,COSAVG) #if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3SETREF) !/REF1 !WRITE (6,*) 'COASTAL REFLECTION:',IX,IY, & !/REF1 !SINAVG,COSAVG,THAVG/TPI,NINT(THAVG/TPI*NTH),MOD(NTH+NINT(THAVG/TPI*NTH),NTH) #endif !/REF1 REFLD(1,MAPFS(IY,IX))=1+MOD(NTH+NINT(THAVG/TPI*NTH),NTH) !/REF1 ELSE !/REF1 !/REF1! 1 1 1 !/REF1! Looks for mild corners like 1 1 1 !/REF1! 1 0 0 !/REF1 DO K=0,7 !/REF1 IF (NEIGH1(K).EQ.0.AND.NEIGH1(MOD(K+1,8)).EQ.0 & !/REF1 .AND.NEIGH1(MOD(K+4,8)).NE.0) THEN !/REF1 REFLC(1,MAPFS(IY,IX))= REFPARS(1) !/REF1 REFLD(1,MAPFS(IY,IX))= 1+MOD((K*NTH+(K+1)*NTH)/16,NTH) !/REF1 REFLD(2,MAPFS(IY,IX))= 1 !/REF1 ENDIF !/REF1 END DO !/REF1! 1 1 1 1 1 1 !/REF1! Looks for sharp corners like 1 1 1 but not diagonals like 1 1 1 !/REF1! 1 0 1 1 1 0 !/REF1 IF (REFLC(1,MAPFS(IY,IX)).LE.0) THEN !/REF1 DO K=0,7,2 !/REF1 IF ( NEIGH1(K).EQ.0.AND.NEIGH1(MOD(K+4,8)).NE.0) THEN !/REF1 REFLC(1,MAPFS(IY,IX))= REFPARS(1) !/REF1 REFLD(1,MAPFS(IY,IX))= 1+(K*NTH)/8 !/REF1 REFLD(2,MAPFS(IY,IX))= 0 !/REF1 !WRITE(6,*) 'NEIGH3:',IX,IY,K,NEIGH1,K*(NTH/8) !/REF1 END IF !/REF1 END DO !/REF1 END IF !/REF1 END IF !/REF1! End of test if surrounding point is land !/REF1 END IF !/REFT IF (REFLC(1,MAPFS(IY,IX)).GT.0) THEN !/REFT WRITE (6,*) 'COAST DIRECTION AT POINT:',IX,IY,' IS ', & !/REFT REFLD(:,MAPFS(IY,IX)),TH(REFLD(1,MAPFS(IY,IX)))*360/TPI !/REFT ENDIF !/REF1! End of test if local point is sea !/REF1 END IF !/REF1 END IF !/REF1 END DO !/REF1 END DO ! RETURN ! ! Formats ! !/ !/ End of W3SETREF ----------------------------------------------------- / !/ END SUBROUTINE W3SETREF !/ !/ End of module W3GDATMD -------------------------------------------- / !/ END MODULE W3GDATMD