WW3/w3gridmd_8F90_source.html

#include "w3macros.h"

!/ ------------------------------------------------------------------- /

MODULE w3gridmd

  !/

  !/                  +-----------------------------------+

  !/                  | WAVEWATCH III           NOAA/NCEP |

  !/                  |           H. L. Tolman            |

  !/                  |           J. H. Alves             |

  !/                  |            F. Ardhuin             |

  !/                  |                        FORTRAN 90 |

  !/                  | Last update :         27-May-2021 |

  !/                  +-----------------------------------+

  !/

  !/    14-Jan-1999 : Final FORTRAN 77                    ( version 1.18 )

  !/    27-Jan-2000 : Upgrade to FORTRAN 90               ( version 2.00 )

  !/                  Add UNFORMATTED bath file option.

  !/                  Read options with namelists.

  !/    14-Feb-2000 : Adding exact Snl                    ( version 2.01 )

  !/    04-May-2000 : Non central source term int.        ( version 2.03 )

  !/    24-Jan-2001 : Flat grid option.                   ( version 2.06 )

  !/    02-Feb-2001 : Xnl version 3.0                     ( version 2.07 )

  !/    09-Feb-2001 : Third propagation scheme added.     ( version 2.08 )

  !/    27-Feb-2001 : O0 output switch added.             ( version 2.08 )

  !/    16-Mar-2001 : Fourth propagation scheme added.    ( version 2.09 )

  !/    29-Mar-2001 : Sub-grid island treatment.          ( version 2.10 )

  !/    20-Jul-2001 : Clean up.                           ( version 2.11 )

  !/    12-Sep-2001 : Clean up.                           ( version 2.13 )

  !/    09-Nov-2001 : Clean up.                           ( version 2.14 )

  !/    11-Jan-2002 : Sub-grid ice treatment.             ( version 2.15 )

  !/    17-Jan-2002 : DSII bug fix.                       ( version 2.16 )

  !/    09-May-2002 : Switch clean up.                    ( version 2.21 )

  !/    26-Nov-2002 : Adding first version of NL-3/4.     ( version 3.01 )

  !/                  Removed before distribution in 3.12.

  !/    26-Dec-2002 : Relaxing CFL time step.             ( version 3.02 )

  !/    01-Aug-2003 : Modify GSE correction for moving gr.( version 3.03 )

  !/                  Add offset option for first direction.

  !/    24-Dec-2004 : Multiple grid version.              ( version 3.06 )

  !/    04-May-2005 : Allow active points at edge.        ( version 3.07 )

  !/    07-Jul-2005 : Add MAPST2 and map processing.      ( version 3.07 )

  !/    09-Nov-2005 : Remove soft boundary options.       ( version 3.08 )

  !/    23-Jun-2006 : Adding alternative source terms.    ( version 3.09 )

  !/                  Module W3SLN1MD, dummy for others.

  !/    28-Jun-2006 : Adding file name preamble.          ( version 3.09 )

  !/    28-Oct-2006 : Spectral partitioning.              ( version 3.09 )

  !/    09-Jan-2007 : Correct edges of read mask.         ( version 3.10 )

  !/    26-Mar-2007 : Add to spectral partitioning.       ( version 3.11 )

  !/    14-Apr-2007 : Add Miche style limiter.            ( version 3.11 )

  !/                  ( J. H. Alves )

  !/    25-Apr-2007 : Battjes-Janssen Sdb added.          ( version 3.11 )

  !/                  ( J. H. Alves )

  !/    18-Sep-2007 : Adding WAM4 physics option.         ( version 3.13 )

  !/                  ( F. Ardhuin )

  !/    09-Oct-2007 : Adding bottom scattering SBS1.      ( version 3.13 )

  !/                  ( F. Ardhuin )

  !/    22-Feb-2008 : Initialize TRNX-Y properly.         ( version 3.13 )

  !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )

  !/    23-Jul-2009 : Modification of ST3 namelist  .     ( version 3.14-SHOM )

  !/    31-Mar-2010 : Addition of shoreline reflection    ( version 3.14-IFREMER )

  !/    29-Jun-2010 : Adding Stokes drift profile output  ( version 3.14-IFREMER )

  !/    30-Aug-2010 : Adding ST4 option                   ( version 3.14-IFREMER )


  !/    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 : Clean up of unstructured grids      ( version 3.14.4 )

  !/                  (A. Roland and F. Ardhuin)

  !/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to

  !/                  specify index closure for a grid. Change GLOBAL

  !/                  input in ww3_grid.inp to CSTRG.     ( version 3.14 )

  !/                  (T. J. Campbell, NRL)

  !/    25-Jun-2011 : Adding movable bed friction         ( version 4.01 )

  !/    16-Sep-2011 : Clean up.                           ( version 4.05 )

  !/    01-Dec-2011 : New namelist for reflection         ( version 4.05 )

  !/    01-Mar-2012 : Bug correction for NLPROP in ST2    ( version 4.05 )

  !/    12-Jun-2012 : Add /RTD rotated grid option. JGLi  ( version 4.06 )

  !/    13-Jul-2012 : Move data structures GMD (SNL3) and nonlinear

  !/                  filter (SNLS) from 3.15 (HLT).      ( version 4.07 )

  !/    02-Sep-2012 : Clean up of reflection and UG grids ( version 4.08 )

  !/    12-Dec-2012 : Adding SMC grid.  JG_Li             ( version 4.08 )

  !/    19-Dec-2012 : Add NOSWLL as namelist variable.    ( version 4.OF )

  !/    05-Mar-2013 : Adjusted default roughness for rocks( version 4.09 )

  !/    01-Jun-2013 : Adding namelist for spectral output ( version 4.10 )

  !/    12-Sep-2013 : Adding Arctic part for SMC grid.    ( version 4.11 )

  !/    01-Nov-2013 : Changed UG list name to UNST        ( version 4.12 )

  !/    11-Nov-2013 : Make SMC and RTD option compatible. ( version 4.13 )

  !/    13-Nov-2013 : Moved out reflection to W3UPDTMD    ( version 4.12 )

  !/    27-Jul-2013 : Adding free infragravity waves      ( version 4.15 )

  !/    02-Dec-2013 : Update of ST4                       ( version 4.16 )

  !/    16-Feb-2014 : Adds wind bias correction: WCOR     ( version 5.00 )

  !/    10-Mar-2014 : Adding namelist for IC2             ( version 5.01 )

  !/    29-May-2014 : Adding namelist for IC3             ( version 5.01 )

  !/    15 Oct-2015 : Change SMC grid input files. JGLi   ( version 5.09 )

  !/    10-Jan-2017 : Changes for US3D and USSP           ( version 6.01 )

  !/    20-Jan-2017 : Bug fix for mask input from file.   ( version 6.02 )

  !/    01-Mar-2018 : RTD poles info read from namelist   ( version 6.02 )

  !/    14-Mar-2018 : Option to read UNST boundary file   ( version 6.02 )

  !/    26-Mar-2018 : Sea-point only Wnd/Cur input. JGLi  ( version 6.02 )

  !/    15-May-2018 : Dry sea points over zlim            ( version 6.04 )

  !/    06-Jun-2018 : add Implicit grid parameters for unstructured grids

  !/                  add DEBUGGRID/DEBUGSTP              ( version 6.04 )

  !/    18-Aug-2018 : S_{ice} IC5 (Q. Liu)                ( version 6.06 )

  !/    20-Jun-2018 : Update of ST6  (Q. Liu)             ( version 6.06 )

  !/    26-Aug-2018 : UOST (Mentaschi et al. 2015, 2018)  ( version 6.06 )

  !/    27-Aug-2018 : Add WBT parameter                   ( version 6.06 )

  !/    22-Jan-2020 : Update default values for IS2       ( version 7.05 )

  !/    20-Feb-2020 : Include Romero's dissipation in ST4 ( version 7.06 )

  !/    15-Apr-2020 : Adds optional opt-out for CFL on BC ( version 7.08 )

  !/    18-Jun-2020 : Adds 360-day calendar option        ( version 7.08 )

  !/    24-Jun-2020 : RTD output b. c. to rotated grid.   ( version 7.11 )

  !/    05-Jan-2021 : Update SMC grid for multi-grid. JGLi( version 7.13 )

  !/    27-May-2021 : Updates for IC5 (Q. Liu)            ( version 7.12 )

  !/    27-May-2021 : Moved to a subroutine               ( version 7.13 )

  !/    07-Jun-2021 : S_{nl} GKE NL5 (Q. Liu)             ( version 7.13 )

  !/    19-Jul-2021 : Momentum and air density support    ( version 7.14 )

  !/    28-Feb-2023 : GQM as an alternative for NL1       ( version 7.15 )

  !/    11-Jan-2024 : New namelist parameters for IC4     ( version 7.15 )

  !/    03-May-2024 : New CAPCHNK parameters for SIN4     ( version 7.15 )

  !/

  !/    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 :

  !

  !     "Grid" preprocessing subroutine, which writes a model definition

  !     file containing the model parameter settigs and grid data.

  !

  !  2. Method :

  !

  !     Information is read from the file ww3_grid.inp (NDSI), or

  !     preset in this subroutine. A model definition file mod_def.ww3 is

  !     then produced by W3IOGR. Note that the name of the model

  !     definition file is set in W3IOGR.

  !

  !  3. Parameters :

  !

  !     Local parameters.

  !     ----------------------------------------------------------------

  !       NDSI    Int.  Input unit number ("ww3_grid.inp").

  !       NDSS    Int.  Scratch file.

  !       NDSG    Int.  Grid unit ( may be NDSI )

  !       NDSTR   Int.  Sub-grid unit ( may be NDSI or NDSG )

  !       VSC     Real  Scale factor.

  !       VOF     Real  Add offset.

  !       ZLIM    Real  Limiting bottom depth, used to define land.

  !       IDLA    Int.  Layout indicator used by INA2R.

  !       IDFM    Int.  Id. FORMAT indicator.

  !       RFORM   C*16  Id. FORMAT.

  !       FNAME   C*60  File name with bottom level data.

  !       FROM    C*4   Test string for open, 'UNIT' or 'FILE'

  !     ----------------------------------------------------------------

  !

  !  4. Subroutines used :

  !

  !      Name      Type  Module   Description

  !     ----------------------------------------------------------------

  !      W3NMOD    Subr. W3GDATMD Set number of model.

  !      W3SETG    Subr.   Id.    Point to selected model.

  !      W3DIMS    Subr.   Id.    Set array dims for a spectral grid.

  !      W3DIMX    Subr.   Id.    Set array dims for a spatial grid.

  !      W3GRMP    Subr. W3GSRUMD Compute bilinear interpolation for point

  !      W3NOUT    Subr. W3ODATMD Set number of model for output.

  !      W3SETO    Subr.   Id.    Point to selected model for output.

  !      W3DMO5    Subr.   Id.    Set array dims for output type 5.

  !      ITRACE    Subr. W3SERVMD Subroutine tracing initialization.

  !      STRACE    Subr.   Id.    Subroutine tracing.

  !      NEXTLN    Subr.   Id.    Get next line from input file

  !      EXTCDE    Subr.   Id.    Abort program as graceful as possible.

  !      DISTAB    Subr. W3DISPMD Make tables for solution of the

  !                               dispersion relation.

  !      READNL    Subr. Internal Read namelist.

  !      INAR2R    Subr. W3ARRYMD Read in an REAL array.

  !      PRTBLK    Subr.   Id.    Print plot of array.

  !      W3IOGR    Subr. W3IOGRMD Reading/writing model definition file.

  !     ----------------------------------------------------------------

  !

  !  5. Called by :

  !

  !     ww3_grid program

  !

  !  6. Error messages :

  !

  !  7. Remarks :

  !

  !      Physical grid :

  !     -----------------

  !

  !     The physical grid is defined by a grid counter IX defining the

  !     discrete longitude and IY defining the discrete latitude as shown

  !     below. For mathemathical convenience, these grid axes will

  !     generally be denoted as the X and Y axes. Two-dimensional arrays

  !     describing parameters on this grid are given as A(IY,IX).

  !

  !           IY=NY

  !             ^  |      |      |      |      |      |            ^ N

  !             |  |------|------|------|------|------|----        |

  !             |  |  ::  |  25  |  26  |  27  |  28  |          --|--

  !                |------|------|------|------|------|----        |

  !           IY=3 |  ::  |  ::  |  9   |  10  |  11  |            |

  !                |------|------|------|------|------|----

  !           IY=2 |  ::  |   1  |   2  |  ::  |   3  |

  !                |------|------|------|------|------|----

  !           IY=1 |  ::  |  ::  |  ::  |  ::  |  ::  |

  !                +------+------+------+------+------+----

  !                  IX=1   IX=2   IX=3   IX=4   IX=5   ---> IX=NX

  !

  !                                        :: is a land point.

  !

  !     To reduce memory usage of the model, spectra are stored for sea

  !     points only, in a one-dimensional grid with the length NSEA. This

  !     grid is called the storage grid. The definition of the counter

  !     in the storage grid is graphically depicted above. To transfer

  !     data between the two grids, the maps MAPFS and MAPSF are

  !     determined. MAPFS gives the counter of the storage grid ISEA

  !     for every physical grid point (IY,IX), such that

  !

  !             MAPFS(IY,IX) = ISEA

  !

  !     ISEA = 0 corresponds to land points. The map MAPSF gives the grid

  !     counters (IY,IX) for a given storage point ISEA.

  !

  !             MAPSF(ISEA,1) = IX

  !             MAPSF(ISEA,2) = IY

  !             MAPSF(ISEA,3) = IY+(IX-1)*NY  ( filled during reading )

  !

  !     Finally, a status maps MAPSTA and MAPST2 are determined, where

  !     the status indicator ISTAT = MAPSTA(IY,IX) determines the type

  !     of the grid point.

  !

  !         ISTAT  Means

  !       ---------------------------------------------------

  !           0    Point excluded from grid.

  !        (-)1    Sea point

  !        (-)2    "Active" boundary point (data prescribed)

  !

  !     For ISTAT=0, the secondary status counter ISTA2 is defined as

  !

  !         ISTA2  Means

  !       ---------------------------------------------------

  !           0    Land point.

  !           1    Point excluded from grid.

  !

  !     Negative values of ISTAT identify points that are temporarily

  !     taken out of the computation. For these points ISTA2 are

  !     defined per bit

  !

  !         BIT    Means

  !       ---------------------------------------------------

  !          1     Ice flag (1 = ice coverage)

  !          2     Dry flag (1 = dry point with depth 0)

  !          3     Inferred land in multi-grid model.

  !          4     Masking in multi-grid model.

  !          5     land point flag for relocatable grid.

  !

  !      Thus ISTA2=0 for ISTAT<0 is in error, ISTA2=1 means ice cover,

  !      ISTA2=3 means ice on dry point, etc.

  !

  !      Spectral grid :

  !     -----------------

  !

  !     In the spectral grid (and in physical space in general),

  !     the cartesian convention for directions is used, i.e., the

  !     direction 0 corresponds to waves propagating in the positive

  !     X-direction and 90 degr. corresponds to waves propagating in

  !     the positive Y-direction. Similar definitions are used for the

  !     internal description of winds and currents. Output can obviously

  !     be transformed according to any preferred convention.

  !

  !          ITH=NTH

  !             ^  |      |      |      |      |

  !             |  |------|------|------|------|----

  !             |  |      |      |      |      |      TH(3) = DTH*2.

  !                |------|------|------|------|----

  !          ITH=2 |      |      |      |      |      TH(2) = DTH

  !                |------|------|------|------|----

  !          ITH=1 |      |      |      |      |      TH(1) = 0.

  !                +------+------+------+------+----

  !                  IK=1   IK=2   IK=3   IK=4   ---> IK=NK

  !

  !     The spectral grid consists of NK wavenumbers. The first

  !     wavenumber IK=1 corresponds to the longest wave. The wavenumber

  !     grid varies in space, as given by an invariant relative freq.

  !     grid and the local depth. The spectral grid furthermore contains

  !     NTH directions, equally spaced over a full circle. the first

  !     direction corresponds to the direction 0, etc.

  !

  ! (Begin SMC description)

  !

  !      Spherical Multiple-Cell (SMC) grid

  !     -----------------------------------

  !

  !     SMC grid is a multi-resolution grid using cells of multiple times

  !     of each other.  It is similar to the lat-lon grid using rectangular

  !     cells but only cells at sea points are retained.  All land points

  !     have been removed from the model.  At high latitudes, cells are

  !     merged longitudinally to relax the CFL resctiction on time steps.

  !     Near coastlines, cells are divided into quarters in a few steps so

  !     that high resolution is achieved to refine coastlines and resolve

  !     small islands.  At present, three tiers of quarter cells are used.

  !     For locating purpose, a usual x-y counter is setup by the smallest

  !     cell size and starting from the south-west corner of the usual

  !     rectuangular domain.  Each sea cell is then given a pair of x-y

  !     index, plus a pair of increments.  These four index are stored in

  !     the cell array IJKCel(4, NCel), each row holds i, j, di, dj, and

  !     IJKDep holds ndps, where ndps is an integer depth in metre.  If

  !     precision higher than a metre is required, it may use other unit

  !     (cm for instance) with a conversion factor.

  !

  !     For transport calculation, two face arrays, IJKUFc(7, NUFc) and

  !     IJKVFc(7, NVFc), are also created to store the neighbouring cell

  !     sequential numbers and the face location and size.  The 3 arrays

  !     are calculated outside the wave model and input from text files.

  !

  !     Boundary condition is added for SMC grid so that it can be used for

  !     regional model as well.  Most of the original boundary settings

  !     are reclaimed as long as the boundary condition file is provided

  !     by a lat-lon grid WW3 model, which will set the interpolation

  !     parameters in the boundary condition file.  The NBI number is

  !     reset with an input value because the NX-Y double loop overcount

  !     the boundary cells for merged cells in the SMC grid.  ISBPI

  !     boundary cell mapping array is fine as MAPFS uses duplicated cell

  !     number in any merged cell.  From there, all original NBI loops are

  !     reusable.

  !

  !     The whole Arctic can be included in the SMC grid if ARCTC variable

  !     is set to be .TRUE. within the SMC option.  The ARCTC option appends

  !     the polar Arctic part above 86N to the existing SMC grid and uses

  !     a map-east reference direction for this extra polar region.

  !     Because the map-east direction changes with latitude and longitude

  !     the wave spectra defined to the map-east direction could not be

  !     mixed up with the conventional spectra defined to the local east

  !     direction.  A rotation sub is provided for convertion from one to

  !     another.  Propagation part will be calculated together, including

  !     the boundary cells.  The boundary cells are then updated by

  !     assigning the corresponding inner cells to them after conversion.

  !     Boundary cells are duplicated northmost 4 rows of the global part

  !     and they can be excluded for source term and output if required.

  !     For convenience, Arctic cellls are all base level cells and are

  !     appended to the end of the global cells.  If refined cells were

  !     used in the Arctic part, it would not be kept all together, making

  !     the sub-loops much more complicated. If refined resolution cells

  !     are required for a Arctic regional model, users may consider use

  !     the rotated SMC grid options (RTD and SMC).

  !

  !     For more information about the SMC grid, please refer to

  !     Li, J.G. (2012) Propagation of Ocean Surface Waves on a Spherical

  !     Multiple-Cell Grid.  J. Comput. Phys., 231, 8262-8277.  online at

  !     http://dx.doi.org/10.1016/j.jcp.2012.08.007

  !

  ! (End SMC description)

  !

  !     ICEWIND is the scale factor for reduction of wind input by ice

  !     concentration. Value specified corresponds to the fractional

  !     input for 100% ice concentration. Default is 1.0, meaning that

  !     100% ice concentration result in zero wind input.

  !     Sin_in_ice=Sin_in_open_water * (1-ICE*ICEWIND)


  !     -----------------------------------------------------------------*

  !  8. Structure :

  !

  !     ----------------------------------------------------------------

  !        1.   Set up grid storage structure.

  !                               ( W3NMOD , W3NOUT , W3SETG , W3SETO )

  !        2.a  I-O setup.

  !          b  Print heading(s).

  !        3.   Prepare int. table for dispersion relation   ( DISTAB )

  !        4.   Read and process input file up to spectrum.

  !          a  Get comment character

  !          b  Name of grid

  !          c  Define spectrum                              ( W3DIMS )

  !        5.   Set-up discrete spectrum.

  !          a  Directions.

  !          b  Frequency for spectrum.

  !        6.   Read and process input file up to numerical parameters

  !          a  Set model flags and time steps

  !          b  Set / select source term package

  !          c  Pre-process namelists.

  !          d  Wind input source term.

  !          e  Nonlinear interactions.

  !          f  Whitecapping term.

  !          g  Bottom friction source term.

  !          h  Depth indiced breaking source term.

  !          i  Triad interaction source term.

  !          j  Bottom scattering source term.

  !          k  Undefined source term.

  !          l  Set / select propagaton scheme

  !          m  Parameters for propagation scheme.

  !          n  Set misc. parameters (ice, seeding, ...)

  !          o  End of namelist processing

  !          p  Set various other variables

  !        7.   Read and prepare grid.

  !          a  Layout of grid

  !          b  Storage of grid of grid

  !          c  Read bottom depths

  !          d  Set up temp map

  !          e  Subgrid information

  !            1 Info from input file

  !            2 Open file and check if necessary

  !            3 Read the data

  !            4 Limit

  !        8    Finalize status maps

  !          a  Determine where to get the data

  !             Get data in parts from input file

  !             ----------------------------------------------------

  !          b  Read and update TMPSTA with bound. and excl. points.

  !          c  Finalize excluded points

  !             ----------------------------------------------------

  !             Read data from file

  !             ----------------------------------------------------

  !          d  Read data from file

  !             ----------------------------------------------------

  !          e  Get NSEA and other counters

  !          f  Set up all maps                              ( W3DIMX )

  !        9.   Prepare output boundary points.

  !          a  Read

  !          b  Update

  !       10.   Write model definition file.                 ( W3IOGR )

  !     ----------------------------------------------------------------

  !

  !  9. Switches :

  !

  !     !/FLX1  Stresses according to Wu (1980).

  !     !/FLX2  Stresses according to T&C (1996).

  !     !/FLX3  Stresses according to T&C (1996) with cap on Cd.

  !     !/FLX4  Stresses according to Hwang (2011).

  !     !/FLX5  Direct use of stress from atmospheric model/input file.

  !

  !     !/LN0   No linear input source term.

  !     !/SEED  'Seeding' of lowest frequency for sufficiently strong

  !             winds. Proxi for linear input.

  !     !/LN1   Cavaleri and Melanotte-Rizzoli with Tolman filter.

  !

  !     !/ST0   No source terms included (input/dissipation)

  !     !/ST1   WAM-3 physics package.

  !     !/ST2   Tolman and Chalikov (1996) physics package.

  !     !/ST3   WAM 4+ source terms from P.A.E.M. Janssen and J-R. Bidlot

  !     !/ST4   Input and dissipation using saturation following Ardhuin et al. (2009,2010)

  !             Filipot & Ardhuin (2010) or Romero (2019)

  !     !/ST6   BYDRZ source term package featuring Donelan et al.

  !             (2006) input and Babanin et al. (2001,2010) dissipation.

  !

  !     !/NL0   No nonlinear interactions.

  !     !/NL1   Discrete interaction approximation (DIA or GQM).

  !     !/NL2   Exact interactions (WRT).

  !     !/NL3   Generalized Multiple DIA (GMD).

  !     !/NL4   Two Scale Approximation

  !     !/NL5   Generalized Kinetic Equation (GKE)

  !     !/NLS   Snl based HF filter.

  !

  !     !/BT0   No bottom friction included.

  !     !/BT1   JONSWAP bottom friction package.

  !     !/BT4   SHOWEX bottom friction using movable bed roughness

  !                  (Tolman 1994, Ardhuin & al. 2003)

  !

  !     !/IC1   Sink term for interaction with ice (uniform k_i)

  !     !/IC2   Sink term for under-ice boundary layer friction

  !                  (Liu et al.    1991: JGR 96 (C3), 4605-4621)

  !                  (Liu and Mollo 1988: JPO 18       1720-1712)

  !     !/IC3   Sink term for interaction with ice (Wang and Shen method)

  !                  (Wang and Shen JGR 2010)

  !     !/IC4   Sink term for empirical, frequency-dependent attenuation

  !                   in ice (Wadhams et al. 1988: JGR 93 (C6) 6799-6818)

  !     !/IC5   Sink term for interaction with ice (effective medium mod.)

  !                  (Mosig et al. 2015, Meylan et al. 2018, Liu et al.

  !                   2020)

  !

  !     !/UOST  Unresolved Obstacles Source Term (UOST), Mentaschi et al. 2015

  !

  !     !/DB0   No depth-induced breaking included.

  !     !/DB1   Battjes-Janssen depth-limited breaking.

  !     !/MLIM  Mich-style limiter.

  !

  !     !/TR0   No triad interactions included.

  !

  !     !/BS0   No bottom scattering included.

  !     !/BS1   Routines from F. Ardhuin.

  !

  !     !/PR1   First order propagation scheme.

  !     !/PR2   QUICKEST scheme with ULTIMATE limite and diffusion

  !             correction for swell dispersion.

  !     !/PR3   Averaging ULTIMATE QUICKEST scheme.

  !

  !     !/RTD   Rotated regular lat-lon grid. Special case is standard Polat=90.

  !     !/SMC   Spherical Multiple-Cell grid, may includes the whole Arctic.

  !

  !     !/MGG   GSE correction for moving grid.

  !

  !     !/S     Enable subroutine tracing.

  !     !/T     Enable test output.

  !     !/T0    Enable test output tables for boundary output.

  !

  !     !/O0    Print equivalent namelist setting to std out.

  !     !/O1    Print tables with boundary points as part of output.

  !     !/O2    Print MAPSTA as part of output.

  !     !/O2a   Print land-sea mask in mask.ww3.

  !     !/O2b   Print obstruction data.

  !     !/O2c   Print extended status map.

  !

  ! 10. Source code :

  !

  !/ ------------------------------------------------------------------- /

  USE constants

  !/

  USE w3triamd

  USE w3gsrumd, ONLY: w3grmp

  USE w3odatmd, ONLY: w3nout, w3seto, w3dmo5

  USE w3iogrmd, ONLY: w3iogr

  USE w3servmd, ONLY: itrace, nextln, extcde

#ifdef W3_RTD

  USE w3servmd, ONLY: w3eqtoll, w3lltoeq

#endif

#ifdef W3_SMC

  USE w3servmd, ONLY: w3lltoeq

#endif

#ifdef W3_S

  USE w3servmd, ONLY: strace

#endif

  USE w3arrymd, ONLY: ina2r, ina2i

#ifdef W3_T

  USE w3arrymd, ONLY: prtblk

#endif

  USE w3dispmd, ONLY: distab

  !/

  USE w3gdatmd

  USE w3odatmd, ONLY: ndse, ndst, ndso

  USE w3odatmd, ONLY: nbi, nbi2, nfbpo, nbo, nbo2, flbpi, flbpo,  &

       ipbpo, isbpo, xbpo, ybpo, rdbpo, fnmpre,    &

       ihmax, hspmin, wsmult, wscut, flcomb,       &

       noswll, ptmeth, ptfcut

  USE w3timemd, ONLY: caltype

  USE w3nmlgridmd

#ifdef W3_SCRIP

  USE scrip_grids, ONLY: grid1_units, grid1_name, &

       grid1_center_lon, grid1_center_lat, &

       grid1_corner_lon, grid1_corner_lat, &

       grid1_mask, grid1_size, grid1_rank, &

       grid1_imask, &

       grid1_corners, grid1_dims

  USE scrip_kindsmod

  USE wmscrpmd

#endif

#ifdef W3_SCRIPNC

  USE netcdf

#endif

  !

#ifdef W3_NL3

  USE w3snl3md, ONLY: lammax, delthm

#endif

#ifdef W3_NLS

  USE w3snlsmd, ONLY: abmax

#endif

  !

  IMPLICIT NONE

  !/

  !/ ------------------------------------------------------------------- /

  !/ Local parameters

  !/

  TYPE(nml_spectrum_t)     :: nml_spectrum

  TYPE(nml_run_t)          :: nml_run

  TYPE(nml_timesteps_t)    :: nml_timesteps

  TYPE(nml_grid_t)         :: nml_grid

  TYPE(nml_rect_t)         :: nml_rect

  TYPE(nml_curv_t)         :: nml_curv

  TYPE(nml_unst_t)         :: nml_unst

  TYPE(nml_smc_t)          :: nml_smc

  TYPE(nml_depth_t)        :: nml_depth

  TYPE(nml_mask_t)         :: nml_mask

  TYPE(nml_obst_t)         :: nml_obst

  TYPE(nml_slope_t)        :: nml_slope

  TYPE(nml_sed_t)          :: nml_sed

  TYPE(nml_inbnd_count_t)  :: nml_inbnd_count

  TYPE(nml_inbnd_point_t), ALLOCATABLE  :: nml_inbnd_point(:)

  TYPE(nml_excl_count_t)   :: nml_excl_count

  TYPE(nml_excl_point_t), ALLOCATABLE   :: nml_excl_point(:)

  TYPE(nml_excl_body_t), ALLOCATABLE    :: nml_excl_body(:)

  TYPE(nml_outbnd_count_t) :: nml_outbnd_count

  TYPE(nml_outbnd_line_t), ALLOCATABLE  :: nml_outbnd_line(:)

  !

  INTEGER, PARAMETER      :: nfl = 6

  INTEGER                 :: ndsi, ndsi2, ndss, ndsm, ndsg, ndstr,&

       ierr, ndstrc, ntrace, ith, ik, ith0, &

       isp, iyn(nfl), nrlin, nrsrce, nrnl,  &

       nrbt, nrdb, nrtr, nrbs, nrprop,      &

       idla, idfm, ix0, ixn, ix, iy, isea,  &

       idx, ixo, idy, iyo, iba, nba, iloop, &

       ifl, nbotot, npo, ip, ix1, ix2, iy1, &

       iy2, j, jj, ixr(4), iyr(4), iseai(4),&

       ist, nki, nthi, nric, nris, i, idft, &

       nstat, nbt, nland, nosw, nmapb, imapb

#ifdef W3_ASCII

  INTEGER                  :: ndsma

#endif

#ifdef W3_NL2

  INTEGER            :: idepth

#endif

#ifdef W3_O1

  INTEGER             :: ibi, ip0, ipn, iph, ipi

#endif

  INTEGER                 :: ncol =  78

#ifdef W3_SMC

  !!Li     Offset to change Equator index = 0 to regular index JEQT

  !!Li     LvSMC  levels of refinded resolutions for SMC grid.

  !!Li     NBISMC number of boundary point for regional SMC grid.

  !!Li     ISHFT for SMC i-index from smc origin to regular grid west edge.

  !!Li     SMC cell only subgrid obstruction array dimensions NCObst, JObs.

  INTEGER      :: jeqt, lvsmc, nbismc, js, ncobst, jobs, ishft

  INTEGER      :: ngui, ngvj,  naui, navj

#endif

  !

#ifdef W3_O2

  INTEGER                 :: nmap, imap

#endif

#ifdef W3_T

  INTEGER                 :: ix3, iy3

#endif

#ifdef W3_T0

  INTEGER                 :: ifile

#endif

#ifdef W3_S

  INTEGER, SAVE           :: ient = 0

#endif

  !

  INTEGER, ALLOCATABLE    :: tmpsta(:,:), tmpmap(:,:), readmp(:,:)

#ifdef W3_T

  INTEGER, ALLOCATABLE    :: mapout(:,:)

#endif

  !

  REAL                    :: rxfr, rfr1, sigma, sxfr, fachf,      &

       vsc, vsc0, vof,                      &

       zlim, x, y, xp,  xo0, yo0, dxo, dyo, &

       xo, yo, rd(4), rdtot,                &

       factor, rth0, fmiche, rwndc,         &

       wcor1, wcor2

  !

  CHARACTER(LEN=4)        :: gstrg, cstrg

  !

  ! Variables used to allow spectral output on full grid

  !

  INTEGER                 :: p2sf,i1p2sf,i2p2sf

  INTEGER                 :: e3d,i1e3d,i2e3d

  INTEGER                 :: us3d,i1us3d,i2us3d,                  &

       ussp, iussp,                         &

       th1mf, i1th1m, i2th1m,               &

       sth1mf, i1sth1m, i2sth1m,            &

       th2mf, i1th2m, i2th2m,               &

       sth2mf, i1sth2m, i2sth2m

  ! STK_WN are the decays for Stokes drift partitions

  REAL                    :: stk_wn(25)


  !

#ifdef W3_LN1

  REAL                    :: clin, rfpm, rfhf

#endif

#ifdef W3_ST1

  REAL                    :: cinp, cdis, apm

#endif

#ifdef W3_ST2

  REAL                    :: phimin, fpia, fpib, dphid

#endif

#ifdef W3_NL1

  REAL                    :: nlprop

#endif

#ifdef W3_NL2

  REAL                    :: dptfac, depths(100)

#endif

#ifdef W3_NL3

  REAL                    :: qparms(500)

#endif

#ifdef W3_NLS

  REAL                    :: a34, fhfc, dnm, fc1, fc2, fc3

#endif

#ifdef W3_BT1

  REAL                    :: gamma

#endif

#ifdef W3_PR2

  REAL                    :: latmin

#endif

  !

#ifdef W3_SMC

  REAL                    :: dvsmc

  REAL                    :: trnmx, trnmy

  INTEGER, ALLOCATABLE    :: nlvcelsk(:),  nlvufcsk(:),  nlvvfcsk(:)

  INTEGER, ALLOCATABLE    :: ijkcelin(:,:),ijkufcin(:,:),ijkvfcin(:,:)

  INTEGER, ALLOCATABLE    :: nbicelin(:),  ijkobstr(:,:)

  REAL                    :: polonac, polatac

  INTEGER, ALLOCATABLE    :: ijkcelac(:,:),ijkufcac(:,:),ijkvfcac(:,:)

  INTEGER, ALLOCATABLE    :: ijkdep(:), ijkvfc8(:)

  REAL,    ALLOCATABLE    :: xlonac(:),ylatac(:),elonac(:),elatac(:)

#endif

  !

#ifdef W3_RTD

  REAL, ALLOCATABLE       :: angldin(:,:),stdlon(:,:),stdlat(:,:)

  ! 1-dim boundary sectors

  REAL, ALLOCATABLE       :: bdylon(:), bdylat(:),                &

       elatbdy(:), elonbdy(:), anglbdy(:)

  ! If the destination grid for an output b.c. is rotated, its pole is:

  REAL                    :: bpolat, bpolon

  !

#endif

  REAL, ALLOCATABLE       :: xgrdin(:,:), ygrdin(:,:)

  REAL, ALLOCATABLE       :: zbin(:,:), obsx(:,:), obsy(:,:)

  REAL, ALLOCATABLE       :: refd(:,:), refd2(:,:), refs(:,:)

#ifdef W3_BT4

  REAL, ALLOCATABLE  :: sed_d50file(:,:), sed_porofile(:,:)

  LOGICAL            :: sedmapd50

  REAL               :: sed_d50_uniform, sed_dstar, ripfac1, &

       ripfac2, ripfac3, ripfac4, sigdepth, &

       botroughmin, botroughfac

#endif

  !

  LOGICAL                 :: fllin, flinds, flnl, flbt, fldb,     &

       fltr, flbs, flprop, flref,     &

       first, connct, flnew, ingrid,flic,   &

       flis, flgnml

  LOGICAL                 :: fltc96 = .false.

  LOGICAL                 :: flnmlo = .false.

  LOGICAL                 :: flstb2 = .false.

  LOGICAL                 :: flst4  = .false.

  LOGICAL                 :: flst6  = .false.


  REAL                    :: facberg, refslope

#ifdef W3_IS1

  REAL                    :: isc1, isc2

#endif

#ifdef W3_IS2

  REAL                    :: isc1, is2backscat, is2c2, is2c3,&

       is2fragility, is2dmin, is2damp, &

       is2conc, is2creepb, is2creepc,  &

       is2creepd, is2creepn, is2breake,&

       is2wim1, is2breakf, is2flexstr, &

       is2andisn, is2andise, is2andisd

  LOGICAL                 :: is2break, is2disp, is2dupdate,  &

       is2isoscat, is2andisb

#endif

  !

#ifdef W3_REF1

  REAL                    :: refcoast, reffreq, refmap,     &

       refsubgrid, refrmax, refmapd,  &

       reficeberg, refcosp_straight,  &

       reffreqpow, refunstsource

#endif

  !

#ifdef W3_IG1

  LOGICAL                 :: igswellmax, igbcoverwrite

  INTEGER                 :: igmethod, igaddoutp, igsource,      &

       igsourceatbp, igsterms

  REAL                    :: igmaxfreq, igmindep, igmaxdep,      &

       igkdmin, igfixeddepth, igempirical

#endif

  !

#ifdef W3_IC2

  LOGICAL                 :: ic2disper

  REAL                    :: ic2turb, ic2rough, ic2reynolds,      &

       ic2smooth, ic2visc, ic2turbs, ic2dmax

#endif


#ifdef W3_IC3

  REAL                    :: ic2turb, ic2rough, ic2reynolds,      &

       ic2smooth, ic2visc, ic2turbs,        &

       ic3maxthk, ic3maxcnc,                &

       ic3hilim, ic3kilim,                  &

       ic3visc, ic3elas, ic3dens, ic3hice

  LOGICAL                 :: ic3cheng,usecgice

#endif


#ifdef W3_IC4

  INTEGER                 :: ic4method

  REAL                    :: ic4ki(nic4), ic4fc(nic4),            &

                             ic4cn(nic42), ic4fmin, ic4kibk

#endif


#ifdef W3_IC5

  REAL                    :: ic5minig, ic5minwt,                  &

       ic5maxkratio, ic5maxki, ic5minhw,    &

       ic5maxiter, ic5rkick, ic5kfilter,    &

       ic5vemod

  CHARACTER(LEN=4)        :: ic5mstr(3) = (/' EFS', ' RP ', ' M2 '/)

#endif


  CHARACTER               :: comstr*1, pname*30, rform*16,        &

       from*4, fname*60, tname*60, line*80, &

       status*20,fname2*60, pname2*40

  CHARACTER(LEN=6)        :: yesxno(2)

#ifdef W3_FLX3

  CHARACTER(LEN=18)       :: typeid

#endif


#ifdef W3_SCRIP

  INTEGER :: ncid

  INTEGER :: grid_size_dimid, grid_rank_dimid, grid_corners_dimid

  INTEGER :: grid_center_lat_varid, grid_center_lon_varid

  INTEGER :: grid_corner_lat_varid, grid_corner_lon_varid

  INTEGER :: grid_area_varid, grid_imask_varid

  INTEGER :: grid_dims_varid

  REAL (scrip_r8) :: conv_dx,conv_dy,offset

#endif


  !/ ------------------------------------------------------------------- /

  !/ Namelists

  !/

  INTEGER                 :: flagtr, ihm

  REAL                    :: cfltm, cice0, cicen, pmove, xfilt,    &

       lice, xseed, xr, hspm, wsm, wsc, stdx,&

       stdy, stdt, icehmin, icehfac, icehinit, &

       icesln, icewind, icesnl, icesds,        &

       icehdisp, icefdisp, iceddisp, btbet

  !

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

  LOGICAL                 :: flc, icedisp, trckcmpr

  INTEGER                 :: ptm   ! Partitioning method

  REAL                    :: ptfc  ! Part. cut off freq (for method 5)

  REAL                    :: aircmin, airgb

  CHARACTER               :: pmname*45, pmnam2*45  ! Part. method desc.

#ifdef W3_FLD1

  INTEGER                 :: tailtype

  REAL                    :: taillev, tailt1, tailt2

#endif

#ifdef W3_FLD2

  INTEGER                 :: tailtype

  REAL                    :: taillev, tailt1, tailt2

#endif

#ifdef W3_FLX3

  INTEGER                 :: ctype

  REAL                    :: cdmax

#endif

#ifdef W3_FLX4

  REAL                    :: cdfac

#endif

#ifdef W3_ST2

  REAL                    :: zwnd, swellf, stabsh, stabof,        &

       cneg, cpos, fneg, fpos

  REAL                    :: sdsa0, sdsa1, sdsa2,                 &

       sdsb0, sdsb1, sdsb2, sdsb3

#endif

#ifdef W3_ST3

  REAL                    :: zwnd, alpha0, z0max, betamax, sinthp,&

       zalp, swellf, fxpm3, fxfm3,          &

       wnmeanptail, wnmeanp, stxftf, stxftwn

  REAL                    :: stxftftail, sdsc1,                   &

       sdsdelta1, sdsdelta2

#endif

  !

#ifdef W3_ST4

  INTEGER                 :: swellfpar, sdsiso, sdsbrfdf, sintable,&

                             tauwbug

  REAL         :: sdsbchoice

  REAL                    :: zwnd, alpha0, z0max, betamax, sinthp,&

       zalp, z0rat, tauwshelter, swellf,    &

       swellf2,swellf3,swellf4, swellf5,    &

       swellf6, swellf7, fxpm3, fxfm3,      &

       wnmeanptail, wnmeanp, stxftf, stxftftail,       &

       stxftwn, sinbr, fxfmage,             &

       sdsc2, sdscum, sdsc4, sdsc5, sdsc6, whitecapwidth, whitecapdur, &

       sdsstrain, sdsstraina, sdsstrain2,   &

       sdsbr, sdsp, sdsbt, sds4a, sdkof,    &

       sdscos, sdsdth, sdsbck, sdsabk,      &

       sdspbk, sdsbint, sdshck,             &

       sdsbrf1,                             &

       sdsbm0, sdsbm1, sdsbm2, sdsbm3,      &

       sdsbm4, sdsfacmtf, sdscump,  sdsnuw, &

       sdsl, sdsmwd, sdsmwpow, spmss, sdsnmtf, sintail1, sintail2, &

       cumsigp, viscstress,                 &

       capcha, chamin, cha0, ucap, sigmaucap

#endif

  !

#ifdef W3_ST6

  REAL                    :: sina0, sinws, sinfc,                 &

       sdsa1, sdsa2, swlb1

  INTEGER                 :: sdsp1, sdsp2

  LOGICAL                 :: sdset, cstb1

#endif

  !

#ifdef W3_NL1

  REAL                    :: lambda, kdconv, kdmin,               &

       snlcs1, snlcs2, snlcs3

  INTEGER                 :: iqtype, gqmnf1, gqmnt1, gqmnq_om2

  REAL                    :: tailnl, gqmthrsat, gqmthrcou, gqamp1, gqamp2, gqamp3, gqamp4

#endif

#ifdef W3_NL2

  INTEGER                 :: iqtype, ndepth

  REAL                    :: tailnl

#endif

#ifdef W3_NL3

  INTEGER                 :: nqdef

  REAL                    :: msc, nsc, kdfd, kdfs

#endif

#ifdef W3_NL4

  INTEGER                 :: indtsa, altlp

#endif

#ifdef W3_NL5

  REAL                    :: nl5dpt, nl5oml

  INTEGER                 :: nl5dis, nl5kev, nl5ipl, nl5pmx

#endif

#ifdef W3_DB1

  REAL                    :: bjalfa, bjgam

  LOGICAL                 :: bjflag

#endif

#ifdef W3_PR2

  REAL                    :: dtime

#endif

  !

#ifdef W3_SMC

  REAL                    :: dtims, cflsm, rfmaxd, symr, yj0r

  LOGICAL                 :: uno3, averg, seawnd, arctic

  CHARACTER               :: pnsmc*30

#endif

  !

#ifdef W3_PR3

  REAL                    :: wdthcg, wdthth

#endif

  LOGICAL :: jgs_terminate_maxiter

  LOGICAL :: jgs_terminate_difference

  LOGICAL :: jgs_terminate_norm

  LOGICAL :: jgs_limiter

  INTEGER :: jgs_limiter_func

  LOGICAL :: jgs_block_gauss_seidel

  LOGICAL :: jgs_use_jacobi

  LOGICAL :: jgs_source_nonlinear

  LOGICAL :: ugobcauto

  LOGICAL :: ugbccfl

  LOGICAL :: expfsn

  LOGICAL :: expfspsi

  LOGICAL :: expfsfct

  LOGICAL :: impfsn

  LOGICAL :: exptotal

  LOGICAL :: imptotal

  LOGICAL :: imprefraction

  LOGICAL :: impfreqshift

  LOGICAL :: impsource

  LOGICAL :: setup_apply_wlv

  INTEGER :: jgs_maxiter

  INTEGER :: nbsel

  INTEGER :: unstschemes(6)

  INTEGER :: unstscheme

  INTEGER :: jgs_nlevel

  real*8  :: jgs_pmin

  real*8  :: jgs_diff_thr

  real*8  :: jgs_norm_thr

  real*8  :: solverthr_setup

  real*8  :: crit_dep_setup

  !

  CHARACTER               :: ugobcfile*60

  REAL                    :: ugobcdepth

  LOGICAL                 :: ugobcok


#ifdef W3_RTD

  REAL                    :: plat, plon

  LOGICAL                 :: unrot

  ! Poles of the output nested grids. May be a mix of rotated and standard

  REAL, DIMENSION(9)      :: bplat, bplon

#endif

  !

#ifdef W3_FLD1

  namelist /fld1/ tailtype, taillev, tailt1, tailt2

#endif

#ifdef W3_FLD2

  namelist /fld2/ tailtype, taillev, tailt1, tailt2

#endif

#ifdef W3_FLX3

  namelist /flx3/ cdmax, ctype

#endif

#ifdef W3_FLX4

  namelist /flx4/ cdfac

#endif

#ifdef W3_IC2

  namelist /sic2/  ic2disper, ic2turb, ic2rough, ic2reynolds,      &

       ic2smooth, ic2visc, ic2turbs, ic2dmax

#endif

#ifdef W3_IC3

  namelist /sic3/  ic3maxthk, ic2turb, ic2rough, ic2reynolds,      &

       ic2smooth, ic2visc, ic2turbs, ic3maxcnc,      &

       ic3cheng, usecgice, ic3hilim, ic3kilim,      &

       ic3visc, ic3elas, ic3dens, ic3hice

#endif

#ifdef W3_IC4

  namelist /sic4/  ic4method, ic4ki, ic4fc, ic4cn, ic4fmin,  &

                   ic4kibk

#endif

#ifdef W3_IC5

  namelist /sic5/  ic5minig, ic5minwt, ic5maxkratio,        &

       ic5maxki, ic5minhw, ic5maxiter, ic5rkick,&

       ic5kfilter, ic5vemod

#endif

#ifdef W3_IG1

  namelist /sig1/  igmethod, igaddoutp, igsource, igbcoverwrite,   &

       igmaxfreq, igsterms, igswellmax,                &

       igsourceatbp, igkdmin, igfixeddepth, igempirical

#endif

#ifdef W3_LN1

  namelist /sln1/ clin, rfpm, rfhf

#endif

#ifdef W3_ST1

  namelist /sin1/ cinp

#endif

#ifdef W3_ST2

  namelist /sin2/ zwnd, swellf, stabsh, stabof, cneg, cpos, fneg

#endif

#ifdef W3_ST3

  namelist /sin3/ zwnd, alpha0, z0max, betamax, sinthp, zalp, &

       swellf

#endif

#ifdef W3_ST4

  namelist /sin4/ zwnd, alpha0, z0max, betamax, sinthp, zalp, &

       tauwshelter, swellfpar, swellf,                 &

       swellf2, swellf3, swellf4, swellf5, swellf6,    &

       swellf7, z0rat, sinbr, sintable, sintail1, sintail2, tauwbug, viscstress, &

       capcha, chamin, cha0, ucap, sigmaucap

#endif

#ifdef W3_NL1

  namelist /snl1/ lambda, nlprop, kdconv, kdmin,                  &

       snlcs1, snlcs2, snlcs3,                         &

       iqtype, tailnl, gqmnf1, gqmnt1,                 &

       gqmnq_om2, gqmthrsat, gqmthrcou, gqamp1, gqamp2, gqamp3, gqamp4

#endif

#ifdef W3_NL2

  namelist /snl2/ iqtype, tailnl, ndepth

  namelist /anl2/ depths

#endif

#ifdef W3_NL3

  namelist /snl3/ nqdef, msc, nsc, kdfd, kdfs

  namelist /anl3/ qparms

#endif

#ifdef W3_NL4

  namelist /snl4/ indtsa, altlp

#endif

#ifdef W3_NL5

  namelist /snl5/ nl5dpt, nl5oml, nl5dis, nl5kev, nl5ipl, nl5pmx

#endif

#ifdef W3_NLS

  namelist /snls/ a34, fhfc, dnm, fc1, fc2, fc3

#endif

#ifdef W3_ST1

  namelist /sds1/ cdis, apm

#endif

#ifdef W3_ST2

  namelist /sds2/ sdsa0, sdsa1, sdsa2, sdsb0, sdsb1, phimin

#endif

#ifdef W3_ST3

  namelist /sds3/ sdsc1, wnmeanp, fxpm3, fxfm3, sdsdelta1,        &

       sdsdelta2

#endif

#ifdef W3_ST4

  namelist /sds4/ sdsbchoice, wnmeanp, wnmeanptail, fxpm3, fxfm3, &

       fxfmage, sdsc2, sdscum, sdsstrain, sdsstraina,  &

       sdsstrain2, sdsc4, sdsfacmtf, sdsnmtf,sdscump,  &

       sdsc5, sdsc6, sdsbr, sdsbt, sdsp, sdsiso,       &

       sdsbck, sdsabk, sdspbk, sdsbint, sdshck,        &

       sdsdth, sdscos, sdsbrf1, sdsbrfdf,  sdsnuw,     &

       sdsbm0, sdsbm1, sdsbm2, sdsbm3, sdsbm4, cumsigp,&

       whitecapwidth, whitecapdur, sdsmwd, sdsmwpow, sdkof

#endif


#ifdef W3_ST6

  namelist /sin6/ sina0, sinws, sinfc

  namelist /sds6/ sdset, sdsa1, sdsa2, sdsp1, sdsp2

  namelist /swl6/ swlb1, cstb1

#endif

#ifdef W3_BT1

  namelist /sbt1/ gamma

#endif

#ifdef W3_BT4

  namelist /sbt4/ sedmapd50, sed_d50_uniform, ripfac1,            &

       ripfac2, ripfac3, ripfac4, sigdepth,            &

       botroughmin, botroughfac

#endif

#ifdef W3_DB1

  namelist /sdb1/ bjalfa, bjgam, bjflag

#endif

#ifdef W3_UOST

  namelist /uost/ uostfilelocal, uostfileshadow,             &

       uostfactorlocal, uostfactorshadow

#endif

  !

#ifdef W3_PR1

  namelist /pro1/ cfltm

#endif

#ifdef W3_PR2

  namelist /pro2/ cfltm, dtime, latmin

#endif

#ifdef W3_SMC

  namelist /psmc/ cflsm, dtims, rfmaxd, arctic, averg, uno3, &

       lvsmc, ishft, jeqt,   nbismc, seawnd

#endif

  !

#ifdef W3_PR3

  namelist /pro3/ cfltm, wdthcg, wdthth

#endif

  namelist /unst/ ugobcauto, ugobcdepth, ugobcfile,          &

       ugbccfl, expfsn, expfspsi, expfsfct,       &

       impfsn, imptotal, exptotal,                &

       imprefraction, impfreqshift,               &

       impsource,                                 &

       jgs_terminate_maxiter,                     &

       jgs_terminate_difference,                  &

       jgs_terminate_norm,                        &

       jgs_limiter,                               &

       jgs_limiter_func,                          &

       jgs_use_jacobi,                            &

       jgs_block_gauss_seidel,                    &

       jgs_maxiter,                               &

       jgs_pmin,                                  &

       jgs_diff_thr,                              &

       jgs_norm_thr,                              &

       jgs_nlevel,                                &

       jgs_source_nonlinear,                      &

       setup_apply_wlv, solverthr_setup,          &

       crit_dep_setup

  namelist /misc/ cice0, cicen, lice, xseed, flagtr, xp, xr, &

       xfilt, pmove, ihm, hspm, wsm, wsc, flc, fmiche, &

       rwndc, facberg, nosw, gshift, wcor1, wcor2,     &

       stdx, stdy, stdt, icehmin, icehinit, icedisp,   &

       icesln, icewind, icesnl, icesds, icehfac,       &

       icehdisp, iceddisp, icefdisp, caltype,          &

       trckcmpr, ptm, ptfc, btbet

  namelist /outs/ p2sf, i1p2sf, i2p2sf,                      &

       us3d, i1us3d, i2us3d,                    &

       ussp, iussp, stk_wn,                     &

       e3d, i1e3d, i2e3d,                       &

       th1mf, i1th1m, i2th1m,                   &

       sth1mf, i1sth1m, i2sth1m,                &

       th2mf, i1th2m, i2th2m,                   &

       sth2mf, i1sth2m, i2sth2m

#ifdef W3_IS1

  namelist /sis1/ isc1, isc2

#endif

#ifdef W3_IS2

  namelist /sis2/ isc1, is2c2, is2c3, is2backscat, is2isoscat, is2break,  &

       is2disp, is2fragility, is2conc, is2dmin,    &

       is2damp, is2dupdate, is2creepb, is2creepc,  &

       is2creepd, is2creepn, is2breake, is2breakf, &

       is2wim1, is2flexstr, is2andisb, is2andise, is2andisd,   &

       is2andisn

#endif

#ifdef W3_REF1

  namelist /ref1/ refcoast, reffreq, refmap,  refmapd,       &

       refsubgrid, reficeberg,                     &

       refcosp_straight, refslope, refrmax,        &

       reffreqpow, refunstsource

#endif

  !/

#ifdef W3_RTD

  namelist /rotd/ plat, plon, unrot

  ! Poles of destination grids for boundary conditions output

  namelist /rotb/ bplat, bplon

#endif

  !/

  !/ ------------------------------------------------------------------- /

  !/

  DATA yesxno / 'YES/--' , '---/NO' /


CONTAINS


  SUBROUTINE w3grid()


#ifdef W3_O0

    flnmlo = .true.

#endif

#ifdef W3_STAB2

    flstb2 = .true.

#endif

    !

    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    ! 1.  Set up grid storage structure

    !

    CALL w3nmod ( 1, 6, 6 )

    CALL w3setg ( 1, 6, 6 )

    CALL w3nout (    6, 6 )

    CALL w3seto ( 1, 6, 6 )

    !

    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    ! 2.  IO set-up.

    !

    ndsi   = 10

    ndss   = 99

    ndsm   = 20

    !

    INQUIRE(file=trim(fnmpre)//"ww3_grid.nml", exist=flgnml)

    IF (flgnml) THEN

      ! Read namelist

      CALL w3nmlgrid (ndsi, trim(fnmpre)//'ww3_grid.nml', nml_spectrum, nml_run,  &

           nml_timesteps, nml_grid, nml_rect, nml_curv,   &

           nml_unst, nml_smc, nml_depth, nml_mask,        &

           nml_obst, nml_slope, nml_sed, nml_inbnd_count, &

           nml_inbnd_point, nml_excl_count,               &

           nml_excl_point, nml_excl_body,                 &

           nml_outbnd_count, nml_outbnd_line, ierr)

    ELSE

      OPEN (ndsi,file=trim(fnmpre)//'ww3_grid.inp',status='OLD',        &

           err=2000,iostat=ierr)

    END IF

    !

    ndstrc =  6

    ntrace =  10

    CALL itrace ( ndstrc, ntrace )

    !

#ifdef W3_S

    CALL strace (ient, 'W3GRID')

#endif

    WRITE (ndso,900)

    !

    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    ! 3.a Interpolation table for dispersion relation.

    !

    CALL distab

    !

    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    ! 3.b Table for friction factors

    !

    CALL tabu_fw

    !

    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    ! 4   Read and process input file up to spectrum

    !


    IF (flgnml) THEN

      ! grid name

      gname=trim(nml_grid%NAME)

      WRITE (ndso,902) gname


      ! spectrum parameters

      rxfr=nml_spectrum%XFR

      rfr1=nml_spectrum%FREQ1

      nki=nml_spectrum%NK

      nthi=nml_spectrum%NTH

      rth0=nml_spectrum%THOFF


    ELSE


      READ (ndsi,'(A)',END=2001,ERR=2002,IOSTAT=IERR) comstr

      IF (comstr.EQ.' ') comstr = '$'

      WRITE (ndso,901) comstr

      CALL nextln ( comstr , ndsi , ndse )

      !

      CALL nextln ( comstr , ndsi , ndse )

      READ (ndsi,*,END=2001,ERR=2002) gname

      WRITE (ndso,902) gname

      !

      CALL nextln ( comstr , ndsi , ndse )

      READ (ndsi,*,END=2001,ERR=2002) RXFR, RFR1, NKI, NTHI, rth0

    END IF


    nk     = nki

    nk2    = nki + 2

    nth    = nthi

    nspec  = nk * nth

    xfr    = max( rxfr , 1.00001 )

    fr1    = max( rfr1 , 1.e-6 )

    dth    = tpi / real(nth)

    rth0   = max( -0.5 , min( 0.5 , rth0 ) )

    WRITE (ndso,903) nth, dth*rade

    WRITE (ndso,904) 360./real(nth)*rth0

    WRITE (ndso,905) nk, fr1, fr1*xfr**(nk-1), xfr

    !

    CALL w3dims ( 1, nk, nth, ndse, ndst )

    !

    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    ! 5.  Initialize spectral parameters.

    ! 5.a Directions :

    !

    DO ith=1, nth

      th(ith) = dth * ( rth0 + real(ith-1) )

      esin(ith) = sin( th(ith) )

      ecos(ith) = cos( th(ith) )

      IF ( abs(esin(ith)) .LT. 1.e-5 ) THEN

        esin(ith) = 0.

        IF ( ecos(ith) .GT. 0.5 ) THEN

          ecos(ith) =  1.

        ELSE

          ecos(ith) = -1.

        END IF

      END IF

      IF ( abs(ecos(ith)) .LT. 1.e-5 ) THEN

        ecos(ith) = 0.

        IF ( esin(ith) .GT. 0.5 ) THEN

          esin(ith) =  1.

        ELSE

          esin(ith) = -1.

        END IF

      END IF

      es2(ith) = esin(ith)**2

      ec2(ith) = ecos(ith)**2

      esc(ith) = esin(ith)*ecos(ith)

    END DO

    !

    DO ik=2, nk+1

      ith0   = (ik-1)*nth

      DO ith=1, nth

        esin(ith0+ith) = esin(ith)

        ecos(ith0+ith) = ecos(ith)

        es2(ith0+ith) = es2(ith)

        ec2(ith0+ith) = ec2(ith)

        esc(ith0+ith) = esc(ith)

      END DO

    END DO

    !

    !   b Frequencies :

    !

    sigma   = fr1 * tpi / xfr**2

    sxfr    = 0.5 * (xfr-1./xfr)

    !

    DO ik=0, nk+1

      sigma    = sigma * xfr

      sig(ik) = sigma

      dsip(ik) = sigma * sxfr

    END DO

    !

    dsii( 1) = 0.5 * sig( 1) * (xfr-1.)

    DO ik=2, nk-1

      dsii(ik) = dsip(ik)

    END DO

    dsii(nk) = 0.5 * sig(nk) * (xfr-1.) / xfr

    !

    DO ik=1, nk

      dden(ik) = dth * dsii(ik) * sig(ik)

    END DO

    !

    DO isp=1, nspec

      ik         = 1 + (isp-1)/nth

      sig2(isp) = sig(ik)

      dden2(isp) = dden(ik)

    END DO

    !

    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    ! 6   Read and process input file up to numerical parameters

    ! 6.a Set model flags and time steps

    !

    WRITE (ndso,910)

    IF (flgnml) THEN

      fldry=nml_run%FLDRY

      flcx=nml_run%FLCX

      flcy=nml_run%FLCY

      flcth=nml_run%FLCTH

      flck=nml_run%FLCK

      flsou=nml_run%FLSOU

    ELSE

      CALL nextln ( comstr , ndsi , ndse )

      READ (ndsi,*,END=2001,ERR=2002)                                 &

           fldry, flcx, flcy, flcth, flck, flsou

    END IF

    !

    iyn = 2

    IF ( fldry ) iyn(1) = 1

    IF ( flcx  ) iyn(2) = 1

    IF ( flcy  ) iyn(3) = 1

    IF ( flcth ) iyn(4) = 1

    IF ( flck  ) iyn(5) = 1

    IF ( flsou ) iyn(6) = 1

    !

    WRITE (ndso,911) (yesxno(iyn(ifl)),ifl=1,nfl)

    !

    IF ( .NOT. (fldry.OR.flcx.OR.flcy.OR.flck.OR.flcth.OR.flsou) ) THEN

      WRITE (ndse,1010)

      CALL extcde ( 2 )

    END IF

    !

    IF (flgnml) THEN

      dtmax=nml_timesteps%DTMAX

      dtcfl=nml_timesteps%DTXY

      dtcfli=nml_timesteps%DTKTH

      dtmin=nml_timesteps%DTMIN

    ELSE

      CALL nextln ( comstr , ndsi , ndse )

      READ (ndsi,*,END=2001,ERR=2002) DTMAX, DTCFL, DTCFLI, dtmin

    END IF

#ifdef W3_SEC1

    IF (dtmax.LT.1.) THEN

      nitersec1=ceiling(1./dtmax)

      WRITE (ndso,913) nitersec1

    ELSE

      nitersec1=1

    END IF

#endif


    dtmax  = max( 1. , dtmax )

    !

    ! Commented to allow very high resolution zooms

    !

    !      DTCFL  = MAX ( 1. , DTCFL  )

    !      DTCFLI = MIN ( DTMAX , MAX ( 1. , DTCFLI ) )

    dtmin  = min( dtmax , max( 0. , dtmin  ) )

    WRITE (ndso,912) dtmax, dtcfl, dtcfli, dtmin

    !

    ! 6.b Set / select source term package

    !

    nrlin  = 0

    nrsrce = 0

    nrnl   = 0

    nrbt   = 0

    nric   = 0

    nris   = 0

    nrdb   = 0

    nrtr   = 0

    nrbs   = 0

    !

    fllin  = .true.

    flinds = .true.

    flnl   = .true.

    flbt   = .true.

    flic   = .false.

    flis   = .false.

    fldb   = .true.

    fltr   = .true.

    flbs   = .true.

    flref  = .false.

    !

#ifdef W3_LN0

    nrlin  = nrlin + 1

    fllin  = .false.

#endif

#ifdef W3_SEED

    nrlin  = nrlin + 1

#endif

#ifdef W3_LN1

    nrlin  = nrlin + 1

#endif

    !

#ifdef W3_ST0

    nrsrce = nrsrce + 1

    flinds = .false.

#endif

#ifdef W3_ST1

    nrsrce = nrsrce + 1

#endif

#ifdef W3_ST2

    nrsrce = nrsrce + 1

    fltc96 = .true.

#endif

#ifdef W3_ST3

    nrsrce = nrsrce + 1

#endif

#ifdef W3_ST4

    nrsrce = nrsrce + 1

    flst4  = .true.

#endif

#ifdef W3_ST6

    nrsrce = nrsrce + 1

    flst6  = .true.

#endif

    !

#ifdef W3_NL0

    nrnl   = nrnl + 1

    flnl   = .false.

#endif

#ifdef W3_NL1

    nrnl   = nrnl + 1

#endif

#ifdef W3_NL2

    nrnl   = nrnl + 1

#endif

#ifdef W3_NL3

    nrnl   = nrnl + 1

#endif

#ifdef W3_NL4

    nrnl   = nrnl + 1

#endif

#ifdef W3_NL5

    nrnl   = nrnl + 1

#endif

    !

#ifdef W3_BT0

    nrbt   = nrbt + 1

    flbt   = .false.

#endif

#ifdef W3_BT1

    nrbt   = nrbt + 1

#endif

#ifdef W3_BT4

    nrbt   = nrbt + 1

#endif

#ifdef W3_BT8

    nrbt   = nrbt + 1

#endif

#ifdef W3_BT9

    nrbt   = nrbt + 1

#endif

    !

#ifdef W3_IC1

    nric   = nric + 1

    flic   = .true.

#endif

#ifdef W3_IC2

    nric   = nric + 1

    flic   = .true.

#endif

#ifdef W3_IC3

    nric   = nric + 1

    flic   = .true.

#endif

#ifdef W3_IC4

    nric   = nric + 1

    flic   = .true.

#endif

#ifdef W3_IC5

    nric   = nric + 1

    flic   = .true.

#endif

    !

#ifdef W3_IS1

    nris   = nris + 1

    flis   = .true.

#endif

#ifdef W3_IS2

    nris   = nris + 1

    flis   = .true.

#endif

    !

#ifdef W3_DB0

    nrdb   = nrdb + 1

    fldb   = .false.

#endif

#ifdef W3_DB1

    nrdb   = nrdb + 1

#endif

    !

#ifdef W3_TR0

    nrtr   = nrtr + 1

    fltr   = .false.

#endif

#ifdef W3_TR1

    nrtr   = nrtr + 1

#endif

    !

#ifdef W3_BS0

    nrbs   = nrbs + 1

    flbs   = .false.

#endif

#ifdef W3_BS1

    nrbs   = nrbs + 1

#endif

    !

#ifdef W3_REF1

    flref   = .true.

#endif

    !

    IF ( .NOT.fllin .AND.  .NOT.flinds .AND.  .NOT.flnl .AND.        &

         .NOT.flbt  .AND.  .NOT.flic   .AND.  .NOT.flis .AND.        &

         .NOT.fldb  .AND.  .NOT.fltr   .AND.  .NOT.flbs .AND.        &

         .NOT.flref .AND.  flsou ) THEN

      WRITE (ndse,1020)

      CALL extcde ( 10 )

    END IF

    !

    IF ( ( fllin .OR. flinds .OR. flnl .OR. flbt .OR. fldb .OR.     &

         fltr .OR. flbs .OR. flref .OR. flic )          &

         .AND. .NOT.flsou ) THEN

      WRITE (ndse,1021)

    END IF

    !

    IF ( nrlin .NE. 1 ) THEN

      WRITE (ndse,1022) nrlin

      CALL extcde ( 11 )

    END IF

    !

    IF ( nrsrce .NE. 1 ) THEN

      WRITE (ndse,1023) nrsrce

      CALL extcde ( 12 )

    END IF

    !

    IF ( nrnl .NE. 1 ) THEN

      WRITE (ndse,1024) nrnl

      CALL extcde ( 13 )

    END IF

    !

    IF ( nrbt .NE. 1 ) THEN

      WRITE (ndse,1025) nrbt

      CALL extcde ( 14 )

    END IF

    !

    IF ( nrdb .NE. 1 ) THEN

      WRITE (ndse,1026) nrdb

      CALL extcde ( 15 )

    END IF

    !

    IF ( nrtr .NE. 1 ) THEN

      WRITE (ndse,1027) nrtr

      CALL extcde ( 16 )

    END IF

    !

    IF ( nrbs .NE. 1 ) THEN

      WRITE (ndse,1028) nrbs

      CALL extcde ( 17 )

    END IF

    !

    IF ( nric .GT. 1 ) THEN

      WRITE (ndse,1034) nric

      CALL extcde ( 19 )

    END IF

    !

    IF ( nris .GT. 1 ) THEN

      WRITE (ndse,1036) nris

      CALL extcde ( 26 )

    END IF


    !

    ! 6.c Read namelist file or Pre-process namelists into scratch file

    !

    WRITE (ndso,915)

    IF (flgnml) THEN

      OPEN (ndss,file=trim(fnmpre)//trim(nml_grid%NML),status='OLD',form='FORMATTED')

    ELSE

      OPEN (ndss,file=trim(fnmpre)//'ww3_grid.scratch',form='FORMATTED')

      DO

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,'(A)',END=2001,ERR=2002) line

        IF ( line(1:16) .EQ. 'END OF NAMELISTS' ) THEN

          EXIT

        ELSE

          WRITE (ndss,'(A)') line

        ENDIF

      END DO

    END IF

    WRITE (ndso,916)

    !

    ! 6.d Define Sin.

    ! 6.d.1 Stresses

    !

#ifdef W3_FLX1

    WRITE (ndso,810)

#endif

#ifdef W3_FLX2

    WRITE (ndso,810)

    cinxsi =    0.20

    nittin =    3

#endif

#ifdef W3_FLX3

    cinxsi =    0.20

    nittin =    3

    cdmax  =    2.5e-3

    ctype  =    0

    CALL readnl ( ndss, 'FLX3', status )

    WRITE (ndso,810) status

    cdmax  = max( 0. , cdmax )

    IF ( ctype .EQ. 1 ) THEN

      typeid = 'hyperbolic tangent'

    ELSE

      ctype = 0

      typeid = 'discontinuous     '

    END IF

    WRITE (ndso,811) cdmax*1.e3, typeid

    cd_max =    cdmax

    cap_id =    ctype

#endif

    !

#ifdef W3_FLX4

    cdfac  = 1.0

    CALL readnl ( ndss, 'FLX4', status )

    WRITE (ndso,810) status

    WRITE (ndso,811) cdfac

    flx4a0 = cdfac

#endif

#ifdef W3_FLX5

    WRITE (ndso,810)

#endif

    !

    ! 6.d.2 Linear input

    !

#ifdef W3_LN0

    WRITE (ndso,820)

#endif

#ifdef W3_SEED

    WRITE (ndso,820)

#endif

    !

#ifdef W3_LN1

    clin   = 80.

    rfpm   =  1.

    rfhf   =  0.5

    CALL readnl ( ndss, 'SLN1', status )

    WRITE (ndso,820) status

    clin   = max(0.,clin)

    rfpm   = max(0.,rfpm)

    rfhf   = max(0.,min(1.,rfhf))

    WRITE (ndso,821) clin, rfpm, rfhf

    slnc1  = clin * (dair/dwat)**2 / grav**2

    fspm   = rfpm

    fshf   = rfhf

#endif

    !

    ! 6.d.3 Exponential input

    !

#ifdef W3_ST0

    WRITE (ndso,920)

#endif

    !

#ifdef W3_ST1

    cinp   =    0.25

#endif

#ifdef W3_ST2

    zwnd   =   10.

    swellf =    0.100

    stabsh =    1.38

    stabof =   -0.01

    cneg   =   -0.1

    cpos   =    0.1

    fneg   =  150.

#endif

    !

#ifdef W3_ST3

    zwnd   =   10.

    alpha0 = 0.0095

    z0max = 0.0

    betamax  = 1.2       !  default WAM4 / WAM4 + is 1.2 with rhow=1000

    sinthp   = 2.

    swellf = 0.

    zalp   = 0.0110

#endif

    !

#ifdef W3_ST4

    zwnd   =   10.

    alpha0 = 0.0095

    z0max = 0.0

    z0rat = 0.04

    betamax   = 1.43

    sinthp    = 2.

    swellf    = 0.66

    swellfpar = 1

    swellf2 = -0.018

    swellf3 = 0.022

    swellf4 = 1.5e5

    swellf5 = 1.2

    swellf6 = 0.

    swellf7 = 360000.

    tauwshelter = 0.3

    zalp   = 0.006

    sinbr   = 0.

    sintable = 1

    sintail1 = 0. !  TAUWSHELTER FOR TAIL (no table)

    sintail2 = 0. !  additional peak in capillary range

    tauwbug  = 1  !  TAUWBUG is 1 is the bug is kept:

    !  initializes TAUWX/Y to zero in W3SRCE

    viscstress =0

    capcha   = 0.     ! =1 indicates capping of drag is active

    chamin   = 0.0001 !

    cha0     = alpha0 ! initial value for charnock

    ucap     = 30.    ! U10 threshold from which drag capping is applied

    sigmaucap = 10.   ! Width for reduction of drag beyond UCAP

#endif

    !

#ifdef W3_ST6

    sina0  = 0.09

    sinws  = 32.0

    sinfc  = 6.0

#endif

    !

#ifdef W3_ST1

    CALL readnl ( ndss, 'SIN1', status )

    WRITE (ndso,920) status

    WRITE (ndso,921) cinp

    sinc1  = 28. * cinp * dair / dwat

#endif

    !

#ifdef W3_ST2

    CALL readnl ( ndss, 'SIN2', status )

    WRITE (ndso,920) status

    IF ( swellf.LT.0. .OR. swellf.GT.1. ) swellf = 1.

    WRITE (ndso,921) zwnd, swellf

    IF ( stabsh .LT. 0.1 ) stabsh = 1.

    IF ( cneg*cpos .EQ. 0. ) THEN

      cneg   = 0.

      cpos   = 0.

      fneg   = 0.

      fpos   = 0.

    ELSE

      cpos   = - abs(cpos) * abs(cneg)/cneg

      fneg   = - max(1.,abs(fneg))

      fpos   = fneg * cneg/cpos

    END IF

#endif

#ifdef W3_STAB2

    WRITE (ndso,1921) stabsh, stabof, cneg, cpos, fneg, fpos

#endif

#ifdef W3_ST2

    zwind  = zwnd

    fswell = swellf

    shstab = stabsh

    ofstab = stabof

    ccng   = cneg

    ccps   = cpos

    ffng   = fneg

    ffps   = fpos

#endif

    !

#ifdef W3_ST3

    CALL readnl ( ndss, 'SIN3', status )

    WRITE (ndso,920) status

    WRITE (ndso,921) alpha0, betamax, sinthp, z0max, zalp, zwnd, &

         swellf

    zzwnd  = zwnd

    aalpha = alpha0

    bbeta  = betamax

    ssinthp  = sinthp

    zz0max  = z0max

    zzalp  = zalp

    sswellf(1) = swellf

#endif

    !

#ifdef W3_ST4

    CALL readnl ( ndss, 'SIN4', status )

    WRITE (ndso,920) status

    WRITE (ndso,921) alpha0, betamax, sinthp, z0max, zalp, zwnd, tauwshelter, &

         swellfpar, swellf, swellf2, swellf3, swellf4, swellf5, &

         swellf6, swellf7, z0rat

    zzwnd  = zwnd

    aalpha = alpha0

    bbeta  = betamax

    ssinbr  = sinbr

    ssinthp  = sinthp

    zz0max  = z0max

    zz0rat  = z0rat

    zzalp  = zalp

    ttauwshelter = tauwshelter

    sswellf(1) = swellf

    sswellf(2) = swellf2

    sswellf(3) = swellf3

    sswellf(4) = swellf4

    sswellf(5) = swellf5

    sswellf(6) = swellf6

    sswellf(7) = swellf7

    sswellfpar = swellfpar

    sintailpar(1) = float(sintable)

    sintailpar(2) = sintail1

    sintailpar(3) = sintail2

    sintailpar(4) = float(tauwbug)

    sintailpar(5) = viscstress

    capchnk(1) = capcha

    capchnk(2) = chamin

    capchnk(3) = cha0

    capchnk(4) = ucap

    capchnk(5) = sigmaucap

#endif

    !

#ifdef W3_ST6

    CALL readnl ( ndss, 'SIN6', status )

    WRITE (ndso,920) status

    sin6a0 = sina0

    sin6ws = sinws

    sin6fc = sinfc

    j = 1

    IF ( sin6a0.LE.0. ) j = 2

    WRITE (ndso,921) yesxno(j), sin6a0, sin6ws, sin6fc

#endif

    !

    ! 6.e Define Snl.

    !

#ifdef W3_NL0

    WRITE (ndso,922)

#endif

    !

#ifdef W3_NL1

    lambda =  0.25

    IF ( fltc96 ) THEN

      nlprop =  1.00e7

    ELSE IF ( flst4 ) THEN

      nlprop =  2.50e7

    ELSE IF ( flst6 ) THEN

      nlprop =  3.00e7

    ELSE

      nlprop =  2.78e7

    END IF

    kdconv =  0.75

    kdmin  =  0.50

    snlcs1 =  5.5

    snlcs2 =  0.833

    snlcs3 = -1.25

    ! Additional parameters for GQM

    iqtype =  1

    tailnl = -fachf

    gqmnf1 = 14

    gqmnt1 = 8

    gqmnq_om2=8

    gqmthrsat=0.

    gqmthrcou=0.015

    gqamp1=1.

    gqamp2=0.002

    gqamp3=1.

    gqamp4=1.

    CALL readnl ( ndss, 'SNL1', status )

    WRITE (ndso,922) status

    WRITE (ndso,923) lambda, nlprop, kdconv, kdmin,            &

         snlcs1, snlcs2, snlcs3

    snlc1  = nlprop / grav**4

    lam    = lambda

    kdcon  = kdconv

    kdmn   = kdmin

    snls1  = snlcs1

    snls2  = snlcs2

    snls3  = snlcs3

    ! Additional parameters for GQM

    iqtpe  = iqtype

    gqnf1  = gqmnf1

    gqnt1  = gqmnt1

    gqnq_om2  = gqmnq_om2

    gqthrsat  = gqmthrsat

    gqthrcou  = gqmthrcou

    gqamp(1)  = gqamp1

    gqamp(2)  = gqamp2

    gqamp(3)  = gqamp3

    gqamp(4)  = gqamp4

    nltail = tailnl

#endif

    !

#ifdef W3_ST0

    fachf  = 5.

#endif

#ifdef W3_ST1

    fachf  = 4.5

#endif

#ifdef W3_ST2

    fachf  = 5.

#endif

#ifdef W3_ST3

    fachf  = 5.

#endif

#ifdef W3_ST4

    fachf  = 5.

#endif

#ifdef W3_ST6

    fachf  = 5.

#endif

#ifdef W3_NL2

    iqtype =  2

    tailnl = -fachf

    ndepth =  0

#endif

#ifdef W3_NL3

    nqdef  =  0

    msc    =  0.

    nsc    = -3.5

    kdfd   =  0.20

    kdfs   =  5.00

#endif

#ifdef W3_NL4

    indtsa =  1

    altlp  =  2

#endif

#ifdef W3_NL5

    nl5dpt = 3000.

    nl5oml = 0.10

    nl5dis = 0

    nl5kev = 0

    nl5ipl = 1

    nl5pmx = 100

#endif

#ifdef W3_NLS

    a34    =  0.05

    fhfc   =  1.e10

    dnm    =  0.25

    fc1    =  1.25

    fc2    =  1.50

    fc3    =  6.00

#endif

    !

#ifdef W3_NL2

    CALL readnl ( ndss, 'SNL2', status )

    WRITE (ndso,922) status

    tailnl = min( max( tailnl, -5. ) , -4. )

    IF ( iqtype .EQ. 3 ) THEN

      WRITE (ndso,923) 'Shallow water', tailnl

    ELSE IF ( iqtype .EQ. 2 ) THEN

      WRITE (ndso,923) 'Deep water with scaling', tailnl

    ELSE

      WRITE (ndso,923) 'Deep water', tailnl

      iqtype = 1

    END IF

    !

    IF ( iqtype .NE. 3 ) THEN

      ndepth = 1

      ALLOCATE ( mpars(1)%SNLPS%DPTHNL(ndepth) )

      dpthnl => mpars(1)%SNLPS%DPTHNL

      dpthnl = 1000.

    ELSE

      IF ( ndepth .EQ. 0 ) ndepth = 7

      ndepth = max( 1 , ndepth )

      ALLOCATE ( mpars(1)%SNLPS%DPTHNL(ndepth) )

      dpthnl => mpars(1)%SNLPS%DPTHNL

      dpthnl(1) = 640.

      dpthnl(ndepth) = 10.

      IF ( ndepth .GT. 1 ) THEN

        dptfac = (dpthnl(ndepth)/dpthnl(1))**(1./(real(ndepth-1)))

        DO idepth=2, ndepth-1

          dpthnl(idepth) = dptfac*dpthnl(idepth-1)

        END DO

      END IF

      CALL readnl ( ndss, 'ANL2', status )

      WRITE (ndso,1923) ndepth, dpthnl(1:min(5,ndepth))

      IF (ndepth .GT. 5 )WRITE (ndso,2923) dpthnl(6:ndepth)

    END IF

    WRITE (ndst,*)

    iqtpe  = iqtype

    ndpths = ndepth

    nltail = tailnl

#endif

    !

#ifdef W3_NL3

    CALL readnl ( ndss, 'SNL3', status )

    WRITE (ndso,922) status

    kdfd   = max( 0.001 , min( 10. , kdfd ) )

    kdfs   = max( kdfd , min( 10. , kdfs ) )

    WRITE (ndso,923) msc, nsc, kdfd, kdfs

    !

    nqdef  = max( 0 , nqdef )

    IF ( nqdef .EQ. 0 ) THEN

      nqdef  = 1

      qparms(1:5) = [ 0.25 , 0.00, -1., 1.e7, 0.00 ]

    ELSE

      DO j=1, nqdef

        qparms((j-1)*5+1:j*5) = [ 0.25, 0.00, -1., 1.e7, 1.e6 ]

      END DO

      CALL readnl ( ndss, 'ANL3', status )

    END IF

    DO j=1, nqdef

      qparms((j-1)*5+1) = max(0.,min(lammax,qparms((j-1)*5+1)))

      qparms((j-1)*5+2) = max(0.,min(qparms((j-1)*5+1),        &

           qparms((j-1)*5+2)))

      qparms((j-1)*5+3) = min(delthm,qparms((j-1)*5+3))

      qparms((j-1)*5+4) = max(0.,qparms((j-1)*5+4))

      qparms((j-1)*5+5) = max(0.,qparms((j-1)*5+5))

    END DO

    WRITE (ndso,1923) nqdef

    WRITE (ndso,2923) qparms(1:nqdef*5)

    WRITE (ndso,*)

    snlnq  = nqdef

    snlmsc = msc

    snlnsc = nsc

    snlsfd = sqrt( kdfd * tanh(kdfd) )

    snlsfs = sqrt( kdfs * tanh(kdfs) )

    ALLOCATE ( mpars(1)%SNLPS%SNLL(nqdef),                     &

         mpars(1)%SNLPS%SNLM(nqdef),                     &

         mpars(1)%SNLPS%SNLT(nqdef),                     &

         mpars(1)%SNLPS%SNLCD(nqdef),                    &

         mpars(1)%SNLPS%SNLCS(nqdef) )

    snll   => mpars(1)%SNLPS%SNLL

    snll   = qparms(1:nqdef*5:5)

    snlm   => mpars(1)%SNLPS%SNLM

    snlm   = qparms(2:nqdef*5:5)

    snlt   => mpars(1)%SNLPS%SNLT

    snlt   = qparms(3:nqdef*5:5)

    snlcd  => mpars(1)%SNLPS%SNLCD

    snlcd  = qparms(4:nqdef*5:5)

    snlcs  => mpars(1)%SNLPS%SNLCS

    snlcs  = qparms(5:nqdef*5:5)

#endif

    !

#ifdef W3_NL4

    CALL readnl ( ndss, 'SNL4', status )

    WRITE (ndso,922) status

    WRITE (ndso,923) indtsa, altlp

    itsa = indtsa

    ialt = altlp

#endif

    !

#ifdef W3_NL5

    CALL readnl ( ndss, 'SNL5', status )

    WRITE (ndso,922) status

    nl5dpt = max(0., min(nl5dpt, 3000.))

    nl5dis = max(0 , min(nl5dis, 1))

    nl5kev = max(0 , min(nl5kev, 1))

    nl5ipl = max(0 , min(nl5ipl, 1))

    IF (nl5dis .EQ. 1) nl5ipl = 0

    IF (nl5pmx .GT. 0) nl5pmx = max(10, nl5pmx)

    WRITE (ndso,923) nl5dpt, nl5oml, nl5dis, nl5kev, nl5ipl, nl5pmx

    qr5dpt = nl5dpt

    qr5oml = nl5oml

    qi5dis = nl5dis

    qi5kev = nl5kev

    qi5ipl = nl5ipl

    qi5pmx = nl5pmx

#endif

    !

#ifdef W3_NLS

    CALL readnl ( ndss, 'SNLS', status )

    WRITE (ndso,9922) status

    a34    = max( 0. , min( a34 , abmax ) )

    fhfc   = max( 0. , fhfc )

    dnm    = max( 0., dnm )

    WRITE (ndso,9923) a34, (xfr-1.)*a34, fhfc, dnm, fc1, fc2, fc3

    cnlsa  = a34

    cnlsc  = fhfc

    cnlsfm = dnm

    cnlsc1 = fc1

    cnlsc2 = fc2

    cnlsc3 = fc3

#endif

    !

    ! 6.f Define Sds.

    !

#ifdef W3_ST0

    WRITE (ndso,924)

#endif

    !

#ifdef W3_ST1

    cdis   = -2.36e-5

    apm    =  3.02e-3

#endif

#ifdef W3_ST2

    sdsa0  =  4.8

    sdsa1  =  1.7e-4

    sdsa2  =  2.0

    sdsb0  =  0.3e-3

    sdsb1  =  0.47

    phimin =  0.003

    sdsaln =  0.002

    fpimin =  0.009

#endif

#ifdef W3_ST3

    sdsc1  = -2.1 !! This is Bidlot et al. 2005,  Otherwise WAM4 uses -4.5

    wnmeanp = 0.5 !! This is Bidlot et al. 2005,  Otherwise WAM4 uses -0.5

    fxfm3 = 2.5

    fxpm3 = 4.

    wnmeanptail = 0.5

    sdsdelta1 = 0.4 !! This is Bidlot et al. 2005,  Otherwise WAM4 uses 0.5

    sdsdelta2 = 0.6 !! This is Bidlot et al. 2005,  Otherwise WAM4 uses 0.5

#endif

    !

#ifdef W3_ST4

    wnmeanp = 0.5    ! taken from Bidlot et al. 2005

    fxfm3 = 2.5

    fxfmage = 0.

    fxpm3 = 4.

    wnmeanptail = -0.5

    sdsbchoice =1 ! 1: Ardhuin et al., 2: Filipot & Ardhuin, 3: Romero

    sdsc2     = -2.2e-5     ! -3.8 for Romero

    sdscum    = -0.40344

    sdsc4     = 1.

    sdsc5     = 0.

    sdsnuw    = 0.

    sdsc6     = 0.3

    sdsbr     = 0.90e-3     ! 0.005 for Romero

    sdsbrfdf  = 0

    sdsbrf1   = 0.5

    sdsp      = 2.   ! this is now fixed in w3sds4, should be cleaned up

    sdsdth    = 80.

    sdscos    = 2.

    sdsiso    = 2

    sdsbm0    = 1.          ! All these parameters are related to finite depth

    sdsbm1    = 0.          ! scaling of breaking

    sdsbm2    = 0.

    sdsbm3    = 0.

    sdsbm4    = 0.

    sdsbck    = 0.

    sdsabk    = 1.5

    sdspbk    = 4.

    sdsbint   = 0.3

    sdshck    = 1.5

    whitecapwidth = 0.3

    sdsfacmtf =  400    ! MTF factor for Lambda , Romero (2019)

    cumsigp   = 0.

    sdsstrain = 0.

    sdsstraina = 15.

    sdsstrain2 = 0.

    whitecapdur   = 0.56 ! breaking duration factor

    ! b (strength of breaking)

    sdsbt     = 1.100e-3 ! B_T (sturation threshold for dissipation rate b)

    ! Lambda parameters

    sdsl     = 3.5000e-05  ! L scaling

    ! MTF

    spmss     = 0.5    ! cmss^SPMSS

    sdsnmtf   = 1.5    ! MTF power

    sdscump   = 2.     ! 2 for cumulative mss, 1 for cumulative orb. vel.

    ! MW

    sdsmwd    = .9  ! new AFo

    sdsmwpow  = 1.  ! (k )^pow

    sdkof     = 3.  !  ko factor such that ko= g (SDKOF/(28 us))^2

#endif

    !

#ifdef W3_ST6

    sdset  = .true.

    sdsa1  = 4.75e-06

    sdsp1  = 4

    sdsa2  = 7.00e-05

    sdsp2  = 4

    cstb1  = .false.

    swlb1  = 0.41e-02

#endif

    !

#ifdef W3_ST1

    CALL readnl ( ndss, 'SDS1', status )

    WRITE (ndso,924) status

    WRITE (ndso,925) cdis, apm

    sdsc1  = tpi * cdis / apm**2

#endif

    !

#ifdef W3_ST2

    CALL readnl ( ndss, 'SDS2', status )

    WRITE (ndso,924) status

    IF ( phimin .LE. 0. ) THEN

      sdsb2  = 0.

      sdsb3  = 0.

      phimin = sdsb0 + sdsb1*fpimin

    ELSE

      fpia   = ( phimin - sdsb0 ) / sdsb1

      IF ( fpia .LT. fpimin ) THEN

        sdsb3  = 4.

        sdsb2  = fpimin**sdsb3 * (phimin-sdsb0-sdsb1*fpimin)

      ELSE

        fpib   = max( fpia-0.0025 , fpimin )

        dphid  = max( phimin - sdsb0 - sdsb1*fpib , 1.e-15 )

        sdsb3  = min( 10. , sdsb1*fpib / dphid )

        sdsb2  = fpib**sdsb3 * dphid

        fpimin = fpib

      END IF

    END IF

    WRITE (ndso,925) sdsa0, sdsa1, sdsa2,                      &

         sdsb0, sdsb1, sdsb2, sdsb3, fpimin, phimin

    cdsa0  = sdsa0

    cdsa1  = sdsa1

    cdsa2  = sdsa2

    cdsb0  = sdsb0

    cdsb1  = sdsb1

    cdsb2  = sdsb2

    cdsb3  = sdsb3

#endif

    !

#ifdef W3_ST3

    CALL readnl ( ndss, 'SDS3', status )

    WRITE (ndso,924) status

    WRITE (ndso,925) sdsc1, wnmeanp, sdsdelta1,  &

         sdsdelta2

    ssdsc1   = sdsc1

    wwnmeanp   = wnmeanp

    ffxfm = fxfm3 * tpi

    ffxpm = fxpm3 * grav / 28.

    wwnmeanptail   = wnmeanptail

    ddelta1   = sdsdelta1

    ddelta2   = sdsdelta2

#endif

    !

#ifdef W3_ST4

    CALL readnl ( ndss, 'SDS4', status )

    WRITE (ndso,924) status

    WRITE (ndso,925) sdsc2, sdsbck, sdscum, wnmeanp

    ssdsc(1)   = real(sdsbchoice)

    ssdsc(2)   = sdsc2

    ssdsc(3)   = sdscum

    ssdsc(4)   = sdsc4

    ssdsc(5)   = sdsc5

    ssdsc(6)   = sdsc6

    ssdsc(7)   = whitecapwidth

    ssdsc(8)   = sdsstrain   ! Straining constant ...

    ssdsc(9)   = sdsl

    ssdsc(10)  = sdsstraina*nth/360. ! angle for enhanced straining

    ssdsc(11)  = sdsstrain2  ! straining constant for directional part

    ssdsc(12)  = cumsigp

    ssdsc(13)  = sdsmwd

    ssdsc(14)  = spmss

    ssdsc(15)  = sdsmwpow

    ssdsc(16)  = sdkof

    ssdsc(17)  = whitecapdur

    ssdsc(18)  = sdsfacmtf

    ssdsc(19)  = sdsnmtf

    ssdsc(20)  = sdscump

    ssdsc(21)  = sdsnuw

    !

    ssdsbr   = sdsbr

    ssdsbrf1 = sdsbrf1

    ssdsbrfdf= sdsbrfdf

    ssdsbm(0)   = sdsbm0

    ssdsbm(1)   = sdsbm1

    ssdsbm(2)   = sdsbm2

    ssdsbm(3)   = sdsbm3

    ssdsbm(4)   = sdsbm4

    ssdsbt   = sdsbt

    ssdsiso  = sdsiso

    ssdscos  = sdscos

    ssdsp    = sdsp

    ssdsdth  = sdsdth

    wwnmeanp   = wnmeanp

    ffxfm = fxfm3 * tpi

    ffxfa = fxfmage * tpi

    ffxpm = fxpm3 * grav / 28.

    wwnmeanptail   = wnmeanptail

    ssdsbck   = sdsbck

    ssdsabk   = sdsabk

    ssdspbk   = sdspbk

    ssdsbint  = sdsbint

    ssdshck   = sdshck

#endif

    !

#ifdef W3_ST6

    CALL readnl ( ndss, 'SDS6', status )

    WRITE (ndso,924) status

    sds6et = sdset

    sds6a1 = sdsa1

    sds6p1 = sdsp1

    sds6a2 = sdsa2

    sds6p2 = sdsp2

    j = 2

    IF (sdset) j = 1

    WRITE (ndso,925) yesxno(j), yesxno(3-j), sds6a1, sds6p1, sds6a2, sds6p2


    CALL readnl ( ndss, 'SWL6', status )

    WRITE (ndso,937) status

    j = 1

    swl6s6 = swlb1.GT.0.0

    IF (.NOT.swl6s6) j  = 2

    swl6b1 = swlb1

    swl6cstb1 = cstb1

    IF (cstb1) THEN

      WRITE (ndso,940) yesxno(j), '(constant)           ' ,swl6b1

    ELSE

      WRITE (ndso,940) yesxno(j), '(steepness dependent)' ,swl6b1

    END IF

#endif

    !

    ! 6.g Define Sbt.

    !

#ifdef W3_BT0

    WRITE (ndso,926)

#endif

#ifdef W3_BT4

    WRITE (ndso,926)

#endif

    !

#ifdef W3_BT1

    gamma  = -0.067

    CALL readnl ( ndss, 'SBT1', status )

    WRITE (ndso,926) status

    WRITE (ndso,927) gamma

    sbtc1  = 2. * gamma / grav

#endif

    !

#ifdef W3_BT4

    sedmapd50=.false.

    sed_d50_uniform=2.e-4  ! default grain size: medium sand 200 microns

    ripfac1=0.4    ! A1 in Ardhuin et al. 2003

    ripfac2=-2.5   ! A2 in Ardhuin et al. 2003

    ripfac3=1.2    ! A3 in Ardhuin et al. 2003

    ripfac4=0.05   ! A4 in Ardhuin et al. 2003

    sigdepth=0.05

    botroughmin=0.01

    botroughfac=1.00

    CALL readnl ( ndss, 'SBT4', status )

    WRITE (ndso,926) status

    WRITE (ndso,927) sedmapd50, sed_d50_uniform, &

         ripfac1,ripfac2,ripfac3,ripfac4,sigdepth,  &

         botroughmin, botroughfac

    sbtcx(1)=ripfac1

    sbtcx(2)=ripfac2

    sbtcx(3)=ripfac3

    sbtcx(4)=ripfac4

    sbtcx(5)=sigdepth

    sbtcx(6)=botroughmin

    sbtcx(7)=botroughfac

#endif

    !

    !

    ! 6.h Define Sdb.

    !

#ifdef W3_DB0

    WRITE (ndso,928)

#endif

    !

#ifdef W3_DB1

    bjalfa = 1.

    bjgam  = 0.73

    bjflag = .true.

    CALL readnl ( ndss, 'SDB1', status )

    WRITE (ndso,928) status

    bjalfa = max( 0. , bjalfa )

    bjgam  = max( 0. , bjgam )

    WRITE (ndso,929) bjalfa, bjgam

    IF ( bjflag ) THEN

      WRITE (ndso,*) '      Using Hmax/d ratio only.'

    ELSE

      WRITE (ndso,*)                                       &

           '      Using Hmax/d in Miche style formulation.'

    END IF

    WRITE (ndso,*)

    sdbc1  = bjalfa

    sdbc2  = bjgam

    fdonly = bjflag

#endif

    !

    !

#ifdef W3_UOST

    uostfilelocal = 'obstructions_local.'//adjustl(trim(gname))//'.in'

    uostfileshadow = 'obstructions_shadow.'//adjustl(trim(gname))//'.in'

    uostfactorlocal = 1

    uostfactorshadow = 1

    CALL readnl ( ndss, 'UOST', status )

    WRITE (ndso,4500) status

    WRITE (ndso,4501) adjustl(trim(uostfilelocal)), adjustl(trim(uostfileshadow)), &

         uostfactorlocal, uostfactorshadow

#endif

    !

    ! 6.i Define Str.

    !

#ifdef W3_TR0

    WRITE (ndso,930)

#endif

    !

    ! 6.j Define Sbs.

    !

#ifdef W3_BS0

    WRITE (ndso,932)

#endif

#ifdef W3_BS1

    WRITE (ndso,932)

#endif

    !

    ! 6.k Define Sxx and Sic.

    !

#ifdef W3_IC1

    WRITE (ndso,935)

    WRITE(ndso,'(A/A)')'    Sice will be calculated using ' &

         //'user-specified ki values.','        Required ' &

         //'field input: ice parameter 1.'

#endif

    !

#ifdef W3_IC2

    WRITE (ndso,935)

    WRITE(ndso,'(A/A)')'    Sice will be calculated using ' &

         //'under-ice boundary layer method.','        Required '  &

         //'field input: ice parameters 1 and 2.'

#endif

    !

#ifdef W3_IC3

    WRITE (ndso,935)

    WRITE(ndso,'(A/A)')'    Sice will be calculated using '&

         //'Wang and Shen method.','        '&

         //'Required field input: ice parameters 1, 2, 3 and 4.'

#endif

    !

#ifdef W3_IC4

    WRITE (ndso,935)

    WRITE(ndso,'(A/A)')'    Sice will be calculated using '&

         //'Empirical method.','        '&

         //'Required field input: ice parameters (varies).'

#endif

    !

#ifdef W3_IC5

    WRITE (ndso,935)

    WRITE(ndso,'(A/A/)')'    Sice will be calculated using '&

         //'effective medium models.','        '&

         //'Required field input: ice parameters 1, 2, 3 and 4.'

#endif

    !

    ! 6.l Read unstructured data

    ! initialisation of logical related to unstructured grid

    ugobcauto = .true.

    ugbccfl = .true.

    ugobcdepth= -10.

    ugobcok = .false.

    ugobcfile = 'unset'

    expfsn    = .true.

    expfspsi  = .false.

    expfsfct  = .false.

    impfsn    = .false.

    imptotal  = .false.

    exptotal  = .false.

    imprefraction = .false.

    impfreqshift = .false.

    impsource = .false.

    setup_apply_wlv = .true.

    solverthr_setup=1e-6

    crit_dep_setup=0.1

    jgs_terminate_maxiter = .true.

    jgs_terminate_difference = .true.

    jgs_terminate_norm = .false.

    jgs_limiter = .false.

    jgs_limiter_func = 1

    jgs_block_gauss_seidel = .true.

    jgs_use_jacobi = .true.

    jgs_maxiter=100

    jgs_pmin = 1

    jgs_diff_thr = 1.e-10

    jgs_norm_thr = 1.e-20

    jgs_nlevel = 0

    jgs_source_nonlinear = .false.

    ! read data from the unstructured devoted namelist

    CALL readnl ( ndss, 'UNST', status )


    b_jgs_use_jacobi = jgs_use_jacobi

    b_jgs_terminate_maxiter = jgs_terminate_maxiter

    b_jgs_terminate_difference = jgs_terminate_difference

    b_jgs_terminate_norm = jgs_terminate_norm

    b_jgs_limiter = jgs_limiter

    b_jgs_limiter_func = jgs_limiter_func

    b_jgs_block_gauss_seidel = jgs_block_gauss_seidel

    b_jgs_maxiter = jgs_maxiter

    b_jgs_pmin = jgs_pmin

    b_jgs_diff_thr = jgs_diff_thr

    b_jgs_norm_thr = jgs_norm_thr

    b_jgs_nlevel = jgs_nlevel

    b_jgs_source_nonlinear = jgs_source_nonlinear


    nbsel=0


    IF (expfsn)   nbsel = nbsel+1

    IF (expfspsi) nbsel = nbsel+1

    IF (expfsfct) nbsel = nbsel+1

    IF (impfsn)   nbsel = nbsel+1

    IF (imptotal) nbsel = nbsel+1

    IF (exptotal) nbsel = nbsel+1


    IF (gtype .EQ. ungtype) THEN

      IF (nbsel .ne. 1) THEN

        IF (nbsel .gt. 1) THEN

          WRITE (ndse,*) 'MORE THAN ONE UNSTRUCTURED SCHEME SELECTED'

          CALL extcde ( 19 )

        ELSE IF (nbsel .eq. 0) THEN

          WRITE (ndse,*) 'NOTHING SELECTED FROM THE UNSTRUCTURED PART'

          CALL extcde ( 19 )

        END IF

      END IF

    END IF

    !

    ! 6.m Select propagation scheme

    !

    WRITE (ndso,950)

    !

    nrprop = 0

    flprop = .true.

    pname  = '                              '

#ifdef W3_PR0

    pname  = 'Not defined                   '

    nrprop = nrprop + 1

    flprop = .false.

#endif

#ifdef W3_PR1

    pname  = 'First order upstream          '

    nrprop = nrprop + 1

#endif

#ifdef W3_UQ

    pname  = '3rd order UQ'

#endif

#ifdef W3_UNO

    pname  = '2nd order UNO'

#endif

    j = len_trim(pname)

#ifdef W3_PR2

    pname  = pname(1:j)//' + GSE diffusion '

    nrprop = nrprop + 1

#endif

#ifdef W3_PR3

    pname  = pname(1:j)//' + GSE averaging '

    nrprop = nrprop + 1

#endif

    !

#ifdef W3_SMC

    pname  = 'UNO2 on SMC grid + diffusion  '

#endif

    !

    IF ( (flcx.OR.flcy.OR.flcth.OR.flck) .AND. .NOT. flprop ) THEN

      WRITE (ndse,1030)

      CALL extcde ( 20 )

    END IF

    !

    IF ( .NOT.(flcx.OR.flcy.OR.flcth.OR.flck) .AND. flprop ) THEN

      WRITE (ndse,1031)

    END IF

    !

    IF ( nrprop.EQ.0 ) THEN

      WRITE (ndse,1032)

      CALL extcde ( 21 )

    END IF

    !

    IF ( nrprop .GT. 1 ) THEN

      WRITE (ndse,1033) nrprop

      CALL extcde ( 22 )

    END IF

    !

    ! 6.m Parameters for propagation scheme

    !

    WRITE (ndso,951) pname

    !

    cfltm  =  0.7

    !

#ifdef W3_PR2

    dtime  =  0.

    latmin = 70.

#endif

    !

#ifdef W3_SMC

    !!   Default values of SMC grid parameters.  JGLi06Apr2021

    ncel   =  1

    nufc   =  1

    nvfc   =  1

    nglo   =  1

    narc   =  1

    nbgl   =  1

    nbac   =  1

    lvsmc  =  1

    mrfct  =  1

    ishft  =  0

    jeqt   =  0

    nbismc =  0

    cflsm  =  0.7

    dtims  =  360.0

    rfmaxd =  36.0

    uno3   = .false.

    averg  = .true.

    seawnd = .false.

    arctic = .false.

#endif

    !

#ifdef W3_PR3

    wdthcg = 1.5

    wdthth = wdthcg

#endif

    !

#ifdef W3_PR1

    CALL readnl ( ndss, 'PRO1', status )

    IF ( status(18:18) .EQ. ':' ) status(18:18) = ' '

    WRITE (ndso,952) status(1:18)

    cfltm  = max( 0. , cfltm )

    WRITE (ndso,953) cfltm

#endif

    !

#ifdef W3_PR2

    CALL readnl ( ndss, 'PRO2', status )

    IF ( status(18:18) .EQ. ':' ) status(18:18) = ' '

    WRITE (ndso,952) status(1:18)

    cfltm  = max( 0. , cfltm )

    dtime  = max( 0. , dtime )

    latmin = min( 89. , abs(latmin) )

    clatmn = cos( latmin * dera )

    IF ( dtime .EQ. 0. ) THEN

      WRITE (ndso,953) cfltm, latmin

    ELSE

      WRITE (ndso,954) cfltm, dtime/3600., latmin

    END IF

    dtme   = dtime

#endif

    !

#ifdef W3_SMC

    CALL readnl ( ndss, 'PSMC', status )

    IF ( status(18:18) .EQ. ':' ) status(18:18) = ' '

    WRITE (ndso,952) status(1:18)

    cflsm  = max( 0. , cflsm )

    dtims  = max( 0. , dtims )

    rfmaxd = min( 80.0, abs(rfmaxd) )

    refran = rfmaxd * dera

    !! Printing out SMC grid parameters.

    WRITE (ndso,1950)

    WRITE (ndso,1951) pnsmc

    WRITE (ndso,1953) cflsm, dtims/3600., rfmaxd

    funo3  = uno3

    fverg  = averg

    fswnd  = seawnd

    arctc  = arctic

    nbsmc  = nbismc

    IF( funo3 ) WRITE (ndso,*)                &

         " Advection use 3rd order UNO3 instead of UNO2 scheme."

    IF( fverg ) WRITE (ndso,*)                &

         " Extra 1-2-1 average smoothing activated on SMC grid."

    IF( fswnd ) WRITE (ndso,*)                &

         " Sea-point only wind input is required for SMC grid. "

    IF( arctc ) WRITE (ndso,*)                &

         " Arctic polar part will be appended to this SMC grid."

    nrlv = lvsmc

    WRITE (ndso,4001) nrlv

    WRITE (ndso,4002) jeqt

    WRITE (ndso,4302) ishft

    WRITE (ndso,4003) nbsmc

#endif

    !

#ifdef W3_PR3

    CALL readnl ( ndss, 'PRO3', status )

    IF ( status(18:18) .EQ. ':' ) status(18:18) = ' '

#endif

    IF (gtype.NE.ungtype) THEN

#ifdef W3_PR3

      WRITE (ndso,952) status(1:18)

      cfltm  = max( 0. , cfltm )

      WRITE (ndso,953) cfltm, wdthcg

      IF ( wdthcg*(xfr-1.) .GT. 1. ) WRITE (ndso,955) 1./(xfr-1.)

      WRITE (ndso,954) wdthth

      IF ( wdthth*dth .GT. 1. ) WRITE (ndso,955) 1./dth

      WRITE (ndso,*)

#endif

    ENDIF

#ifdef W3_PR3

    wdcg   = wdthcg

    wdth   = wdthth

#endif

    !

    ctmax  = cfltm

    !

#ifdef W3_RTD

    ! Set/ read in rotation values - these will be written out

    ! later with the rest of the grid info

    ! Default is a non-rotated lat-lon grid

    plat = 90.

    plon = -180.

    unrot = .false.

    CALL readnl ( ndss, 'ROTD', status )

    plon = mod( plon + 180., 360. ) - 180.

    ! Ensure that a grid with pole at the geographic North is standard lat-lon

    IF ( plat == 90. .AND. ( plon /= -180. .OR. unrot ) ) THEN

      WRITE( ndse, 1052 )

      CALL extcde ( 33 )

    ENDIF

    ! Default poles of output b. c. are non-rotated:

    bplat = 90.

    bplon = -180.

    CALL readnl ( ndss, 'ROTB', status )

    ! A b. c. dest. grid with pole at the geographic North must be non-rotated

    DO i=1,9

      IF ( bplat(i) == 90. ) THEN

        ! Require BPLON(I) == -180., but don't blaim the user if BPLON(I) == 180.

        IF ( bplon(i) == 180. ) bplon(i) = -180.

        IF ( bplon(i) == -180. ) cycle

      END IF

      IF ( bplat(i) < 90. ) cycle

      WRITE( ndse, 1053 )

      CALL extcde ( 34 )

    END DO

#endif

    !

    ! 6.n Set miscellaneous parameters (ice, seeding, numerics ... )

    !

    cice0  = 0.5

    cicen  = 0.5

    lice   = 0.

    icehfac= 1.0

    icehmin= 0.2  ! the 0.2 value is arbitrary and needs to be tuned.

    icehinit= 0.5

    icesln = 1.0

    icewind= 1.0

    icesnl = 1.0

    icesds = 1.0

    icehdisp= 0.6 ! Prevent from convergence crash in w3dispmd in the presence of ice, should be tuned

    iceddisp= 80

    icefdisp= 2

    gshift = 0.0d0

    pmove  = 0.5

    xseed  = 1.

    flagtr = 0

    xp     = 0.15

    xr     = 0.10

    xfilt  = 0.05

    ihm    = 100

    hspm   = 0.05

    wsm    = 1.7

    wsc    = 0.333

    flc    = .true.

    trckcmpr = .true.

    nosw   = 5

    !

    ! Gas fluxes

    !

    aircmin   = 2.0  ! cmin for whitecap coverage and entrained air

    airgb     = 0.2  ! volume of entrained air constant (Deike et al. 2017)

    !

#ifdef W3_NCO

    ! NCEP operations retains first three swell systems.

    nosw=3

#endif

    ptm    = 1    ! Default to standard WW3 partitioning. C. Bunney

    ptfc   = 0.1  ! Part. method 5 cutoff freq default. C. Bunney

    fmiche = 1.6

    rwndc  = 1.

    wcor1  = 99.

    wcor2  = 0.

    btbet  = 1.2 ! β for c / [U cos(θ - φ)] < β

    ! Variables for Space-Time Extremes

    !  Default negative values make w3iogomd switch off space-time extremes

    !  forces user to provide NAMELIST if wanting to compute STE parameters

    stdx = -1.

    stdy = -1.

    stdt = -1.

    icedisp = .false.

    caltype = 'standard'

    ! Variables for 3D array output

    e3d=0

    i1e3d=1

    i2e3d=nk

    p2sf   = 0

    i1p2sf = 1

    i2p2sf = 15

    us3d   = 0

    i1us3d = 1

    i2us3d = nk

    ussp=0

    iussp=1

    stk_wn(:)=0.0

    stk_wn(1)=tpi/100. !Set default decay of 100 m for Stokes drift

    th1mf=0

    i1th1m=1

    i2th1m=nk

    sth1mf=0

    i1sth1m=1

    i2sth1m=nk

    th2mf=0

    i1th2m=1

    i2th2m=nk

    sth2mf=0

    i1sth2m=1

    i2sth2m=nk

    !

    facberg=1.

#ifdef W3_IS0

    WRITE (ndso,944)

#endif

#ifdef W3_IS1

    isc1 = 1.

    isc2 = 0.

    CALL readnl ( ndss, 'SIS1', status )

    WRITE (ndso,945) status

    WRITE (ndso,946) isc1, isc2

    is1c1 = isc1

    is1c2 = isc2

#endif

#ifdef W3_IS2

    isc1 = 1.

    is2c2 = 0.   ! 0.025

    is2c3 = 0.   ! 2.4253

    is2conc = 0.

    is2backscat = 1.

    is2break = .false.

    is2breakf = 3.6

    is2flexstr=6.00e+05   ! value used in Ardhuin et al. 2020

    is2isoscat=.true.     ! uses isotropic back-scatter

    is2disp=.false. !not dispersion only attenuation following Liu disp. eq.

    is2dupdate=.true.

    is2fragility=0.9

    is2dmin=20

    is2damp=0.

    is2creepb=0.

    is2creepc=0.4     ! This gives an impact of break-up over a wider freq. range

    !                            ! compared to the 0.2 value in Boutin et al. 2018

    is2creepd=0.5

    is2creepn=3.0

    is2breake=1.

    is2wim1=1.

    is2andisb=.true.  !anelastic instead of inelastic dissipation if IS2CREEPB>0

    is2andise=0.55    !energy of activation

    is2andisd=2.0e-9  !see Ardhuin et al. 2020

    is2andisn=1.      !dependency on stress. Equal to 1 normally?

    CALL readnl ( ndss, 'SIS2', status )

    WRITE (ndso,947) status

    WRITE (ndso,2948) isc1, is2backscat, is2isoscat, is2break, is2dupdate, is2flexstr, is2disp, &

         is2damp, is2fragility, is2dmin, is2c2, is2c3, is2conc, is2creepb,&

         is2creepc, is2creepd, is2creepn, is2breake, is2breakf, is2wim1,  &

         is2andisb, is2andise, is2andisd, is2andisn

#endif

    !

#ifdef W3_REF1

    refcoast=0.

    refmap=0.

    refmapd=0.

    refrmax=1.

    reffreqpow=2.

    reffreq=0.

    refcosp_straight=4.

    refslope=0.22

    refsubgrid=0.

    reficeberg=0.

    refunstsource=0.

    !

    CALL readnl ( ndss, 'REF1', status )

    WRITE (ndso,969) status

#endif

    !

#ifdef W3_IG1

    igmethod = 2

    igaddoutp= 0

    igsource = 2

    igsterms = 0

    igmaxfreq=0.03

    igsourceatbp = 0

    igbcoverwrite = .true.

    igswellmax = .true.

    igkdmin = 1.1

    igfixeddepth = 0.

    igempirical = 0.00125

    CALL readnl ( ndss, 'SIG1 ', status )

    WRITE (ndso,970) status

#endif

    !

#ifdef W3_IC2

    ic2disper = .false.

    ic2turb = 1.

    ic2turbs = 0.

    ic2rough = 0.01

    ic2reynolds = 1.5e5

    ic2smooth = 2e5

    ic2visc = 1.

    ic2dmax = 0.

#endif

    !

#ifdef W3_IC3

    ic3maxthk = 100.0

    ic3maxcnc = 100.0

    ic2turb = 2.0 ! from run_test example by F.A.

    ic2turbs = 0.

    ic2rough = 0.02  !  from run_test example by F.A. (alt:0.1)

    ic2reynolds = 1.5e5

    ic2smooth = 7.0e4

    ic2visc = 2.0

    ic3cheng = .true.

    usecgice = .false.

    ic3hilim = 100.0

    ic3kilim = 100.0

    ic3hice = -1.0

    ic3visc = -2.0

    ic3dens = -3.0

    ic3elas = -4.0

#endif

    !fixme: if USECGICE = .TRUE., don't allow use of IC3MAXTHK<100.0


#ifdef W3_IC4

    ic4method = 1 !switch for methods within IC4

    ic4ki=0.0

    ic4fc=0.0

    ic4cn=0.0

    ic4fmin=0.0

    ic4kibk=0.0

#endif

    !

#ifdef W3_IC5

    ic5minig      = 1.

    ic5minwt      = 0.

    ic5maxkratio  = 1e9

    ic5maxki      = 100.

    ic5minhw      = 0.

    ic5maxiter    = 100.

    ic5rkick      = 0.

    ic5kfilter    = 0.0025

    ic5vemod      = 3. ! 1: EFS, 2: RP, 3: M2 (default)

#endif

    !

#ifdef W3_IC2

    CALL readnl ( ndss, 'SIC2 ', status )

    WRITE (ndso,971) status

#endif

    !

#ifdef W3_IC3

    CALL readnl ( ndss, 'SIC3 ', status )

    WRITE (ndso,971) status

#endif

    !

#ifdef W3_IC4

    CALL readnl ( ndss, 'SIC4 ', status )

    WRITE (ndso,971) status

#endif

    !

#ifdef W3_IC5

    CALL readnl ( ndss, 'SIC5 ', status )

    ic5vemod = min(max(1., ic5vemod), 3.)

    WRITE (ndso,971) status

    WRITE (ndso,2971) ic5minig, ic5minwt, ic5maxkratio,         &

         ic5maxki, ic5minhw, ic5maxiter, ic5rkick, &

         ic5kfilter, ic5mstr(nint(ic5vemod))

#endif

    !

    CALL readnl ( ndss, 'OUTS', status )

    WRITE (ndso,4970) status

    !

    !

    ! output of frequency spectra, th1m ...

    !

    e3df(1,1) = e3d

    e3df(2,1) = min(max(1,i1e3d),nk)

    e3df(3,1) = min(max(1,i2e3d),nk)

    e3df(1,2) = th1mf

    e3df(2,2) = min(max(1,i1th1m),nk)

    e3df(3,2) = min(max(1,i2th1m),nk)

    e3df(1,3) = sth1mf

    e3df(2,3) = min(max(1,i1sth1m),nk)

    e3df(3,3) = min(max(1,i2sth1m),nk)

    e3df(1,4) = th2mf

    e3df(2,4) = min(max(1,i1th2m),nk)

    e3df(3,4) = min(max(1,i2th2m),nk)

    e3df(1,5) = sth2mf

    e3df(2,5) = min(max(1,i1sth2m),nk)

    e3df(3,5) = min(max(1,i2sth2m),nk)

    !

    ! output of microseismic source spectra

    !

    p2msf(1) = p2sf

    p2msf(2) = min(max(1,i1p2sf),nk)

    p2msf(3) = min(max(1,i2p2sf),nk)

    !

    ! output of Stokes drift profile

    !

    us3df(1) = us3d

    us3df(2) = max( 1 , min( nk, i1us3d) )

    us3df(3) = max( 1 , min( nk, i2us3d) )

    !

    ! output of Stokes drift partitions

    !

    usspf(1) = ussp

    usspf(2) = max( 1 , min(25, iussp ) )

    IF (iussp.GT.25) THEN

      WRITE(ndse,*) ' *** WAVEWATCH III ERROR IN ww3_grid:'

      WRITE(ndse,*) "  Stokes drift partition outputs not    "

      WRITE(ndse,*) "   intended for use with more than 25   "

      WRITE(ndse,*) "   partitions.  Please reduce IUSSP     "

      WRITE(ndse,*) "   specified in ww3_grid.inp to proceed "

      CALL extcde( 31)

    ENDIF


    ussp_wn = 0.0 ! initialize to 0s

    DO j=1,usspf(2)

      ussp_wn(j) = stk_wn(j)

    ENDDO


    !

    WRITE (ndso,4971) p2msf(1:3)

    WRITE (ndso,4972) us3df(1:3)

    WRITE (ndso,4973) e3df(1:3,1)

    WRITE (ndso,4974) usspf(1:2)

    DO j=1,usspf(2)

      WRITE(ndso,4975) j,ussp_wn(j)

    ENDDO

    !

    CALL readnl ( ndss, 'MISC', status )

    WRITE (ndso,960) status

    !

    IF ( flagtr.LT.0 .OR. flagtr.GT.6 ) flagtr = 0

    cicen  = min( 1. , max( 0. , cicen ) )

    icesln  = min( 1. , max( 0. , icesln ) )

    icewind = min( 1. , max( 0. , icewind ) )

    icesds  = min( 1. , max( 0. , icesds ) )

    icesnl  = min( 1. , max( 0. , icesnl ) )

    ficen  = cicen

    gridshift=gshift

    icescales(1)=icesln

    icescales(2)=icewind

    icescales(3)=icesnl

    icescales(4)=icesds

    cmprtrck=trckcmpr

    cice0  = min( cicen , max( 0. , cice0 ) )

    ficel  = lice

    iicehmin  = icehmin

    iicehfac  = icehfac

    iicehinit  = icehinit

    iicedisp= icedisp

    iicehdisp  = icehdisp

    iiceddisp  = iceddisp

    iicefdisp  = icefdisp

    pmove  = max( 0. , pmove )

    pfmove = pmove

    !

    btbeta = min(max(1., btbet), 2.)

    aaircmin = alog(grav/aircmin/sig(1))/alog(xfr)+1 ! goes from phase speed C=g/sig to index

    aairgb = airgb

    !

    ! Notes: Presently, if we select CICE0.ne.CICEN requires an obstruction

    !     grid, that is initialized with zeros as default.

    IF ( flagtr .LT. 3 ) THEN

      IF (cice0.NE.cicen) THEN

        cice0 = cicen

        IF (status=='(user def. values) :')  WRITE (ndso,2961)

      END IF

    END IF

#ifdef W3_IC0

    IF ( cice0.EQ.cicen .AND. flagtr.GE.3 ) flagtr = flagtr - 2

#endif

    WRITE (ndso,961) cice0, cicen

    WRITE (ndso,8972) icewind

    fice0  = cice0

    ! Variables for Space-Time Extremes

    stexu = stdx

    IF ( stdy .LE. 0. ) THEN

      stdy = stdx

    END IF

    steyu = stdy

    stedu = stdt

    IF ( stdx .GT. 0 ) THEN

      WRITE (ndso,1040) stdx

      WRITE (ndso,1041) stdy

    ELSE

      WRITE (ndso,1042)

    END IF

    IF ( stdt .GT. 0 ) THEN

      WRITE (ndso,1043) stdt

    ELSE

      WRITE (ndso,1044)

    END IF

#ifdef W3_MGG

    WRITE (ndso,962) pmove

#endif

    !

#ifdef W3_SEED

    xseed  =  max( 1. , xseed )

    WRITE (ndso,964) xseed

#endif

#ifdef W3_SCRIP

    WRITE (ndso,963) gshift

#endif

    WRITE (ndso,1972) trckcmpr

    facsd  = xseed

#ifdef W3_RWND

    rwindc = rwndc

#endif

#ifdef W3_WCOR

    wwcor(1) = wcor1

    wwcor(2) = wcor2

#endif

    !

    xp     = max( 1.e-6 , xp )

    xr     = max( 1.e-6 , xr )

    xrel   = xr

    xfilt  = max( 0. , xfilt )

    xflt   = xfilt

    WRITE (ndso,965) xp, xr, xfilt

    facp   = xp / pi * 0.62e-3 * tpi**4 / grav**2

    !

    ihmax  = max( 50, ihm )

    hspmin = max( 0.0001 , hspm )

    wsmult = max( 1. , wsm )

    wscut  = min( 1.0001 , max( 0. , wsc ) )

    flcomb = flc

    noswll = max( 1 , nosw )

    ptmeth = ptm  ! Partitioning method. Chris Bunney (Jan 2016)

    ptfcut = ptfc ! Freq cutoff for partitiong method 5

    pmnam2 = ""

    IF( ptmeth .EQ. 1 ) THEN

      pmname = "WW3 default"

    ELSE IF( ptmeth .EQ. 2 ) THEN

      pmname = "Watershedding plus wind cut-off"

    ELSE IF( ptmeth .EQ. 3 ) THEN

      pmname = "Watershedding only"

      wscut = 0.0 ! We don't want to classify by ws frac

      pmnam2 = "WSC set to 0.0"

    ELSE IF( ptmeth .EQ. 4 ) THEN

      pmname = "Wind speed cut-off only"

      pmnam2 = "WSC set to 0.0, NOSW set to 1"

      wscut = 0.0 ! We don't want to classify by ws frac

      noswll = 1  ! Only ever one swell

    ELSE IF( ptmeth .EQ. 5 ) THEN

      WRITE(pmname, '("2-Band hi/low cutoff at ", F4.2,"Hz")') ptfcut

      pmnam2 = "WSC set to 0.0, NOSW set to 1"

      wscut = 0.0 ! We don't want to classify by ws frac

      noswll = 1  ! Only ever one swell

    ELSE

      WRITE( ndse, * )                                                &

           "*** Error - unknown partitioing method (PTM)! ***"

      CALL exit(1)

    ENDIF


    IF ( flcomb ) THEN

      j      = 1

    ELSE

      j      = 2

    END IF

    WRITE (ndso,966) ihmax, hspmin, wsmult, wscut, yesxno(j), noswll

    WRITE (ndso,5971) pmname

    IF( pmnam2 .NE. "" ) WRITE (ndso,5972) pmnam2

    !!    WRITE (NDSO,966) IHMAX, HSPMIN, WSMULT, WSCUT, YESXNO(J)

    !

    fhmax  = max( 0.01 , fmiche )

    j      = 2

#ifdef W3_MLIM

    j      = 1

#endif

    WRITE (ndso,967) fhmax, fhmax/sqrt(2.), yesxno(j)

    IF ( fhmax.LT.0.50 .AND. j.EQ.1 ) WRITE (ndst,968)

    !

    IF (trim(caltype) .NE. 'standard' .AND.                           &

         trim(caltype) .NE. '360_day'  .AND.                           &

         trim(caltype) .NE. '365_day' ) GOTO 2003

    WRITE (ndst,1973) caltype

    WRITE (ndso,*)

    !

    ! 6.x Read values for FLD stress calculation

    !

#ifdef W3_FLD1

    tailtype = 0

    taillev  = 0.006

    tailt1 = 1.25

    tailt2 = 3.00

#endif

#ifdef W3_FLD2

    tailtype = 0

    taillev  = 0.006

    tailt1 = 1.25

    tailt2 = 3.00

#endif

    !

#ifdef W3_FLD1

    CALL readnl ( ndss, 'FLD1', status )

    taillev  = min( max( 0.0005 , taillev ), 0.04)

    tail_lev = taillev

    tail_id = tailtype

    tail_tran1 = tailt1

    tail_tran2 = tailt2

#endif

#ifdef W3_FLD2

    CALL readnl ( ndss, 'FLD2', status )

    taillev  = min( max( 0.0005 , taillev ), 0.04)

    tail_lev = taillev

    tail_id = tailtype

    tail_tran1 = tailt1

    tail_tran2 = tailt2

#endif

    !

    ! 6.o End of namelist processing

    !

    IF (flgnml) THEN

      CLOSE (ndss)

    ELSE

      CLOSE (ndss,status='DELETE')

    END IF

    !

    IF ( flnmlo ) THEN

      WRITE (ndso,917)

#ifdef W3_FLX3

      WRITE (ndso,2810) cdmax*1.e3, ctype

#endif

#ifdef W3_FLX4

      WRITE (ndso,2810) cdfac

#endif

#ifdef W3_LN1

      WRITE (ndso,2820) clin, rfpm, rfhf

#endif

#ifdef W3_ST1

      WRITE (ndso,2920) cinp

#endif

      IF ( .NOT. flstb2 ) THEN

#ifdef W3_ST2

        WRITE (ndso,2920) zwnd, swellf

#endif

      ELSE

#ifdef W3_STAB2

        WRITE (ndso,2921) zwnd, swellf, stabsh, stabof,  &

             cneg, cpos, fneg

#endif

      END IF

      !

#ifdef W3_ST3

      WRITE (ndso,2920) zwnd, alpha0, z0max, betamax, sinthp, zalp,   &

           swellf

#endif

#ifdef W3_ST4

      WRITE (ndso,2920) zwnd, alpha0, z0max, betamax, sinthp, zalp,   &

           tauwshelter, swellfpar, swellf, swellf2, swellf3, swellf4, &

           swellf5, swellf6, swellf7, z0rat, sinbr, sintable, tauwbug, viscstress, sintail1, sintail2, &

           capcha, chamin, cha0, ucap, sigmaucap

#endif

#ifdef W3_ST6

      WRITE (ndso,2920) sina0, sinws, sinfc

#endif

#ifdef W3_NL1

      WRITE (ndso,2922) lambda, nlprop, kdconv, kdmin,       &

           snlcs1, snlcs2, snlcs3,              &

           iqtype, tailnl, gqmnf1,              &

           gqmnt1, gqmnq_om2, gqmthrsat, gqmthrcou,&

           gqamp1, gqamp2, gqamp3, gqamp4

#endif

#ifdef W3_NL2

      WRITE (ndso,2922) iqtype, tailnl, ndepth

      IF ( iqtype .EQ. 3 ) THEN

        IF ( ndepth .EQ. 1 ) THEN

          WRITE (ndso,3923) dpthnl(1)

        ELSE

          WRITE (ndso,4923) dpthnl(1)

        END IF

        WRITE (ndso,5923) dpthnl(2:ndepth-1)

        WRITE (ndso,6923) dpthnl(ndepth)

      END IF

#endif

#ifdef W3_NL3

      WRITE (ndso,2922) nqdef, msc, nsc, kdfd, kdfs

      IF ( nqdef .EQ. 1 ) THEN

        WRITE (ndso,3923) qparms(1:5)

      ELSE

        WRITE (ndso,4923) qparms(1:5)

        DO j=2, nqdef-1

          WRITE (ndso,5923) qparms((j-1)*5+1:j*5)

        END DO

        WRITE (ndso,6923) qparms((nqdef-1)*5+1:nqdef*5)

      END IF

#endif

#ifdef W3_NL4

      WRITE (ndso,2922) indtsa, altlp

#endif

#ifdef W3_NL5

      WRITE (ndso,2922) qr5dpt, qr5oml, qi5dis, qi5kev, qi5ipl, qi5pmx

#endif

#ifdef W3_NLS

      WRITE (ndso,8922) a34, fhfc, dnm, fc1, fc2, fc3

#endif

#ifdef W3_ST1

      WRITE (ndso,2924) cdis, apm

#endif

#ifdef W3_ST2

      WRITE (ndso,2924) sdsa0, sdsa1, sdsa2, sdsb0, sdsb1, phimin

#endif

#ifdef W3_ST3

      WRITE (ndso,2924) sdsc1, wnmeanp, fxpm3, fxfm3, sdsdelta1,  &

           sdsdelta2

#endif


#ifdef W3_ST4

      WRITE (ndso,2924) sdsbchoice, sdsc2, sdscum, sdsc4,         &

           sdsc5, sdsc6, &

           wnmeanp, fxpm3, fxfm3, fxfmage,                   &

           sdsbint, sdsbck, sdsabk, sdspbk, sdshck,          &

           sdsbr, sdsstrain,  sdsstraina,  sdsstrain2,       &

           sdsbt, sdsp, sdsiso, sdscos, sdsdth, sdsbrf1,     &

           sdsbrfdf, sdsbm0, sdsbm1, sdsbm2, sdsbm3, sdsbm4, &

           spmss, sdkof, sdsmwd, sdsfacmtf, sdsnmtf,sdsmwpow,&

           sdscump, cumsigp, sdsnuw, whitecapwidth, whitecapdur

#endif

#ifdef W3_ST6

      WRITE (ndso,2924) sdset, sdsa1, sdsa2, sdsp1, sdsp2

      WRITE (ndso,2937) swlb1, cstb1

#endif

#ifdef W3_BT1

      WRITE (ndso,2926) gamma

#endif

#ifdef W3_BT4

      WRITE (ndso,2926) sedmapd50, sed_d50_uniform,      &

           ripfac1,ripfac2,ripfac3,ripfac4, sigdepth, &

           botroughmin, botroughfac

#endif

#ifdef W3_DB1

      IF ( bjflag ) THEN

        WRITE (ndso,2928) bjalfa, bjgam, '.TRUE.'

      ELSE

        WRITE (ndso,2928) bjalfa, bjgam, '.FALSE.'

      END IF

#endif

#ifdef W3_PR1

      WRITE (ndso,2953) cfltm

#endif

#ifdef W3_PR2

      WRITE (ndso,2953) cfltm, dtime, latmin

#endif

#ifdef W3_SMC

      WRITE (ndso,2954) cflsm, dtims, arctic, rfmaxd, uno3, &

           averg, lvsmc, nbismc, ishft, jeqt, seawnd

#endif

#ifdef W3_PR3

      WRITE (ndso,2953) cfltm, wdthcg, wdthth

#endif

      !

      WRITE (ndso,2956) ugbccfl, ugobcauto, ugobcdepth,trim(ugobcfile), &

           expfsn, expfspsi, expfsfct, impfsn, exptotal,&

           imptotal, imprefraction, impfreqshift,      &

           impsource, setup_apply_wlv,                 &

           jgs_terminate_maxiter,                      &

           jgs_terminate_difference,                   &

           jgs_terminate_norm,                         &

           jgs_limiter,                                &

           jgs_limiter_func,                           &

           jgs_use_jacobi,                             &

           jgs_block_gauss_seidel,                     &

           jgs_maxiter,                                &

           jgs_pmin,                                   &

           jgs_diff_thr,                               &

           jgs_norm_thr,                               &

           jgs_nlevel,                                 &

           jgs_source_nonlinear

      !

      WRITE (ndso,2976)    p2sf, i1p2sf, i2p2sf,                    &

           us3d, i1us3d, i2us3d,                    &

           ussp, iussp,                             &

           e3d, i1e3d, i2e3d,                       &

           th1mf, i1th1m, i2th1m,                   &

           sth1mf, i1sth1m, i2sth1m,                &

           th2mf, i1th2m, i2th2m,                   &

           sth2mf, i1sth2m, i2sth2m

      !

#ifdef W3_REF1

      WRITE(ndso,2986) refcoast, reffreq, refslope, refmap,  &

           refmapd, refsubgrid , refrmax, reffreqpow,  &

           reficeberg, refcosp_straight, refunstsource

#endif

      !

#ifdef W3_IG1

      WRITE(ndso,2977) igmethod, igaddoutp, igsource,         &

           igsterms, igbcoverwrite, igswellmax,         &

           igmaxfreq, igsourceatbp, igkdmin,            &

           igfixeddepth, igempirical

#endif

      !

#ifdef W3_IC2

      WRITE(ndso,2978) ic2disper, ic2turb, ic2rough,          &

           ic2reynolds,  ic2smooth, ic2visc, ic2turbs,  &

           ic2dmax

#endif

      !

#ifdef W3_IC3

      WRITE(ndso,2979) ic3maxthk, ic3maxcnc, ic2turb,         &

           ic2rough,  ic2reynolds,  ic2smooth,    &

           ic2visc, ic2turbs, ic3cheng,           &

           usecgice, ic3hilim, ic3kilim,          &

           ic3hice, ic3visc, ic3dens, ic3elas

#endif

      !

#ifdef W3_IC4

      WRITE(ndso,nml=sic4)

#endif

      !

#ifdef W3_IC5

      WRITE(ndso,2981) ic5minig, ic5minwt, ic5maxkratio,       &

           ic5maxki, ic5minhw, ic5maxiter,         &

           ic5rkick, ic5kfilter, ic5vemod

#endif

      !

#ifdef W3_IS1

      WRITE (ndso,2946) is1c1, is1c2

#endif

      !

#ifdef W3_IS2

      WRITE (ndso,948) isc1, is2backscat, is2isoscat, is2break,  &

           is2dupdate, is2flexstr, is2disp,  is2damp, is2fragility, is2dmin, is2c2,   &

           is2c3, is2conc, is2creepb, is2creepc, is2creepd,  &

           is2creepn, is2breake, is2breakf, is2wim1, is2andisb, &

           is2andise, is2andisd, is2andisn

#endif

      !

#ifdef W3_UOST

      WRITE (ndso, 4502) adjustl(trim(uostfilelocal)), adjustl(trim(uostfileshadow)), &

           uostfactorlocal, uostfactorshadow

#endif


      !

      IF ( flcomb ) THEN

        WRITE (ndso,2966) cice0, cicen, lice, pmove, xseed, flagtr, &

             xp, xr, xfilt, ihmax, hspmin, wsmult, &

             wscut, '.TRUE.', noswll, fhmax,       &

             rwndc, wcor1, wcor2, facberg, gshift, &

             stdx, stdy, stdt, icehmin, icehfac,   &

             icehinit, icedisp, icehdisp,          &

             icesln, icewind, icesnl, icesds,      &

             iceddisp,icefdisp, caltype, trckcmpr, &

             btbeta

      ELSE

        WRITE (ndso,2966) cice0, cicen, lice, pmove, xseed, flagtr, &

             xp, xr, xfilt, ihmax, hspmin, wsmult, &

             wscut, '.FALSE.', noswll, fhmax,      &

             rwndc, wcor1, wcor2, facberg, gshift, &

             stdx, stdy, stdt,  icehmin, icehfac,  &

             icehinit, icedisp, icehdisp,          &

             icesln, icewind, icesnl, icesds,      &

             iceddisp, icefdisp, caltype, trckcmpr,&

             btbeta

      END IF

      !

#ifdef W3_FLD1

      WRITE(ndso,2987) tail_id, tail_lev, tail_tran1, tail_tran2

#endif

#ifdef W3_FLD2

      WRITE(ndso,2987) tail_id, tail_lev, tail_tran1, tail_tran2

#endif

#ifdef W3_RTD

      WRITE(ndso,4991) plat, plon, unrot

      WRITE(ndso,4992) bplat, bplon

#endif

      !

      WRITE (ndso,918)

    END IF

    !

    ! 6.p Set various other values ...

    ! ... Tail in integration       --> scale factor for A to E conv

    !

    fte    = 0.25 * sig(nk)      * dth * sig(nk)

    ftf    = 0.20                * dth * sig(nk)

    ftwn   = 0.20 * sqrt(grav)   * dth * sig(nk)

    fttr   = ftf

    ftwl   = grav / 6. / sig(nk) * dth * sig(nk)

#ifdef W3_ST3

    stxftf      = 1/(fachf-1.-wnmeanp*2)                       &

         * sig(nk)**(2+wnmeanp*2) * dth

    stxftftail  = 1/(fachf-1.-wnmeanptail*2)                   &

         * sig(nk)**(2+wnmeanptail*2) * dth

    stxftwn = 1/(fachf-1.-wnmeanp*2) * sig(nk)**(2)            &

         * (sig(nk)/sqrt(grav))**(wnmeanp*2)   * dth

    sstxftf     = stxftf

    sstxftftail = stxftftail

    sstxftwn    = stxftwn

#endif

    !

#ifdef W3_ST4

    stxftf      = 1/(fachf-1.-wnmeanp*2)                       &

         * sig(nk)**(2+wnmeanp*2) * dth

    stxftftail  = 1/(fachf-1.-wnmeanptail*2)                   &

         * sig(nk)**(2+wnmeanptail*2) * dth

    stxftwn = 1/(fachf-1.-wnmeanp*2) * sig(nk)**(2)            &

         * (sig(nk)/sqrt(grav))**(wnmeanp*2)   * dth

    sstxftf     = stxftf

    sstxftftail = stxftftail

    sstxftwn    = stxftwn

#endif

    !

    ! ... High frequency cut-off

    !

    fxfm   = 2.5

#ifdef W3_ST6

    fxfm   = sin6fc

#endif

    fxpm   = 4.0

    fxpm   = fxpm * grav / 28.

    fxfm   = fxfm * tpi

    xfc    = 3.0

#ifdef W3_ST2

    xfh    = 2.0

    xf1    = 1.75

    xf2    = 2.5

    xft    = xf2

#endif

    !

    facti1 = 1. / log(xfr)

    facti2 = 1. - log(tpi*fr1) * facti1

    !

    ! Setting of FACHF moved to before !/NL2 set-up for consistency

    !

#ifdef W3_NL2

    fachf  = -tailnl

#endif

    fachfa = xfr**(-fachf-2)

    fachfe = xfr**(-fachf)

    !

    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    ! 7.  Read and prepare the grid.

    ! 7.a Type of grid

    !

    IF (flgnml) THEN

      gstrg=trim(nml_grid%TYPE)

      IF (trim(nml_grid%COORD).EQ.'SPHE') flagll=.true.

      IF (trim(nml_grid%COORD).EQ.'CART') flagll=.false.

      cstrg=trim(nml_grid%CLOS)

    ELSE

      CALL nextln ( comstr , ndsi , ndse )

      READ (ndsi,*,END=2001,ERR=2002) GSTRG, FLAGLL, cstrg

      CALL nextln ( comstr , ndsi , ndse )

    END IF


    SELECT CASE (trim(gstrg))

    CASE ('RECT')

      gtype = rlgtype

      WRITE (ndso,3000) 'rectilinear'

    CASE ('CURV')

      gtype = clgtype

      WRITE (ndso,3000) 'curvilinear'

    CASE ('UNST')

      gtype = ungtype

      WRITE (ndso,3000) 'unstructured'

      !!Li  Add SMC grid type option.  JGLi12Oct2020

    CASE ('SMCG')

      gtype = smctype

      WRITE (ndso,3000) 'SMC Grid'

    CASE DEFAULT

      WRITE (ndse,1007) trim(gstrg)

      CALL extcde ( 25 )

    END SELECT

    !

    IF ( flagll ) THEN

      factor = 1.

      WRITE (ndso,3001) 'spherical'

    ELSE

      factor = 1.e-3

      WRITE (ndso,3001) 'Cartesian'

    END IF

    !

    !     Only process grid closure string for logically rectangular grids.

    !     Closure setting for unstructured grids is NONE.

    iclose = iclose_none

    IF ( gtype.NE.ungtype ) THEN

      SELECT CASE (trim(cstrg))

      CASE ('NONE')

        iclose = iclose_none

        WRITE (ndso,3002) 'none'

      CASE ('SMPL')

        iclose = iclose_smpl

        WRITE (ndso,3002) 'simple'

      CASE ('TRPL')

        WRITE (ndse,'(/2A)') ' *** WARNING WW3_GRID: TRIPOLE ',  &

             'GRID CLOSURE IMPLEMENTATION IS INCOMPLETE ***'

        iclose = iclose_trpl

        WRITE (ndso,3002) 'tripole'

        IF ( gtype.EQ.rlgtype ) THEN

          WRITE (ndse,1009)

          CALL extcde ( 25 )

        END IF

      CASE DEFAULT

        ! Check for old style GLOBAL input

        SELECT CASE (trim(cstrg))

        CASE ('T','t','.TRU','.tru')

          iclose = iclose_smpl

          WRITE (ndso,3002) 'simple'

          WRITE (ndse,1013)

        CASE ('F','f','.FAL','.fal')

          iclose = iclose_none

          WRITE (ndso,3002) 'none'

          WRITE (ndse,1013)

        CASE DEFAULT

          WRITE (ndse,1012) trim(cstrg)

          CALL extcde ( 25 )

        END SELECT

      END SELECT

      IF ( iclose.NE.iclose_none .AND. .NOT.flagll ) THEN

        WRITE (ndse,1008)

        CALL extcde ( 25 )

      END IF

    END IF !GTYPE.NE.UNGTYPE

    !

    ! 7.b Size of grid

    !

    IF (flgnml) THEN

      SELECT CASE ( gtype )

        !!Li  SMCTYPE shares domain info with RLGTYPE.  JGLi12Oct2020

      CASE ( rlgtype, smctype )

        nx = nml_rect%NX

        ny = nml_rect%NY

        nx = max( 3 , nx )

        ny = max( 3 , ny )

        WRITE (ndso,3003) nx, ny

      CASE ( clgtype )

        nx = nml_curv%NX

        ny = nml_curv%NY

        nx = max( 3 , nx )

        ny = max( 3 , ny )

        WRITE (ndso,3003) nx, ny

      CASE ( ungtype )

        ny=1

      END SELECT

    ELSE

      IF ( gtype.NE.ungtype) THEN

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,*,END=2001,ERR=2002) NX, ny

        nx     = max( 3 , nx )

        ny     = max( 3 , ny )

        WRITE (ndso,3003) nx, ny

      ELSE

        ny =1

      END IF

    END IF

    !

    ! Propagation specific to unstructured grids

    !

    do_change_wlv=.false.

    IF ( gtype.EQ.ungtype) THEN

      unstschemes = 0

      IF (expfsn)   unstschemes(1) = 1

      IF (expfspsi) unstschemes(2) = 1

      IF (expfsfct) unstschemes(3) = 1

      IF (impfsn)   unstschemes(4) = 1

      IF (imptotal) unstschemes(5) = 1

      IF (exptotal) unstschemes(6) = 1


      IF (sum(unstschemes) .eq. 0) THEN

        WRITE(ndse,*) 'NO UNST SCHEME SELECTED'

        CALL extcde ( 19 )

      ELSE IF (sum(unstschemes) .gt. 1) THEN

        WRITE(ndse,*) 'MORE THAN ONE UNST SCHEME SELECTED'

        CALL extcde ( 19 )

      ENDIF


      unstscheme=-1

      DO ix=1,6

        IF (unstschemes(ix).EQ.1) THEN

          unstscheme=ix

          EXIT

        END IF

      END DO


      fsbccfl = ugbccfl

      SELECT CASE (unstscheme)

      CASE (1)

        fsn = expfsn

        pname2 = 'N Explicit (Fluctuation Splitting) '

      CASE (2)

        fspsi = expfspsi

        pname2 = 'PSI Explicit (Fluctuation Splitting)  '

      CASE (3)

        fsfct = expfsfct

        pname2 = ' Flux Corrected Transport Explicit'

      CASE (4)

        fsnimp = impfsn

        pname2 = 'N Implicit (Fluctuation Splitting) '

      CASE (5)

        fstotalimp = imptotal

        pname2 = 'N Implicit (Fluctuation Splitting) for total implicit'

      CASE (6)

        fstotalexp = exptotal

        pname2 = 'N Explicit (Fluctuation Splitting) for one exchange explicit DC HPCF '

      END SELECT


      IF (fstotalimp .or. fstotalexp) THEN

        lpdlib = .true.

      ENDIF

      !

      IF (sum(unstschemes).GT.1) WRITE(ndso,1035)

      WRITE (ndso,2951) pname2


      IF (imprefraction .and. imptotal .AND. flcth) THEN

        fsrefraction = .true.

        pname2 = 'Refraction done implicitly'

        WRITE (ndso,2951) pname2

      ELSE

        fsrefraction = .false.

      END IF

      IF (impfreqshift .and. imptotal .AND. flck) THEN

        fsfreqshift = .true.

        pname2 = 'Frequency shifting done implicitly'

        WRITE (ndso,2951) pname2

      ELSE

        fsfreqshift = .false.

      END IF

      IF (impsource .and. imptotal .AND. flsou) THEN

        fssource = .true.

        pname2 = 'Source terms integrated implicitly'

        WRITE (ndso,2951) pname2

      ELSE

        fssource = .false.

      END IF

      IF (setup_apply_wlv) THEN

        do_change_wlv = setup_apply_wlv

        pname2 = 'Wave setup is added to the WLV'

        WRITE (ndso,2952) pname2

      END IF

      solverthr_stp = solverthr_setup

      crit_dep_stp  = crit_dep_setup

    END IF


    !

    ! 7.c Grid coordinates (branch here based on grid type)

    !

    IF ( gtype.NE.ungtype) ALLOCATE ( xgrdin(nx,ny), ygrdin(nx,ny) )

    SELECT CASE ( gtype )

      !

      ! 7.c.1 Rectilinear grid

      !

      !!Li  SMC grid shares domain info with RLGTYPE.   JGLi12Oct2020

    CASE ( rlgtype, smctype )

      !

      IF (flgnml) THEN

        sx = nml_rect%SX

        sy = nml_rect%SY

        vsc = nml_rect%SF

        x0 = nml_rect%X0

        y0 = nml_rect%Y0

        vsc0 = nml_rect%SF0

      ELSE

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,*,END=2001,ERR=2002) SX, SY, vsc

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,*,END=2001,ERR=2002) X0, Y0, vsc0

      END IF

      !

      vsc    = max( 1.e-7 , vsc )

      sx     = sx / vsc

      sy     = sy / vsc

      sx     = max( 1.e-7 , sx )

      sy     = max( 1.e-7 , sy )

      IF ( iclose.EQ.iclose_smpl ) sx = 360. / real(nx)

      !

      vsc0    = max( 1.e-7 , vsc0 )

      x0     = x0 / vsc0

      y0     = y0 / vsc0

      !

      IF ( flagll ) THEN

        WRITE (ndso,3004) factor*sx, factor*sy,         &

             factor*x0, factor*(x0+real(nx-1)*sx),    &

             factor*y0, factor*(y0+real(ny-1)*sy)

      ELSE

        WRITE (ndso,3005) factor*sx, factor*sy,         &

             factor*x0, factor*(x0+real(nx-1)*sx),    &

             factor*y0, factor*(y0+real(ny-1)*sy)

      END IF

      !

      DO iy=1, ny

        DO ix=1, nx

          xgrdin(ix,iy) = x0 + real(ix-1)*sx

          ygrdin(ix,iy) = y0 + real(iy-1)*sy

        END DO

      END DO

      !

      ! 7.c.2 Curvilinear grid

      !

    CASE ( clgtype )

      !

      ! 7.c.2.a Process x-coordinates

      !

      IF (flgnml) THEN

        ndsg = nml_curv%XCOORD%IDF

        vsc = nml_curv%XCOORD%SF

        vof = nml_curv%XCOORD%OFF

        idla = nml_curv%XCOORD%IDLA

        idfm = nml_curv%XCOORD%IDFM

        rform = trim(nml_curv%XCOORD%FORMAT)

        from = trim(nml_curv%XCOORD%FROM)

        fname = trim(nml_curv%XCOORD%FILENAME)

      ELSE

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,*,END=2001,ERR=2002) NDSG, VSC, VOF, &

             idla, idfm, rform, from, fname

      END IF

      !

      IF (idla.LT.1 .OR. idla.GT.4) idla   = 1

      IF (idfm.LT.1 .OR. idfm.GT.3) idfm   = 1

      !

      WRITE (ndso,3006) ndsg, vsc, vof, idla, idfm

      IF (idfm.EQ.2) WRITE (ndso,3008) trim(rform)

      IF (from.EQ.'NAME' .AND. ndsg.NE.ndsi) &

           WRITE (ndso,3009) trim(fname)

      !

      IF ( ndsg .EQ. ndsi ) THEN

        IF ( idfm .EQ. 3 ) THEN

          WRITE (ndse,1004) ndsg

          CALL extcde (23)

        ELSE

          IF (.NOT.flgnml) THEN

            CALL nextln ( comstr , ndsi , ndse )

          END IF

        END IF

      ELSE

        IF ( idfm .EQ. 3 ) THEN

          IF (from.EQ.'NAME') THEN

            OPEN (ndsg,file=trim(fnmpre)//trim(fname),&

                 form='UNFORMATTED', convert=file_endian,                 &

                 status='OLD',err=2000,iostat=ierr)

          ELSE

            OPEN (ndsg,                               &

                 form='UNFORMATTED', convert=file_endian,                 &

                 status='OLD',err=2000,iostat=ierr)

          END IF

        ELSE

          IF (from.EQ.'NAME') THEN

            OPEN (ndsg,file=trim(fnmpre)//trim(fname),&

                 status='OLD',err=2000,iostat=ierr)

          ELSE

            OPEN (ndsg,                               &

                 status='OLD',err=2000,iostat=ierr)

          END IF

        END IF !IDFM

      END IF !NDSG

      !

      CALL ina2r ( xgrdin, nx, ny, 1, nx, 1, ny, ndsg, ndst, ndse, &

           idfm, rform, idla, vsc, vof)

      !

      ! 7.c.2.b Process y-coordinates

      !

      IF (flgnml) THEN

        ndsg = nml_curv%YCOORD%IDF

        vsc = nml_curv%YCOORD%SF

        vof = nml_curv%YCOORD%OFF

        idla = nml_curv%YCOORD%IDLA

        idfm = nml_curv%YCOORD%IDFM

        rform = trim(nml_curv%YCOORD%FORMAT)

        from = trim(nml_curv%YCOORD%FROM)

        fname = trim(nml_curv%YCOORD%FILENAME)

      ELSE

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,*,END=2001,ERR=2002) NDSG, VSC, VOF, &

             idla, idfm, rform, from, fname

      END IF

      !

      IF (idla.LT.1 .OR. idla.GT.4) idla   = 1

      IF (idfm.LT.1 .OR. idfm.GT.3) idfm   = 1

      !

      WRITE (ndso,3007) ndsg, vsc, vof, idla, idfm

      IF (idfm.EQ.2) WRITE (ndso,3008) trim(rform)

      IF (from.EQ.'NAME' .AND. ndsg.NE.ndsi) &

           WRITE (ndso,3009) trim(fname)

      !

      IF ( ndsg .EQ. ndsi ) THEN

        IF ( idfm .EQ. 3 ) THEN

          WRITE (ndse,1004) ndsg

          CALL extcde (23)

        ELSE

          IF (.NOT.flgnml) THEN

            CALL nextln ( comstr , ndsi , ndse )

          END IF

        END IF

      ELSE

        IF ( idfm .EQ. 3 ) THEN

          IF (from.EQ.'NAME') THEN

            OPEN (ndsg,file=trim(fnmpre)//trim(fname),&

                 form='UNFORMATTED', convert=file_endian,                 &

                 status='OLD',err=2000,iostat=ierr)

          ELSE

            OPEN (ndsg,                               &

                 form='UNFORMATTED', convert=file_endian,                 &

                 status='OLD',err=2000,iostat=ierr)

          END IF

        ELSE

          IF (from.EQ.'NAME') THEN

            OPEN (ndsg,file=trim(fnmpre)//trim(fname),&

                 status='OLD',err=2000,iostat=ierr)

          ELSE

            OPEN (ndsg,                               &

                 status='OLD',err=2000,iostat=ierr)

          END IF

        END IF !IDFM

      END IF !NDSG

      !

      CALL ina2r ( ygrdin, nx, ny, 1, nx, 1, ny, ndsg, ndst, ndse, &

           idfm, rform, idla, vsc, vof)

      !

      ! 7.c.2.c Check for obvious errors in grid definition or input

      !

      ! ....... Check for inverted grid (can result from wrong IDLA)

      IF ( (xgrdin(2,1)-xgrdin(1,1))*(ygrdin(1,2)-ygrdin(1,1)) .LT. &

           (ygrdin(2,1)-ygrdin(1,1))*(xgrdin(1,2)-xgrdin(1,1)) ) THEN

        WRITE (ndse,1011) idla

        !.........Notes: here, we are checking to make sure that the j axis is ~90 degrees

        !................counter-clockwise from the i axis (the standard cartesian setup).

        !................So, it is a check on the handedness of the grid.

        !................We have confirmed for one case that a left-handed grid produces

        !................errors in SCRIP. We have not confirmed that left-handed grids necessarily

        !................produce errors in single-grid simulations, or that they necessarily

        !................produce errors in all multi-grid simulations.

        !................Note that transposing or flipping a grid will generally change the handedness.

        CALL extcde (25)

      END IF

      !

      ! 7.c.3 Unstructured grid

      !

    CASE ( ungtype )

      !

      maxx = 0.

      maxy = 0.

      dxymax = 0.

      WRITE (ndso,1150)


      IF (flgnml) THEN

        zlim = nml_grid%ZLIM

        dmin = nml_grid%DMIN

        ndsg = nml_unst%IDF

        vsc = nml_unst%SF

        idla = nml_unst%IDLA

        idfm = nml_unst%IDFM

        rform = trim(nml_unst%FORMAT)

        from = 'NAME'

        fname = trim(nml_unst%FILENAME)

        ugobcfile = trim(nml_unst%UGOBCFILE)

      END IF

    END SELECT !GTYPE

    !

    ! 7.d Depth information for grid

    !

    IF (flgnml) THEN

      IF (gtype.NE.ungtype) THEN

        zlim = nml_grid%ZLIM

        dmin = nml_grid%DMIN

        ndsg = nml_depth%IDF

        vsc = nml_depth%SF

        idla = nml_depth%IDLA

        idfm = nml_depth%IDFM

        rform = trim(nml_depth%FORMAT)

        from = trim(nml_depth%FROM)

        fname = trim(nml_depth%FILENAME)

      END IF

    ELSE

      CALL nextln ( comstr , ndsi , ndse )

      READ (ndsi,*,END=2001,ERR=2002) ZLIM, DMIN, NDSG, VSC, IDLA,    &

           idfm, rform, from, fname

    END IF

    !

    dmin    = max( 1.e-3 , dmin )

    IF (   abs(vsc) .LT. 1.e-7  ) vsc    = 1.

    IF (idla.LT.1 .OR. idla.GT.4) idla   = 1

    IF (idfm.LT.1 .OR. idfm.GT.3) idfm   = 1

    !

    WRITE (ndso,972) ndsg, zlim, dmin, vsc, idla, idfm

    IF (idfm.EQ.2) WRITE (ndso,973) trim(rform)

    IF (from.EQ.'NAME' .AND. ndsg.NE.ndsi) &

         WRITE (ndso,974) trim(fname)


#ifdef W3_SMC

    !Li  Save the depth conversion factor for SMC grid use.  JGLi03Nov2023

    dvsmc = vsc

#endif


    !

    ! 7.e Read bottom depths

    !

    IF ( gtype.NE.ungtype ) THEN

      !

      ! Reading depths on structured grid

      !

      ALLOCATE ( zbin(nx,ny), obsx(nx,ny), obsy(nx,ny) )

      !

      !       Initialize subgrid obstructions with zeros.

      zbin(:,:)=0.

      obsx(:,:)=0.

      obsy(:,:)=0.


      !Li Suspended for SMC grid, which uses depth stored in its cell array.

      !Li               JGLi15Oct2014

      IF( gtype .NE. smctype ) THEN

        !

        IF ( ndsg .EQ. ndsi ) THEN

          IF ( idfm .EQ. 3 ) THEN

            WRITE (ndse,1004) ndsg

            CALL extcde (23)

          ELSE

            CALL nextln ( comstr , ndsi , ndse )

          END IF

        ELSE  ! NDSG.NE.NDSI

          IF ( idfm .EQ. 3 ) THEN

            IF (from.EQ.'NAME') THEN

              OPEN (ndsg,file=trim(fnmpre)//trim(fname), &

                   form='UNFORMATTED', convert=file_endian,&

                   status='OLD',err=2000,iostat=ierr)

            ELSE

              OPEN (ndsg, form='UNFORMATTED', convert=file_endian,                &

                   status='OLD',err=2000,iostat=ierr)

            END IF

          ELSE

            IF (from.EQ.'NAME') THEN

              OPEN (ndsg,file=trim(fnmpre)//trim(fname),  &

                   status='OLD',err=2000,iostat=ierr)

            ELSE

              OPEN (ndsg,                                     &

                   status='OLD',err=2000,iostat=ierr)

            END IF

          END IF

        END IF  !( NDSG .EQ. NDSI )

        !

        CALL ina2r ( zbin, nx, ny, 1, nx, 1, ny, ndsg, ndst, ndse,      &

             idfm, rform, idla, vsc, 0.0)

        !

        !Li     End of IF( GTYPE .NE. SMCTYPE ) block

      ENDIF

      !

    ELSE

      !

      ! Reading depths on unstructured grid (this also sets number of mesh points, NX)

      !

      CALL readmsh(ndsg,fname)

      ALLOCATE(zbin(nx, ny),obsx(nx,ny),obsy(nx,ny))

      zbin(:,1) = vsc * zb(:)

      !

      ! subgrid obstructions are not yet handled in unstructured grids

      !

      obsx(:,:)=0.

      obsy(:,:)=0.


    END IF

    !

    ! 7.f Set up temporary map

    !

    ALLOCATE ( tmpsta(ny,nx), tmpmap(ny,nx) )

    tmpsta = 0

    !

    IF (gtype .EQ. ungtype) THEN

      tmpsta = 1

    ELSE

      DO iy=1, ny

        DO ix=1, nx

          IF ( zbin(ix,iy) .LE. zlim ) tmpsta(iy,ix) = 1

        END DO

      END DO

    ENDIF

    !

    !Li   Suspended for SMC grid.  JGLi15Oct2014

    IF( gtype .NE. smctype ) THEN

      !

      ! 7.g Subgrid information

      !

      trflag = flagtr

      IF ( trflag.GT.6 .OR. trflag.LT.0 ) trflag = 0

      !

      IF ( trflag .EQ. 0 ) THEN

        WRITE (ndso,976) 'Not available.'

      ELSE IF ( trflag.EQ.1 .OR. trflag.EQ.3 .OR. trflag.EQ.5 ) THEN

        WRITE (ndso,976) 'In between grid points.'

      ELSE

        WRITE (ndso,976) 'At grid points.'

      END IF

      !

      IF ( trflag .NE. 0 ) THEN

        !

        ! 7.g.1 Info from input file

        !

        IF (flgnml) THEN

          ndstr = nml_obst%IDF

          vsc = nml_obst%SF

          idla = nml_obst%IDLA

          idft = nml_obst%IDFM

          rform = trim(nml_obst%FORMAT)

          from = trim(nml_obst%FROM)

          tname = trim(nml_obst%FILENAME)

        ELSE

          CALL nextln ( comstr , ndsi , ndse )

          READ (ndsi,*,END=2001,ERR=2002) NDSTR, VSC, IDLA, IDFT, RFORM, &

               from, tname

        END IF

        !

        IF (   abs(vsc) .LT. 1.e-7  ) vsc    = 1.

        IF (idla.LT.1 .OR. idla.GT.4) idla   = 1

        IF (idft.LT.1 .OR. idft.GT.3) idft   = 1

        !

        WRITE (ndso,977) ndstr, vsc, idla, idft

        IF (idft.EQ.2) WRITE (ndso,973) rform

        IF (from.EQ.'NAME' .AND. ndsg.NE.ndstr) WRITE (ndso,974) tname

        !

        ! 7.g.2 Open file and check if necessary

        !

        IF ( ndstr .EQ. ndsi ) THEN

          IF ( idft .EQ. 3 ) THEN

            WRITE (ndse,1004) ndstr

            CALL extcde (23)

          ELSE

            CALL nextln ( comstr , ndsi , ndse )

          END IF

        ELSE IF ( ndstr .EQ. ndsg ) THEN

          IF ( ( idfm.EQ.3 .AND. idft.NE.3 ) .OR.                 &

               ( idfm.NE.3 .AND. idft.EQ.3 ) ) THEN

            WRITE (ndse,1005) idfm, idft

            CALL extcde (24)

          END IF

        ELSE

          IF ( idft .EQ. 3 ) THEN

            IF (from.EQ.'NAME') THEN

              OPEN (ndstr,file=trim(fnmpre)//tname,             &

                   form='UNFORMATTED', convert=file_endian,status='OLD',err=2000, &

                   iostat=ierr)

            ELSE

              OPEN (ndstr,           form='UNFORMATTED', convert=file_endian,      &

                   status='OLD',err=2000,iostat=ierr)

            END IF

          ELSE

            IF (from.EQ.'NAME') THEN

              OPEN (ndstr,file=trim(fnmpre)//tname,             &

                   status='OLD',err=2000,iostat=ierr)

            ELSE

              OPEN (ndstr,                                    &

                   status='OLD',err=2000,iostat=ierr)

            END IF

          END IF

        END IF

        !

        ! 7.g.3 Read the data

        !

        CALL ina2r ( obsx, nx, ny, 1, nx, 1, ny, ndstr, ndst, ndse, &

             idft, rform, idla, vsc, 0.0)

        !

        IF ( ndstr .EQ. ndsi ) CALL nextln ( comstr , ndsi , ndse )

        !

        CALL ina2r ( obsy, nx, ny, 1, nx, 1, ny, ndstr, ndst, ndse, &

             idft, rform, idla, vsc, 0.0)

        !

        ! 7.g.4 Limit

        !

        DO ix=1, nx

          DO iy=1, ny

            obsx(ix,iy) = max( 0. , min(1.,obsx(ix,iy)) )

            obsy(ix,iy) = max( 0. , min(1.,obsy(ix,iy)) )

          END DO

        END DO

        !

        WRITE (ndso,*)

        !

      END IF ! TRFLAG

      !

      !Li     End of IF( GTYPE .NE. SMCTYPE ) block

    END IF

    !

#ifdef W3_RTD

    ! 7.h Calculate rotation angles for configs with rotated pole

    polon = plon

    polat = plat

    flagunr = unrot

    ! Default values PLON=-180, PLAT=90, UNROT=.FALSE. for standard lat-lon


    ALLOCATE( angldin(nx,ny) )

    ! For standard lat-lon the rotation angles are zero

    IF ( polat == 90. ) THEN

      angldin = 0.

    ELSE

      ALLOCATE(stdlat(nx,ny), stdlon(nx,ny))


      !       Calculate rotation angles; (StdLon/Lat are returned, but not used)

      !       The regular grid X/YGRDIN are used as equatorial lon and lat

      CALL w3eqtoll( ygrdin, xgrdin, stdlat, stdlon, angldin, &

           polat, polon, nx*ny )


      !       Clean up

      DEALLOCATE( stdlat, stdlon )

    END IF

    !     Write out rotation information

    WRITE (ndso,4203)   polat, polon

    WRITE (ndso,4200)

    WRITE (ndso,4201)    (        ix,     ix=1,nx,nx/3)

    WRITE (ndso,4202)    1,(angldin(ix, 1), ix=1,nx,nx/3)

    WRITE (ndso,4202)   ny,(angldin(ix,ny), ix=1,nx,nx/3)

    IF ( flagunr ) WRITE (ndso,4204)

    WRITE (ndso,*) ' '


#endif

    !

#ifdef W3_SMC

    !! 7.i  Read SMC grid cell and face integer arrays.

    IF( gtype .EQ. smctype ) THEN


      !! Overwrite 2 parameters for SMC grid.  JGLi03Mar2021

      dtms   = dtims

      ctmax  = cflsm

      !

      IF (flgnml) THEN

        ndstr = nml_smc%MCELS%IDF

        idla = nml_smc%MCELS%IDLA

        idfm = nml_smc%MCELS%IDFM

        rform = trim(nml_smc%MCELS%FORMAT)

        tname = trim(nml_smc%MCELS%FILENAME)

      ELSE

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, tname

      END IF

      OPEN (ndstr,file=trim(fnmpre)//tname,             &

           form='FORMATTED',status='OLD',err=2000)

      ALLOCATE (  nlvcelsk( 0:nrlv ) )

      READ (ndstr,*) nlvcelsk

      ncel=nlvcelsk(0)

      nglo=ncel

      WRITE (ndso,4004)  ncel, nlvcelsk


      ALLOCATE (   ijkcelin( 5, ncel))

      CALL ina2i ( ijkcelin, 5, ncel, 1, 5, 1, ncel, ndstr, ndst, ndse, &

           idfm, rform, idla, 1, 0)

      CLOSE(ndstr)

      !!Li     Offset to change Equator index = 0 to regular grid index JEQT

      ijkcelin( 2, :) = ijkcelin( 2, :) + jeqt

      !!Li     Offset to change i-index = 0 to regular grid index ISHFT

      ijkcelin( 1, :) = ijkcelin( 1, :) + ishft


      WRITE (ndso,4005) tname

      WRITE (ndso,4006)    1,(ijkcelin(ix,    1), ix=1,5)

      WRITE (ndso,4006) ncel,(ijkcelin(ix, ncel), ix=1,5)

      WRITE (ndso,*) ' '


      IF (flgnml) THEN

        ndstr = nml_smc%ISIDE%IDF

        idla = nml_smc%ISIDE%IDLA

        idfm = nml_smc%ISIDE%IDFM

        rform = trim(nml_smc%ISIDE%FORMAT)

        tname = trim(nml_smc%ISIDE%FILENAME)

      ELSE

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, tname

      END IF

      OPEN (ndstr,file=trim(fnmpre)//tname,             &

           form='FORMATTED',status='OLD',err=2000)

      ALLOCATE (  nlvufcsk( 0:nrlv ) )

      READ (ndstr,*)  nlvufcsk

      nufc = nlvufcsk(0)

      ngui = nufc

      WRITE (ndso,4007)   nufc, nlvufcsk


      ALLOCATE (   ijkufcin( 7, nufc) )

      CALL ina2i ( ijkufcin, 7, nufc, 1, 7, 1, nufc, ndstr, ndst, ndse, &

           idfm, rform, idla, 1, 0)

      CLOSE(ndstr)

      !!Li     Offset to change Equator index = 0 to regular grid index

      ijkufcin( 2, :) = ijkufcin( 2, :) + jeqt

      ijkufcin( 1, :) = ijkufcin( 1, :) + ishft


      WRITE (ndso,4008) tname

      WRITE (ndso,4009)    1,(ijkufcin(ix,    1), ix=1,7)

      WRITE (ndso,4009) nufc,(ijkufcin(ix, nufc), ix=1,7)

      WRITE (ndso,*) ' '


      IF (flgnml) THEN

        ndstr = nml_smc%JSIDE%IDF

        idla = nml_smc%JSIDE%IDLA

        idfm = nml_smc%JSIDE%IDFM

        rform = trim(nml_smc%JSIDE%FORMAT)

        tname = trim(nml_smc%JSIDE%FILENAME)

      ELSE

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, tname

      END IF

      OPEN (ndstr,file=trim(fnmpre)//tname,             &

           form='FORMATTED',status='OLD',err=2000)

      ALLOCATE (  nlvvfcsk( 0:nrlv ) )

      READ (ndstr,*) nlvvfcsk

      nvfc= nlvvfcsk(0)

      ngvj= nvfc

      WRITE (ndso,4010)   nvfc, nlvvfcsk


      ALLOCATE (   ijkvfcin( 8, nvfc) )

      CALL ina2i ( ijkvfcin, 8, nvfc, 1, 8, 1, nvfc, ndstr, ndst, ndse, &

           idfm, rform, idla, 1, 0)

      CLOSE(ndstr)

      !!Li     Offset to change Equator index = 0 to regular grid index

      ijkvfcin( 2, :) = ijkvfcin( 2, :) + jeqt

      ijkvfcin( 1, :) = ijkvfcin( 1, :) + ishft


      WRITE (ndso,4011) tname

      WRITE (ndso,4012)    1,(ijkvfcin(ix,    1), ix=1,8)

      WRITE (ndso,4012) nvfc,(ijkvfcin(ix, nvfc), ix=1,8)

      WRITE (ndso,*) ' '


      !!Li  Subgrid obstruction for each SMCels.  JGLi15Oct2014

      IF (flgnml) THEN

        ndstr = nml_smc%SUBTR%IDF

        idla = nml_smc%SUBTR%IDLA

        idfm = nml_smc%SUBTR%IDFM

        rform = trim(nml_smc%SUBTR%FORMAT)

        tname = trim(nml_smc%SUBTR%FILENAME)

      ELSE

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, tname

      END IF

      OPEN (ndstr,file=trim(fnmpre)//tname,             &

           form='FORMATTED',status='OLD',err=2000)

      READ (ndstr,*) ncobst, jobs

      WRITE (ndso,4110)   ncobst, jobs


      ALLOCATE (   ijkobstr( jobs, ncobst) )

      CALL ina2i ( ijkobstr, jobs, ncobst, 1, jobs, 1, ncobst, ndstr, ndst,  &

           ndse, idfm, rform, idla, 1, 0)

      CLOSE(ndstr)


      WRITE (ndso,4111) tname

      WRITE (ndso,4012)      1, (ijkobstr(ix,      1), ix=1,jobs)

      WRITE (ndso,4012) ncobst, (ijkobstr(ix, ncobst), ix=1,jobs)

      WRITE (ndso,*) ' '


      !!Li     Bounary cell sequential numbers are read only if NBISMC>0

      IF( nbismc .GT. 0 ) THEN

        IF (flgnml) THEN

          ndstr = nml_smc%BUNDY%IDF

          idla = nml_smc%BUNDY%IDLA

          idfm = nml_smc%BUNDY%IDFM

          rform = trim(nml_smc%BUNDY%FORMAT)

          tname = trim(nml_smc%BUNDY%FILENAME)

        ELSE

          CALL nextln ( comstr , ndsi , ndse )

          READ (ndsi,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, tname

        END IF

        OPEN (ndstr,file=trim(fnmpre)//tname,             &

             form='FORMATTED',status='OLD',err=2000)

        ALLOCATE (  nbicelin( nbismc )  )

        CALL ina2i ( nbicelin, 1, nbismc, 1, 1, 1, nbismc, ndstr, ndst, &

             ndse, idfm, rform, idla, 1, 0)

        CLOSE(ndstr)


        WRITE (ndso,4013) tname

        WRITE (ndso,4014)      1, nbicelin(     1)

        WRITE (ndso,4014) nbismc, nbicelin(nbismc)

        WRITE (ndso,*) ' '

      ENDIF

      !

      !! 7.j  Read Arctic grid cell and boundary cell integer arrays.

      IF( arctc ) THEN


        IF (flgnml) THEN

          ndstr = nml_smc%MBARC%IDF

          idla = nml_smc%MBARC%IDLA

          idfm = nml_smc%MBARC%IDFM

          rform = trim(nml_smc%MBARC%FORMAT)

          tname = trim(nml_smc%MBARC%FILENAME)

        ELSE

          CALL nextln ( comstr , ndsi , ndse )

          READ (ndsi,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, tname

        END IF

        OPEN (ndstr,file=trim(fnmpre)//tname,             &

             form='FORMATTED',status='OLD',err=2000)

        READ (ndstr,*) narc, nbgl, nbac

        WRITE (ndso,4015)  narc, nbgl, nbac


        ALLOCATE (   ijkcelac( 5, narc) )

        CALL ina2i ( ijkcelac, 5, narc, 1, 5, 1, narc, ndstr, ndst, ndse, &

             idfm, rform, idla, 1, 0)

        CLOSE(ndstr)

        !!Li     Offset to change Equator index = 0 to regular grid index JEQT

        ijkcelac( 2, :) = ijkcelac( 2, :) + jeqt

        ijkcelac( 1, :) = ijkcelac( 1, :) + ishft


        WRITE (ndso,4016) tname

        WRITE (ndso,4006)    1,(ijkcelac(ix,    1), ix=1,5)

        WRITE (ndso,4006) narc,(ijkcelac(ix, narc), ix=1,5)

        WRITE (ndso,*) ' '


        IF (flgnml) THEN

          ndstr = nml_smc%AISID%IDF

          idla = nml_smc%AISID%IDLA

          idfm = nml_smc%AISID%IDFM

          rform = trim(nml_smc%AISID%FORMAT)

          tname = trim(nml_smc%AISID%FILENAME)

        ELSE

          CALL nextln ( comstr , ndsi , ndse )

          READ (ndsi,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, tname

        END IF

        OPEN (ndstr,file=trim(fnmpre)//tname,             &

             form='FORMATTED',status='OLD',err=2000)

        READ (ndstr,*)  naui

        WRITE (ndso,4017)   naui


        ALLOCATE (   ijkufcac( 7, naui) )

        CALL ina2i ( ijkufcac, 7, naui, 1, 7, 1, naui, ndstr, ndst, ndse, &

             idfm, rform, idla, 1, 0)

        CLOSE(ndstr)

        !!Li     Offset to change Equator index = 0 to regular grid index

        ijkufcac( 2, :) = ijkufcac( 2, :) + jeqt

        ijkufcac( 1, :) = ijkufcac( 1, :) + ishft

        !!Li     Offset Arctic cell sequential numbers by global cell number NGLO

        DO  ip=1, naui

          DO  ix=4,7

            IF( ijkufcac(ix,ip) > 0 ) ijkufcac(ix,ip) = ijkufcac(ix,ip) + nglo

          ENDDO

        ENDDO


        WRITE (ndso,4018) tname

        WRITE (ndso,4009)    1,(ijkufcac(ix,    1), ix=1,7)

        WRITE (ndso,4009) naui,(ijkufcac(ix, naui), ix=1,7)

        WRITE (ndso,*) ' '


        IF (flgnml) THEN

          ndstr = nml_smc%AJSID%IDF

          idla = nml_smc%AJSID%IDLA

          idfm = nml_smc%AJSID%IDFM

          rform = trim(nml_smc%AJSID%FORMAT)

          tname = trim(nml_smc%AJSID%FILENAME)

        ELSE

          CALL nextln ( comstr , ndsi , ndse )

          READ (ndsi,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, tname

        END IF

        OPEN (ndstr,file=trim(fnmpre)//tname,             &

             form='FORMATTED',status='OLD',err=2000)

        READ (ndstr,*) navj

        WRITE (ndso,4019)   navj


        ALLOCATE (   ijkvfcac( 8, navj) )

        CALL ina2i ( ijkvfcac, 8, navj, 1, 8, 1, navj, ndstr, ndst, ndse, &

             idfm, rform, idla, 1, 0)

        CLOSE(ndstr)

        !!Li     Offset to change Equator index = 0 to regular grid index

        ijkvfcac( 2, :) = ijkvfcac( 2, :) + jeqt

        ijkvfcac( 1, :) = ijkvfcac( 1, :) + ishft

        !!Li     Offset Arctic cell sequential numbers by global cell number NGLO

        DO  ip=1, navj

          DO  iy=4,7

            IF( ijkvfcac(iy,ip) > 0 ) ijkvfcac(iy,ip) = ijkvfcac(iy,ip) + nglo

          ENDDO

        ENDDO


        WRITE (ndso,4020) tname

        WRITE (ndso,4012)    1,(ijkvfcac(ix,    1), ix=1,8)

        WRITE (ndso,4012) navj,(ijkvfcac(ix, navj), ix=1,8)

        WRITE (ndso,*) ' '


        !!Li  Reset total cell and face numbers

        ncel = nglo + narc

        nufc = ngui + naui

        nvfc = ngvj + navj

        !!Li  Also append Arctic part into base level sub-loops

        nlvcelsk(nrlv)=nlvcelsk(nrlv)+narc

        nlvufcsk(nrlv)=nlvufcsk(nrlv)+naui

        nlvvfcsk(nrlv)=nlvvfcsk(nrlv)+navj

        !!Li  Reset NBAC to total number of boundary cells.

        nbac = nbgl + nbac


      ENDIF  !! ARCTC section.


    ENDIF  !! GTYPE .EQ. SMCTYPE

#endif

    !

    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    ! 8.  Finalize status maps

    ! 8.a Defines open boundary conditions for UNST grids

    !

    j = len_trim(ugobcfile)

    IF (gtype.EQ.ungtype.AND.ugobcfile(:j).NE.'unset')  &

         CALL readmshobc(ndsg,ugobcfile,tmpsta,ugobcok)

    IF ((gtype.EQ.ungtype).AND.ugobcauto.AND.(.NOT.ugobcok))  &

         CALL ug_getopenboundary(tmpsta,zbin,ugobcdepth)

    !

    ! 8.b Determine where to get the data

    !

    IF (flgnml) THEN

      ndstr = nml_mask%IDF

      idla = nml_mask%IDLA

      idft = nml_mask%IDFM

      rform = trim(nml_mask%FORMAT)

      from = trim(nml_mask%FROM)

      tname = trim(nml_mask%FILENAME)

      IF (tname.EQ.'unset' .OR. tname.EQ.'UNSET') from='PART'

    ELSE

      CALL nextln ( comstr , ndsi , ndse )

      READ (ndsi,*,END=2001,ERR=2002) NDSTR, IDLA, IDFT, RFORM,     &

           from, tname

    END IF

    !

    ! ... Data to be read in parts

    !

    IF ( from .EQ. 'PART' ) THEN

      !

      ! 8.b Update TMPSTA with input boundary data (ILOOP=1)

      !                        and excluded points (ILOOP=2)

      !

      IF ( iclose .EQ. iclose_trpl ) THEN

        WRITE(ndse,*)'PROGRAM W3GRID STATUS MAP CALCULATION IS '//   &

             'NOT TESTED FOR TRIPOLE GRIDS FOR CASE WHERE USER OPTS '//   &

             'TO READ DATA IN PARTS. STOPPING NOW (107).'

        CALL extcde ( 107 )

      END IF

      DO iloop=1, 2

        !

        i = 1

        IF ( iloop .EQ. 1 ) THEN

          WRITE (ndso,979) 'boundary points'

          nstat  = 2

        ELSE

          WRITE (ndso,979) 'excluded points'

          nstat  = -1

        END IF

        first  = .true.

        !

        DO

          IF (flgnml) THEN

            ! inbound points

            IF (iloop.EQ.1) THEN

              IF (nml_inbnd_count%N_POINT.GT.0 .AND. i.LE.nml_inbnd_count%N_POINT) THEN

                ix = nml_inbnd_point(i)%X_INDEX

                iy = nml_inbnd_point(i)%Y_INDEX

                connct = nml_inbnd_point(i)%CONNECT

                i=i+1

              ELSE

                EXIT

              END IF

              ! excluded points

            ELSE IF (iloop.EQ.2) THEN

              IF (nml_excl_count%N_POINT.GT.0 .AND. i.LE.nml_excl_count%N_POINT) THEN

                ix = nml_excl_point(i)%X_INDEX

                iy = nml_excl_point(i)%Y_INDEX

                connct = nml_excl_point(i)%CONNECT

                i=i+1

              ELSE

                EXIT

              END IF

            END IF

          ELSE

            CALL nextln ( comstr , ndsi , ndse )

            READ (ndsi,*,END=2001,ERR=2002) IX, IY, connct

          END IF

          !

          ! ... Check if last point reached.

          !

          IF (ix.EQ.0 .AND. iy.EQ.0) EXIT

          !

          ! ... Check if point in grid.

          !

          IF (gtype.EQ.ungtype.AND.(ugobcauto.OR.ugobcok)) cycle

          IF (ix.LT.1 .OR. ix.GT.nx .OR.  iy.LT.1 .OR. iy.GT.ny) THEN

            WRITE (ndso,981)

            WRITE (ndso,*) '       ', ix, iy

            cycle

          END IF

          !

          ! ... Check if intermediate points are to be added.

          !

          IF ( connct .AND. .NOT.first ) THEN

            idx    = ix - ixo

            idy    = iy - iyo

            IF ( idx.EQ.0 .OR. idy.EQ.0 .OR.                      &

                 abs(idx).EQ.abs(idy) ) THEN

              nba    = max( max(abs(idx),abs(idy))-1 , 0 )

              IF (idx.NE.0) idx = sign(1,idx)

              IF (idy.NE.0) idy = sign(1,idy)

              ix     = ixo

              iy     = iyo

              DO iba=1, nba

                ix     = ix + idx

                iy     = iy + idy

                IF ( tmpsta(iy,ix).EQ.1 .OR. j.EQ.2 ) THEN

                  tmpsta(iy,ix) = nstat

                ELSE

                  WRITE(ndso,*) 'WARNING: POINT (',ix,',',iy,  &

                       ') CANNOT BE GIVEN THE STATUS ',nstat

                END IF

              END DO

              ix     = ix + idx

              iy     = iy + idy

            ELSE

              WRITE (ndso,982)

              WRITE (ndso,*) '       ', ix , iy

              WRITE (ndso,*) '       ', ixo, iyo

            END IF

          END IF

          !

          ! ... Check if point itself is to be added

          !

          IF ( tmpsta(iy,ix).EQ.1 .OR. j.EQ.2 ) THEN

            tmpsta(iy,ix) = nstat

          END IF

          !

          ! ... Save data of previous point

          !

          ixo    = ix

          iyo    = iy

          first  = .false.

          !

          ! ... Branch back to read.

          !

        END DO

        !

        ! 8.c Final processing excluded points

        !

        IF ( iloop .EQ. 2 ) THEN

          !

          i = 1

          DO

            IF (flgnml) THEN

              ! excluded bodies

              IF (nml_excl_count%N_BODY.GT.0 .AND. i.LE.nml_excl_count%N_BODY) THEN

                ix = nml_excl_body(i)%X_INDEX

                iy = nml_excl_body(i)%Y_INDEX

                i=i+1

              ELSE

                EXIT

              END IF

            ELSE

              CALL nextln ( comstr , ndsi , ndse )

              READ (ndsi,*,END=2001,ERR=2002) IX, iy

            END IF

            !

            ! ... Check if last point reached.

            !

            IF (ix.EQ.0 .AND. iy.EQ.0) EXIT

            !

            ! ... Check if point in grid.

            !

            IF (ix.LT.1 .OR. ix.GT.nx .OR. iy.LT.1 .OR. iy.GT.ny) THEN

              WRITE (ndso,981)

              WRITE (ndso,*) '       ', ix, iy

              cycle

            END IF

            !

            ! ... Check if point already excluded

            !

            IF ( tmpsta(iy,ix) .EQ. nstat ) THEN

              WRITE (ndso,1981)

              WRITE (ndso,*) '       ', ix, iy

              cycle

            END IF

            !

            ! ... Search for points to exclude

            !

            tmpmap = tmpsta

            j      = 1

            ix1    = ix

            iy1    = iy

            !

            jj     = tmpsta(iy,ix)

            tmpsta(iy,ix) = nstat

            DO

              nbt    = 0

              DO ix=max(1,ix1-j), min(ix1+j,nx)

                DO iy=max(1,iy1-j), min(iy1+j,ny)

                  IF ( tmpsta(iy,ix) .EQ. jj ) THEN

                    IF (ix.GT.1) THEN

                      IF (tmpsta(iy  ,ix-1).EQ.nstat           &

                           .AND. tmpmap(iy  ,ix-1).EQ.jj ) THEN

                        tmpsta(iy,ix) = nstat

                      END IF

                    END IF

                    IF (ix.LT.nx) THEN

                      IF (tmpsta(iy  ,ix+1).EQ.nstat           &

                           .AND. tmpmap(iy  ,ix+1).EQ.jj ) THEN

                        tmpsta(iy,ix) = nstat

                      END IF

                    END IF

                    IF (iy.LT.ny) THEN

                      IF (tmpsta(iy+1,ix  ).EQ.nstat           &

                           .AND. tmpmap(iy+1,ix  ).EQ.jj ) THEN

                        tmpsta(iy,ix) = nstat

                      END IF

                    END IF

                    IF (iy.GT.1) THEN

                      IF (tmpsta(iy-1,ix  ).EQ.nstat           &

                           .AND. tmpmap(iy-1,ix  ).EQ.jj ) THEN

                        tmpsta(iy,ix) = nstat

                      END IF

                    END IF

                    IF (tmpsta(iy,ix).EQ.nstat) nbt = nbt + 1

                  END IF

                END DO

              END DO

              !

              IF ( nbt .NE. 0 ) THEN

                j = j + 1

              ELSE

                EXIT

              END IF

            END DO

          END DO

          !

          ! ... Outer boundary excluded points

          !

          IF ( gtype.NE.ungtype ) THEN


            DO ix=1, nx

              IF ( tmpsta( 1,ix) .EQ. 1 ) tmpsta( 1,ix) = nstat

              IF ( tmpsta(ny,ix) .EQ. 1 ) tmpsta(ny,ix) = nstat

            END DO

            !

            IF ( iclose.EQ.iclose_none ) THEN

              DO iy=2, ny-1

                IF ( tmpsta(iy, 1) .EQ. 1 ) tmpsta(iy, 1) = nstat

                IF ( tmpsta(iy,nx) .EQ. 1 ) tmpsta(iy,nx) = nstat

              END DO

            END IF


          END IF ! GTYPE

          !

        END IF ! ILOOP .EQ. 2

        !

        ! ... Branch back input / excluded points ( ILOOP in 8.b )

        !

      END DO

      !

    ELSE ! FROM .EQ. PART

      !

      ! 8.d Read the map from file instead

      !

      nstat  = -1

      IF (idla.LT.1 .OR. idla.GT.4) idla   = 1

      IF (idft.LT.1 .OR. idft.GT.3) idft   = 1


      !!Li  Suspended for SMC grid though the file input line in  ww3_grid.inp

      !!Li  is kept to divert the program into this block.  JGLi15Oct2014

      !!Li

      IF( gtype .NE. smctype ) THEN

        !!Li

        !

        WRITE (ndso,978) ndstr, idla, idft

        IF (idft.EQ.2) WRITE (ndso,973) rform

        IF (from.EQ.'NAME') WRITE (ndso,974) tname

        !

        IF ( ndstr .EQ. ndsi ) THEN

          IF ( idft .EQ. 3 ) THEN

            WRITE (ndse,1004) ndstr

            CALL extcde (23)

          ELSE

            CALL nextln ( comstr , ndsi , ndse )

          END IF

        ELSE

          IF ( idft .EQ. 3 ) THEN

            IF (from.EQ.'NAME') THEN

              OPEN (ndstr,file=trim(fnmpre)//tname,             &

                   form='UNFORMATTED', convert=file_endian,status='OLD',err=2000, &

                   iostat=ierr)

            ELSE

              OPEN (ndstr,           form='UNFORMATTED', convert=file_endian,      &

                   status='OLD',err=2000,iostat=ierr)

            END IF

          ELSE

            IF (from.EQ.'NAME') THEN

              OPEN (ndstr,file=trim(fnmpre)//tname,             &

                   status='OLD',err=2000,iostat=ierr)

            ELSE

              OPEN (ndstr,                                    &

                   status='OLD',err=2000,iostat=ierr)

            END IF

          END IF

        END IF

        !

        ALLOCATE ( readmp(nx,ny) )

        CALL ina2i ( readmp, nx, ny, 1, nx, 1, ny, ndstr, ndst,    &

             ndse, idft, rform, idla, 1, 0 )

        !

        IF ( iclose.EQ.iclose_none ) THEN

          DO iy=2, ny-1

            IF ( readmp( 1,iy) .EQ. 1 ) readmp( 1,iy) = 3

            IF ( readmp(nx,iy) .EQ. 1 ) readmp(nx,iy) = 3

          END DO

        END IF

        !

        DO ix=1, nx

          IF ( readmp(ix, 1) .EQ. 1 ) readmp(ix, 1) = 3

          IF ( readmp(ix,ny) .EQ. 1 .AND. iclose .NE. iclose_trpl)   &

               readmp(ix,ny) = 3

        END DO

        !

        DO iy=1, ny

          DO ix=1, nx

            IF ( readmp(ix,iy) .EQ. 3 ) THEN

              tmpsta(iy,ix) = nstat

            ELSE

              tmpsta(iy,ix) = readmp(ix,iy)

              ! force to dry the sea points over zlim

              IF ( zbin(ix,iy) .GT. zlim ) tmpsta(iy,ix) = 0

            END IF

          END DO

        END DO

        DEALLOCATE ( readmp )

        !!Li

      ENDIF   !! GTYPE .NE. SMCTYPE

      !

    END IF !FROM .NE. 'PART'

    !

    ! 8.e Get NSEA and other counters

    !

    nsea   = 0

    nland  = 0

    nbi    = 0

    nbt    = 0

    !

    DO ix=1, nx

      DO iy=1, ny

        IF ( tmpsta(iy,ix) .GT. 0 ) nsea   = nsea + 1

        IF ( tmpsta(iy,ix) .EQ. 0 ) nland  = nland + 1

        IF ( tmpsta(iy,ix) .LT. 0 ) nbt    = nbt + 1

        IF ( tmpsta(iy,ix) .EQ. 2 ) nbi    = nbi + 1

      END DO

    END DO

    !

#ifdef W3_SMC

    IF( gtype .EQ. smctype ) THEN

      !Li   Moved before FLBPI is defined with NBI value.  JGLi05Jun2015

      !Li   Overwrite NSEA with NCel for SMC grid.

      nsea = ncel

      !Li   Use input NBI number for SMC grid because merged

      !Li   cells are over-counted by model.

      nbi = nbismc

      !Li   No land points are used in SMC grid.   JGLi26Feb2016

      nland = 0

    ENDIF  !!  GTYPE .EQ. SMCTYPE

#endif

    !

    WRITE (ndso,980)

    flbpi  = nbi .GT. 0

    IF ( .NOT. flbpi ) THEN

      WRITE (ndso,985)

    ELSE

      WRITE (ndso,986) nbi

#ifdef W3_O1

      IF ( flagll ) THEN

        WRITE (ndso, 987)

      ELSE

        WRITE (ndso,1987)

      END IF

      ibi    = 1

      DO iy=1, ny

        DO ix=1, nx

          IF (gtype.NE.ungtype) THEN

            x = factor * ( xgrdin(ix,iy) )

            y = factor * ( ygrdin(ix,iy) )

          ELSE

            x = factor * xgrd(1,ix)

            y = factor * ygrd(1,ix)

          END IF

          IF ( tmpsta(iy,ix).EQ.2 ) THEN

            IF ( flagll ) THEN

              WRITE (ndso, 988) ibi, ix, iy, x, y

            ELSE

              WRITE (ndso,1988) ibi, ix, iy, x, y

            END IF

            ibi    = ibi + 1

          END IF

        END DO

      END DO

#endif

    END IF

    !

    WRITE (ndso,1980)

    IF ( nbt .EQ. 0 ) THEN

      WRITE (ndso,1985)

    ELSE

      WRITE (ndso,1986) nbt

    END IF

    !

    ! 8.f Set up all maps

    !

    CALL w3dimx ( 1, nx, ny, nsea, ndse, ndst  &

#ifdef W3_SMC

         , ncel, nufc, nvfc, nrlv, nbsmc  &

         , narc, nbac, nspec              &

#endif

         )

#ifdef W3_SMC

    WRITE (ndso,4021)   ncel

#endif

    !

    ! 8.g Activation of reflections and scattering

    ffacberg=facberg

#ifdef W3_REF1

    refpars(1)=refcoast

    refpars(2)=refsubgrid

    refpars(3)=refunstsource

    refpars(4)=reficeberg

    refpars(6)=reffreq

    refpars(7)=refslope

    refpars(8)=refcosp_straight

    refpars(9)=refrmax

    refpars(10)=reffreqpow

    IF (gtype.EQ.ungtype) refpars(2:5)=0.

    IF (refmap.EQ.0) THEN

      reflc(3,:)=refpars(7)

    END IF

#endif


    IF (gtype.NE.ungtype) THEN

      DO iy=1, ny

        DO ix=1, nx

          xgrd(iy,ix) = xgrdin(ix,iy)

          ygrd(iy,ix) = ygrdin(ix,iy)

        END DO

      END DO

      DEALLOCATE ( xgrdin, ygrdin )

      CALL w3gntx ( 1, 6, 6 )

    ELSE

    END IF   ! GTYPE

    !

#ifdef W3_SMC

    !!Li  Shelter MAPSTA LLG definition for SMC

    IF( gtype .NE. smctype ) THEN

#endif

      !

      mapsta = tmpsta

      mapfs  = 0

      !

#ifdef W3_T

      ALLOCATE ( mapout(nx,ny) )

      mapout = 0

      !

      ix3    = 1 + nx/60

      iy3    = 1 + ny/60

      CALL prtblk (ndst, nx, ny, nx, zbin, mapout, 1, 0.,          &

           1, nx, ix3, 1, ny, iy3, 'Zb', 'm')

#endif

      !

      trnx   = 0.

      trny   = 0.

      !

      isea   = 0

      DO iy=1, ny

        DO ix=1, nx

          IF ( tmpsta(iy,ix) .EQ. nstat ) THEN

            mapsta(iy,ix) = 0

            mapst2(iy,ix) = 1

            tmpsta(iy,ix) = 3

          ELSE

            mapsta(iy,ix) = tmpsta(iy,ix)

            mapst2(iy,ix) = 0

          END IF

          IF ( mapsta(iy,ix) .NE. 0 ) THEN

            isea           = isea + 1

            mapfs(iy,ix)  = isea

            zb(isea)       = zbin(ix,iy)

#ifdef W3_T

            mapout(ix,iy)  = 1

#endif

            mapsf(isea,1)  = ix

            mapsf(isea,2)  = iy

            IF ( flagll ) THEN

              y              = ygrd(iy,ix)

              clats(isea)    = cos(y*dera)

              clatis(isea)   = 1. / clats(isea)

              cthg0s(isea)   = - tan(dera*y) / radius

            ELSE

              clats(isea)    = 1.

              clatis(isea)   = 1.

              cthg0s(isea)   = 0.

            END IF

          END IF


          !/ ------------------------------------------------------------------- /


          ! notes: Oct 22 2012: I moved the following "if-then" statement from

          ! inside the  "IF ( MAPSTA(IY,IX) .NE. 0 )" statement to outside that

          ! statement. This is needed since later on, ATRNX is computed from

          ! TRNX(ix-1) , TRNX(ix) etc. which causes boundary effects if the

          ! MAPSTA=0 values are set to TRNX=0


          IF ( trflag .NE. 0 ) THEN

            trnx(iy,ix) = 1. - obsx(ix,iy)

            trny(iy,ix) = 1. - obsy(ix,iy)

          END IF


        END DO

      END DO

      !

#ifdef W3_SMC

      !!Li SMC grid definition of mapping arrays.

    ELSE

      !!Li  Pass refined level cell and face counts to NLv*(NRLv)

      nlvcel(0)=0

      nlvufc(0)=0

      nlvvfc(0)=0

      DO ip = 1, nrlv

        nlvcel(ip)=nlvcelsk(ip) + nlvcel(ip-1)

        nlvufc(ip)=nlvufcsk(ip) + nlvufc(ip-1)

        nlvvfc(ip)=nlvvfcsk(ip) + nlvvfc(ip-1)

      ENDDO

      WRITE (ndso,4022)   nlvcel

      WRITE (ndso,4023)   nlvufc

      WRITE (ndso,4024)   nlvvfc


      !Li     Redefine MAPSF MAPFS MAPSTA MAPST2 CLATS and ZB for SMC Grid,

      !Li     using SMC grid cell array and assuming NSEA=NCel.

      mapsta = 0

      mapst2 = 1

      mapfs  = 0

      !LS    Allocation for read-in variables that remain local only.

      ALLOCATE ( ijkvfc8(nvfc) )

      ALLOCATE ( ijkdep(-9:ncel) )


      !Li     Pass input SMC arrays to newly declared grid arrays.

      WRITE (ndso,4025)   ncel

      ijkcel(1:4, 1:nglo)=ijkcelin(1:4, 1:nglo)

      ijkdep(1:nglo)=ijkcelin(5, 1:nglo)

      ijkufc(1:7, 1:ngui)=ijkufcin(1:7, 1:ngui)

      ijkvfc(1:7, 1:ngvj)=ijkvfcin(1:7, 1:ngvj)

      ijkvfc8(1:ngvj)=ijkvfcin(8, 1:ngvj)

      !Li     Append Arctic part

      IF( arctc ) THEN

        ijkcel(1:4, nglo+1:ncel)=ijkcelac(1:4, 1:narc)

        ijkdep(nglo+1:ncel)=ijkcelac(5, 1:narc)

        ijkufc(1:7, ngui+1:nufc)=ijkufcac(1:7, 1:naui)

        ijkvfc(1:7, ngvj+1:nvfc)=ijkvfcac(1:7, 1:navj)

        ijkvfc8(ngvj+1:nvfc)=ijkvfcac(8, 1:navj)

      ENDIF !! ARCTC


      WRITE (ndso,4026)

      WRITE (ndso,4006)    1,(ijkcel(ix,  1), ix=1,4), ijkdep(1)

      jj=ncel

      WRITE (ndso,4006)   jj,(ijkcel(ix, jj), ix=1,4), ijkdep(jj)

      WRITE (ndso,*) ' '

      WRITE (ndso,4027)

      WRITE (ndso,4009)    1,(ijkufc(ix,  1), ix=1,7)

      jj=nufc

      WRITE (ndso,4009)   jj,(ijkufc(ix, jj), ix=1,7)

      WRITE (ndso,*) ' '

      WRITE (ndso,4028)

      WRITE (ndso,4012)    1,(ijkvfc(ix,  1), ix=1,7), ijkvfc8(1)

      jj=nvfc

      WRITE (ndso,4012)   jj,(ijkvfc(ix, jj), ix=1,7), ijkvfc8(jj)

      WRITE (ndso,*) ' '


      !Li    Boundary -9 to 0 cells for cell x-size 2**n

      !Li    Note the position indice for bounary cell are not used.

      ijkcel(1, -9:0)=0

      !Li    Use Equator Y index for boundary cells.  JGLi04Apr2011

      !Li   IJKCel(2, -9:0)=0

      ijkcel(2, -9:0)=jeqt

      ijkcel(3,    0)=1

      ijkcel(4,    0)=1

      !Li    Use minimum 10 m depth for boundary cells.

      !Li    Y-size is restricted below base-cell value.

      !Li    For refined boundary cells, its y-size is replaced with

      !Li    the inner cell y-size for flux gradient.

      ijkdep(0)=10

      DO ip=1,9

        ijkcel(3,-ip)=ijkcel(3,-ip+1)*2

        ik=min(ip, nrlv-1)

        ijkcel(4,-ip)=2**ik

        ijkdep(-ip)=10

      ENDDO

      WRITE (ndso,4029)

      DO ip=0, -9, -1

        WRITE (ndso,4030)  ijkcel(:,ip), ijkdep(ip)

      ENDDO


      WRITE (ndso,4031)   ncel

      !Li    Multi-resolution SMC grid requires rounding of x, y indices

      !Li    by a factor MRFct.

      mrfct = 2**(nrlv - 1)

      WRITE (ndso,4032)   mrfct


      !Li   Cosine for SMC uses refined latitude increment.

      symr = sy*dera/float( mrfct )

      !Li   Reference y point for adjusted cell j=0 in radian.  JGLi16Feb2016

      yj0r = ( y0 - 0.5*sy )*dera


      DO isea=1, ncel

        !Li   There is no polar cell row so it is mapped to last row.

        IF( arctc .AND. (isea .EQ. ncel) ) THEN

          ix=1

          iy=ny

          ik=1

          js=1

        ELSE

          ix=ijkcel(1,isea)/mrfct + 1

          iy=ijkcel(2,isea)/mrfct + 1

          ik=max(1, ijkcel(3,isea)/mrfct)

          js=max(1, ijkcel(4,isea)/mrfct)

        ENDIF


        !      Check that IX, IY are in the bound of [1,NX] and [1,NY] respec.

        IF ((ix+ik-1 .GT. nx) .OR. (ix .LE. 0)) THEN

          WRITE (ndse,1014) isea, ix, ix+ik-1, nx

          CALL extcde(65)

        END IF


        IF ((iy+js-1 .GT. ny) .OR. (iy .LE. 0)) THEN

          WRITE (ndse,1015) isea, iy, iy+js-1, ny

          CALL extcde(65)

        END IF


        !Li Allow land cell to be defined by ZLIM value and only reset

        !Li MAPST* land values for sea points.   JGLi03Nov2023

        zb(isea) = dvsmc * float(ijkdep(isea))

        IF( zb(isea) .LT. zlim ) THEN

          mapsta(iy:iy+js-1,ix:ix+ik-1) = 1

          mapst2(iy:iy+js-1,ix:ix+ik-1) = 0

        ENDIF

        mapfs(iy:iy+js-1,ix:ix+ik-1) = isea

        mapsf(isea,1) = ix

        mapsf(isea,2) = iy

        mapsf(isea,3) = iy + (ix-1) * ny


        !Li   New variable CLATS to hold cosine latitude at cell centre.

        !Li   Also added CLATIS and CTHG0S for version 4.08.

        !Li   Use adjusted j-index to calculate cell centre y from YJ0R.

        y = yj0r + symr*( float(ijkcel(2,isea))+0.5*float(ijkcel(4,isea)) )

        !Li   Arctic polar cell does not need COS(LAT), set 1 row down.

        IF(y .GE. hpi-0.1*symr) y=hpi - symr*0.5*float( mrfct )


        clats(isea) = cos( y )

        clatis(isea)= 1. / clats(isea)

        cthg0s(isea)= - tan( y ) / radius

        !!Li  Sub-grid obstruction is set zero beyond NCObst cells.

        IF(isea .GT. ncobst) THEN

          trnmx=1.0

          trnmy=1.0

        ELSE

          !!Li    Present obstruction is isotropic and in percentage.

          trnmx=1.0 - ijkobstr(1,    isea)*0.01

          trnmy=1.0 - ijkobstr(jobs, isea)*0.01

        ENDIF

        ctrnx(isea) = max(0.11, trnmx)

        ctrny(isea) = max(0.11, trnmy)

      END DO

      !!Li    Transparency for boundary cells are 1.0   JGLi16Jan2012

      ctrnx(-9:0) = 1.0

      ctrny(-9:0) = 1.0

      !!Li  Check range of MAPSF and MAPFS

      WRITE (ndso,4033) minval( mapsf(:,1) ), maxval( mapsf(:,1) )

      WRITE (ndso,4034) minval( mapsf(:,2) ), maxval( mapsf(:,2) )

      WRITE (ndso,4035) minval( mapsf(:,3) ), maxval( mapsf(:,3) )

      WRITE (ndso,4036) minval( mapfs(:,:) ), maxval( mapfs(:,:) )


      !Li   New variable CLATF to hold cosine latitude at cell V face.

      DO ip = 1, nvfc

        !        CLATF(IP) = COS( SYMR*FLOAT(IJKVFc(2,IP) - JEQT) )

        !Li   Use adjusted j-index to calculate cell face Y from YJ0R.

        clatf(ip) = cos( symr*float(ijkvfc(2,ip)) + yj0r )

      ENDDO

      IF(nbismc .GT. 0) THEN

        !Li   Save input boundary SMC list to ISMCBP(NBSMC)

        ismcbp(1:nbismc) = nbicelin(1:nbismc)

        !Li   Reset MAPSTA for boundary cells if any.

        DO ip=1, nbismc

          isea = nbicelin(ip)

          ix=ijkcel(1,isea)/mrfct + 1

          iy=ijkcel(2,isea)/mrfct + 1

          ik=max(1, ijkcel(3,isea)/mrfct)

          js=max(1, ijkcel(4,isea)/mrfct)

          mapsta(iy:iy+js-1,ix:ix+ik-1)  = 2

          mapst2(iy:iy+js-1,ix:ix+ik-1)  = 0

        ENDDO

      ENDIF

      !Li   Define rotation angle for Arctic cells.

      IF( arctc ) THEN


        polonac = 179.999

        polatac =   0.001

        ALLOCATE( xlonac(narc),ylatac(narc),elonac(narc),elatac(narc) )

        DO isea=nglo+1, ncel

          !Li   There is no polar cell row so it is mapped to last row.

          IF(isea .EQ. ncel) THEN

            ix=1

            iy=ny

            ik=1

            js=1

          ELSE

            ix=ijkcel(1,isea)/mrfct + 1

            iy=ijkcel(2,isea)/mrfct + 1

            ik=max(1, ijkcel(3,isea)/mrfct)

            js=max(1, ijkcel(4,isea)/mrfct)

          ENDIF

          xlonac(isea-nglo)= x0 + real(ix-1+ik/2)*sx

          ylatac(isea-nglo)= y0 + real(iy-1+js/2)*sy

        ENDDO


        CALL w3lltoeq ( ylatac, xlonac, elatac, elonac,   &

             &                 angarc, polatac, polonac, narc  )


        WRITE (ndso,4037)  narc

        WRITE (ndso,4038) (angarc(ix), ix=1,narc,narc/8)


        !Li   Mapping Arctic boundary cells with inner model cells

        DO ip=1, nbac

          ix=ijkcel(1,ip+nglo)

          iy=ijkcel(2,ip+nglo)

          DO isea=1, nglo

            IF( (ix .EQ. ijkcel(1,isea)) .AND.      &

                 &          (iy .EQ. ijkcel(2,isea)) ) THEN

              iclbac(ip) = isea

            ENDIF

          ENDDO

        ENDDO

        WRITE (ndso,4039)  nbac

        WRITE (ndso,4040) (iclbac(ix), ix=1,nbac,nbac/8)


        !Li   Redefine GCT term factor for Arctic part or the netative of

        !Li   tangient of rotated latitude divided by radius. JGLi14Sep2015

        DO isea=nglo+1, ncel-1

          cthg0s(isea)= - tan( elatac(isea-nglo)*dera ) / radius

        ENDDO

        cthg0s(ncel)=0.0


      ENDIF  !! ARCTC section.

    ENDIF  !! (GTYPE .NE. SMCTYPE) ELSE SMCTYPE block.

#endif

    !

#ifdef W3_RTD

    !Li   Assign rotated grid angle for all sea points.  JGLi01Feb2016

    DO isea=1,nsea

      ix = mapsf(isea,1)

      iy = mapsf(isea,2)

      angld(isea) = angldin(ix,iy)

    END DO

#endif

    !

#ifdef W3_T

    CALL prtblk (ndst, nx, ny, nx, zbin, mapout, 0, 0.,          &

         1, nx, ix3, 1, ny, iy3, 'Sea points', 'm')

    DEALLOCATE ( mapout )

#endif

    !

    DO isp=1, nspec+nth

      mapwn(isp) = 1 + (isp-1)/nth

      mapth(isp) = 1 + mod(isp-1,nth)

    END DO

    !

#ifdef W3_O2

    nmap   = 1 + (nx-1)/ncol

    WRITE (ndso,1100) nmap

    DO imap=1, nmap

      ix0    = 1 + (imap-1)*ncol

      ixn    = min( nx , imap*ncol )

      DO iy=ny,1,-1

        WRITE (ndso,1101) (tmpsta(iy,ix),ix=ix0,ixn)

      END DO

      WRITE (ndso,*) ' '

    END DO

    WRITE (ndso,1102)

#endif


#ifdef W3_O2a

    OPEN (ndsm,file=trim(fnmpre)//'mask.ww3')

    DO iy=1, ny

      WRITE (ndsm,998) min(1,mapsta(iy,:))

    END DO

    CLOSE (ndsm)

#endif

    !

#ifdef W3_O2b

    IF ( trflag .GT. 0 ) THEN

      nmapb  = 1 + (nx-1)/ncol

      WRITE (ndso,1103) 'X', nmapb

      DO imapb=1, nmapb

        ix0    = 1 + (imapb-1)*ncol

        ixn    = min( nx , imapb*ncol )

        DO iy=ny,1,-1

          WRITE (ndso,1101) (nint(10.*obsx(ix,iy)),ix=ix0,ixn)

        END DO

        WRITE (ndso,*) ' '

      END DO

      WRITE (ndso,1104)

      WRITE (ndso,1103) 'Y', nmapb

      DO imapb=1, nmapb

        ix0    = 1 + (imapb-1)*ncol

        ixn    = min( nx , imapb*ncol )

        DO iy=ny,1,-1

          WRITE (ndso,1101) (nint(10.*obsy(ix,iy)),ix=ix0,ixn)

        END DO

        WRITE (ndso,*) ' '

      END DO

      WRITE (ndso,1104)

    END IF

#endif

    !

#ifdef W3_O2c

    OPEN (ndsm,file=trim(fnmpre)//'mapsta.ww3', recl=2*nx*ny*50+1)

    DO iy=ny,1, -1

      DO ix=1,nx

        DO i=1,50

          WRITE (ndsm,1998,advance='NO') (tmpsta(iy,ix))

        END DO

      END DO

    END DO

    CLOSE (ndsm)

#endif

    !


#ifdef W3_IG1

    igpars(1)=igmethod

    igpars(2)=igaddoutp

    igpars(3)=igsource

    igpars(4)=0

    IF (igbcoverwrite) igpars(4)=igpars(4)+1

    IF (igswellmax) igpars(4)=igpars(4)+2

    igpars(5)=1

    DO ik=1,nk

      IF (sig(ik)*tpiinv.LT.igmaxfreq) igpars(5)=ik

    END DO

    igmindep=minval(zb*(-1.)-2)  ! -2 / +2 is there for water level changes

    igmaxdep=maxval(zb*(-1.)+2)

    IF (igsourceatbp.EQ.1)  igmindep=1.   ! should use true minimum depth ...

    igpars(6)=1+nint(log(max(igmaxdep,1.0)/max(igmindep,1.0))/log(1.1))

    igpars(7)=max(igmindep,1.0)

    igpars(8)=igsourceatbp

    igpars(9)=igkdmin

    igpars(10)=igfixeddepth

    igpars(11)=igempirical**2

    igpars(12)=igsterms

#endif

    !

#ifdef W3_IC2

    ic2pars(:)=0.

    IF (ic2disper) ic2pars(1)=1.

    ic2pars(2)=ic2turb

    ic2pars(3)=ic2rough

    ic2pars(4)=ic2reynolds

    ic2pars(5)=ic2smooth

    ic2pars(6)=ic2visc

    ic2pars(7)=ic2turbs

    ic2pars(8)=ic2dmax

#endif

    !

#ifdef W3_IC3

    ic3pars(:)=0.

    ic3pars(1)=ic3maxthk

    ic3pars(2)=ic2turb

    ic3pars(3)=ic2rough

    ic3pars(4)=ic2reynolds

    ic3pars(5)=ic2smooth

    ic3pars(6)=ic2visc

    ic3pars(7)=ic2turbs

    ic3pars(8)=ic3maxcnc

    IF (ic3cheng) ic3pars(9)=1.0

    ic3pars(10)=ic3hilim

    ic3pars(11)=ic3kilim

    IF (usecgice) ic3pars(12)=1.0

    ic3pars(13)=ic3hice

    ic3pars(14)=ic3visc

    ic3pars(15)=ic3dens

    ic3pars(16)=ic3elas

#endif

    !

#ifdef W3_IC4

    ic4pars(1)=ic4method

    ic4_ki=ic4ki

    ic4_fc=ic4fc

    ic4_cn=ic4cn

    ic4_fmin=ic4fmin

    ic4_kibk=ic4kibk

#endif

    !

#ifdef W3_IC5

    ic5pars(:)=0.

    ic5pars(1)=ic5minig

    ic5pars(2)=ic5minwt

    ic5pars(3)=ic5maxkratio

    ic5pars(4)=ic5maxki

    ic5pars(5)=ic5minhw

    ic5pars(6)=ic5maxiter

    ic5pars(7)=ic5rkick

    ic5pars(8)=ic5kfilter

    ic5pars(9)=ic5vemod

#endif

    !

#ifdef W3_IS2

    is2pars(1) = isc1

    is2pars(2) = is2backscat

    is2pars(3)=0.

    IF (is2break) is2pars(3)=1.

    is2pars(4)=is2c2

    is2pars(5)=is2c3

    is2pars(6)=0.

    IF (is2disp) is2pars(6)=1.

    is2pars(7)=is2damp

    is2pars(8)=is2fragility

    is2pars(9)=is2dmin

    is2pars(10)=0.

    IF (is2dupdate) is2pars(10)=1.

    is2pars(11)=is2conc

    is2pars(12)=abs(is2creepb)

    is2pars(13)=is2creepc

    is2pars(14)=is2creepd

    is2pars(15)=is2creepn

    is2pars(16)=is2breake

    is2pars(17)=is2breakf

    is2pars(18)=is2wim1

    is2pars(19)=is2flexstr

    is2pars(20)=0.

    IF (is2isoscat) is2pars(20)=1.

    is2pars(21)=is2andisd

    is2pars(22)=is2andisn

    is2pars(23)=0.

    IF (is2andisb) is2pars(23)=1.

    is2pars(24)=is2andise

#endif

    !

    ! 9.d Estimates shoreline direction for reflection

    !     and shoreline treatment in general for UNST grids.

    ! NB: this is updated with moving water levels in W3ULEV

    ! AR: this is not anymore needed and will be deleted ...

    !

    IF (gtype.EQ.ungtype) THEN

      CALL set_ug_iobp


#ifdef W3_REF1

    ELSE

      CALL w3setref

#endif

    END IF

#ifdef W3_REF1

    !

    !  9.a Reads shoreline slope  (whith REF1 switch only)

    !

    ALLOCATE ( refd(nx,ny), refd2(nx,ny), refs(nx,ny) )

    IF (refmap.EQ.0) THEN

      refs(:,:)=1.

    ELSE

      !

      !  9.b Info from input file

      !

      IF (flgnml) THEN

        ndstr = nml_slope%IDF

        vsc = nml_slope%SF

        idla = nml_slope%IDLA

        idft = nml_slope%IDFM

        rform = trim(nml_slope%FORMAT)

        from = trim(nml_slope%FROM)

        tname = trim(nml_slope%FILENAME)

      ELSE

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,*,END=2001,ERR=2002) NDSTR, VSC, IDLA, IDFT, RFORM, &

             from, tname

      END IF

      !

      IF (   abs(vsc) .LT. 1.e-7  ) vsc    = 1.

      IF (idla.LT.1 .OR. idla.GT.4) idla   = 1

      IF (idft.LT.1 .OR. idft.GT.3) idft   = 1

      !

      WRITE (ndso,1977) ndstr, vsc, idla, idft

      IF (idft.EQ.2) WRITE (ndso,973) rform

      IF (from.EQ.'NAME' .AND. ndsg.NE.ndstr) WRITE (ndso,974) tname

      !

      ! 9;c  Open file and check if necessary

      !

      IF ( ndstr .EQ. ndsi ) THEN

        IF ( idft .EQ. 3 ) THEN

          WRITE (ndse,1004) ndstr

          CALL extcde (23)

        ELSE

          CALL nextln ( comstr , ndsi , ndse )

        END IF

      ELSE IF ( ndstr .EQ. ndsg ) THEN

        IF ( ( idfm.EQ.3 .AND. idft.NE.3 ) .OR.                 &

             ( idfm.NE.3 .AND. idft.EQ.3 ) ) THEN

          WRITE (ndse,1005) idfm, idft

          CALL extcde (24)

        END IF

      ELSE

        IF ( idft .EQ. 3 ) THEN

          IF (from.EQ.'NAME') THEN

            OPEN (ndstr,file=trim(fnmpre)//tname,                 &

                 form='UNFORMATTED', convert=file_endian,status='OLD',err=2000, &

                 iostat=ierr)

          ELSE

            OPEN (ndstr,           form='UNFORMATTED', convert=file_endian,      &

                 status='OLD',err=2000,iostat=ierr)

          END IF

        ELSE

          IF (from.EQ.'NAME') THEN

            OPEN (ndstr,file=trim(fnmpre)//tname,             &

                 status='OLD',err=2000,iostat=ierr)

          ELSE

            OPEN (ndstr,                                    &

                 status='OLD',err=2000,iostat=ierr)

          END IF   !end  of (FROM.EQ.'NAME')

        END IF     !end of ( IDFT .EQ. 3 )

      END IF       !end of ( NDSTR .EQ. NDSG )

      !

      ! 9.d Read the data

      !

      !         CALL INA2R ( REFD, NX, NY, 1, NX, 1, NY, NDSTR, NDST, NDSE, &

      !                       IDFM, RFORM, IDLA, VSC, 0.0)

      !

      IF ( ndstr .EQ. ndsi ) CALL nextln ( comstr , ndsi , ndse )

      !

      !         CALL INA2R ( REFD2, NX, NY, 1, NX, 1, NY, NDSTR, NDST, NDSE, &

      !                       IDFM, RFORM, IDLA, VSC, 0.0)

      CALL ina2r ( refs, nx, ny, 1, nx, 1, ny, ndstr, ndst, ndse, &

           idfm, rform, idla, vsc, 0.0)

      DO isea=1,nsea

        ix = mapsf(isea,1)

        iy = mapsf(isea,2)

        reflc(3,isea) = refs(ix,iy)*refmap

      END DO

      nmapb  = 1 + (nx-1)/ncol

      WRITE (ndso,1105) nmapb

#endif

#if defined W3_T && defined W3_REF1

      WRITE(ndso,*) 'Maximum slope for reflection:',maxval(refs*refmap)

#endif

      !

#ifdef W3_REF1

      DO imapb=1, nmapb

        ix0    = 1 + (imapb-1)*ncol

        ixn    = min( nx , imapb*ncol )

#endif

#if defined W3_T && defined W3_REF1

        DO iy=ny,1,-1

          WRITE (ndso,1101) (nint(100.*refs(ix,iy)*refmap),ix=ix0,ixn)

        END DO

#endif

#ifdef W3_REF1

        WRITE (ndso,*) ' '

      END DO

      WRITE (ndso,1106)

      !

      WRITE (ndso,*)

      !

    END IF         !end of (REFMAP.EQ.0)

#endif

    !

    DEALLOCATE ( zbin, tmpsta, tmpmap )

#ifdef W3_RTD

    DEALLOCATE ( angldin )

#endif

    !

    ! 9.e Reads bottom information from file

    !

#ifdef W3_BT4

    ALLOCATE ( sed_d50file(nx,ny))

    IF ( sedmapd50 ) THEN


      !

      !  9.e.1 Info from input file

      !

      IF (flgnml) THEN

        ndstr = nml_sed%IDF

        vsc = nml_sed%SF

        idla = nml_sed%IDLA

        idft = nml_sed%IDFM

        rform = trim(nml_sed%FORMAT)

        from = trim(nml_sed%FROM)

        tname = trim(nml_sed%FILENAME)

      ELSE

        CALL nextln ( comstr , ndsi , ndse )

        READ (ndsi,*,END=2001,ERR=2002) NDSTR, VSC, IDLA, IDFT, RFORM, &

             from, tname

      END IF

      !

      IF (   abs(vsc) .LT. 1.e-7  ) THEN

        vsc    = 1.

      ELSE

        ! WARNING TO BE ADDED ...

      END IF

      IF (idla.LT.1 .OR. idla.GT.4) idla   = 1

      IF (idft.LT.1 .OR. idft.GT.3) idft   = 1

      !

      WRITE (ndso,1978) ndstr, vsc, idla, idft

      IF (idft.EQ.2) WRITE (ndso,973) rform

      IF (from.EQ.'NAME' .AND. ndsg.NE.ndstr) WRITE (ndso,974) tname

      !

      ! 9.e.2  Open file and check if necessary

      !

      IF ( ndstr .EQ. ndsi ) THEN

        IF ( idft .EQ. 3 ) THEN

          WRITE (ndse,1004) ndstr

          CALL extcde (23)

        ELSE

          CALL nextln ( comstr , ndsi , ndse )

        END IF

      ELSE IF ( ndstr .EQ. ndsg ) THEN

        IF ( ( idfm.EQ.3 .AND. idft.NE.3 ) .OR.                 &

             ( idfm.NE.3 .AND. idft.EQ.3 ) ) THEN

          WRITE (ndse,1005) idfm, idft

          CALL extcde (24)

        END IF

      ELSE

        IF ( idft .EQ. 3 ) THEN

          IF (from.EQ.'NAME') THEN

            OPEN (ndstr,file=trim(fnmpre)//tname,             &

                 form='UNFORMATTED', convert=file_endian,status='OLD',err=2000, &

                 iostat=ierr)

          ELSE

            OPEN (ndstr,           form='UNFORMATTED', convert=file_endian,      &

                 status='OLD',err=2000,iostat=ierr)

          END IF

        ELSE

          IF (from.EQ.'NAME') THEN

            OPEN (ndstr,file=trim(fnmpre)//tname,             &

                 status='OLD',err=2000,iostat=ierr)

          ELSE

            OPEN (ndstr,                                    &

                 status='OLD',err=2000,iostat=ierr)

          END IF

        END IF

      END IF

      !

      ! 9.e.3 Read the data

      !

      CALL ina2r ( sed_d50file, nx, ny, 1, nx, 1, ny, ndstr, ndst, ndse, &

           idfm, rform, idla, vsc, vof)

      !

      IF ( ndstr .EQ. ndsi ) CALL nextln ( comstr , ndsi , ndse )

      !

      WRITE (ndso,*) 'Min and Max values of grain sizes:',minval(sed_d50file), maxval(sed_d50file)

      WRITE (ndso,*)

      !

    ELSE

      sed_d50file(:,:)=sed_d50_uniform

    END IF

    !

    DO iy=1, ny

      DO ix=1, nx

        isea = mapfs(iy,ix)

        sed_d50(isea)       = sed_d50file(ix,iy)

        sed_d50(isea)       = max(sed_d50(isea),1e-5)

        ! Critical Shields number, Soulsby, R.L. and R J S W Whitehouse

        ! Threshold of sed. motion in coastal environments, Proc. Pacific Coasts and

        ! ports, 1997 conference, Christchurch, p149-154, University of Cantebury, NZ

        sed_dstar=(grav*(sed_sg-1)/nu_water**2)**(0.333333)*sed_d50(isea)

        sed_psic(isea)=0.3/(1+1.2*sed_dstar)+0.55*(1-exp(-0.02*sed_dstar))

#endif


#ifdef W3_BT4

      END DO

    END DO

#endif

    !

    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    ! 10.  Prepare output boundary points.

    !     ILOOP = 1 to count NFBPO and NBO

    !     ILOOP = 2 to fill data arrays

    !

    WRITE (ndso,990)

    IF ( .NOT. flgnml ) &

         OPEN (ndss,file=trim(fnmpre)//'ww3_grid.scratch',form='FORMATTED')

    !

    DO iloop = 1, 2

      !

      IF ( iloop.EQ.2 ) CALL w3dmo5 ( 1, ndst, ndse, 2 )

      !

      i = 1

      nbotot = 0

      nfbpo  = 0

      nbo(0) = 0

      nbo2(0)= 0

      first  = .true.

      IF ( .NOT. flgnml ) THEN

        rewind(ndss)

        IF ( iloop .EQ. 1 ) THEN

          ndsi2 = ndsi

        ELSE

          ndsi2 = ndss

        END IF

      END IF

      !

      DO

        IF (flgnml) THEN

          ! outbound lines

          IF (nml_outbnd_count%N_LINE.GT.0 .AND. i.LE.nml_outbnd_count%N_LINE) THEN

            xo0 = nml_outbnd_line(i)%X0

            yo0 = nml_outbnd_line(i)%Y0

            dxo = nml_outbnd_line(i)%DX

            dyo = nml_outbnd_line(i)%DY

            npo = nml_outbnd_line(i)%NP

            i=i+1

          ELSE

            npo=0

          END IF

        ELSE

          CALL nextln ( comstr , ndsi2 , ndse )

          READ (ndsi2,*,END=2001,ERR=2002) XO0, YO0, DXO, DYO, npo

        END IF

        !

        IF ( .NOT. flgnml .AND. iloop .EQ. 1 ) THEN

          backspace(ndsi)

          READ (ndsi,'(A)') line

          WRITE (ndss,'(A)') line

        END IF

        !

        ! ... Check if new file to be used

        !

        first  = first .OR. npo.LE.0

        npo    = abs(npo)

        !

        ! ... Preparations for new output file including end check

        !     and output for last output file

        !

        IF ( first ) THEN

          !

          first  = .false.

          !

#ifdef W3_RTD

          IF ( npo.NE.0 ) THEN

            ! Destination pole lat, lon from namelist

            bpolat = bplat(nfbpo+1)

            bpolon = bplon(nfbpo+1)

          END IF

          !

#endif

          IF ( nfbpo.GE.1 .AND. iloop.EQ.2 ) THEN

            WRITE (ndso,991)  nfbpo, nbo(nfbpo) - nbo(nfbpo-1), &

                 nbo2(nfbpo) - nbo2(nfbpo-1)

#ifdef W3_RTD

            ! Print dest. Pole lat/lon if either the dest or present grid is rotated

            IF ( bplat(nfbpo) < 90. .OR. polat < 90. )      &

                 WRITE (ndso,1991) bplat(nfbpo), bplon(nfbpo)

            !

#endif

#ifdef W3_O1

            IF ( nbo(nfbpo) - nbo(nfbpo-1) .EQ. 1 ) THEN

              IF ( flagll ) THEN

                WRITE (ndso,992)

              ELSE

                WRITE (ndso,2992)

              END IF

            ELSE

              IF ( flagll ) THEN

                WRITE (ndso,1992)

              ELSE

                WRITE (ndso,3992)

              END IF

            END IF

            ip0    = nbo(nfbpo-1)+1

            ipn    = nbo(nfbpo)

            iph    = ip0 + (ipn-ip0-1)/2

            ipi    = iph -ip0 + 1 + mod(ipn-ip0+1,2)

            DO ip=ip0, iph

              IF ( flagll ) THEN

                WRITE (ndso,1993) ip-nbo(nfbpo-1),     &

                     factor*xbpo(ip),     &

                     factor*ybpo(ip),     &

                     ip+ipi-nbo(nfbpo-1), &

                     factor*xbpo(ip+ipi), &

                     factor*ybpo(ip+ipi)

              ELSE

                WRITE (ndso,3993) ip-nbo(nfbpo-1),     &

                     factor*xbpo(ip),     &

                     factor*ybpo(ip),     &

                     ip+ipi-nbo(nfbpo-1), &

                     factor*xbpo(ip+ipi), &

                     factor*ybpo(ip+ipi)

              END IF

            END DO

            IF ( mod(ipn-ip0+1,2) .EQ. 1 ) THEN

              IF ( flagll ) THEN

                WRITE (ndso, 993) iph+1-nbo(nfbpo-1), &

                     factor*xbpo(iph+1), &

                     factor*ybpo(iph+1)

              ELSE

                WRITE (ndso,2993) iph+1-nbo(nfbpo-1), &

                     factor*xbpo(iph+1), &

                     factor*ybpo(iph+1)

              END IF

            END IF

            WRITE (ndso,*)

#endif

          END IF

          !

          IF ( npo .EQ. 0 ) EXIT

          !

          nfbpo  = nfbpo + 1

          IF ( nfbpo .GT. 9 ) THEN

            WRITE (ndse,1006)

            CALL extcde ( 50 )

          END IF

          nbo2(nfbpo) = nbo2(nfbpo-1)

          nbo(nfbpo) = nbotot

          !

        END IF

        !

        ! ... Loop over line segment - - - - - - - - - - - - - - - - - - - - -

        !

#ifdef W3_RTD

        ! If either base or destination grid is rotated lat-lon

        IF ( allocated(bdylon) .eqv. .true. ) THEN

          deallocate( bdylon, bdylat )

          IF ( bpolat < 90. .OR. polat < 90. ) &

               deallocate( elatbdy, elonbdy, anglbdy )

        END IF

        allocate( bdylon(npo), bdylat(npo))

        IF ( bpolat < 90. .OR. polat < 90. ) &

             allocate( elatbdy(npo), elonbdy(npo), anglbdy(npo) )

        !

#endif

#ifdef W3_T

        WRITE (ndst,9090)

#endif

        !

        DO ip=1, npo

          !

          xo     = xo0 + real(ip-1)*dxo

          yo     = yo0 + real(ip-1)*dyo

#ifdef W3_RTD

          !

          ! Boundary points are specified in coordinates of the destination grid

          !

          ! Collect the line segment points into arrays

          bdylon(ip)     = xo

          bdylat(ip)     = yo

          ! Close the loop before calculating rotated lat-lon coordinates.

        END DO


        ! Create one or two sets of the segment points:

        ! 1. (BDYLAT, BDYLON) in standard lat-lon coordinates,

        ! 2. Also (ELatbdy, ELonbdy) in case the base grid is rotated


        IF ( bpolat < 90. ) THEN

          ! The destination grid is rotated (std->rot or rot->rot)

          ! Change BDYLAT, BDYLON to their standard lat-lon positions

          ! Let ELatbdy,ELonbdy contain the rotated lat-lon coordinates

          elatbdy(:) = bdylat(:)

          elonbdy(:) = bdylon(:)

          CALL w3eqtoll ( elatbdy, elonbdy, bdylat, bdylon,     &

               &                anglbdy, bpolat, bpolon, npo )

          ! Let the standard longitudes BDYLON be within the range [-180.,180.[

          ! or [0., 360.[ depending on the grid pole

          IF ( polon < -90. .OR. polon > 90. ) THEN

            bdylon(:) = mod( bdylon(:) + 180., 360. ) - 180.

          ELSE

            bdylon(:) = mod( bdylon(:) + 360., 360. )

          END IF

        END IF ! bPolat < 90.

        ! From now, BDYLAT, BDYLON are defined in standard lat-lon coordinates

        !

        IF ( polat < 90. ) THEN

          ! The base grid is rotated (rot->std or rot->rot)

          ! Find lat-lon in coordinates of the rotated base grid

          CALL w3lltoeq ( bdylat, bdylon, elatbdy, elonbdy,     &

               &                anglbdy, polat, polon, npo )

        END IF

        !

        ! Take up again the loop over the line segment points

        DO ip=1, npo

          IF ( polat < 90. ) THEN

            ! The base grid is rotated (rot->std, rot->rot)

            ! (The std. lat-lon values BDYLAT, BDYLON go to YBPO, XBPO)

            xo = elonbdy(ip)

            yo = elatbdy(ip)

          ELSE

            ! The base grid is standard geographic (std->rot or std->std)

            xo = bdylon(ip)

            yo = bdylat(ip)

          END IF

#endif

          !

          ! ... Compute bilinear remapping weights

          !

          ingrid = w3grmp( gsu, xo, yo, ixr, iyr, rd )

          !

          !           Change cell-corners from counter-clockwise to column-major order

          ix     = ixr(3);  iy     = iyr(3);  x     = rd(3);

          ixr(3) = ixr(4);  iyr(3) = iyr(4);  rd(3) = rd(4);

          ixr(4) = ix    ;  iyr(4) = iy    ;  rd(4) = x    ;

          !

#ifdef W3_T

          WRITE (ndst,9091) factor*xo, factor*yo,                   &

               (ixr(j), iyr(j), rd(j), j=1,4)

#endif

          !

          ! ... Check if point in grid

          !

          IF ( ingrid ) THEN

            !

            ! ... Check if point not on land

            !

            IF ( ( mapsta(iyr(1),ixr(1)).GT.0 .AND.                 &

                 rd(1).GT.0.05 ) .OR.          &

                 ( mapsta(iyr(2),ixr(2)).GT.0 .AND.                 &

                 rd(2).GT.0.05 ) .OR.          &

                 ( mapsta(iyr(3),ixr(3)).GT.0 .AND.                 &

                 rd(3).GT.0.05 ) .OR.          &

                 ( mapsta(iyr(4),ixr(4)).GT.0 .AND.                 &

                 rd(4).GT.0.05 ) ) THEN

              !

              ! ... Check storage and store coordinates

              !

              nbotot = nbotot + 1

              IF ( iloop .EQ. 1 ) cycle

              !

#ifdef W3_RTD

              ! BDYLAT, BDYLON contain Y0, X0, which are remapped to standard lat/lon.

              ! BDYLAT, BDYLON are stored in the mod_def file.

              IF ( polat < 90. ) THEN

                xo = bdylon(ip)

                yo = bdylat(ip)

              END IF

#endif

              xbpo(nbotot) = xo

              ybpo(nbotot) = yo

              !

              ! ... Interpolation factors

              !

              rdtot = 0.

              DO j=1, 4

                IF ( mapsta(iyr(j),ixr(j)).GT.0 .AND.               &

                     rd(j).GT.0.05 ) THEN

                  rdbpo(nbotot,j) = rd(j)

                ELSE

                  rdbpo(nbotot,j) = 0.

                END IF

                rdtot = rdtot + rdbpo(nbotot,j)

              END DO

              !

              DO j=1, 4

                rdbpo(nbotot,j) = rdbpo(nbotot,j) / rdtot

              END DO

              !

#ifdef W3_T

              WRITE (ndst,9092) rdtot, (rdbpo(nbotot,j),j=1,4)

#endif

              !

              ! ... Determine sea and interpolation point counters

              !

              DO j=1, 4

                iseai(j) = mapfs(iyr(j),ixr(j))

              END DO

              !

              DO j=1, 4

                IF ( iseai(j).EQ.0 .OR. rdbpo(nbotot,j).EQ. 0. ) THEN

                  ipbpo(nbotot,j) = 0

                ELSE

                  flnew   = .true.

                  DO ist=nbo2(nfbpo-1)+1, nbo2(nfbpo)

                    IF ( iseai(j) .EQ. isbpo(ist) ) THEN

                      flnew  = .false.

                      ipbpo(nbotot,j) = ist - nbo2(nfbpo-1)

                    END IF

                  END DO

                  IF ( flnew ) THEN

                    nbo2(nfbpo)        = nbo2(nfbpo) + 1

                    ipbpo(nbotot,j)    = nbo2(nfbpo) - nbo2(nfbpo-1)

                    isbpo(nbo2(nfbpo)) = iseai(j)

                  END IF

                END IF

              END DO

              !

#ifdef W3_T

              WRITE (ndst,9093) iseai, (ipbpo(nbotot,j),j=1,4)

#endif

              !

              ! ... Error output

              !

            ELSE

              IF ( flagll ) THEN

                WRITE (ndse,2995) factor*xo, factor*yo

              ELSE

                WRITE (ndse,995) factor*xo, factor*yo

              END IF

            END IF

          ELSE

            IF ( flagll ) THEN

              WRITE (ndse,2994) factor*xo, factor*yo

            ELSE

              WRITE (ndse,994) factor*xo, factor*yo

            END IF

          END IF

          !

        END DO

        !

        nbo(nfbpo) = nbotot

        !

        ! ... Branch back to read.

        !

      END DO

      !

      ! ... End of ILOOP loop

      !

    END DO

    !

    IF ( .NOT. flgnml ) CLOSE ( ndss, status='DELETE' )

    !

    flbpo  = nbotot .GT. 0

    IF ( .NOT. flbpo ) THEN

      WRITE (ndso,996)

    ELSE

      WRITE (ndso,997) nbotot, nbo2(nfbpo)

    END IF

    !

#ifdef W3_T0

    WRITE (ndst,9095)

    DO ifile=1, nfbpo

      DO ip=nbo2(ifile-1)+1, nbo2(ifile)

        WRITE (ndst,9096) ifile, ip-nbo2(ifile-1), isbpo(ip)

      END DO

    END DO

#endif

    !

    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    !10.  Write model definition file.

    !

    WRITE (ndso,999)

    CALL w3iogr ( 'WRITE', ndsm &

#ifdef W3_ASCII

                  ,ndsa=ndsma        &

#endif

            )

    !

    CLOSE (ndsm)

#ifdef W3_ASCII

    CLOSE (ndsma)

#endif

    !

    GOTO 2222

    !

    ! Escape locations read errors :

    !

2000 CONTINUE

    WRITE (ndse,1000) ierr

    CALL extcde ( 60 )

    !

2001 CONTINUE

    WRITE (ndse,1001)

    CALL extcde ( 61 )

    !

2002 CONTINUE

    WRITE (ndse,1002) ierr

    CALL extcde ( 62 )

    !

2003 CONTINUE

    WRITE (ndse,1003)

    CALL extcde ( 64 )

    !

2222 CONTINUE

    IF ( gtype .NE. ungtype) THEN

      IF ( nx*ny .NE. nsea ) THEN

        WRITE (ndso,9997) nx, ny, nx*ny, nsea,                       &

             100.*real(nsea)/real(nx*ny), nbi, nland, nbt

      ELSE

        WRITE (ndso,9998) nx, ny, nx*ny, nsea, nbi, nland, nbt

      END IF

    ELSE IF ( gtype .EQ. ungtype ) THEN

      IF ( nx*ny .NE. nsea ) THEN

        WRITE (ndso,9997)  0,  0, nx*ny, nsea,                       &

             100.*real(nsea)/real(nx*ny), nbi, nland, nbt

      ELSE

        WRITE (ndso,9998)  0,  0, nx*ny, nsea, nbi, nland, nbt

      END IF

    ENDIF ! GTYPE .EQ. UNGTYPE


    WRITE (ndso,9999)


#ifdef W3_SCRIP

    grid1_units='degrees' ! the other option is radians...we don't use this

    grid1_name='src' ! this is not used, except for netcdf output

    CALL get_scrip_info(1,                                            &

         &   grid1_center_lon, grid1_center_lat,                            &

         &   grid1_corner_lon, grid1_corner_lat, grid1_mask,                &

         &   grid1_dims, grid1_size, grid1_corners, grid1_rank)


#endif


#ifdef W3_SCRIP

    IF (gtype .EQ. ungtype) THEN

      grid1_rank=1

      DEALLOCATE(grid1_dims)

      ALLOCATE(grid1_dims(grid1_rank))

      grid1_dims(1) = grid1_size

    ENDIF

#endif


#ifdef W3_SCRIP

    DO i = 1,grid1_size

      IF (grid1_center_lon(i) < 0.0) THEN

        grid1_center_lon(i) = grid1_center_lon(i)+360.0

      ENDIF

      DO j = 1,grid1_corners

        IF (grid1_corner_lon(j,i) < 0.0) THEN

          grid1_corner_lon(j,i) = grid1_corner_lon(j,i)+360.0

        ENDIF

      ENDDO

    ENDDO

#endif


#ifdef W3_SCRIPNC

    ierr = nf90_create(trim('scrip.nc'), nf90_netcdf4, ncid)

    ierr = nf90_def_dim(ncid, 'grid_size', grid1_size, grid_size_dimid)

    ierr = nf90_def_dim(ncid, 'grid_corners', grid1_corners, grid_corners_dimid)

    ierr = nf90_def_dim(ncid, 'grid_rank', grid1_rank, grid_rank_dimid)

#endif


#ifdef W3_SCRIPNC

    ierr = nf90_def_var(ncid, 'grid_center_lat', nf90_double, &

         (/grid_size_dimid/),grid_center_lat_varid)

    ierr = nf90_def_var(ncid, 'grid_center_lon', nf90_double, &

         (/grid_size_dimid/),grid_center_lon_varid)

    ierr = nf90_def_var(ncid, 'grid_corner_lat', nf90_double, &

         (/grid_corners_dimid,grid_size_dimid/), &

         grid_corner_lat_varid)

    ierr = nf90_def_var(ncid, 'grid_corner_lon', nf90_double, &

         (/grid_corners_dimid,grid_size_dimid/), &

         grid_corner_lon_varid)

    ierr = nf90_def_var(ncid, 'grid_imask', nf90_int, &

         (/grid_size_dimid/),grid_imask_varid)

    ierr = nf90_def_var(ncid, 'grid_dims', nf90_int, &

         (/grid_rank_dimid/),grid_dims_varid)

    ierr = nf90_enddef(ncid)

#endif


#ifdef W3_SCRIP

    ALLOCATE(grid1_imask(grid1_dims(1)))

    grid1_imask = 0

    DO i = 1,grid1_dims(1)

      IF (grid1_mask(i)) THEN

        grid1_imask(i) = 1

      ENDIF

    ENDDO

#endif


#ifdef W3_SCRIPNC

    ierr = nf90_put_att(ncid,grid_center_lat_varid,'units',grid1_units)

    ierr = nf90_put_att(ncid,grid_center_lon_varid,'units',grid1_units)

    ierr = nf90_put_att(ncid,grid_corner_lat_varid,'units',grid1_units)

    ierr = nf90_put_att(ncid,grid_corner_lon_varid,'units',grid1_units)

    ierr = nf90_put_att(ncid,grid_imask_varid,'units','unitless')

#endif


#ifdef W3_SCRIPNC

    ierr = nf90_put_var(ncid,grid_center_lat_varid,grid1_center_lat)

    ierr = nf90_put_var(ncid,grid_center_lon_varid,grid1_center_lon)

    ierr = nf90_put_var(ncid,grid_corner_lat_varid,grid1_corner_lat)

    ierr = nf90_put_var(ncid,grid_corner_lon_varid,grid1_corner_lon)

    ierr = nf90_put_var(ncid,grid_imask_varid,grid1_imask)

    ierr = nf90_put_var(ncid,grid_dims_varid,grid1_dims)

    ierr = nf90_close(ncid)

#endif


    !

    ! Formats

    !

900 FORMAT (/15x,'    *** WAVEWATCH III Grid preprocessor ***    '/ &

         15x,'==============================================='/)

901 FORMAT ( '  Comment character is ''',a,''''/)

902 FORMAT ( '  Grid name : ',a/)

903 FORMAT (/'  Spectral discretization : '/                        &

         ' --------------------------------------------------'/ &

         '       Number of directions        :',i4/             &

         '       Directional increment (deg.):',f6.1)

904 FORMAT ( '       First direction       (deg.):',f6.1)

905 FORMAT ( '       Number of frequencies       :',i4/             &

         '       Frequency range        (Hz) :',f9.4,'-',f6.4/  &

         '       Increment factor            :',f8.3/)

    !

910 FORMAT (/'  Model definition :'/                                &

         ' --------------------------------------------------')

911 FORMAT ( '       Dry run (no calculations)   :  ',a/            &

         '       Propagation in X-direction  :  ',a/            &

         '       Propagation in Y-direction  :  ',a/            &

         '       Refraction                  :  ',a/            &

         '       Current-induced k-shift     :  ',a/            &

         '       Source term calc. and int.  :  ',a/)

912 FORMAT (/'  Time steps : '/                                     &

         ' --------------------------------------------------'/ &

         '       Maximum global time step      (s) :',f8.2/     &

         '       Maximum CFL time step X-Y     (s) :',f8.2/     &

         '       Maximum CFL time step k-theta (s) :',f8.2/     &

         '       Minimum source term time step (s) :',f8.2/)

913 FORMAT (/ '  WARNING, TIME STEP LESS THAN 1 s, NITER:',i8 /)

915 FORMAT ( '  Preprocessing namelists ...')

916 FORMAT ( '  Preprocessing namelists finished.'/)

917 FORMAT (/'  Equivalent namelists ...'/)

918 FORMAT (/'  Equivalent namelists finished.'/)

    !

#ifdef W3_FLX1

810 FORMAT (/'  Stresses (Wu 1980)'/                          &

         ' --------------------------------------------------'/)

#endif

#ifdef W3_FLX2

810 FORMAT (/'  Stresses (T&C 96)'/                           &

         ' --------------------------------------------------'/)

#endif

#ifdef W3_FLX3

810 FORMAT (/'  Stresses (T&C 96 capped) ',a/                 &

         ' --------------------------------------------------')

#endif

#ifdef W3_FLX4

810 FORMAT (/'  Stresses (Hwang 2011) ',a/                     &

         ' --------------------------------------------------')

811 FORMAT ( '       drag coefficient scaling    :',f8.2    /)

2810 FORMAT ( '  &FLX4 CDFAC =',f6.3,' /')

#endif

#ifdef W3_FLX5

810 FORMAT (/'  Direct use of stress from input'/                          &

         ' --------------------------------------------------'/)

#endif

#ifdef W3_FLX3

811 FORMAT ( '       Max Cd * 10^3               :',f8.2/     &

         '       Cap type                    : ',a/)

2810 FORMAT ( '  &FLX3 CDMAX =',f6.2,'E-3 , CTYPE = ',i1,' /')

#endif

    !

#ifdef W3_LN0

820 FORMAT (/'  Linear input not defined.'/)

#endif

#ifdef W3_SEED

820 FORMAT (/'  Seeding as proxi for linear input.'/)

#endif

    !

#ifdef W3_LN1

820 FORMAT (/'  Linear input (C&M-R 82) ',a/                   &

         ' --------------------------------------------------')

821 FORMAT ( '       CLIN                        :',f8.2/      &

         '       Factor for fPM in filter    :',f8.2/      &

         '       Factor for fh in filter     :',f8.2/)

2820 FORMAT ( '  &SLN1 CLIN =',f6.1,', RFPM =',f6.2,            &

         ', RFHF =',f6.2,' /')

#endif

    !

#ifdef W3_ST0

920 FORMAT (/'  Wind input not defined.'/)

#endif

    !

#ifdef W3_ST1

920 FORMAT (/'  Wind input (WAM-3) ',a/                        &

         ' --------------------------------------------------')

921 FORMAT ( '       Cinp                        :',e10.3/)

2920 FORMAT ( '  &SIN1 CINP =',f7.3,' /')

#endif

    !

#ifdef W3_ST2

920 FORMAT (/'  Wind input (T&C 1996) ',a/                     &

         ' --------------------------------------------------')

921 FORMAT ( '       Height of input wind (m)    :',f8.2/      &

         '       Factor negative swell       :',f9.3/)

#endif

#ifdef W3_STAB2

1921 FORMAT ( '       Effective wind mean factor  :',f8.2/    &

         '       Stability par. offset       :',f9.3/    &

         '       Stab. correction            :',f9.3,f8.3/&

         '       Stab. correction stab. fac. :',f7.1,f9.1/)

#endif

#ifdef W3_ST2

2920 FORMAT ( '  &SIN2 ZWND =',f5.1,', SWELLF =',f6.3,' /')

#endif

#ifdef W3_STAB2

2921 FORMAT ( '  &SIN2 ZWND =',f5.1,', SWELLF =',f6.3,', STABSH =',  &

         f6.3,', STABOF = ',e10.3,','/          &

         '        CNEG =',f7.3,', CPOS =',f7.3,', FNEG =',f7.1,' /')

#endif

    !

#ifdef W3_ST3

920 FORMAT (/'  Wind input (WAM 4+) ',a/                            &

         ' --------------------------------------------------')

921 FORMAT ( '       minimum Charnock coeff.     :',f10.4/          &

         '       betamax                     :',f9.3/           &

         '       power of cos. in wind input :',f9.3/           &

         '       z0max                       :',f9.3/           &

         '       zalp                        :',f9.3/           &

         '       Height of input wind (m)    :',f8.2/           &

         '       swell attenuation factor    :',f9.3/ )

2920 FORMAT ( '  &SIN3 ZWND =',f5.1,', ALPHA0 =',f8.5,', Z0MAX =',f8.5,', BETAMAX =', &

         f8.5,','/                                           &

         '        SINTHP =',f8.5,', ZALP =',f8.5,','/            &

         '        SWELLF =',f8.5,'R /'/)

#endif

    !

#ifdef W3_ST4

920 FORMAT (/'  Wind input (WAM 4+) ',a/                            &

         ' --------------------------------------------------')

921 FORMAT ( '       minimum Charnock coeff.     :',f10.4/          &

         '       betamax                     :',f9.3/           &

         '       power of cos. in wind input :',f9.3/           &

         '       z0max                       :',f9.3/           &

         '       zalp                        :',f9.3/           &

         '       Height of input wind (m)    :',f8.2/           &

         '       wind stress sheltering      :',f9.3/           &

         '       swell attenuation param.    :',i5/             &

         '       swell attenuation factor    :',f9.3/           &

         '       swell attenuation factor2   :',f9.3/           &

         '       swell attenuation factor3   :',f9.3/           &

         '       critical Reynolds number    :',f9.1/           &

         '       swell attenuation factor5   :',f9.3/           &

         '       swell attenuation factor6   :',f9.3/           &

         '       swell attenuation factor7   :',f14.3/          &

         '       ratio of z0 for orb. & mean :',f9.3/)

2920 FORMAT ( '  &SIN4 ZWND =',f5.1,', ALPHA0 =',f8.5,', Z0MAX =',f8.5,', BETAMAX =', &

         f8.5,','/                                           &

         '        SINTHP =',f8.5,', ZALP =',f8.5,', TAUWSHELTER =',f8.5,           &

         ', SWELLFPAR =',i2,','/                                 &

         '        SWELLF =',f8.5,', SWELLF2 =',f8.5,             &

         ', SWELLF3 =',f8.5,', SWELLF4 =',f9.1,','/              &

         '        SWELLF5 =',f8.5,', SWELLF6 =',f8.5,            &

         ', SWELLF7 =',f12.2,', Z0RAT =',f8.5,', SINBR =',f8.5,','/              &

         '        SINTABLE =',i2,', TAUWBUG =',i2,               &

         ', VISCSTRESS =',f8.5,', SINTAIL1 =',f8.5,', SINTAIL2 =',f8.5,',' / &

         ', CAPCHA =',f8.5,', CHAMIN =',f8.5,', CHA0 =',f8.5,', UCAP =',f5.1,', SIGMAUCAP =', &

         f5.1,'  /')

#endif

    !

#ifdef W3_ST6

920 FORMAT (/'  Wind input (Donelan et al, 2006) ',a/       &

         ' --------------------------------------------------')

921 FORMAT ( '  negative wind input active       :  ',a/    &

         '  attenuation factor               :  ',f6.2/ &

         '  wind speed scaling factor        :  ',f6.2/ &

         '  frequency cut-off factor         :  ',f6.2/)

2920 FORMAT ( '  &SIN6 SINA0 =', f6.3, ', SINWS =', f6.2, ', SINFC =', f6.2, ' /')

#endif

    !

#ifdef W3_NL0

922 FORMAT (/'  Nonlinear interactions not defined.'/)

#endif

    !

#ifdef W3_NL1

922 FORMAT (/'  Nonlinear interactions (DIA) ',a/                   &

         ' --------------------------------------------------')

923 FORMAT ( '       Lambda                      :',f8.2/      &

         '       Prop. constant              :',e10.3/     &

         '       kd conversion factor        :',f8.2/      &

         '       minimum kd                  :',f8.2/      &

         '       shallow water constants     :',f8.2,2f6.2/)

2922 FORMAT ( '  &SNL1 LAMBDA =',f7.3,', NLPROP =',e10.3,       &

         ', KDCONV =',f7.3,', KDMIN =',f7.3,','/           &

         '        SNLCS1 =',f7.3,', SNLCS2 =',f7.3,        &

         ', SNLCS3 = ',f7.3','/                            &

         '        IQTYPE =',i2,', TAILNL =',f5.1,','/      &

         '        GQMNF1 =',i2,', GQMNT1 =',i2,',',        &

         ' GQMNQ_OM2 =',i2,', GQMTHRSAT =',e11.4,', GQMTHRCOU =',f4.3,','/ &

         '        GQAMP1 =',f5.3,', GQAMP2 =',f5.3,', GQAMP3 =',f5.3,', GQAMP4 =',f5.3,' /')

#endif

    !

#ifdef W3_NL2

922 FORMAT (/'  Nonlinear interactions (WRT) ',a/              &

         ' --------------------------------------------------')

923 FORMAT ( '       Deep/shallow options        : ',a/        &

         '       Power of h-f tail           : ',f6.1)

1923 FORMAT ( '       Number of depths used       : ',i4/       &

         '       Depths (m)                  :',5f7.1)

2923 FORMAT ( '                                    ',5f7.1)

2922 FORMAT ( '  &SNL2 IQTYPE =',i2,', TAILNL =',f5.1,',',      &

         ' NDEPTH =',i3,' /')

3923 FORMAT ( '  &SNL2 DEPTHS =',f9.2,' /')

4923 FORMAT ( '  &ANL2 DEPTHS =',f9.2,' ,')

5923 FORMAT ( '                ',f9.2,' ,')

6923 FORMAT ( '                ',f9.2,' /')

#endif

    !

#ifdef W3_NL3

922 FORMAT (/'  Nonlinear interactions (GMD) ',a/              &

         ' --------------------------------------------------')

923 FORMAT ( '       Powers in scaling functions : ',2f7.2/    &

         '       Nondimension filter depths  : ',2f7.2)

1923 FORMAT ( '       Number of quad. definitions : ',i4)

2923 FORMAT ( '             ',2f8.3,f6.1,2e12.4)

2922 FORMAT ( '  &SNL3 NQDEF =',i3,', MSC =',f6.2,',  NSC =',   &

         f6.2,',  KDFD =',f6.2,',  KDFS =',f6.2,' /')

3923 FORMAT ( '  &ANL3 QPARMS = ',2(f5.3,', '),f5.1,', ',e11.4, &

         ', ',e11.4,' /')

4923 FORMAT ( '  &ANL3 QPARMS = ',2(f5.3,', '),f5.1,', ',e11.4, &

         ', ',e11.4,' ,')

5923 FORMAT ( '                 ',2(f5.3,', '),f5.1,', ',e11.4, &

         ', ',e11.4,' ,')

6923 FORMAT ( '                 ',2(f5.3,', '),f5.1,', ',e11.4, &

         ', ',e11.4,' /')

#endif

    !

#ifdef W3_NL4

922 FORMAT (/'  Nonlinear interactions (TSA) ',a/              &

         ' --------------------------------------------------')

923 FORMAT ( '   Source term computation (1=TSA,0=FBI) : ',i2/ &

         '   Alternate loops (1=no,2=yes)          : ',i2/ &

         '   (To speed up computation) ')

2922 FORMAT ( '  &SNL4 ITSA =',i2,', IALT =',i2 )

#endif

    !

#ifdef W3_NL5

922 FORMAT(/'  Nonlinear interactions (GKE) ',a/              &

         ' --------------------------------------------------')

923 FORMAT ( '   Constant water depth (in meter) : ', f7.1/ &

         '   Quasi-resonant quartets cut-off : ', f8.2/ &

         '   Discretiz. of GKE (0:Con., 1:GS): ', i5/   &

         '   GKE (0: GS13-JFM, 1: J03-JPO)   : ', i5/   &

         '   Interp (0: nearest, 1: bilinear): ', i5/   &

         '   Mixing (0: no, N: N Tm, -1: b_T): ', i5/)

2922 FORMAT ( '  &SNL5 NL5DPT =', f7.1, ', NL5OML =', f5.2, &

         ', NL5DIS =', i2.1, ', NL5KEV =', i2.1,       &

         ', NL5IPL =', i2.1, ', NL5PMX =', i5.1, ' /')

#endif

    !

#ifdef W3_NLS

9922 FORMAT (/'  HF filter based on Snl ',a/                    &

         ' --------------------------------------------------')

9923 FORMAT ( '       a34 (lambda)                :',f9.3,f9.4/ &

         '       Prop. constant              :',e10.3/     &

         '       maximum relative change     :',f9.3/      &

         '       filter constants            :',f8.2,2f6.2/)

8922 FORMAT ( '  &SNLS A34 =',f6.3,', FHFC =',e11.4,            &

         ',  DNM =',f6.3,','/'        FC1 =',f6.3,         &

         ',  FC2 =',f6.3,',  FC3 =',f6.3,' /')

#endif

    !

#ifdef W3_ST0

924 FORMAT (/'  Dissipation not defined.'/)

#endif

    !

#ifdef W3_ST1

924 FORMAT (/'  Dissipation (WAM-3) ',a/                       &

         ' --------------------------------------------------')

925 FORMAT ( '       Cdis                        :',e10.3/     &

         '       Apm                         :',e10.3/)

2924 FORMAT ( '  &SDS1 CDIS =',e12.4,', APM =',e11.4,' /')

#endif

    !

#ifdef W3_ST2

924 FORMAT (/'  Dissipation (T&C 1996) ',a/                    &

         ' --------------------------------------------------')

925 FORMAT ( '       High-frequency constants    :',f8.2,e11.3,f6.2/ &

         '       Low-frequency constants     :',e11.3,f6.2/&

         '                                    ',e11.3,f6.2/&

         '       Minimum input peak freq. (-):',f10.4/     &

         '       Minimum PHI                 :',f10.4/)

2924 FORMAT ( '  &SDS2 SDSA0 =',e10.3,', SDSA1 =',e10.3,', SDSA2 =', &

         e10.3,', '/                              &

         '        SDSB0 =',e10.3,', SDSB1 =',e10.3,', ',   &

         'PHIMIN =',e10.3,' /')

#endif

    !

#ifdef W3_ST3

924 FORMAT (/' Dissipation (WAM Cycle 4+) ',a/                 &

         ' --------------------------------------------------')

925 FORMAT ( '       SDSC1                       :',1e11.3/    &

         '       Power of k in mean k        :',f8.2/      &

         '       weights of k and k^2        :',f9.3,f6.3/)

2924 FORMAT ( '  &SDS3 SDSC1 =',e12.4,', WNMEANP =',f4.2,       &

         ', FXPM3 =', f4.2,',FXFM3 =',f4.2,', '/           &

         '        SDSDELTA1 =', f5.2,', SDSDELTA2 =',f5.2, &

         ' /')

#endif

    !

#ifdef W3_ST4

924 FORMAT (/' Dissipation (Ardhuin / Filipot / Romero ) ',a/          &

         ' --------------------------------------------------')

925 FORMAT ( '       SDSC2, SDSBCK, SDSCUM       :',3e11.3/    &

         '       Power of k in mean k        :',f8.2/)

#endif


#ifdef W3_ST4

2924 FORMAT ( '  &SDS4 SDSBCHOICE = ',f3.1,                       &

         ', SDSC2 =',e12.4,', SDSCUM =',f6.2,', '/         &

         '        SDSC4 =',f6.2,', SDSC5 =',e12.4,         &

         ', SDSC6 =',e12.4,','/                            &

         '        WNMEANP =',f4.2,', FXPM3 =', f4.2,       &

         ', FXFM3 =',f4.1,', FXFMAGE =',f6.3, ', '/       &

         '        SDSBINT =',e12.4,', SDSBCK =',e12.4,     &

         ', SDSABK =',f6.3,', SDSPBK =',f6.3,', '/         &

         '        SDSHCK =',f5.2,', SDSBR = ',e12.4,       &

         ', SDSSTRAIN =',f5.1,', SDSSTRAINA =',f4.1,       &

         ', SDSSTRAIN2 =',f5.1,', '/                       &

         '        SDSBT =',f5.2,', SDSP =',f5.2,          &

         ', SDSISO =',i2, &

         ', SDSCOS =',f3.1,', SDSDTH =',f5.1,', '/         &

         '        SDSBRF1 = ',f5.2,', SDSBRFDF =',i2,', '/ &

         '        SDSBM0 = ',f5.2, ', SDSBM1 =',f5.2,      &

         ', SDSBM2 =',f5.2,', SDSBM3 =',f5.2,', SDSBM4 =', &

         f7.2,', '/,                                       &

         '        SPMSS = ',f5.2, ', SDKOF =',f5.2,        &

         ', SDSMWD =',f5.2,', SDSFACMTF =',f5.1,', '/      &

         '        SDSMWPOW =',f3.1,', SDSNMTF =', f5.2,    &

         ', SDSCUMP =', f3.1,', CUMSIGP =', f3.1,', SDSNUW =', e10.3,', '/,     &

         '        WHITECAPWIDTH =',f5.2, ' WHITECAPDUR =',f5.2,' /')

#endif

    !

#ifdef W3_ST6

924 FORMAT (/'  Dissipation (Rogers et al. 2012) ',a/             &

         ' --------------------------------------------------')

925 FORMAT ( '  normalise by threshold spectral density    :  ',a/&

         '  normalise by spectral density              :  ',a/&

         '  coefficient and exponent  for                 '/  &

         '   inherent breaking term a1, L as in (21)   : ',e10.3,i3/ &

         '   cumulative breaking term a2, M as in (22) : ',e10.3,i3/ &

         ' ')

2924 FORMAT ( '  &SDS6 SDSET = ',l,', SDSA1 = ',e10.3,              &

         ', SDSA2 = ',e10.3,', SDSP1 = ',i2,', SDSP1 = ',      &

         i2,' /'                                              )


937 FORMAT (/'  Swell dissipation ',a/                            &

         ' --------------------------------------------------')

940 FORMAT ( '  subroutine W3SWL6 activated           : ',a/      &

         '   coefficient b1 ',a,                ' : ',e10.3/   )

2937 FORMAT ( '  &SWL6 SWLB1 = ',e10.3,', CSTB1 = ',l,' /')

#endif

    !

#ifdef W3_BT0

926 FORMAT (/'  Bottom friction not defined.'/)

#endif

    !

#ifdef W3_BT1

926 FORMAT (/'  Bottom friction (JONSWAP) ',a/                 &

         ' --------------------------------------------------')

927 FORMAT ( '       gamma                       :',f8.4/)

2926 FORMAT ( '  &SBT1 GAMMA =',e12.4,' /')

#endif

    !

#ifdef W3_BT4

926 FORMAT (/'  Bottom friction  (SHOWEX)  ',a/                 &

         ' --------------------------------------------------')

927 FORMAT ( '       SEDMAPD50, SED_D50_UNIFORM        :',l3,1x,f8.6/ &

         '       RIPFAC1,RIPFAC2,RIPFAC3,RIPFAC4   :',4f8.4/      &

         '       SIGDEPTH, BOTROUGHMIN, BOTROUGHFAC:',3f8.4/)

2926 FORMAT ( '  &SBT4 SEDMAPD50 =',l3,', SED_D50_UNIFORM =',f8.6,','/ &

         '        RIPFAC1 =',f8.4,', RIPFAC2 =',f8.4,      &

         ', RIPFAC3 =',f8.4,', RIPFAC4 =',f8.4,','/        &

         '        SIGDEPTH =',f8.4,', BOTROUGHMIN =',f8.4, &

         ', BOTROUGHFAC =',f4.1,' /')

#endif

    !

#ifdef W3_DB0

928 FORMAT (/'  Surf breaking not defined.'/)

#endif

    !

#ifdef W3_DB1

928 FORMAT (/'  Surf breaking (B&J 1978) ',a/                  &

         ' --------------------------------------------------')

929 FORMAT ( '       alpha                       :',f8.3/      &

         '       gamma                       :',f8.3)

2928 FORMAT ( '  &SDB1 BJALFA =',f7.3,', BJGAM =',f7.3,         &

         ', BJFLAG = ',a,' /')

#endif

    !

#ifdef W3_TR0

930 FORMAT (/'  Triad interactions not defined.'/)

#endif

    !

#ifdef W3_BS0

932 FORMAT (/'  Bottom scattering not defined.'/)

#endif

#ifdef W3_BS1

932 FORMAT (/'  Experimental bottom scattering (F. Ardhuin).'/)

#endif

    !

#ifdef W3_IC1

935 FORMAT (/'  Dissipation via ice parameters (SIC1).'&

         ,/' --------------------------------------------------')

#endif

    !

#ifdef W3_IC2

935 FORMAT (/'  Dissipation via ice parameters (SIC2).'&

         ,/' --------------------------------------------------')

#endif

    !

#ifdef W3_IC3

935 FORMAT (/'  Dissipation via ice parameters (SIC3).'&

         ,/' --------------------------------------------------')

#endif

    !

#ifdef W3_IC4

935 FORMAT (/'  Dissipation via ice parameters (SIC4).'&

         ,/' --------------------------------------------------')

#endif

    !

#ifdef W3_IC5

935 FORMAT (/'  Dissipation via ice parameters (SIC5).'&

         ,/' --------------------------------------------------')

#endif

    !

#ifdef W3_IS0

944 FORMAT  (/'  Ice scattering not defined.'/)

#endif

#ifdef W3_IS1

945 FORMAT  (/'  Ice scattering ',a,/ &

         ' --------------------------------------------------')

946 FORMAT  ('  Isotropic (linear function of ice concentration)'/&

         '        slope                      : ',e10.3/ &

         '        offset                     : ',e10.3)

2946 FORMAT ( '  &SIS1 ISC1 =',e10.3,', ISC2 =',e10.3)

#endif

#ifdef W3_IS2

947 FORMAT  (/'  Ice scattering ',a,/ &

         ' --------------------------------------------------')

948 FORMAT  ('  IS2 Scattering ... '/&

         '        scattering coefficient       : ',e10.3/ &

         '        0: no back-scattering        : ',e10.3/ &

         '     TRUE: istropic back-scattering  : ',l3/   &

         '     TRUE: update of ICEDMAX         : ',l3/   &

         '     TRUE: keeps updated ICEDMAX     : ',l3/   &

         '        flexural strength            : ',e10.3/ &

         '     TRUE: uses Robinson-Palmer disp.: ',l3/   &

         '        attenuation                  : ',f5.2/ &

         '        fragility                    : ',f5.2/ &

         '        minimum floe size in meters  : ',f5.2/ &

         '        pack scattering coef 1       : ',f5.2/ &

         '        pack scattering coef 2       : ',f5.2/ &

         '        scaling by concentration     : ',f5.2/ &

         '        creep B coefficient          : ',e10.3/ &

         '        creep C coefficient          : ',f5.2/ &

         '        creep D coefficient          : ',f5.2/ &

         '        creep N power                : ',f5.2/ &

         '        elastic energy factor        : ',f5.2/ &

         '        factor for ice breakup       : ',f5.2/ &

         '        IS2WIM1                      : ',f5.2/ &

         '        anelastic dissipation        : ',l3/   &

         '        energy of activation         : ',f5.2/ &

         '        anelastic coefficient        : ',e11.3/ &

         '        anelastic exponent           : ',f5.2)

2948 FORMAT ( '  &SIS2 ISC1 =',e10.3,', IS2BACKSCAT =',e10.3,   &

         ', IS2ISOSCAT =',l3,', IS2BREAK =',l3,          &

         ', IS2DUPDATE =',l3,','/                        &

         '       IS2FLEXSTR =',e11.3,', IS2DISP =',l3,   &

         ', IS2DAMP =',f3.1,       &

         ', IS2FRAGILITY =',f4.2,', IS2DMIN =',f5.2,','/ &

         '       IS2C2 =',f12.8,', IS2C3 =',f8.4,        &

         ', IS2CONC =',f5.1,', IS2CREEPB =',e11.3,','/   &

         '       IS2CREEPC =',f5.2,', IS2CREEPD =',f5.2, &

         ', IS2CREEPN =',f5.2,','/                       &

         '       IS2BREAKE =',f5.2,                      &

         ', IS2BREAKF =',f5.2,', IS2WIM1 =',f5.2,','/    &

         ', IS2ANDISB =',l3,', IS2ANDISE =',f5.2,        &

         ', IS2ANDISD =',e11.3,', IS2ANDISN=',f5.2, ' /')

#endif

#ifdef W3_UOST

4500 FORMAT (/' Unresolved Obstacles Source Term (UOST) ',a,/ &

         ' --------------------------------------------------')

4501 FORMAT ('    local alpha-beta file:  ',a,    &

         '    shadow alpha-beta file: ',a,/    &

         '    local calibration factor: ',f5.2,  &

         '    shadow calibration factor: ',f5.2)

4502 FORMAT ('  &UOST UOSTFILELOCAL = ',a,', UOSTFILESHADOW = ',a,/ &

         '        UOSTFACTORLOCAL = ',f5.2', UOSTFACTORSHADOW = ',f5.2,' /')

#endif

    !

950 FORMAT (/'  Propagation scheme : '/                             &

         ' --------------------------------------------------')

951 FORMAT ( '       Type of scheme (structured) :',1x,a)

2951 FORMAT ( '       Type of scheme(unstructured):',1x,a)

2952 FORMAT ( '             wave setup computation:',1x,a)

952 FORMAT ( '                                    ',1x,a)

#ifdef W3_PR1

953 FORMAT ( '       CFLmax depth refraction     :',f9.3/)

2953 FORMAT ( '  &PRO1 CFLTM =',f5.2,' /')

#endif

    !

#ifdef W3_PR2

953 FORMAT ( '       CFLmax depth refraction     :',f9.3/      &

         '       Effective swell age     (h) : switched off'/   &

         '       Cut-off latitude    (degr.) :',f7.1/)

954 FORMAT ( '       CFLmax depth refraction     :',f9.3/      &

         '       Effective swell age     (h) :',f8.2/      &

         '       Cut-off latitude    (degr.) :',f7.1/)

2953 FORMAT ( '  &PRO2 CFLTM =',f5.2,', DTIME =',f8.0,          &

         ', LATMIN =',f5.1,' /')

#endif

    !

#ifdef W3_SMC

1950 FORMAT (/'  SMC grid parameters : '/                            &

         ' --------------------------------------------------')

1951 FORMAT ( '       Type of scheme (structured) :',1x,a)

1953 FORMAT ( '       Max propagation CFL number  :',f9.3/      &

         '       Effective swell age     (h) :',f8.2/      &

         '       Maximum refraction  (degr.) :',f8.2/)

2954 FORMAT ( '  &PSMC CFLSM  =',f5.2,', DTIMS  =', f9.1/     &

         '        Arctic =',l5,  ', RFMAXD =', f9.2/     &

         '        UNO3   =',l5,  ', AVERG  =',l5/        &

         '        LvSMC  =',i5,  ', NBISMC =',i9/        &

         '        ISHFT  =',i5,  ', JEQT   =',i9/        &

         '        SEAWND =',l5,  '/')

#endif

    !

#ifdef W3_PR3

953 FORMAT ( '       CFLmax depth refraction     :',f9.3/      &

         '       Averaging area factor Cg    :',f8.2)

954 FORMAT ( '       Averaging area factor theta :',f8.2)

955 FORMAT ( .GE.'            **** Internal maximum ',f6.2,' ****')

2953 FORMAT ( '  &PRO3 CFLTM =',f5.2,                           &

         ', WDTHCG = ',f4.2,', WDTHTH = ',f4.2,' /')

#endif

    !

2956 FORMAT ( '  &UNST UGBCCFL =',l3,', UGOBCAUTO =',l3,             &

         ', UGOBCDEPTH =', f8.3,', UGOBCFILE=',a,','/           &

         ',  EXPFSN =',l3,',EXPFSPSI =',l3,                     &

         ',  EXPFSFCT =', l3,',IMPFSN =',l3,',EXPTOTAL=',l3,    &

         ',  IMPTOTAL=',l3,',IMPREFRACTION=', l3,               &

         ',  IMPFREQSHIFT=', l3,', IMPSOURCE=', l3,             &

         ',  SETUP_APPLY_WLV=', l3,                             &

         ',  JGS_TERMINATE_MAXITER=', l3,                       &

         ',  JGS_TERMINATE_DIFFERENCE=', l3,                    &

         ',  JGS_TERMINATE_NORM=', l3,                          &

         ',  JGS_LIMITER=', l3,                                 &

         ',  JGS_LIMITER_FUNC=', i3,                            &

         ',  JGS_USE_JACOBI=', l3,                              &

         ',  JGS_BLOCK_GAUSS_SEIDEL=', l3,                      &

         ',  JGS_MAXITER=', i5,                                 &

         ',  JGS_PMIN=', f8.3,                                  &

         ',  JGS_DIFF_THR=', f8.3,                              &

         ',  JGS_NORM_THR=', f8.3,                              &

         ',  JGS_NLEVEL=', i3,                                  &

         ',  JGS_SOURCE_NONLINEAR=', l3 / )

    !

960 FORMAT (/'  Miscellaneous ',a/                                   &

         ' --------------------------------------------------')

2961 FORMAT ( ' *** WAVEWATCH-III WARNING IN W3GRID :'/               &

         .NE.'     CICE0CICEN requires FLAGTR>2'/                &

         '     Parameters corrected: CICE0 = CICEN'/)

2962 FORMAT (/' *** WAVEWATCH-III WARNING IN W3GRID : User requests', &

         'CICE0=CICEN corresponding to discontinuous treatment of ',   &

         'ice, so we will change FLAGTR')

2963 FORMAT (/' *** WAVEWATCH-III WARNING IN W3GRID :'/               &

         '     Ice physics used, so we will change FLAGTR.')

961 FORMAT ( '       Ice concentration cut-offs  :',f8.2,f6.2)

#ifdef W3_MGG

962 FORMAT  ( '       Moving grid GSE cor. power  :',f8.2)

#endif

#ifdef W3_SCRIP

963 FORMAT( ' Grid offset for multi-grid w/SCRIP  : ',e11.3)

#endif

1972 FORMAT ( '       Compression of track output  : ',l3)

#ifdef W3_SEED

964 FORMAT ( '       Xseed in seeding algorithm  :',f8.2)

#endif

965 FORMAT (/'    Dynamic source term integration scheme :'/        &

         '       Xp                      (-) :',f9.3/           &

         '       Xr                      (-) :',f9.3/           &

         '       Xfilt                   (-) :',f9.3)

966 FORMAT (/'    Wave field partitioning :'/                       &

         '       Levels                  (-) :',i5/             &

         '       Minimum wave height     (m) :',f9.3/           &

         '       Wind area multiplier    (-) :',f9.3/           &

         '       Cut-off wind sea fract. (-) :',f9.3/           &

         '       Combine wind seas           :  ',a/            &

         '       Number of swells in fld out :',i5)

967 FORMAT (/'    Miche-style limiting wave height :'/              &

         '       Hs,max/d factor         (-) :',f9.3/           &

         '       Hrms,max/d factor       (-) :',f9.3/           &

         '       Limiter activated           :  ',a)

968 FORMAT ( '          *** FACTOR DANGEROUSLY LOW ***')

1973 FORMAT (/'    Calendar type                  :  ',a)

    !

#ifdef W3_REF1

969 FORMAT (/'  Shoreline reflection     ',a/                  &

         ' --------------------------------------------------')

#endif

    !

#ifdef W3_IG1

970 FORMAT (/'  Second order and infragravity waves  ',a/      &

         ' --------------------------------------------------')

#endif

    !

5971 FORMAT ('       Partitioning method         :  ',a)

5972 FORMAT ('       Namelist options overridden :  ',a)

    !

#ifdef W3_IC2

971 FORMAT (/'  Boundary layer below ice  ',a/      &

         ' --------------------------------------------------')

#endif

#ifdef W3_IC3

971 FORMAT (/'  Visco-elastic ice layer   ',a/      &

         ' --------------------------------------------------')

#endif

#ifdef W3_IC4

971 FORMAT (/'  Empirical wave-ice physics   ',a/      &

         ' --------------------------------------------------')

#endif

#ifdef W3_IC5

971 FORMAT (/'  Effective medium ice model (SIC5) ',a/      &

         ' --------------------------------------------------')

2971 FORMAT ( '       Min. Ice shear modulus G     : ', e10.1/, &

         '       Min. Wave period T           : ', f7.2/,  &

         '       Max. Wavenumber Ratio (Ko/Kr): ', e10.1/, &

         '       Max. Attenu. Rate (Ki)       : ', e10.1/, &

         '       Min. Water depth (d)         : ', f5.0/,  &

         '       Max. # of Newton Iter.       : ', f5.0/,  &

         '       Use Rand. Kick               : ', f5.0/,  &

         '       Excluded Imag. Corridor      : ', f9.4/,  &

         '       Selected ice model           : ', a/)

#endif

    !

8972 FORMAT ( '       Wind input reduction factor in presence of ', &

         /'         ice :',f6.2, &

         /'         (0.0==> no reduction and 1.0==> no wind', &

         /'         input with 100% ice cover)')

    !

    !

4970 FORMAT (/'  Spectral output on full grid ',a/                   &

         ' --------------------------------------------------')

4971 FORMAT ( '       Second order pressure at K=0:',3i4)

4972 FORMAT ( '       Spectrum of Uss             :',3i4)

4973 FORMAT ( '       Frequency spectrum          :',3i4)

4974 FORMAT ( '       Partions of Uss             :',2i4)

4975 FORMAT ( '       Partition wavenumber #',i2,'   : ',1f6.3)


    !

4980 FORMAT (/'  Coastal / iceberg reflection  ',a/                   &

         ' --------------------------------------------------')

4981 FORMAT ( '       Coefficient for shorelines  :',f6.4)

4989 FORMAT ( '          *** CURVLINEAR GRID: REFLECTION NOT IMPLEMENTED YET ***')

2977 FORMAT ( '  &SIG1  IGMETHOD =',i2,', IGADDOUTP =',i2,', IGSOURCE =',i2, &

         ', IGSTERMS = ',i2,', IGBCOVERWRITE =', l3,','/        &

         '        IGSWELLMAX =', l3,', IGMAXFREQ =',f6.4,       &

         ', IGSOURCEATBP = ',i2,', IGKDMIN = ',f6.4,','/        &

         '        IGFIXEDDEPTH = ',f6.2,', IGEMPIRICAL = ',f8.6,' /')

    !

2978 FORMAT ( '  &SIC2  IC2DISPER =',l3,', IC2TURB =',f6.2,          &

         ', IC2ROUGH  =',f10.6,','/                             &

         '        IC2REYNOLDS = ',f10.1,', IC2SMOOTH = ',f10.1, &

         ', IC2VISC =',f6.3,','/                                &

         ',       IC2TURBS =',f8.2,', IC2DMAX =',f5.3,' /')

    !

2979 FORMAT ( '  &SIC3 IC3MAXTHK =',f6.2, ', IC3MAXCNC =',f6.2,','/  &

         '        IC2TURB =',f8.2,                              &

         ', IC2ROUGH  =',f7.3,','/                              &

         '        IC2REYNOLDS = ',f10.1,', IC2SMOOTH = ',f10.1, &

         ', IC2VISC =',f10.3,','/                               &

         '        IC2TURBS =',f8.2,', IC3CHENG =',l3,           &

         ', USECGICE =',l3,', IC3HILIM = ',f6.2,','/            &

         '        IC3KILIM = ',e9.2,', IC3HICE = ',e9.2,        &

         ', IC3VISC = ',e9.2,','/                               &

         '        IC3DENS = ',e9.2,', IC3ELAS = ',e9.2,' /')

    !

2981 FORMAT ( '  &SIC5 IC5MINIG = ', e9.2, ', IC5MINWT = ', f5.2,    &

         ', IC5MAXKRATIO = ', e9.2, ','/                        &

         '        IC5MAXKI = ', e9.2, ', IC5MINHW = ', f4.0,    &

         ', IC5MAXITER = ', f4.0, ','/                          &

         '        IC5RKICK = ', f2.0, ', IC5KFILTER = ', f7.4,  &

         ', IC5VEMOD   = ', f4.0, ' /')

    !

2966 FORMAT ( '  &MISC CICE0 =',f6.3,', CICEN =',f6.3,               &

         ', LICE = ',f8.1,', PMOVE =',f6.3,','/           &

         '        XSEED =',f6.3,', FLAGTR = ', i1,              &

         ', XP =',f6.3,', XR =',f6.3,', XFILT =', f6.3 /  &

         '        IHM =',i5,', HSPM =',f6.3,', WSM =',f6.3,     &

         ', WSC =',f6.3,', FLC = ',a/                     &

         '        NOSW =',i3,', FMICHE =',f6.3,', RWNDC =' ,    &

         f6.3,', WCOR1 =',f6.2,', WCOR2 =',f6.2,','/   &

         '        FACBERG =',f4.1,', GSHIFT = ',e11.3,          &

         ', STDX = ' ,f7.2,', STDY =',f7.2,','/           &

         '        STDT =', f8.2,                                &

         ', ICEHMIN =',f5.2,', ICEHFAC =',f5.2,','/       &

         '        ICEHINIT =',f5.2,', ICEDISP =',l3,            &

         ', ICEHDISP =',f5.2,','/                         &

         '        ICESLN = ',f6.2,', ICEWIND = ',f6.2,          &

         ', ICESNL = ',f6.2,', ICESDS = ',f5.2,','/       &

         '        ICEDDISP = ',f5.2,', ICEFDISP = ',f5.2,       &

         ', CALTYPE = ',a8,' , TRCKCMPR = ', l3,','/      &

         '        BTBET  = ', f6.2, ' /')

    !

2976 FORMAT ( '  &OUTS P2SF  =',i2,', I1P2SF =',i2,', I2P2SF =',i3,','/&

         '        US3D  =',i2,', I1US3D =',i3,', I2US3D =',i3,','/&

         '        USSP  =',i2,', IUSSP  =',i3,','/&

         '        E3D   =',i2,', I1E3D  =',i3,', I2E3D  =',i3,','/&

         '        TH1MF =',i2,', I1TH1M =',i3,', I2TH1M =',i3,','/&

         '        STH1MF=',i2,', I1STH1M=',i3,', I2STH1M=',i3,','/&

         '        TH2MF =',i2,', I1TH2M =',i3,', I2TH2M =',i3,','/&

         '        STH2MF=',i2,', I1STH2M=',i3,', I2STH2M=',i3,' /')

    !

2986 FORMAT ( '  &REF1 REFCOAST =',f5.2,', REFFREQ =',f5.2,', REFSLOPE =',f5.3, &

         ', REFMAP =',f4.1, ', REFMAPD =',f4.1, ', REFSUBGRID =',f5.2,','/ &

         '        REFRMAX=',f5.2,', REFFREQPOW =',f5.2,                    &

         ', REFICEBERG =',f5.2,', REFCOSP_STRAIGHT =',f4.1,' /')

    !

2987 FORMAT ( '  &FLD TAIL_ID =',i1,' TAIL_LEV =',f5.4,' TAILT1 =',f5.3,&

         ' TAILT2 =',f5.3,' /')

#ifdef W3_RTD


4991 FORMAT ( '  &ROTD PLAT =', f6.2,', PLON =', f7.2,', UNROT =',l3,' /')

4992 FORMAT ( '  &ROTB BPLAT =',9(f6.1,",")/                        &

         '        BPLON =',9(f6.1,","),' /')

#endif


3000 FORMAT (/'  The spatial grid: '/                                &

         ' --------------------------------------------------'/ &

         /'       Grid type                   : ',a)

3001 FORMAT ( '       Coordinate system           : ',a)

3002 FORMAT ( '       Index closure type          : ',a)

3003 FORMAT ( '       Dimensions                  : ',i6,i8)

3004 FORMAT (/'       Increments           (deg.) :',2f10.4/         &

         '       Longitude range      (deg.) :',2f10.4/         &

         '       Latitude range       (deg.) :',2f10.4)

3005 FORMAT ( '       Increments             (km) :',2f8.2/          &

         '       X range                (km) :',2f8.2/          &

         '       Y range                (km) :',2f8.2)

3006 FORMAT (/'       X-coordinate unit           :',i6/             &

         '       Scale factor                :',f10.4/           &

         '       Add offset                  :',e12.4/          &

         '       Layout indicator            :',i6/             &

         '       Format indicator            :',i6)

3007 FORMAT (/'       Y-coordinate unit           :',i6/             &

         '       Scale factor                :',f10.4/           &

         '       Add offset                  :',e12.4/          &

         '       Layout indicator            :',i6/             &

         '       Format indicator            :',i6)

3008 FORMAT ( '       Format                      : ',a)

3009 FORMAT ( '       File name                   : ',a)

#ifdef W3_SMC

4001 FORMAT ( '       SMC refined levels NRLv   = ',i8)

4002 FORMAT ( '       SMC Equator j shift no.   = ',i8)

4302 FORMAT ( '       SMC I-index shift number  = ',i8)

4003 FORMAT ( '       SMC input boundary  no.   = ',i8)

4004 FORMAT ( '       SMC NCel   = ',6i9)

4005 FORMAT ( '       IJKCel(5,NCel) read from ', a)

4006 FORMAT (6i8)

4007 FORMAT ( '       SMC NUFc   = ',6i9)

4008 FORMAT ( '       IJKUFc(7,NCel) read from ', a)

4009 FORMAT (8i8)

4010 FORMAT ( '       SMC NVFc   = ',6i9)

4011 FORMAT ( '       IJKVFc(8,NCel) read from ', a)

4110 FORMAT ( '       SMC NCObsr = ',6i9)

4111 FORMAT ( '       IJKObstr(1,NCel) read from ', a)

4012 FORMAT (9i8)

4013 FORMAT ( '       NBICelin(NBISMC) read from ', a)

4014 FORMAT (2i8)

4015 FORMAT ( '       ARC NARC   = ',6i9)

4016 FORMAT ( '       IJKCel(5,NARC) read from ', a)

4017 FORMAT ( '       ARC NAUI   = ',6i9)

4018 FORMAT ( '       IJKUFc(7,NAUI) read from ', a)

4019 FORMAT ( '       ARC NAVJ   = ',6i9)

4020 FORMAT ( '       IJKVFc(8,NAVJ) read from ', a)

4021 FORMAT ( '       Varables by W3DIMX NCel = ',i9)

4022 FORMAT ( '       Defined NLvCel ',6i9)

4023 FORMAT ( '       Defined NLvUFc ',6i9)

4024 FORMAT ( '       Defined NLvVFc ',6i9)

4025 FORMAT ( '       Define IJKCel from -9 to ',i9)

4026 FORMAT ( '       IJKCel(5,NCel) defined : ')

4027 FORMAT ( '       IJKUFc(7,NUFc) defined : ')

4028 FORMAT ( '       IJKVFc(8,NVFc) defined : ')

4029 FORMAT ( '       Boundary cells IJKCel(:,-9:0) : ')

4030 FORMAT (5i8)

4031 FORMAT ( '       Define MAPSF ...    1 to ',i9)

4032 FORMAT ( '       Multi-Resolution factor = ',i6)

4033 FORMAT ( '       Range of MAPSF(:,1)    : ',2i9)

4034 FORMAT ( '       Range of MAPSF(:,2)    : ',2i9)

4035 FORMAT ( '       Range of MAPSF(:,3)    : ',2i9)

4036 FORMAT ( '       Range of MAPFS(:,:)    : ',2i9)

4037 FORMAT ( '       Arctic AngArc defined as ',i6)

4038 FORMAT (9f8.2)

4039 FORMAT ( '       Arctic ICLBAC defined as ',i6)

4040 FORMAT (9i8)

#endif

#ifdef W3_RTD

4200 FORMAT ( '       AnglDin(NX,NY) defn checks  : ')

4201 FORMAT ( '       JY/IX',4i8)

4202 FORMAT (i12,4f8.2)

4203 FORMAT ( '       Rotated pole lat/lon (deg.) :  ',2f9.3)

4204 FORMAT ( '       Output dirns and x-y vectors will be set to True North')

#endif

972 FORMAT (/'       Bottom level unit           :',i6/             &

         '       Limiting depth          (m) :',f8.2/           &

         '       Minimum depth           (m) :',f8.2/           &

         '       Scale factor                :',f8.2/           &

         '       Layout indicator            :',i6/             &

         '       Format indicator            :',i6)

973 FORMAT ( '       Format                      : ',a)

974 FORMAT ( '       File name                   : ',a)

976 FORMAT (/'       Sub-grid information        : ',a)

977 FORMAT ( '       Obstructions unit           :',i6/             &

         '       Scale factor                :',f10.4/          &

         '       Layout indicator            :',i6/             &

         '       Format indicator            :',i6)

978 FORMAT (/'       Mask information            : From file.'/     &

         '       Mask unit                   :',i6/             &

         '       Layout indicator            :',i6/             &

         '       Format indicator            :',i6)

1977 FORMAT ( '       Shoreline slope             :',i6/             &

         '       Scale factor                :',f10.4/          &

         '       Layout indicator            :',i6/             &

         '       Format indicator            :',i6)

1978 FORMAT ( '       Grain sizes                 :',i6/             &

         '       Scale factor                :',f10.4/          &

         '       Layout indicator            :',i6/             &

         '       Format indicator            :',i6)

    !

979 FORMAT ( '  Processing ',a)

980 FORMAT (/'  Input boundary points : '/                          &

         ' --------------------------------------------------')

1980 FORMAT (/'  Excluded points : '/                                &

         ' --------------------------------------------------')

981 FORMAT ( '   *** POINT OUTSIDE GRID (SKIPPED), IX, IY =')

1981 FORMAT ( '   *** POINT ALREADY EXCLUDED (SKIPPED), IX, IY =')

982 FORMAT ( '   *** CANNOT CONNECT POINTS, IX, IY =')

985 FORMAT ( '       No boundary points.'/)

986 FORMAT ( '       Number of boundary points   :',i6/)

1985 FORMAT ( '       No excluded points.'/)

1986 FORMAT ( '       Number of excluded points   :',i6/)

987 FORMAT ( '         Nr.|   IX  |   IY  |  Long.  |   Lat.  '/        &

         '       -----|-------|-------|---------|---------')

1987 FORMAT ( '         Nr.|   IX  |   IY  |     X     |     Y     '/    &

         '       -----|-------|-------|-----------|-----------')

988 FORMAT ( '       ',i4,2(' |',i6),2(' |',f8.2))

1988 FORMAT ( '       ',i4,2(' |',i6),2(' |',f8.1,'E3'))

989 FORMAT ( ' ')

    !

990 FORMAT (/'  Output boundary points : '/                         &

         ' --------------------------------------------------')

991 FORMAT ( '       File nest',i1,'.ww3  Number of points  :',i6/  &

         '                       Number of spectra :',i6)

1991 FORMAT ( '                       Dest. grid Polat:',f6.2,', Polon:',f8.2)

992 FORMAT (/'         Nr.|  Long.  |   Lat.  '/               &

         '       -----|---------|---------')

1992 FORMAT (/'         Nr.|  Long.  |   Lat.  ',               &

         '         Nr.|  Long.  |   Lat.  '/               &

         '       -----|---------|---------',               &

         '       -----|---------|---------')

993 FORMAT ( '       ',i4,2(' |',f8.2))

1993 FORMAT ( '       ',i4,2(' |',f8.2),                        &

         '        ',i4,2(' |',f8.2))

994 FORMAT ( '   *** POINT OUTSIDE GRID (SKIPPED) : X,Y =',2f10.5)

995 FORMAT ( '   *** POINT ON LAND      (SKIPPED) : X,Y =',2f10.5)

2992 FORMAT (/'         Nr.|     X     |     Y     '/           &

         '       -----|-----------|-----------')

3992 FORMAT (/'         Nr.|     X     |     Y     ',           &

         '       Nr.|     X     |     Y     '/           &

         '       -----|-----------|-----------',           &

         '     -----|-----------|-----------')

2993 FORMAT ( '       ',i4,2(' |',f8.1,'E3'))

3993 FORMAT ( '       ',i4,2(' |',f8.1,'E3'),                   &

         '      ',i4,2(' |',f8.1,'E3'))

2994 FORMAT ( '   *** POINT OUTSIDE GRID (SKIPPED) : X,Y =',2(f8.1,'E3'))

2995 FORMAT ( '   *** POINT ON LAND      (SKIPPED) : X,Y =',2(f8.1,'E3'))

996 FORMAT ( '       No boundary points.'/)

997 FORMAT ( '       Number of boundary points   :',i6/             &

         '       Number of spectra           :',i6/)

    !

#ifdef W3_O2a

998 FORMAT (50i2)

#endif

#ifdef W3_O2c

1998 FORMAT (50i2)

#endif

    !

999 FORMAT (/'  Writing model definition file ...'/)

    !

1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID : '/               &

         '     ERROR IN OPENING INPUT FILE'/                    &

         '     IOSTAT =',i5/)

    !

1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID : '/               &

         '     PREMATURE END OF INPUT FILE'/)

    !

1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID : '/               &

         '     ERROR IN READING FROM INPUT FILE'/               &

         '     IOSTAT =',i5/)

    !

1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID : '/               &

         '     INVALID CALENDAR TYPE: SELECT ONE OF:',          &

         '     standard, 360_day, or 365_day '/)

    !

1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID : '/               &

         '     CANNOT READ UNFORMATTED (IDFM = 3) FROM UNIT',   &

         i4,' (ww3_grid.inp)'/)

    !

1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID : '/               &

         '     BOTTOM AND OBSTRUCTION DATA FROM SAME FILE '/    &

         '     BUT WITH INCOMPATIBLE FORMATS (',i1,',',i1,')'/)

    !

1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     TOO MANY NESTING OUTPUT FILES '/)

    !

1007 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &

         '     ILLEGAL GRID TYPE:',a4)

    !

1008 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &

         '     A CARTESIAN WITH CLOSURE IS NOT ALLOWED')

    !

1009 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &

         '     A RECTILINEAR TRIPOLE GRID IS NOT ALLOWED')

    !

1010 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'//               &

         '     NO PROPAGATION + NO SOURCE TERMS = NO WAVE MODEL'// &

         '     ( USE DRY RUN FLAG TO TEMPORARILY SWITCH OFF ',  &

         'CALCULATIONS )'/)

    !

1011 FORMAT (/' *** WAVEWATCH-III WARNING IN W3GRID :'/              &

         '     LEFT-HANDED GRID -- POSSIBLE CAUSE IS WRONG '/   &

         '     IDLA:',i4,' . THIS MAY PRODUCE ERRORS '/         &

         '     (COMMENT THIS EXTCDE AT YOUR OWN RISK).')

    !

1012 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &

         '     ILLEGAL GRID CLOSURE TYPE:',a4)

    !

1013 FORMAT (/' *** WAVEWATCH-III WARNING IN W3GRID :'/              &

         '     THE GLOBAL (LOGICAL) INPUT FLAG IS DEPRECATED'/  &

         '     AND REPLACED WITH A STRING INDICATING THE TYPE'/ &

         '     OF GRID INDEX CLOSURE (NONE, SMPL or TRPL).'/    &

         ' *** PLEASE UPDATE YOUR GRID INPUT FILE ACCORDINGLY ***'/)

    !

#ifdef W3_SMC

1014 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &

         '   SMC CELL LONGITUDE RANGE OUTSIDE BASE GRID RANGE:'/&

         '   ISEA =', i6, '; IX =', i4, ':', i4,'; NX =', i4/)

1015 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &

         '   SMC CELL LATITUDE RANGE OUTSIDE BASE GRID RANGE: '/&

         '   ISEA =', i6, '; IY =', i4, ':', i4,'; NY =', i4/)

#endif

    !

1020 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRID :'/                &

         '     SOURCE TERMS REQUESTED BUT NOT SELECTED'/)

1021 FORMAT (/' *** WAVEWATCH III WARNING IN W3GRID :'/              &

         '     SOURCE TERMS SELECTED BUT NOT REQUESTED'/)

1022 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     ILLEGAL NUMBER OF !/LNn OR SEED SWITCHES :',i3)

1023 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     ILLEGAL NUMBER OF !/STn SWITCHES :',i3)

1024 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     ILLEGAL NUMBER OF !/NLn SWITCHES :',i3)

1025 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     ILLEGAL NUMBER OF !/BTn SWITCHES :',i3)

1026 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     ILLEGAL NUMBER OF !/DBn SWITCHES :',i3)

1027 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     ILLEGAL NUMBER OF !/TRn SWITCHES :',i3)

1028 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     ILLEGAL NUMBER OF !/BSn SWITCHES :',i3)

    !

1030 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     PROPAGATION REQUESTED BUT NO SCHEME SELECTED '/)

1031 FORMAT (/' *** WAVEWATCH III WARNING IN W3GRID :'/              &

         '     NO PROPAGATION REQUESTED BUT SCHEME SELECTED '/)

1032 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     NO PROPAGATION SCHEME SELECTED ( use !/PR0 ) '/)

1033 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     MULTIPLE PROPAGATION SCHEMES SELECTED :',i3/     &

         '     CHECK !/PRn SWITCHES'/)

1034 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     ILLEGAL NUMBER OF !/ICn SWITCHES :',i3)

1035 FORMAT (/' *** WAVEWATCH III WARNING IN W3GRID :'/              &

         '     ONLY FIRST PROPAGATION SCHEME WILL BE USED: ')

1036 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     ILLEGAL NUMBER OF !/ISn SWITCHES :',i3)

#ifdef W3_RTD

1052 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     WITH NAMELIST VALUE PLAT == 90, PLON MUST BE -180'/ &

         '     AND UNROT MUST BE .FALSE.' )

1053 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/                &

         '     WITH NAMELIST VALUE BPLAT == 90, BPLON MUST BE -180')

#endif

    !

1040 FORMAT ( '       Space-time extremes DX      :',f10.2)

1041 FORMAT ( '       Space-time extremes DX      :',f10.2)

1042 FORMAT ( '       Space-time extremes DX-Y set to default 1000 m')

1043 FORMAT ( '       Space-time extremes Dt      :',f8.2)

1044 FORMAT ( '       Space-time extremes Dt set to default 1200 s')

    !

1100 FORMAT (/'  Status map, printed in',i6,' part(s) '/             &

         ' -----------------------------------'/)

1101 FORMAT (2x,180i2)

1102 FORMAT ( '  Legend : '/                                         &

         ' -----------------------------'/                      &

         '    0 : Land point            '/                      &

         '    1 : Sea point             '/                      &

         '    2 : Active boundary point '/                      &

         '    3 : Excluded point        '/)

1103 FORMAT (/'  Obstruction map ',a1,', printed in',i6,' part(s) '/ &

         ' ---------------------------------------------'/)

1104 FORMAT ( '  Legend : '/                                         &

         ' --------------------------------'/                   &

         '    fraction of obstruction * 10 '/)


1105 FORMAT (/'  Shoreline slope, printed in',i6,' part(s) '/ &

         ' ---------------------------------------------'/)

1106 FORMAT ( '  Legend : '/                                         &

         ' --------------------------------'/                   &

         '   Slope * 100'/)


1150 FORMAT (/'  Reading unstructured grid definition files ...'/)

    !

9997 FORMAT (/'  Summary grid statistics : '/                        &

         ' --------------------------------------------------'/ &

         '       Number of longitudes      :',i10/              &

         '       Number of latitudes       :',i10/              &

         '       Number of grid points     :',i10/              &

         '       Number of sea points      :',i10,' (',f4.1,'%)'/&

         '       Number of input b. points :',i10/              &

         '       Number of land points     :',i10/              &

         '       Number of excluded points :',i10/)

9998 FORMAT (/'  Summary grid statistics : '/                        &

         ' --------------------------------------------------'/ &

         '       Number of longitudes      :',i10/              &

         '       Number of latitudes       :',i10/              &

         '       Number of grid points     :',i10/              &

         '       Number of sea points      :',i10,' (100%)'/    &

         '       Number of input b. points :',i10/              &

         '       Number of land points     :',i10/              &

         '       Number of excluded points :',i10/)

9999 FORMAT (/'  End of program '/                                   &

         ' ========================================'/           &

         '         WAVEWATCH III Grid preprocessor '/)

    !

#ifdef W3_T

9090 FORMAT ( ' TEST W3GRID : OUTPUT BOUND. POINT DATA LINE SEG.')

9091 FORMAT ( '             ',2f8.2,4(2i4,f7.2))

9092 FORMAT ( '                      ',f7.2,2x,4f7.2)

9093 FORMAT ( '                            ',4i7/                 &

         '                            ',4i7)

#endif

    !

#ifdef W3_T0

9095 FORMAT ( ' TEST W3GRID : OUTPUT BOUND. POINT SPEC DATA ')

9096 FORMAT ( '            ',i3,2i8)

#endif


  END SUBROUTINE w3grid

  !/

  !/ Internal function READNL ------------------------------------------ /

  !/

  !/ ------------------------------------------------------------------- /

  SUBROUTINE readnl ( NDS, NAME, STATUS )

    !/

    !/                  +-----------------------------------+

    !/                  | WAVEWATCH III           NOAA/NCEP |

    !/                  |           H. L. Tolman            |

    !/                  |                        FORTRAN 90 |

    !/                  | Last update :         01-Jun-2013 |

    !/                  +-----------------------------------+

    !/

    !  1. Purpose :

    !

    !     Read namelist info from file if namelist is found in file.

    !

    !  2. Method :

    !

    !     Look for namelist with name NAME in unit NDS and read if found.

    !

    !  3. Parameters :

    !

    !     Parameter list

    !     ----------------------------------------------------------------

    !       NDS     Int.   I   Data set number used for search.

    !       NAME    C*4    I   Name of namelist.

    !       STATUS  C*20   O   Status at end of routine,

    !                            '(default values)  ' if no namelist found.

    !                            '(user def. values)' if namelist read.

    !     ----------------------------------------------------------------

    !

    !  4. Subroutines used :

    !

    !      Name      Type  Module   Description

    !     ----------------------------------------------------------------

    !      EXTCDE    Subr. W3SERVMD Abort program as graceful as possible.

    !     ----------------------------------------------------------------

    !

    !  5. Called by :

    !

    !     Program in which it is contained.

    !

    !  6. Error messages :

    !

    !  7. Remarks :

    !

    !  8. Structure :

    !

    !  9. Switches :

    !

    ! 10. Source code :

    !

    !/ ------------------------------------------------------------------- /

    !/ Parameter list

    !/

    INTEGER, INTENT(IN)     :: NDS

    CHARACTER, INTENT(IN)   :: NAME*4

    CHARACTER, INTENT(OUT)  :: STATUS*20

    !/

    !/ ------------------------------------------------------------------- /

    !/ Local parameters

    !/

    INTEGER                 :: IERR, I, J

    CHARACTER               :: LINE*80

    !/

    !/ ------------------------------------------------------------------- /

    !/

#ifdef W3_S

    CALL strace (ient, 'READNL')

#endif

    !

    rewind(nds)

    status  = '(default values) :  '

    !

    DO

      READ (nds,'(A)',END=800,ERR=800,IOSTAT=IERR) line

      DO i=1, 70

        IF ( line(i:i) .NE. ' ' ) THEN

          IF ( line(i:i) .EQ. '&' ) THEN

            IF ( line(i+1:i+4) .EQ. name ) THEN

              backspace(nds)

              SELECT CASE(name)

#ifdef W3_FLD1

              CASE('FLD1')

                READ (nds,nml=fld1,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_FLD2

              CASE('FLD2')

                READ (nds,nml=fld2,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_FLX3

              CASE('FLX3')

                READ (nds,nml=flx3,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_FLX4

              CASE('FLX4')

                READ (nds,nml=flx4,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_LN1

              CASE('SLN1')

                READ (nds,nml=sln1,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_ST1

              CASE('SIN1')

                READ (nds,nml=sin1,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_ST2

              CASE('SIN2')

                READ (nds,nml=sin2,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_ST3

              CASE('SIN3')

                READ (nds,nml=sin3,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_ST4

              CASE('SIN4')

                READ (nds,nml=sin4,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_ST6

              CASE('SIN6')

                READ (nds,nml=sin6,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_NL1

              CASE('SNL1')

                READ (nds,nml=snl1,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_NL2

              CASE('SNL2')

                READ (nds,nml=snl2,END=801,ERR=802,IOSTAT=J)

              CASE('ANL2')

                IF ( ndepth .GT. 100 ) GOTO 804

                depths(1:ndepth) = dpthnl

                READ (nds,nml=anl2,END=801,ERR=802,IOSTAT=J)

                dpthnl = depths(1:ndepth)

#endif

#ifdef W3_NL3

              CASE('SNL3')

                READ (nds,nml=snl3,END=801,ERR=802,IOSTAT=J)

              CASE('ANL3')

                IF ( nqdef .GT. 100 ) GOTO 804

                READ (nds,nml=anl3,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_NL4

              CASE('SNL4')

                READ (nds,nml=snl4,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_NL5

              CASE('SNL5')

                READ (nds,nml=snl5,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_NLS

              CASE('SNLS')

                READ (nds,nml=snls,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_ST1

              CASE('SDS1')

                READ (nds,nml=sds1,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_ST2

              CASE('SDS2')

                READ (nds,nml=sds2,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_ST3

              CASE('SDS3')

                READ (nds,nml=sds3,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_ST4

              CASE('SDS4')

                READ (nds,nml=sds4,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_ST6

              CASE('SDS6')

                READ (nds,nml=sds6,END=801,ERR=802,IOSTAT=J)

              CASE('SWL6')

                READ (nds,nml=swl6,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_BT1

              CASE('SBT1')

                READ (nds,nml=sbt1,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_BT4

              CASE('SBT4')

                READ (nds,nml=sbt4,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_IS1

              CASE('SIS1')

                READ (nds,nml=sis1,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_IS2

              CASE('SIS2')

                READ (nds,nml=sis2,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_DB1

              CASE('SDB1')

                READ (nds,nml=sdb1,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_UOST

              CASE('UOST')

                READ (nds,nml=uost,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_PR1

              CASE('PRO1')

                READ (nds,nml=pro1,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_PR2

              CASE('PRO2')

                READ (nds,nml=pro2,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_SMC

              CASE('PSMC')

                READ (nds,nml=psmc,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_PR3

              CASE('PRO3')

                READ (nds,nml=pro3,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_RTD

              CASE('ROTD')

                READ (nds,nml=rotd,END=801,ERR=802,IOSTAT=J)

              CASE('ROTB')

                READ (nds,nml=rotb,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_REF1

              CASE('REF1')

                READ (nds,nml=ref1,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_IG1

              CASE('SIG1')

                READ (nds,nml=sig1,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_IC2

              CASE('SIC2')

                READ (nds,nml=sic2,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_IC3

              CASE('SIC3')

                READ (nds,nml=sic3,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_IC4

              CASE('SIC4 ')

                READ (nds,nml=sic4,END=801,ERR=802,IOSTAT=J)

#endif

#ifdef W3_IC5

              CASE('SIC5 ')

                READ (nds,nml=sic5,END=801,ERR=802,IOSTAT=J)

#endif

              CASE('UNST')

                READ (nds,nml=unst,END=801,ERR=802,IOSTAT=J)

              CASE('OUTS')

                READ (nds,nml=outs,END=801,ERR=802,IOSTAT=J)

              CASE('MISC')

                READ (nds,nml=misc,END=801,ERR=802,IOSTAT=J)

              CASE DEFAULT

                GOTO 803

              END SELECT

              status  = '(user def. values) :'

              RETURN

            END IF

          ELSE

            EXIT

          END IF

        ENDIF

      END DO

    END DO

    !

800 CONTINUE

    RETURN

    !

801 CONTINUE

    WRITE (ndse,1001) name

    CALL extcde(1)

    RETURN

    !

802 CONTINUE

    WRITE (ndse,1002) name, j

    CALL extcde(2)

    RETURN

    !

803 CONTINUE

    WRITE (ndse,1003) name

    CALL extcde(3)

    RETURN

    !

#ifdef W3_NL2

804 CONTINUE

    WRITE (ndse,1004) ndepth

    CALL extcde(4)

    RETURN

#endif

    !

#ifdef W3_NL3

804 CONTINUE

    WRITE (ndse,1004) nqdef

    CALL extcde(4)

    RETURN

#endif

    !

    ! Formats

    !

1001 FORMAT (/' *** WAVEWATCH III ERROR IN READNL : '/          &

         '     PREMATURE END OF FILE IN READING ',a/)

1002 FORMAT (/' *** WAVEWATCH III ERROR IN READNL : '/          &

         '     ERROR IN READING ',a,'  IOSTAT =',i8/)

1003 FORMAT (/' *** WAVEWATCH III ERROR IN READNL : '/          &

         '     NAMELIST NAME ',a,' NOT RECOGNIZED'/)

#ifdef W3_NL2

1004 FORMAT (/' *** WAVEWATCH III ERROR IN READNL : '/          &

         .LE.'     TEMP DEPTH ARRAY TOO SMALL,  ',i8/)

#endif

#ifdef W3_NL3

1004 FORMAT (/' *** WAVEWATCH-III ERROR IN READNL : '/          &

         .LE.'     TEMP QPARMS ARRAY TOO SMALL,  ',i8/)

#endif

    !/

    !/ End of READNL ----------------------------------------------------- /

    !/

  END SUBROUTINE readnl

  !/

  !/ End of W3GRID ----------------------------------------------------- /

  !/

END MODULE w3gridmd