diff --git a/model/bin/make_makefile.sh b/model/bin/make_makefile.sh index 6b4cd290b9..3112f81a6b 100755 --- a/model/bin/make_makefile.sh +++ b/model/bin/make_makefile.sh @@ -885,7 +885,7 @@ core= data='w3wdatmd w3gdatmd w3adatmd w3idatmd w3odatmd wmmdatmd' prop= - source="w3parall w3triamd $stx $nlx $btx $is $uostmd" + source="w3parall w3triamd w3gridmd $stx $nlx $btx $is $uostmd" IO='w3iogrmd' aux="constants w3servmd w3arrymd w3dispmd w3gsrumd w3timemd w3nmlgridmd $pdlibyow $memcode" if [ "$scrip" = 'SCRIP' ] @@ -1401,6 +1401,7 @@ 'W3SMCOMD' ) modtest=w3smcomd.o ;; 'W3OUNFMETAMD' ) modtest=w3ounfmetamd.o ;; 'W3METAMD' ) modtest=w3metamd.o ;; + 'W3GRIDMD' ) modtest=w3gridmd.o ;; * ) modfound=no ;; esac diff --git a/model/bin/w3_new b/model/bin/w3_new index d538e71f5f..d030243ada 100755 --- a/model/bin/w3_new +++ b/model/bin/w3_new @@ -87,7 +87,7 @@ 'grib' ) cd $main_dir/ftn ; touch ww3_grib.ftn ;; 'mcp' ) cd $main_dir/ftn ; touch w3wavemd.ftn touch ww3_shel.ftn - touch ww3_grid.ftn ;; + touch w3gridmd.ftn ;; 'c90' ) cd $main_dir/ftn ; touch w3iogomd.ftn touch w3pro1md.ftn touch w3pro2md.ftn @@ -111,7 +111,7 @@ touch ww3_trnc.ftn ;; 'scrip' ) cd $main_dir/ftn ; touch wmgridmd.ftn touch wmscrpmd.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn cd $main_dir/ftn/SCRIP ; touch scrip_interface.ftn ;; 'scripnc') cd $main_dir/ftn ; touch wmgridmd.ftn cd $main_dir/ftn/SCRIP ; touch scrip_interface.ftn ;; @@ -151,7 +151,7 @@ touch wmgridmd.ftn touch ww3_gspl.ftn touch ww3_shel.ftn - touch ww3_grid.ftn ;; + touch w3gridmd.ftn ;; 'prop' ) cd $main_dir/ftn ; touch w3gdatmd.ftn touch w3adatmd.ftn touch w3idatmd.ftn @@ -162,21 +162,21 @@ touch wmgridmd.ftn touch w3updtmd.ftn touch ww3_shel.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_gspl.ftn ;; 'stress' ) cd $main_dir/ftn ; touch w3srcemd.ftn touch w3gdatmd.ftn touch w3iogrmd.ftn touch ww3_outp.ftn touch ww3_ounp.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch gx_outp.ftn ;; 'dstress') cd $main_dir/ftn ; touch w3srcemd.ftn touch w3gdatmd.ftn touch w3iogrmd.ftn touch w3fld1md.ftn touch w3fld2md.ftn - touch ww3_grid.ftn ;; + touch w3gridmd.ftn ;; 's_ln' ) cd $main_dir/ftn ; touch w3gdatmd.ftn touch w3srcemd.ftn touch w3iogrmd.ftn @@ -184,7 +184,7 @@ touch w3adatmd.ftn touch w3iogrmd.ftn touch wminitmd.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_outp.ftn touch ww3_ounp.ftn touch ww3_prep.ftn @@ -202,7 +202,7 @@ touch w3iogomd.ftn touch w3updtmd.ftn touch wmesmfmd.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_outp.ftn touch ww3_ounp.ftn touch ww3_ounf.ftn @@ -210,7 +210,7 @@ 'stab' ) cd $main_dir/ftn ; touch w3updtmd.ftn touch w3src3md.ftn touch w3src4md.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_outp.ftn touch ww3_ounp.ftn touch gx_outp.ftn ;; @@ -219,7 +219,7 @@ touch w3srcemd.ftn touch w3iogrmd.ftn touch wminitmd.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_prep.ftn touch ww3_outp.ftn touch ww3_ounp.ftn @@ -230,7 +230,7 @@ 'snls' ) cd $main_dir/ftn ; touch w3gdatmd.ftn touch w3srcemd.ftn touch w3iogrmd.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_outp.ftn touch gx_outp.ftn ;; 's_bot' ) cd $main_dir/ftn ; touch w3gdatmd.ftn @@ -241,7 +241,7 @@ touch w3profsmd_pdlib.ftn touch w3sic4md.ftn touch w3wavemd.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_gint.ftn touch ww3_outp.ftn touch ww3_outf.ftn @@ -253,18 +253,18 @@ touch w3srcemd.ftn touch w3iogrmd.ftn touch w3profsmd_pdlib.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_outp.ftn touch ww3_ounp.ftn touch gx_outp.ftn ;; 'miche' ) cd $main_dir/ftn ; touch w3gdatmd.ftn touch w3srcemd.ftn - touch ww3_grid.ftn ;; + touch w3gridmd.ftn ;; 's_tr' ) cd $main_dir/ftn ; touch w3gdatmd.ftn touch w3srcemd.ftn touch w3iogrmd.ftn touch w3profsmd_pdlib.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_outp.ftn touch ww3_ounp.ftn touch gx_outp.ftn ;; @@ -272,7 +272,7 @@ touch w3srcemd.ftn touch w3iogrmd.ftn touch w3profsmd_pdlib.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_outp.ftn touch ww3_ounp.ftn touch gx_outp.ftn ;; @@ -283,7 +283,7 @@ touch w3updtmd.ftn touch w3wavemd.ftn touch w3srcemd.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_outp.ftn touch ww3_ounp.ftn touch ww3_shel.ftn @@ -296,7 +296,7 @@ touch w3sic2md.ftn touch w3wavemd.ftn touch ww3_gint.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_ounf.ftn touch ww3_outf.ftn touch ww3_shel.ftn @@ -313,11 +313,11 @@ touch w3triamd.ftn touch w3updtmd.ftn touch w3wavemd.ftn - touch ww3_grid.ftn ;; + touch w3gridmd.ftn ;; 's_xx' ) cd $main_dir/ftn ; touch w3gdatmd.ftn touch w3srcemd.ftn touch w3iogrmd.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_outp.ftn touch ww3_ounp.ftn touch gx_outp.ftn ;; @@ -328,11 +328,11 @@ 'rwind' ) cd $main_dir/ftn ; touch w3updtmd.ftn touch w3gdatmd.ftn touch w3iogrmd.ftn - touch ww3_grid.ftn ;; + touch w3gridmd.ftn ;; 'wcor' ) cd $main_dir/ftn ; touch w3updtmd.ftn touch w3gdatmd.ftn touch w3iogrmd.ftn - touch ww3_grid.ftn ;; + touch w3gridmd.ftn ;; 'rstwind') cd $main_dir/ftn ; touch wmesmfmd.ftn touch w3idatmd.ftn touch w3iorsmd.ftn ;; @@ -352,12 +352,12 @@ touch wminitmd.ftn touch ww3_shel.ftn ;; 'mggse' ) cd $main_dir/ftn ; touch w3pro3md.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_shel.ftn ;; 'subsec' ) cd $main_dir/ftn ; touch w3gdatmd.ftn touch w3iogrmd.ftn touch w3wavemd.ftn - touch ww3_grid.ftn ;; + touch w3gridmd.ftn ;; 'tdyn' ) cd $main_dir/ftn ; touch w3pro2md.ftn touch w3psmcmd.ftn ;; 'dss0' ) cd $main_dir/ftn ; touch w3pro2md.ftn @@ -380,7 +380,7 @@ touch w3ref1md.ftn touch w3src4md.ftn touch w3srcemd.ftn - touch ww3_grid.ftn + touch w3gridmd.ftn touch ww3_ounp.ftn touch ww3_outp.ftn ;; 'rotag' ) cd $main_dir/ftn ; touch w3gdatmd.ftn @@ -393,13 +393,13 @@ touch ww3_ounf.ftn touch ww3_ounp.ftn touch ww3_outf.ftn - touch ww3_grid.ftn ;; + touch w3gridmd.ftn ;; 'arctic' ) cd $main_dir/ftn ; touch w3gdatmd.ftn touch w3iogrmd.ftn touch w3psmcmd.ftn touch w3updtmd.ftn touch w3wavemd.ftn - touch ww3_grid.ftn ;; + touch w3gridmd.ftn ;; 'nnt' ) cd $main_dir/ftn ; touch w3srcemd.ftn ;; 'mprf' ) cd $main_dir/ftn ; touch wmmdatmd.ftn touch wminitmd.ftn @@ -469,7 +469,7 @@ touch w3iogrmd.ftn touch w3srcemd.ftn touch w3wavemd.ftn - touch ww3_grid.ftn ;; + touch w3gridmd.ftn ;; 'b4b' ) cd $main_dir/ftn ; touch w3psmcmd.ftn ;; * ) echo "w3_new: keyword [$key] not recognized" ;; esac diff --git a/model/ftn/w3gridmd.ftn b/model/ftn/w3gridmd.ftn new file mode 100644 index 0000000000..9425c2b8cc --- /dev/null +++ b/model/ftn/w3gridmd.ftn @@ -0,0 +1,6597 @@ +#include "w3macros.h" +!/ ------------------------------------------------------------------- / + MODULE W3GRIDMD +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | H. L. Tolman | +!/ | J. H. Alves | +!/ | F. Ardhuin | +!/ | FORTRAN 90 | +!/ | Last update : 15-Apr-2020 | +!/ +-----------------------------------+ +!/ +!/ 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 ) +!/ +!/ 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 program, 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 program. 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 : +! +! None, stand-alone 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(NCel, 5), each row holds i, j, di, dj, 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(NUFc, 7) and +! IJKVFc(NVFc,8), 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 another option +! ARC is activated along with the SMC option. ARC 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). +! +! !/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. +! !/LNX Open slot. +! +! !/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. +! !/STX Open slot. +! +! !/NL0 No nonlinear interactions. +! !/NL1 Discrete interaction approximation (DIA). +! !/NL2 Exact interactions (WRT). +! !/NL3 Generalized Multiple DIA (GMD). +! !/NL4 Two Scale Approximation +! !/NLX Open slot. +! !/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) +! !/BTX Open slot. +! +! !/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 (Mosig et al. method) +! (Mosig et al. 2015: JGR) +! +! !/UOST Unresolved Obstacles Source Term (UOST), Mentaschi et al. 2015 +! +! !/DB0 No depth-induced breaking included. +! !/DB1 Battjes-Janssen depth-limited breaking. +! !/DBX Open slot. +! !/MLIM Mich-style limiter. +! +! !/TR0 No triad interactions included. +! !/TRX Open slot. +! +! !/BS0 No bottom scattering included. +! !/BS1 Routines from F. Ardhuin. +! !/BSX Open slot. +! +! !/XX0 No unclasified source term included. +! !/XXX Open slot. +! +! !/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 UNO2 scheme on Spherical Multiple-Cell grid. +! !/ARC Append the Arctic part to the SMC grid. +! +! !/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 +!/RTD USE W3SERVMD, ONLY: W3EQTOLL, W3LLTOEQ +!/ARC USE W3SERVMD, ONLY: W3LLTOEQ +!/S USE W3SERVMD, ONLY: STRACE + USE W3ARRYMD, ONLY: INA2R, INA2I +!/T USE W3ARRYMD, ONLY: PRTBLK + 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 +!/SCRIP USE SCRIP_GRIDS, ONLY: GRID1_UNITS, GRID1_NAME, & +!/SCRIP GRID1_CENTER_LON, GRID1_CENTER_LAT, & +!/SCRIP GRID1_CORNER_LON, GRID1_CORNER_LAT, & +!/SCRIP GRID1_MASK, GRID1_SIZE, GRID1_RANK, & +!/SCRIP GRID1_IMASK, & +!/SCRIP GRID1_CORNERS, GRID1_DIMS +!/SCRIP USE SCRIP_KINDSMOD +!/SCRIP USE WMSCRPMD +!/SCRIPNC USE NETCDF +! +!/NL3 USE W3SNL3MD, ONLY: LAMMAX, DELTHM +!/NLS USE W3SNLSMD, ONLY: ABMAX +! + 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, NRXX, 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 +!/NL2 INTEGER :: IDEPTH +!/O1 INTEGER :: IBI, IP0, IPN, IPH, IPI + INTEGER :: NCOL = 78 +!/SMC !!Li Offset to change Equator index = 0 to regular index JEQT +!/SMC !!Li LvSMC levels of refinded resolutions for SMC grid. +!/SMC !!Li NBISMC number of boundary point for regional SMC grid. +!/SMC !!Li ISHFT for SMC i-index from smc origin to regular grid west edge. +!/SMC !!Li SMC cell only subgrid obstruction array dimensions NCObst, JObs. +!/SMC INTEGER :: JEQT, LvSMC, NBISMC, JS, NCObst, JObs, ISHFT +!/SMC INTEGER :: NGUI, NGVJ +!/ARC INTEGER :: NAUI, NAVJ +! +!/O2 INTEGER :: NMAP, IMAP +!/T INTEGER :: IX3, IY3 +!/T0 INTEGER :: IFILE +!/S INTEGER, SAVE :: IENT = 0 +! + INTEGER, ALLOCATABLE :: TMPSTA(:,:), TMPMAP(:,:), READMP(:,:) +!/T INTEGER, ALLOCATABLE :: MAPOUT(:,:) +! + 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) + +!/DEBUGGRID INTEGER :: nbCase1, nbCase2, nbCase3, & +!/DEBUGGRID nbCase4, nbCase5, nbCase6, & +!/DEBUGGRID nbCase7, nbCase8 +!/DEBUGGRID INTEGER :: nbTMPSTA0, nbTMPSTA1, nbTMPSTA2 +!/DEBUGGRID INTEGER :: IAPROC +! +!/LN1 REAL :: CLIN, RFPM, RFHF +!/ST1 REAL :: CINP, CDIS, APM +!/ST2 REAL :: PHIMIN, FPIA, FPIB, DPHID +!/NL1 REAL :: NLPROP +!/NL2 REAL :: DPTFAC, DEPTHS(100) +!/NL3 REAL :: QPARMS(500) +!/NLS REAL :: A34, FHFC, DNM, FC1, FC2, FC3 +!/BT1 REAL :: GAMMA +!/PR2 REAL :: LATMIN +! +!/SMC REAL :: LATMIN, TRNMX, TRNMY +!/SMC INTEGER, ALLOCATABLE :: NLvCelsk(:), NLvUFcsk(:), NLvVFcsk(:) +!/SMC INTEGER, ALLOCATABLE :: IJKCelin(:,:),IJKUFcin(:,:),IJKVFcin(:,:) +!/SMC INTEGER, ALLOCATABLE :: NBICelin(:), IJKObstr(:,:) +!/ARC REAL :: PoLonAC, PoLatAC +!/ARC INTEGER, ALLOCATABLE :: IJKCelAC(:,:),IJKUFcAC(:,:),IJKVFcAC(:,:) +!/ARC REAL, ALLOCATABLE :: XLONAC(:),YLATAC(:),ELONAC(:),ELATAC(:) +! +!/RTD REAL, ALLOCATABLE :: AnglDin(:,:),StdLon(:,:),StdLat(:,:) +!/RTD ! 1-dim boundary sectors +!/RTD REAL, ALLOCATABLE :: BDYLON(:), BDYLAT(:), & +!/RTD ELatbdy(:), ELonbdy(:), Anglbdy(:) +!/RTD ! If the destination grid for an output b.c. is rotated, its pole is: +!/RTD REAL :: bPolat, bPolon +!/RTD! + REAL, ALLOCATABLE :: XGRDIN(:,:), YGRDIN(:,:) + REAL, ALLOCATABLE :: ZBIN(:,:), OBSX(:,:), OBSY(:,:) + REAL, ALLOCATABLE :: REFD(:,:), REFD2(:,:), REFS(:,:) +!/BT4 REAL, ALLOCATABLE :: SED_D50FILE(:,:), SED_POROFILE(:,:) +!/BT4 LOGICAL :: SEDMAPD50 +!/BT4 REAL :: SED_D50_UNIFORM, SED_DSTAR, RIPFAC1, & +!/BT4 RIPFAC2, RIPFAC3, RIPFAC4, SIGDEPTH, & +!/BT4 BOTROUGHMIN, BOTROUGHFAC +! + LOGICAL :: FLLIN, FLINDS, FLNL, FLBT, FLDB, & + FLTR, FLBS, FLXX, FLPROP, FLREF, & + FIRST, CONNCT, FLNEW, INGRID,FLIC, & + FLIS, FLGNML + LOGICAL :: FLTC96 = .FALSE. + LOGICAL :: FLNMLO = .FALSE. + LOGICAL :: FLSTB2 = .FALSE. + LOGICAL :: FLST4 = .FALSE. + LOGICAL :: FLST6 = .FALSE. + +!!Li Add a logical variable to shelter regular grid lines from SMC grid. + LOGICAL :: RGLGRD = .TRUE. +!!Li + REAL :: FACBERG, REFSLOPE +!/IS1 REAL :: ISC1, ISC2 +!/IS2 REAL :: ISC1, IS2BACKSCAT, IS2C2, IS2C3,& +!/IS2 IS2FRAGILITY, IS2DMIN, IS2DAMP, & +!/IS2 IS2CONC, IS2CREEPB, IS2CREEPC, & +!/IS2 IS2CREEPD, IS2CREEPN, IS2BREAKE,& +!/IS2 IS2WIM1, IS2BREAKF, IS2FLEXSTR, & +!/IS2 IS2ANDISN, IS2ANDISE, IS2ANDISD +!/IS2 LOGICAL :: IS2BREAK, IS2DISP, IS2DUPDATE, & +!/IS2 IS2ISOSCAT, IS2ANDISB +! +!/REF1 REAL :: REFCOAST, REFFREQ, REFMAP, & +!/REF1 REFSUBGRID, REFRMAX, REFMAPD, & +!/REF1 REFICEBERG, REFCOSP_STRAIGHT, & +!/REF1 REFFREQPOW, REFUNSTSOURCE +! +!/IG1 LOGICAL :: IGSWELLMAX, IGBCOVERWRITE +!/IG1 INTEGER :: IGMETHOD, IGADDOUTP, IGSOURCE, & +!/IG1 IGSOURCEATBP, IGSTERMS +!/IG1 REAL :: IGMAXFREQ, IGMINDEP, IGMAXDEP, & +!/IG1 IGKDMIN, IGFIXEDDEPTH, IGEMPIRICAL +! +!/IC2 LOGICAL :: IC2DISPER +!/IC2 REAL :: IC2TURB, IC2ROUGH, IC2REYNOLDS, & +!/IC2 IC2SMOOTH, IC2VISC, IC2TURBS, IC2DMAX + +!/IC3 REAL :: IC2TURB, IC2ROUGH, IC2REYNOLDS, & +!/IC3 IC2SMOOTH, IC2VISC, IC2TURBS, & +!/IC3 IC3MAXTHK, IC3MAXCNC, & +!/IC3 IC3HILIM, IC3KILIM, & +!/IC3 IC3VISC, IC3ELAS, IC3DENS, IC3HICE +!/IC3 LOGICAL :: IC3CHENG,USECGICE + +!/IC4 INTEGER :: IC4METHOD +!/IC4 REAL :: IC4KI(NIC4), IC4FC(NIC4) +! +!/IC5 REAL :: IC5MINIG, IC5MINWT, & +!/IC5 IC5MAXKRATIO, IC5MAXKI, IC5MINHW, & +!/IC5 IC5MAXITER, IC5RKICK, IC5KFILTER + + 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) +!/FLX3 CHARACTER(LEN=18) :: TYPEID + +!/SCRIP INTEGER :: NCID +!/SCRIP INTEGER :: grid_size_dimid, grid_rank_dimid, grid_corners_dimid +!/SCRIP INTEGER :: grid_center_lat_varid, grid_center_lon_varid +!/SCRIP INTEGER :: grid_corner_lat_varid, grid_corner_lon_varid +!/SCRIP INTEGER :: grid_area_varid, grid_imask_varid +!/SCRIP INTEGER :: grid_dims_varid +!/SCRIP REAL (SCRIP_R8) :: CONV_DX,CONV_DY,OFFSET + +!/ ------------------------------------------------------------------- / +!/ 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. +!/FLD1 INTEGER :: TAILTYPE +!/FLD1 REAL :: TAILLEV, TAILT1, TAILT2 +!/FLD2 INTEGER :: TAILTYPE +!/FLD2 REAL :: TAILLEV, TAILT1, TAILT2 +!/FLX3 INTEGER :: CTYPE +!/FLX3 REAL :: CDMAX +!/FLX4 REAL :: CDFAC +!/ST2 REAL :: ZWND, SWELLF, STABSH, STABOF, & +!/ST2 CNEG, CPOS, FNEG, FPOS +!/ST2 REAL :: SDSA0, SDSA1, SDSA2, & +!/ST2 SDSB0, SDSB1, SDSB2, SDSB3 +!/ST3 REAL :: ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP,& +!/ST3 ZALP, SWELLF, FXPM3, FXFM3, & +!/ST3 WNMEANPTAIL, WNMEANP, STXFTF, STXFTWN +!/ST3 REAL :: STXFTFTAIL, SDSC1, & +!/ST3 SDSDELTA1, SDSDELTA2 +! +!/ST4 INTEGER :: SWELLFPAR, SDSISO, SDSBRFDF +!/ST4 REAL :: SDSBCHOICE +!/ST4 REAL :: ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP,& +!/ST4 ZALP, Z0RAT, TAUWSHELTER, SWELLF, & +!/ST4 SWELLF2,SWELLF3,SWELLF4, SWELLF5, & +!/ST4 SWELLF6, SWELLF7, FXPM3, FXFM3, & +!/ST4 WNMEANPTAIL, WNMEANP, STXFTF, STXFTFTAIL, & +!/ST4 STXFTWN, SINBR, FXFMAGE, & +!/ST4 SDSC2, SDSCUM, SDSC4, SDSC5, SDSC6, WHITECAPWIDTH, WHITECAPDUR, & +!/ST4 SDSSTRAIN, SDSSTRAINA, SDSSTRAIN2, & +!/ST4 SDSBR, SDSP, SDSBT, SDS4A, SDKOF, & +!/ST4 SDSCOS, SDSDTH, SDSBCK, SDSABK, & +!/ST4 SDSPBK, SDSBINT, SDSHCK, & +!/ST4 SDSBRF1, & +!/ST4 SDSBM0, SDSBM1, SDSBM2, SDSBM3, & +!/ST4 SDSBM4, SDSFACMTF, SDSCUMP, SDSNUW, & +!/ST4 SDSL, SDSMWD, SDSMWPOW, SPMSS, SDSNMTF +! +!/ST6 REAL :: SINA0, SINWS, SINFC, & +!/ST6 SDSA1, SDSA2, SWLB1 +!/ST6 INTEGER :: SDSP1, SDSP2 +!/ST6 LOGICAL :: SDSET, CSTB1 +! +!/NL1 REAL :: LAMBDA, KDCONV, KDMIN, & +!/NL1 SNLCS1, SNLCS2, SNLCS3 +!/NL2 INTEGER :: IQTYPE, NDEPTH +!/NL2 REAL :: TAILNL +!/NL3 INTEGER :: NQDEF +!/NL3 REAL :: MSC, NSC, KDFD, KDFS +!/NL4 INTEGER :: INDTSA, ALTLP +!/DB1 REAL :: BJALFA, BJGAM +!/DB1 LOGICAL :: BJFLAG +!/PR2 REAL :: DTIME +! +!/SMC REAL :: DTIME, RFMAXD, SYMR, YJ0R +!/SMC LOGICAL :: UNO3, AVERG, SEAWND +! +!/PR3 REAL :: WDTHCG, WDTHTH + LOGICAL :: JGS_TERMINATE_MAXITER = .TRUE. + LOGICAL :: JGS_TERMINATE_DIFFERENCE = .TRUE. + LOGICAL :: JGS_TERMINATE_NORM = .TRUE. + LOGICAL :: JGS_LIMITER = .FALSE. + LOGICAL :: JGS_BLOCK_GAUSS_SEIDEL = .TRUE. + LOGICAL :: JGS_USE_JACOBI = .TRUE. + LOGICAL :: JGS_SOURCE_NONLINEAR = .FALSE. + LOGICAL :: UGOBCAUTO = .FALSE. + LOGICAL :: UGBCCFL = .FALSE. + LOGICAL :: EXPFSN = .TRUE. + LOGICAL :: EXPFSPSI = .FALSE. + LOGICAL :: EXPFSFCT = .FALSE. + LOGICAL :: IMPFSN = .FALSE. + LOGICAL :: EXPTOTAL = .FALSE. + LOGICAL :: IMPTOTAL = .FALSE. + LOGICAL :: IMPREFRACTION = .FALSE. + LOGICAL :: IMPFREQSHIFT = .FALSE. + LOGICAL :: IMPSOURCE = .FALSE. + LOGICAL :: SETUP_APPLY_WLV = .FALSE. + INTEGER :: JGS_MAXITER=100 + INTEGER :: nbSel + INTEGER :: UNSTSCHEMES(4) + INTEGER :: UNSTSCHEME + INTEGER :: JGS_NLEVEL = 0 + REAL*8 :: JGS_PMIN = 0. + REAL*8 :: JGS_DIFF_THR = 1.E-10 + REAL*8 :: JGS_NORM_THR = 1.E-20 + REAL*8 :: SOLVERTHR_SETUP = 1.E-20 + REAL*8 :: CRIT_DEP_SETUP = 0. +! + CHARACTER :: UGOBCFILE*60 + REAL :: UGOBCDEPTH + LOGICAL :: UGOBCOK + +!/RTD REAL :: PLAT, PLON +!/RTD LOGICAL :: UNROT +!/RTD ! Poles of the output nested grids. May be a mix of rotated and standard +!/RTD REAL, DIMENSION(9) :: BPLAT, BPLON +! +!/FLD1 NAMELIST /FLD1/ TAILTYPE, TAILLEV, TAILT1, TAILT2 +!/FLD2 NAMELIST /FLD2/ TAILTYPE, TAILLEV, TAILT1, TAILT2 +!/FLX3 NAMELIST /FLX3/ CDMAX, CTYPE +!/FLX4 NAMELIST /FLX4/ CDFAC +!/IC2 NAMELIST /SIC2/ IC2DISPER, IC2TURB, IC2ROUGH, IC2REYNOLDS, & +!/IC2 IC2SMOOTH, IC2VISC, IC2TURBS, IC2DMAX +!/IC3 NAMELIST /SIC3/ IC3MAXTHK, IC2TURB, IC2ROUGH, IC2REYNOLDS, & +!/IC3 IC2SMOOTH, IC2VISC, IC2TURBS, IC3MAXCNC, & +!/IC3 IC3CHENG, USECGICE, IC3HILIM, IC3KILIM, & +!/IC3 IC3VISC, IC3ELAS, IC3DENS, IC3HICE +!/IC4 NAMELIST /SIC4/ IC4METHOD, IC4KI, IC4FC +!/IC5 NAMELIST /SIC5/ IC5MINIG, IC5MINWT, IC5MAXKRATIO, & +!/IC5 IC5MAXKI, IC5MINHW, IC5MAXITER, IC5RKICK,& +!/IC5 IC5KFILTER +!/IG1 NAMELIST /SIG1/ IGMETHOD, IGADDOUTP, IGSOURCE, IGBCOVERWRITE, & +!/IG1 IGMAXFREQ, IGSTERMS, IGSWELLMAX, & +!/IG1 IGSOURCEATBP, IGKDMIN, IGFIXEDDEPTH, IGEMPIRICAL +!/LN1 NAMELIST /SLN1/ CLIN, RFPM, RFHF +!/ST1 NAMELIST /SIN1/ CINP +!/ST2 NAMELIST /SIN2/ ZWND, SWELLF, STABSH, STABOF, CNEG, CPOS, FNEG +!/ST3 NAMELIST /SIN3/ ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & +!/ST3 SWELLF +!/ST4 NAMELIST /SIN4/ ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & +!/ST4 TAUWSHELTER, SWELLFPAR, SWELLF, & +!/ST4 SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, & +!/ST4 SWELLF7, Z0RAT, SINBR +!/NL1 NAMELIST /SNL1/ LAMBDA, NLPROP, KDCONV, KDMIN, & +!/NL1 SNLCS1, SNLCS2, SNLCS3 +!/NL2 NAMELIST /SNL2/ IQTYPE, TAILNL, NDEPTH +!/NL2 NAMELIST /ANL2/ DEPTHS +!/NL3 NAMELIST /SNL3/ NQDEF, MSC, NSC, KDFD, KDFS +!/NL3 NAMELIST /ANL3/ QPARMS +!/NL4 NAMELIST /SNL4/ INDTSA, ALTLP +!/NLS NAMELIST /SNLS/ A34, FHFC, DNM, FC1, FC2, FC3 +!/ST1 NAMELIST /SDS1/ CDIS, APM +!/ST2 NAMELIST /SDS2/ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN +!/ST3 NAMELIST /SDS3/ SDSC1, WNMEANP, FXPM3, FXFM3, SDSDELTA1, & +!/ST3 SDSDELTA2 +!/ST4 NAMELIST /SDS4/ SDSBCHOICE, WNMEANP, WNMEANPTAIL, FXPM3, FXFM3, & +!/ST4 FXFMAGE, SDSC2, SDSCUM, SDSSTRAIN, SDSSTRAINA, & +!/ST4 SDSSTRAIN2, SDSC4, SDSFACMTF, SDSNMTF,SDSCUMP, & +!/ST4 SDSC5, SDSC6, SDSBR, SDSBT, SDSP, SDSISO, & +!/ST4 SDSBCK, SDSABK, SDSPBK, SDSBINT, SDSHCK, & +!/ST4 SDSDTH, SDSCOS, SDSBRF1, SDSBRFDF, SDSNUW, & +!/ST4 SDSBM0, SDSBM1, SDSBM2, SDSBM3, SDSBM4, & +!/ST4 WHITECAPWIDTH, WHITECAPDUR, SDSMWD, SDSMWPOW, SDKOF + +!/ST6 NAMELIST /SIN6/ SINA0, SINWS, SINFC +!/ST6 NAMELIST /SDS6/ SDSET, SDSA1, SDSA2, SDSP1, SDSP2 +!/ST6 NAMELIST /SWL6/ SWLB1, CSTB1 +!/BT1 NAMELIST /SBT1/ GAMMA +!/BT4 NAMELIST /SBT4/ SEDMAPD50, SED_D50_UNIFORM, RIPFAC1, & +!/BT4 RIPFAC2, RIPFAC3, RIPFAC4, SIGDEPTH, & +!/BT4 BOTROUGHMIN, BOTROUGHFAC +!/DB1 NAMELIST /SDB1/ BJALFA, BJGAM, BJFLAG +!/UOST NAMELIST /UOST/ UOSTFILELOCAL, UOSTFILESHADOW, & +!/UOST UOSTFACTORLOCAL, UOSTFACTORSHADOW +! +!/PR1 NAMELIST /PRO1/ CFLTM +!/PR2 NAMELIST /PRO2/ CFLTM, DTIME, LATMIN +!/SMC NAMELIST /PSMC/ CFLTM, DTIME, LATMIN, RFMAXD, UNO3, AVERG, & +!/SMC LvSMC, ISHFT, JEQT, NBISMC, SEAWND +! +!/PR3 NAMELIST /PRO3/ CFLTM, WDTHCG, WDTHTH + 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_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 +!/IS1 NAMELIST /SIS1/ ISC1, ISC2 +!/IS2 NAMELIST /SIS2/ ISC1, IS2C2, IS2C3, IS2BACKSCAT, IS2ISOSCAT, IS2BREAK, & +!/IS2 IS2DISP, IS2FRAGILITY, IS2CONC, IS2DMIN, & +!/IS2 IS2DAMP, IS2DUPDATE, IS2CREEPB, IS2CREEPC, & +!/IS2 IS2CREEPD, IS2CREEPN, IS2BREAKE, IS2BREAKF, & +!/IS2 IS2WIM1, IS2FLEXSTR, IS2ANDISB, IS2ANDISE, IS2ANDISD, & +!/IS2 IS2ANDISN +!/REF1 NAMELIST /REF1/ REFCOAST, REFFREQ, REFMAP, REFMAPD, & +!/REF1 REFSUBGRID, REFICEBERG, & +!/REF1 REFCOSP_STRAIGHT, REFSLOPE, REFRMAX, & +!/REF1 REFFREQPOW, REFUNSTSOURCE +!/ +!/RTD NAMELIST /ROTD/ PLAT, PLON, UNROT +!/RTD! Poles of destination grids for boundary conditions output +!/RTD NAMELIST /ROTB/ BPLAT, BPLON +!/ +!/ ------------------------------------------------------------------- / +!/ + DATA YESXNO / 'YES/--' , '---/NO' / + + CONTAINS + + SUBROUTINE W3GRID() + +!/O0 FLNMLO = .TRUE. +!/STAB2 FLSTB2 = .TRUE. +! +!/SMC !!Li Switch off regular grid lines by setting the logical +!/SMC RGLGRD = .FALSE. +! +!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! 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. +! +!/DEBUGGRID IAPROC = 1 + 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 ) +! +!/S CALL STRACE (IENT, 'W3GRID') + 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 +!/SEC1 IF (DTMAX.LT.1.) THEN +!/SEC1 NITERSEC1=CEILING(1./DTMAX) +!/SEC1 WRITE (NDSO,913) NITERSEC1 +!/SEC1 ELSE +!/SEC1 NITERSEC1=1 +!/SEC1 END IF + + 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 + NRXX = 0 +! + FLLIN = .TRUE. + FLINDS = .TRUE. + FLNL = .TRUE. + FLBT = .TRUE. + FLIC = .FALSE. + FLIS = .FALSE. + FLDB = .TRUE. + FLTR = .TRUE. + FLBS = .TRUE. + FLREF = .FALSE. + FLXX = .TRUE. +! +!/LN0 NRLIN = NRLIN + 1 +!/LN0 FLLIN = .FALSE. +!/SEED NRLIN = NRLIN + 1 +!/LN1 NRLIN = NRLIN + 1 +!/LNX NRLIN = NRLIN + 1 +! +!/ST0 NRSRCE = NRSRCE + 1 +!/ST0 FLINDS = .FALSE. +!/ST1 NRSRCE = NRSRCE + 1 +!/ST2 NRSRCE = NRSRCE + 1 +!/ST2 FLTC96 = .TRUE. +!/ST3 NRSRCE = NRSRCE + 1 +!/ST4 NRSRCE = NRSRCE + 1 +!/ST4 FLST4 = .TRUE. +!/ST6 NRSRCE = NRSRCE + 1 +!/ST6 FLST6 = .TRUE. +!/STX NRSRCE = NRSRCE + 1 +! +!/NL0 NRNL = NRNL + 1 +!/NL0 FLNL = .FALSE. +!/NL1 NRNL = NRNL + 1 +!/NL2 NRNL = NRNL + 1 +!/NL3 NRNL = NRNL + 1 +!/NL4 NRNL = NRNL + 1 +!/NLX NRNL = NRNL + 1 +! +!/BT0 NRBT = NRBT + 1 +!/BT0 FLBT = .FALSE. +!/BT1 NRBT = NRBT + 1 +!/BT4 NRBT = NRBT + 1 +!/BT8 NRBT = NRBT + 1 +!/BT9 NRBT = NRBT + 1 +!/BTX NRBT = NRBT + 1 +! +!/IC1 NRIC = NRIC + 1 +!/IC1 FLIC = .TRUE. +!/IC2 NRIC = NRIC + 1 +!/IC2 FLIC = .TRUE. +!/IC3 NRIC = NRIC + 1 +!/IC3 FLIC = .TRUE. +!/IC4 NRIC = NRIC + 1 +!/IC4 FLIC = .TRUE. +!/IC5 NRIC = NRIC + 1 +!/IC5 FLIC = .TRUE. +! +!/IS1 NRIS = NRIS + 1 +!/IS1 FLIS = .TRUE. +!/IS2 NRIS = NRIS + 1 +!/IS2 FLIS = .TRUE. +! +!/DB0 NRDB = NRDB + 1 +!/DB0 FLDB = .FALSE. +!/DB1 NRDB = NRDB + 1 +!/DBX NRDB = NRDB + 1 +! +!/TR0 NRTR = NRTR + 1 +!/TR0 FLTR = .FALSE. +!/TR1 NRTR = NRTR + 1 +!/TRX NRTR = NRTR + 1 +! +!/BS0 NRBS = NRBS + 1 +!/BS0 FLBS = .FALSE. +!/BS1 NRBS = NRBS + 1 +!/BSX NRBS = NRBS + 1 +! +!/REF1 FLREF = .TRUE. +! +!/XX0 NRXX = NRXX + 1 +!/XX0 FLXX = .FALSE. +!/XXX NRXX = NRXX + 1 +! + 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.FLXX .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. FLXX .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 ( NRXX .NE. 1 ) THEN + WRITE (NDSE,1029) NRXX + CALL EXTCDE ( 18 ) + 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 +! +!/FLX1 WRITE (NDSO,810) +!/FLX2 WRITE (NDSO,810) +! +!/FLX2 CINXSI = 0.20 +!/FLX2 NITTIN = 3 +!/FLX3 CINXSI = 0.20 +!/FLX3 NITTIN = 3 +!/FLX3 CDMAX = 2.5E-3 +!/FLX3 CTYPE = 0 +! +!/FLX3 CALL READNL ( NDSS, 'FLX3', STATUS ) +!/FLX3 WRITE (NDSO,810) STATUS +!/FLX3 CDMAX = MAX ( 0. , CDMAX ) +!/FLX3 IF ( CTYPE .EQ. 1 ) THEN +!/FLX3 TYPEID = 'hyperbolic tangent' +!/FLX3 ELSE +!/FLX3 CTYPE = 0 +!/FLX3 TYPEID = 'discontinuous ' +!/FLX3 END IF +!/FLX3 WRITE (NDSO,811) CDMAX*1.E3, TYPEID +!/FLX3 CD_MAX = CDMAX +!/FLX3 CAP_ID = CTYPE +! +!/FLX4 CDFAC = 1.0 +!/FLX4 CALL READNL ( NDSS, 'FLX4', STATUS ) +!/FLX4 WRITE (NDSO,810) STATUS +!/FLX4 WRITE (NDSO,811) CDFAC +!/FLX4 FLX4A0 = CDFAC +! +! 6.d.2 Linear input +! +!/LN0 WRITE (NDSO,820) +!/SEED WRITE (NDSO,820) +!/LNX WRITE (NDSO,820) +! +!/LN1 CLIN = 80. +!/LN1 RFPM = 1. +!/LN1 RFHF = 0.5 +! +!/LN1 CALL READNL ( NDSS, 'SLN1', STATUS ) +!/LN1 WRITE (NDSO,820) STATUS +!/LN1 CLIN = MAX (0.,CLIN) +!/LN1 RFPM = MAX (0.,RFPM) +!/LN1 RFHF = MAX(0.,MIN (1.,RFHF)) +!/LN1 WRITE (NDSO,821) CLIN, RFPM, RFHF +!/LN1 SLNC1 = CLIN * (DAIR/DWAT)**2 / GRAV**2 +!/LN1 FSPM = RFPM +!/LN1 FSHF = RFHF +! +! 6.d.3 Exponential input +! +!/ST0 WRITE (NDSO,920) +!/STX WRITE (NDSO,920) +! +!/ST1 CINP = 0.25 +!/ST2 ZWND = 10. +!/ST2 SWELLF = 0.100 +!/ST2 STABSH = 1.38 +!/ST2 STABOF = -0.01 +!/ST2 CNEG = -0.1 +!/ST2 CPOS = 0.1 +!/ST2 FNEG = 150. +! +!/ST3 ZWND = 10. +!/ST3 ALPHA0 = 0.0095 +!/ST3 Z0MAX = 0.0 +!/ST3 BETAMAX = 1.2 ! default WAM4 / WAM4 + is 1.2 with rhow=1000 +!/ST3 SINTHP = 2. +!/ST3 SWELLF = 0. +!/ST3 ZALP = 0.0110 +! +!/ST4 ZWND = 10. +!/ST4 ALPHA0 = 0.0095 +!/ST4 Z0MAX = 0.0 +!/ST4 Z0RAT = 0.04 +!/ST4 BETAMAX = 1.43 +!/ST4 SINTHP = 2. +!/ST4 SWELLF = 0.66 +!/ST4 SWELLFPAR = 1 +!/ST4 SWELLF2 = -0.018 +!/ST4 SWELLF3 = 0.022 +!/ST4 SWELLF4 = 1.5E5 +!/ST4 SWELLF5 = 1.2 +!/ST4 SWELLF6 = 0. +!/ST4 SWELLF7 = 360000. +!/ST4 TAUWSHELTER = 0.3 +!/ST4 ZALP = 0.006 +!/ST4 SINBR = 0. +! +!/ST6 SINA0 = 0.09 +!/ST6 SINWS = 32.0 +!/ST6 SINFC = 6.0 +! +!/ST1 CALL READNL ( NDSS, 'SIN1', STATUS ) +!/ST1 WRITE (NDSO,920) STATUS +!/ST1 WRITE (NDSO,921) CINP +!/ST1 SINC1 = 28. * CINP * DAIR / DWAT +! +!/ST2 CALL READNL ( NDSS, 'SIN2', STATUS ) +!/ST2 WRITE (NDSO,920) STATUS +!/ST2 IF ( SWELLF.LT.0. .OR. SWELLF.GT.1. ) SWELLF = 1. +!/ST2 WRITE (NDSO,921) ZWND, SWELLF +!/ST2 IF ( STABSH .LT. 0.1 ) STABSH = 1. +!/ST2 IF ( CNEG*CPOS .EQ. 0. ) THEN +!/ST2 CNEG = 0. +!/ST2 CPOS = 0. +!/ST2 FNEG = 0. +!/ST2 FPOS = 0. +!/ST2 ELSE +!/ST2 CPOS = - ABS(CPOS) * ABS(CNEG)/CNEG +!/ST2 FNEG = - MAX(1.,ABS(FNEG)) +!/ST2 FPOS = FNEG * CNEG/CPOS +!/ST2 END IF +!/STAB2 WRITE (NDSO,1921) STABSH, STABOF, CNEG, CPOS, FNEG, FPOS +!/ST2 ZWIND = ZWND +!/ST2 FSWELL = SWELLF +!/ST2 SHSTAB = STABSH +!/ST2 OFSTAB = STABOF +!/ST2 CCNG = CNEG +!/ST2 CCPS = CPOS +!/ST2 FFNG = FNEG +!/ST2 FFPS = FPOS +! +!/ST3 CALL READNL ( NDSS, 'SIN3', STATUS ) +!/ST3 WRITE (NDSO,920) STATUS +!/ST3 WRITE (NDSO,921) ALPHA0, BETAMAX, SINTHP, Z0MAX, ZALP, ZWND, & +!/ST3 SWELLF +!/ST3 ZZWND = ZWND +!/ST3 AALPHA = ALPHA0 +!/ST3 BBETA = BETAMAX +!/ST3 SSINTHP = SINTHP +!/ST3 ZZ0MAX = Z0MAX +!/ST3 ZZALP = ZALP +!/ST3 SSWELLF(1) = SWELLF +! +!/ST4 CALL READNL ( NDSS, 'SIN4', STATUS ) +!/ST4 WRITE (NDSO,920) STATUS +!/ST4 WRITE (NDSO,921) ALPHA0, BETAMAX, SINTHP, Z0MAX, ZALP, ZWND, TAUWSHELTER, & +!/ST4 SWELLFPAR, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, & +!/ST4 SWELLF6, SWELLF7, Z0RAT +!/ST4 ZZWND = ZWND +!/ST4 AALPHA = ALPHA0 +!/ST4 BBETA = BETAMAX +!/ST4 SSINBR = SINBR +!/ST4 SSINTHP = SINTHP +!/ST4 ZZ0MAX = Z0MAX +!/ST4 ZZ0RAT = Z0RAT +!/ST4 ZZALP = ZALP +!/ST4 TTAUWSHELTER = TAUWSHELTER +!/ST4 SSWELLF(1) = SWELLF +!/ST4 SSWELLF(2) = SWELLF2 +!/ST4 SSWELLF(3) = SWELLF3 +!/ST4 SSWELLF(4) = SWELLF4 +!/ST4 SSWELLF(5) = SWELLF5 +!/ST4 SSWELLF(6) = SWELLF6 +!/ST4 SSWELLF(7) = SWELLF7 +!/ST4 SSWELLFPAR = SWELLFPAR +! +!/ST6 CALL READNL ( NDSS, 'SIN6', STATUS ) +!/ST6 WRITE (NDSO,920) STATUS +!/ST6 SIN6A0 = SINA0 +!/ST6 SIN6WS = SINWS +!/ST6 SIN6FC = SINFC +!/ST6 J = 1 +!/ST6 IF ( SIN6A0.LE.0. ) J = 2 +!/ST6 WRITE (NDSO,921) YESXNO(J), SIN6A0, SIN6WS, SIN6FC +! +! 6.e Define Snl. +! +!/NL0 WRITE (NDSO,922) +! +!/NL1 LAMBDA = 0.25 +!/NL1 IF ( FLTC96 ) THEN +!/NL1 NLPROP = 1.00E7 +!/NL1 ELSE IF ( FLST4 ) THEN +!/NL1 NLPROP = 2.50E7 +!/NL1 ELSE IF ( FLST6 ) THEN +!/NL1 NLPROP = 3.00E7 +!/NL1 ELSE +!/NL1 NLPROP = 2.78E7 +!/NL1 END IF +! +!/NL1 KDCONV = 0.75 +!/NL1 KDMIN = 0.50 +!/NL1 SNLCS1 = 5.5 +!/NL1 SNLCS2 = 0.833 +!/NL1 SNLCS3 = -1.25 +! +!/NL1 CALL READNL ( NDSS, 'SNL1', STATUS ) +!/NL1 WRITE (NDSO,922) STATUS +!/NL1 WRITE (NDSO,923) LAMBDA, NLPROP, KDCONV, KDMIN, & +!/NL1 SNLCS1, SNLCS2, SNLCS3 +!/NL1 SNLC1 = NLPROP / GRAV**4 +!/NL1 LAM = LAMBDA +!/NL1 KDCON = KDCONV +!/NL1 KDMN = KDMIN +!/NL1 SNLS1 = SNLCS1 +!/NL1 SNLS2 = SNLCS2 +!/NL1 SNLS3 = SNLCS3 +! +!/ST0 FACHF = 5. +!/ST1 FACHF = 4.5 +!/ST2 FACHF = 5. +!/ST3 FACHF = 5. +!/ST4 FACHF = 5. +!/ST6 FACHF = 5. +!/STX FACHF = 5. +!/NL2 IQTYPE = 2 +!/NL2 TAILNL = -FACHF +!/NL2 NDEPTH = 0 +!/NL3 NQDEF = 0 +!/NL3 MSC = 0. +!/NL3 NSC = -3.5 +!/NL3 KDFD = 0.20 +!/NL3 KDFS = 5.00 +!/NL4 INDTSA = 1 +!/NL4 ALTLP = 2 +!/NLS A34 = 0.05 +!/NLS FHFC = 1.E10 +!/NLS DNM = 0.25 +!/NLS FC1 = 1.25 +!/NLS FC2 = 1.50 +!/NLS FC3 = 6.00 +! +!/NL2 CALL READNL ( NDSS, 'SNL2', STATUS ) +!/NL2 WRITE (NDSO,922) STATUS +!/NL2 TAILNL = MIN ( MAX ( TAILNL, -5. ) , -4. ) +!/NL2 IF ( IQTYPE .EQ. 3 ) THEN +!/NL2 WRITE (NDSO,923) 'Shallow water', TAILNL +!/NL2 ELSE IF ( IQTYPE .EQ. 2 ) THEN +!/NL2 WRITE (NDSO,923) 'Deep water with scaling', TAILNL +!/NL2 ELSE +!/NL2 WRITE (NDSO,923) 'Deep water', TAILNL +!/NL2 IQTYPE = 1 +!/NL2 END IF +! +!/NL2 IF ( IQTYPE .NE. 3 ) THEN +!/NL2 NDEPTH = 1 +!/NL2 ALLOCATE ( MPARS(1)%SNLPS%DPTHNL(NDEPTH) ) +!/NL2 DPTHNL => MPARS(1)%SNLPS%DPTHNL +!/NL2 DPTHNL = 1000. +!/NL2 ELSE +!/NL2 IF ( NDEPTH .EQ. 0 ) NDEPTH = 7 +!/NL2 NDEPTH = MAX ( 1 , NDEPTH ) +!/NL2 ALLOCATE ( MPARS(1)%SNLPS%DPTHNL(NDEPTH) ) +!/NL2 DPTHNL => MPARS(1)%SNLPS%DPTHNL +!/NL2 DPTHNL(1) = 640. +!/NL2 DPTHNL(NDEPTH) = 10. +!/NL2 IF ( NDEPTH .GT. 1 ) THEN +!/NL2 DPTFAC = (DPTHNL(NDEPTH)/DPTHNL(1))**(1./(REAL(NDEPTH-1))) +!/NL2 DO IDEPTH=2, NDEPTH-1 +!/NL2 DPTHNL(IDEPTH) = DPTFAC*DPTHNL(IDEPTH-1) +!/NL2 END DO +!/NL2 END IF +!/NL2 CALL READNL ( NDSS, 'ANL2', STATUS ) +!/NL2 WRITE (NDSO,1923) NDEPTH, DPTHNL(1:MIN(5,NDEPTH)) +!/NL2 IF (NDEPTH .GT. 5 )WRITE (NDSO,2923) DPTHNL(6:NDEPTH) +!/NL2 END IF +!/NL2 WRITE (NDST,*) +!/NL2 IQTPE = IQTYPE +!/NL2 NDPTHS = NDEPTH +!/NL2 NLTAIL = TAILNL +! +!/NL3 CALL READNL ( NDSS, 'SNL3', STATUS ) +!/NL3 WRITE (NDSO,922) STATUS +!!/NL3 MSC = MAX ( 0. , MIN ( 8. , MSC ) ) ! Disabled HLT ca. 2009 +!/NL3 KDFD = MAX ( 0.001 , MIN ( 10. , KDFD ) ) +!/NL3 KDFS = MAX ( KDFD , MIN ( 10. , KDFS ) ) +!/NL3 WRITE (NDSO,923) MSC, NSC, KDFD, KDFS +! +!/NL3 NQDEF = MAX ( 0 , NQDEF ) +!/NL3 IF ( NQDEF .EQ. 0 ) THEN +!/NL3 NQDEF = 1 +!/NL3 QPARMS(1:5) = [ 0.25 , 0.00, -1., 1.E7, 0.00 ] +!/NL3 ELSE +!/NL3 DO J=1, NQDEF +!/NL3 QPARMS((J-1)*5+1:J*5) = [ 0.25, 0.00, -1., 1.E7, 1.E6 ] +!/NL3 END DO +!/NL3 CALL READNL ( NDSS, 'ANL3', STATUS ) +!/NL3 END IF +!/NL3 DO J=1, NQDEF +!/NL3 QPARMS((J-1)*5+1) = MAX(0.,MIN (LAMMAX,QPARMS((J-1)*5+1))) +!/NL3 QPARMS((J-1)*5+2) = MAX(0.,MIN (QPARMS((J-1)*5+1), & +!/NL3 QPARMS((J-1)*5+2))) +!/NL3 QPARMS((J-1)*5+3) = MIN (DELTHM,QPARMS((J-1)*5+3)) +!/NL3 QPARMS((J-1)*5+4) = MAX (0.,QPARMS((J-1)*5+4)) +!/NL3 QPARMS((J-1)*5+5) = MAX (0.,QPARMS((J-1)*5+5)) +!/NL3 END DO +!/NL3 WRITE (NDSO,1923) NQDEF +!/NL3 WRITE (NDSO,2923) QPARMS(1:NQDEF*5) +!/NL3 WRITE (NDSO,*) +!/NL3 SNLNQ = NQDEF +!/NL3 SNLMSC = MSC +!/NL3 SNLNSC = NSC +!/NL3 SNLSFD = SQRT ( KDFD * TANH(KDFD) ) +!/NL3 SNLSFS = SQRT ( KDFS * TANH(KDFS) ) +!/NL3 ALLOCATE ( MPARS(1)%SNLPS%SNLL(NQDEF), & +!/NL3 MPARS(1)%SNLPS%SNLM(NQDEF), & +!/NL3 MPARS(1)%SNLPS%SNLT(NQDEF), & +!/NL3 MPARS(1)%SNLPS%SNLCD(NQDEF), & +!/NL3 MPARS(1)%SNLPS%SNLCS(NQDEF) ) +!/NL3 SNLL => MPARS(1)%SNLPS%SNLL +!/NL3 SNLL = QPARMS(1:NQDEF*5:5) +!/NL3 SNLM => MPARS(1)%SNLPS%SNLM +!/NL3 SNLM = QPARMS(2:NQDEF*5:5) +!/NL3 SNLT => MPARS(1)%SNLPS%SNLT +!/NL3 SNLT = QPARMS(3:NQDEF*5:5) +!/NL3 SNLCD => MPARS(1)%SNLPS%SNLCD +!/NL3 SNLCD = QPARMS(4:NQDEF*5:5) +!/NL3 SNLCS => MPARS(1)%SNLPS%SNLCS +!/NL3 SNLCS = QPARMS(5:NQDEF*5:5) +! +!/NL4 CALL READNL ( NDSS, 'SNL4', STATUS ) +!/NL4 WRITE (NDSO,922) STATUS +!/NL4 WRITE (NDSO,923) INDTSA, ALTLP +!/NL4 ITSA = INDTSA +!/NL4 IALT = ALTLP +! +!/NLS CALL READNL ( NDSS, 'SNLS', STATUS ) +!/NLS WRITE (NDSO,9922) STATUS +!/NLS A34 = MAX ( 0. , MIN ( A34 , ABMAX ) ) +!/NLS FHFC = MAX ( 0. , FHFC ) +!/NLS DNM = MAX ( 0., DNM ) +!/NLS WRITE (NDSO,9923) A34, (XFR-1.)*A34, FHFC, DNM, FC1, FC2, FC3 +!/NLS CNLSA = A34 +!/NLS CNLSC = FHFC +!/NLS CNLSFM = DNM +!/NLS CNLSC1 = FC1 +!/NLS CNLSC2 = FC2 +!/NLS CNLSC3 = FC3 +! +! 6.f Define Sds. +! +!/ST0 WRITE (NDSO,924) +!/STX WRITE (NDSO,924) +! +!/ST1 CDIS = -2.36E-5 +!/ST1 APM = 3.02E-3 +!/ST2 SDSA0 = 4.8 +!/ST2 SDSA1 = 1.7e-4 +!/ST2 SDSA2 = 2.0 +!/ST2 SDSB0 = 0.3e-3 +!/ST2 SDSB1 = 0.47 +!/ST2 PHIMIN = 0.003 +!/ST2 SDSALN = 0.002 +!/ST2 FPIMIN = 0.009 +!/ST3 SDSC1 = -2.1 !! This is Bidlot et al. 2005, Otherwise WAM4 uses -4.5 +!/ST3 WNMEANP = 0.5 !! This is Bidlot et al. 2005, Otherwise WAM4 uses -0.5 +!/ST3 FXFM3 = 2.5 +!/ST3 FXPM3 = 4. +!/ST3 WNMEANPTAIL = 0.5 +!/ST3 SDSDELTA1 = 0.4 !! This is Bidlot et al. 2005, Otherwise WAM4 uses 0.5 +!/ST3 SDSDELTA2 = 0.6 !! This is Bidlot et al. 2005, Otherwise WAM4 uses 0.5 +! +!/ST4 WNMEANP = 0.5 ! taken from Bidlot et al. 2005 +!/ST4 FXFM3 = 2.5 +!/ST4 FXFMAGE = 0. +!/ST4 FXPM3 = 4. +!/ST4 WNMEANPTAIL = -0.5 +!/ST4 SDSBCHOICE =1 ! 1: Ardhuin et al., 2: Filipot & Ardhuin, 3: Romero +!/ST4 SDSC2 = -2.2E-5 ! -3.8 for Romero +!/ST4 SDSCUM = -0.40344 +!/ST4 SDSC4 = 1. +!/ST4 SDSC5 = 0. +!/ST4 SDSNUW = 0. +!/ST4 SDSC6 = 0.3 +!/ST4 SDSBR = 0.90E-3 ! 0.005 for Romero +!/ST4 SDSBRFDF = 0 +!/ST4 SDSBRF1 = 0.5 +!/ST4 SDSP = 2. ! this is now fixed in w3sds4, should be cleaned up +!/ST4 SDSDTH = 80. +!/ST4 SDSCOS = 2. +!/ST4 SDSISO = 2 +!/ST4 SDSBM0 = 1. +!/ST4 SDSBM1 = 0. +!/ST4 SDSBM2 = 0. +!/ST4 SDSBM3 = 0. +!/ST4 SDSBM4 = 0. +!/ST4 SDSBCK = 0. +!/ST4 SDSABK = 1.5 +!/ST4 SDSPBK = 4. +!/ST4 SDSBINT = 0.3 +!/ST4 SDSHCK = 1.5 +!/ST4 WHITECAPWIDTH = 0.3 +!/ST4 SDSSTRAIN = 0. +!/ST4 SDSFACMTF = 400 ! MTF factor for Lambda , Romero (2019) +!/ST4 SDSSTRAINA = 15. +!/ST4 SDSSTRAIN2 = 0. +!/ST4 WHITECAPDUR = 0.56 ! breaking duration factor +!/ST4! b (strength of breaking) +!/ST4 SDSBT = 1.100E-3 ! B_T (sturation threshold for dissipation rate b) +!/ST4! Lambda parameters +!/ST4 SDSL = 3.5000e-05 ! L scaling +!/ST4! MTF +!/ST4 SPMSS = 0.5 ! cmss^SPMSS +!/ST4 SDSNMTF = 1.5 ! MTF power +!/ST4 SDSCUMP = 2. +!/ST4! MW +!/ST4 SDSMWD = .9 ! new AFo +!/ST4 SDSMWPOW = 1. ! (k )^pow +!/ST4 SDKOF = 3. ! ko factor such that ko= g (SDKOF/(28 us))^2 +! +!/ST6 SDSET = .TRUE. +!/ST6 SDSA1 = 4.75E-06 +!/ST6 SDSP1 = 4 +!/ST6 SDSA2 = 7.00E-05 +!/ST6 SDSP2 = 4 +!/ST6 CSTB1 = .FALSE. +!/ST6 SWLB1 = 0.41E-02 +! +!/ST1 CALL READNL ( NDSS, 'SDS1', STATUS ) +!/ST1 WRITE (NDSO,924) STATUS +!/ST1 WRITE (NDSO,925) CDIS, APM +!/ST1 SDSC1 = TPI * CDIS / APM**2 +! +!/ST2 CALL READNL ( NDSS, 'SDS2', STATUS ) +!/ST2 WRITE (NDSO,924) STATUS +!/ST2 IF ( PHIMIN .LE. 0. ) THEN +!/ST2 SDSB2 = 0. +!/ST2 SDSB3 = 0. +!/ST2 PHIMIN = SDSB0 + SDSB1*FPIMIN +!/ST2 ELSE +!/ST2 FPIA = ( PHIMIN - SDSB0 ) / SDSB1 +!/ST2 IF ( FPIA .LT. FPIMIN ) THEN +!/ST2 SDSB3 = 4. +!/ST2 SDSB2 = FPIMIN**SDSB3 * (PHIMIN-SDSB0-SDSB1*FPIMIN) +!/ST2 ELSE +!/ST2 FPIB = MAX ( FPIA-0.0025 , FPIMIN ) +!/ST2 DPHID = MAX ( PHIMIN - SDSB0 - SDSB1*FPIB , 1.E-15 ) +!/ST2 SDSB3 = MIN ( 10. , SDSB1*FPIB / DPHID ) +!/ST2 SDSB2 = FPIB**SDSB3 * DPHID +!/ST2 FPIMIN = FPIB +!/ST2 END IF +!/ST2 END IF +!/ST2 WRITE (NDSO,925) SDSA0, SDSA1, SDSA2, & +!/ST2 SDSB0, SDSB1, SDSB2, SDSB3, FPIMIN, PHIMIN +!/ST2 CDSA0 = SDSA0 +!/ST2 CDSA1 = SDSA1 +!/ST2 CDSA2 = SDSA2 +!/ST2 CDSB0 = SDSB0 +!/ST2 CDSB1 = SDSB1 +!/ST2 CDSB2 = SDSB2 +!/ST2 CDSB3 = SDSB3 +! +!/ST3 CALL READNL ( NDSS, 'SDS3', STATUS ) +!/ST3 WRITE (NDSO,924) STATUS +!/ST3 WRITE (NDSO,925) SDSC1, WNMEANP, SDSDELTA1, & +!/ST3 SDSDELTA2 +!/ST3 SSDSC1 = SDSC1 +!/ST3 WWNMEANP = WNMEANP +!/ST3 FFXFM = FXFM3 * TPI +!/ST3 FFXPM = FXPM3 * GRAV / 28. +!/ST3 WWNMEANPTAIL = WNMEANPTAIL +!/ST3 DDELTA1 = SDSDELTA1 +!/ST3 DDELTA2 = SDSDELTA2 +! +!/ST4 CALL READNL ( NDSS, 'SDS4', STATUS ) +!/ST4 WRITE (NDSO,924) STATUS +!/ST4 WRITE (NDSO,925) SDSC2, SDSBCK, SDSCUM, WNMEANP +!/ST4 SSDSC(1) = REAL(SDSBCHOICE) +!/ST4 SSDSC(2) = SDSC2 +!/ST4 SSDSC(3) = SDSCUM +!/ST4 SSDSC(4) = SDSC4 +!/ST4 SSDSC(5) = SDSC5 +!/ST4 SSDSC(6) = SDSC6 +!/ST4 SSDSC(7) = WHITECAPWIDTH +!/ST4 SSDSC(8) = SDSSTRAIN ! Straining constant ... +!/ST4 SSDSC(9) = SDSL +!/ST4 SSDSC(10) = SDSSTRAINA*NTH/360. ! angle Aor enhanced straining +!/ST4 SSDSC(11) = SDSSTRAIN2 ! straining constant for directional part +!/ST4 SSDSC(12) = SDSBT +!/ST4 SSDSC(13) = SDSMWD +!/ST4 SSDSC(14) = SPMSS +!/ST4 SSDSC(15) = SDSMWPOW +!/ST4 SSDSC(16) = SDKOF +!/ST4 SSDSC(17) = WHITECAPDUR +!/ST4 SSDSC(18) = SDSFACMTF +!/ST4 SSDSC(19) = SDSNMTF +!/ST4 SSDSC(20) = SDSCUMP +!/ST4 SSDSC(21) = SDSNUW +! +!/ST4 SSDSBR = SDSBR +!/ST4 SSDSBRF1 = SDSBRF1 +!/ST4 SSDSBRFDF= SDSBRFDF +!/ST4 SSDSBM(0) = SDSBM0 +!/ST4 SSDSBM(1) = SDSBM1 +!/ST4 SSDSBM(2) = SDSBM2 +!/ST4 SSDSBM(3) = SDSBM3 +!/ST4 SSDSBM(4) = SDSBM4 +!/ST4 SSDSBT = SDSBT +!/ST4 SSDSISO = SDSISO +!/ST4 SSDSCOS = SDSCOS +!/ST4 SSDSP = SDSP +!/ST4 SSDSDTH = SDSDTH +!/ST4 WWNMEANP = WNMEANP +!/ST4 FFXFM = FXFM3 * TPI +!/ST4 FFXFA = FXFMAGE * TPI +!/ST4 FFXPM = FXPM3 * GRAV / 28. +!/ST4 WWNMEANPTAIL = WNMEANPTAIL +!/ST4 SSDSBCK = SDSBCK +!/ST4 SSDSABK = SDSABK +!/ST4 SSDSPBK = SDSPBK +!/ST4 SSDSBINT = SDSBINT +!/ST4 SSDSHCK = SDSHCK +! +!/ST6 CALL READNL ( NDSS, 'SDS6', STATUS ) +!/ST6 WRITE (NDSO,924) STATUS +!/ST6 SDS6ET = SDSET +!/ST6 SDS6A1 = SDSA1 +!/ST6 SDS6P1 = SDSP1 +!/ST6 SDS6A2 = SDSA2 +!/ST6 SDS6P2 = SDSP2 +!/ST6 J = 2 +!/ST6 IF (SDSET) J = 1 +!/ST6 WRITE (NDSO,925) YESXNO(J), YESXNO(3-J), SDS6A1, SDS6P1, SDS6A2, SDS6P2 +!/ST6 +!/ST6 CALL READNL ( NDSS, 'SWL6', STATUS ) +!/ST6 WRITE (NDSO,937) STATUS +!/ST6 J = 1 +!/ST6 SWL6S6 = SWLB1.GT.0.0 +!/ST6 IF (.NOT.SWL6S6) J = 2 +!/ST6 SWL6B1 = SWLB1 +!/ST6 SWL6CSTB1 = CSTB1 +!/ST6 IF (CSTB1) THEN +!/ST6 WRITE (NDSO,940) YESXNO(J), '(constant) ' ,SWL6B1 +!/ST6 ELSE +!/ST6 WRITE (NDSO,940) YESXNO(J), '(steepness dependent)' ,SWL6B1 +!/ST6 END IF +! +! 6.g Define Sbt. +! +!/BT0 WRITE (NDSO,926) +!/BT4 WRITE (NDSO,926) +!/BTX WRITE (NDSO,926) +! +!/BT1 GAMMA = -0.067 +! +!/BT1 CALL READNL ( NDSS, 'SBT1', STATUS ) +!/BT1 WRITE (NDSO,926) STATUS +!/BT1 WRITE (NDSO,927) GAMMA +!/BT1 SBTC1 = 2. * GAMMA / GRAV +! +!/BT4 SEDMAPD50=.FALSE. +!/BT4 SED_D50_UNIFORM=2.E-4 ! default grain size: medium sand 200 microns +!/BT4 RIPFAC1=0.4 ! A1 in Ardhuin et al. 2003 +!/BT4 RIPFAC2=-2.5 ! A2 in Ardhuin et al. 2003 +!/BT4 RIPFAC3=1.2 ! A3 in Ardhuin et al. 2003 +!/BT4 RIPFAC4=0.05 ! A4 in Ardhuin et al. 2003 +!/BT4 SIGDEPTH=0.05 +!/BT4 BOTROUGHMIN=0.01 +!/BT4 BOTROUGHFAC=1.00 +!/BT4 CALL READNL ( NDSS, 'SBT4', STATUS ) +!/BT4 WRITE (NDSO,926) STATUS +!/BT4 WRITE (NDSO,927) SEDMAPD50, SED_D50_UNIFORM, & +!/BT4 RIPFAC1,RIPFAC2,RIPFAC3,RIPFAC4,SIGDEPTH, & +!/BT4 BOTROUGHMIN, BOTROUGHFAC +!/BT4 SBTCX(1)=RIPFAC1 +!/BT4 SBTCX(2)=RIPFAC2 +!/BT4 SBTCX(3)=RIPFAC3 +!/BT4 SBTCX(4)=RIPFAC4 +!/BT4 SBTCX(5)=SIGDEPTH +!/BT4 SBTCX(6)=BOTROUGHMIN +!/BT4 SBTCX(7)=BOTROUGHFAC +! +! +! 6.h Define Sdb. +! +!/DB0 WRITE (NDSO,928) +!/DBX WRITE (NDSO,928) +! +!/DB1 BJALFA = 1. +!/DB1 BJGAM = 0.73 +!/DB1 BJFLAG = .TRUE. +! +!/DB1 CALL READNL ( NDSS, 'SDB1', STATUS ) +!/DB1 WRITE (NDSO,928) STATUS +!/DB1 BJALFA = MAX ( 0. , BJALFA ) +!/DB1 BJGAM = MAX ( 0. , BJGAM ) +!/DB1 WRITE (NDSO,929) BJALFA, BJGAM +!/DB1 IF ( BJFLAG ) THEN +!/DB1 WRITE (NDSO,*) ' Using Hmax/d ratio only.' +!/DB1 ELSE +!/DB1 WRITE (NDSO,*) & +!/DB1 ' Using Hmax/d in Miche style formulation.' +!/DB1 END IF +!/DB1 WRITE (NDSO,*) +!/DB1 SDBC1 = BJALFA +!/DB1 SDBC2 = BJGAM +!/DB1 FDONLY = BJFLAG +! +! +!/UOST UOSTFILELOCAL = 'obstructions_local.'//ADJUSTL(TRIM(GNAME))//'.in' +!/UOST UOSTFILESHADOW = 'obstructions_shadow.'//ADJUSTL(TRIM(GNAME))//'.in' +!/UOST UOSTFACTORLOCAL = 1 +!/UOST UOSTFACTORSHADOW = 1 +!/UOST CALL READNL ( NDSS, 'UOST', STATUS ) +!/UOST WRITE (NDSO,4500) STATUS +!/UOST WRITE (NDSO,4501) ADJUSTL(TRIM(UOSTFILELOCAL)), ADJUSTL(TRIM(UOSTFILESHADOW)), & +!/UOST UOSTFACTORLOCAL, UOSTFACTORSHADOW +! +! 6.i Define Str. +! +!/TR0 WRITE (NDSO,930) +!/TRX WRITE (NDSO,930) +! +! 6.j Define Sbs. +! +!/BS0 WRITE (NDSO,932) +!/BS1 WRITE (NDSO,932) +!/BSX WRITE (NDSO,932) +! +! 6.k Define Sxx and Sic. +! +! !/XX0 WRITE (NDSO,934) +!/XXX WRITE (NDSO,934) +! +!/IC1 WRITE (NDSO,935) +!/IC1 WRITE(NDSO,'(A/A)')' Sice will be calculated using ' & +!/IC1 //'user-specified ki values.',' Required ' & +!/IC1 //'field input: ice parameter 1.' +! +!/IC2 WRITE (NDSO,935) +!/IC2 WRITE(NDSO,'(A/A)')' Sice will be calculated using ' & +!/IC2 //'under-ice boundary layer method.',' Required ' & +!/IC2 //'field input: ice parameters 1 and 2.' +! +!/IC3 WRITE (NDSO,935) +!/IC3 WRITE(NDSO,'(A/A)')' Sice will be calculated using '& +!/IC3 //'Wang and Shen method.',' '& +!/IC3 //'Required field input: ice parameters 1, 2, 3 and 4.' +! +!/IC4 WRITE (NDSO,935) +!/IC4 WRITE(NDSO,'(A/A)')' Sice will be calculated using '& +!/IC4 //'Empirical method.',' '& +!/IC4 //'Required field input: ice parameters (varies).' +! +!/IC5 WRITE (NDSO,935) +!/IC5 WRITE(NDSO,'(A/A/)')' Sice will be calculated using '& +!/IC5 //'Mosig et al. method.',' '& +!/IC5 //'Required field input: ice parameters 1, 2, 3 and 4.' +! +! 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 = .FALSE. + SOLVERTHR_SETUP=1E-14 + CRIT_DEP_SETUP=0.1 + JGS_TERMINATE_MAXITER = .TRUE. + JGS_TERMINATE_DIFFERENCE = .TRUE. + JGS_TERMINATE_NORM = .FALSE. + JGS_LIMITER = .FALSE. + 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_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 + + IF ((EXPFSN .eqv. .FALSE.).and.(EXPFSPSI .eqv. .FALSE.) & + .and.(EXPFSFCT .eqv. .FALSE.) & + .and.(IMPFSN .eqv. .FALSE.) & + .and.(EXPTOTAL .eqv. .FALSE.) & + .and.(IMPTOTAL .eqv. .FALSE.)) THEN + EXPFSN=.TRUE. ! This is the default scheme ... + END IF + 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 + WRITE(NDSE,*) ' *** WAVEWATCH III ERROR IN WW3_GRID:' + IF (nbSel .gt. 1) THEN + WRITE (NDSE,*) 'More than one scheme selected' + ELSE IF (nbSel .eq. 0) THEN + WRITE (NDSE,*) 'no scheme selected' + END IF + WRITE (NDSE,*)'Select only one of EXPFSN, EXPFSFCT, EXPFSPSI' + WRITE (NDSE,*)'IMPFSN, IMPTOTAL' + CALL EXTCDE ( 30 ) + END IF + END IF +! +! 6.m Select propagation scheme +! + WRITE (NDSO,950) +! + NRPROP = 0 + FLPROP = .TRUE. + PNAME = ' ' +!/PR0 PNAME = 'Not defined ' +!/PR0 NRPROP = NRPROP + 1 +!/PR0 FLPROP = .FALSE. +!/PR1 PNAME = 'First order upstream ' +!/PR1 NRPROP = NRPROP + 1 +!/UQ PNAME = '3rd order UQ' +!/UNO PNAME = '2nd order UNO' + J = LEN_TRIM(PNAME) +!/PR2 PNAME = PNAME(1:J)//' + GSE diffusion ' +!/PR2 NRPROP = NRPROP + 1 +!/PR3 PNAME = PNAME(1:J)//' + GSE averaging ' +!/PR3 NRPROP = NRPROP + 1 +! +!/SMC PNAME = 'UNO2 on SMC grid + diffusion ' +!/SMC NRPROP = NRPROP + 1 +! +!/PRX PNAME = 'Experimental ' +!/PRX NRPROP = NRPROP + 1 +! + 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 +! +!/PR2 DTIME = 0. +!/PR2 LATMIN = 70. +! +!/SMC !Li Default values of smc grid parameters. JGLi23Nov2015 +!/SMC LvSMC = 1 +!/SMC ISHFT = 0 +!/SMC JEQT = 0 +!/SMC NBISMC = 0 +!/SMC DTIME = 0.0 +!/SMC LATMIN = 86.0 +!/SMC RFMAXD = 80.0 +!/SMC UNO3 = .FALSE. +!/SMC AVERG = .FALSE. +!/SMC SEAWND = .FALSE. +! +!/PR3 WDTHCG = 1.5 +!/PR3 WDTHTH = WDTHCG +! +!/PR1 CALL READNL ( NDSS, 'PRO1', STATUS ) +!/PR1 IF ( STATUS(18:18) .EQ. ':' ) STATUS(18:18) = ' ' +!/PR1 WRITE (NDSO,952) STATUS(1:18) +!/PR1 CFLTM = MAX ( 0. , CFLTM ) +!/PR1 WRITE (NDSO,953) CFLTM +! +!/PR2 CALL READNL ( NDSS, 'PRO2', STATUS ) +!/PR2 IF ( STATUS(18:18) .EQ. ':' ) STATUS(18:18) = ' ' +!/PR2 WRITE (NDSO,952) STATUS(1:18) +!/PR2 CFLTM = MAX ( 0. , CFLTM ) +!/PR2 DTIME = MAX ( 0. , DTIME ) +!/PR2 LATMIN = MIN ( 89. , ABS(LATMIN) ) +!/PR2 CLATMN = COS ( LATMIN * DERA ) +!/PR2 IF ( DTIME .EQ. 0. ) THEN +!/PR2 WRITE (NDSO,953) CFLTM, LATMIN +!/PR2 ELSE +!/PR2 WRITE (NDSO,954) CFLTM, DTIME/3600., LATMIN +!/PR2 END IF +!/PR2 DTME = DTIME +! +!/SMC CALL READNL ( NDSS, 'PSMC', STATUS ) +!/SMC IF ( STATUS(18:18) .EQ. ':' ) STATUS(18:18) = ' ' +!/SMC WRITE (NDSO,952) STATUS(1:18) +!/SMC CFLTM = MAX ( 0. , CFLTM ) +!/SMC DTIME = MAX ( 0. , DTIME ) +!/SMC LATMIN = MIN ( 89. , ABS(LATMIN) ) +!/SMC CLATMN = COS ( LATMIN * DERA ) +!/SMC RFMAXD = MIN ( 80.0, ABS(RFMAXD) ) +!/SMC IF ( DTIME .EQ. 0. ) THEN +!/SMC WRITE (NDSO,953) CFLTM, LATMIN, RFMAXD +!/SMC ELSE +!/SMC WRITE (NDSO,954) CFLTM, DTIME/3600., LATMIN, RFMAXD +!/SMC END IF +!/SMC DTME = DTIME +!/SMC Refran = RFMAXD * DERA +!/SMC FUNO3 = UNO3 +!/SMC FVERG = AVERG +!/SMC FSWND = SEAWND +!/SMC IF( UNO3 ) WRITE (NDSO,*) & +!/SMC " Advection use 3rd order UNO3 instead of UNO2 scheme." +!/SMC IF( AVERG ) WRITE (NDSO,*) & +!/SMC " Extra 1-2-1 average smoothing activated on SMC grid." +!/SMC IF( SEAWND ) WRITE (NDSO,*) & +!/SMC " Sea-point only wind input is required for SMC grid. " +!/SMC NRLv = LvSMC +!/SMC WRITE (NDSO,4001) NRLv +!/SMC WRITE (NDSO,4002) JEQT +!/SMC WRITE (NDSO,4302) ISHFT +!/SMC WRITE (NDSO,4003) NBISMC +! +!/PR3 CALL READNL ( NDSS, 'PRO3', STATUS ) +!/PR3 IF ( STATUS(18:18) .EQ. ':' ) STATUS(18:18) = ' ' + IF (GTYPE.NE.UNGTYPE) THEN +!/PR3 WRITE (NDSO,952) STATUS(1:18) +!/PR3 CFLTM = MAX ( 0. , CFLTM ) +!/PR3 WRITE (NDSO,953) CFLTM, WDTHCG +!/PR3 IF ( WDTHCG*(XFR-1.) .GT. 1. ) WRITE (NDSO,955) 1./(XFR-1.) +!/PR3 WRITE (NDSO,954) WDTHTH +!/PR3 IF ( WDTHTH*DTH .GT. 1. ) WRITE (NDSO,955) 1./DTH +!/PR3 WRITE (NDSO,*) + ENDIF +!/PR3 WDCG = WDTHCG +!/PR3 WDTH = WDTHTH +! + CTMAX = CFLTM +! +!/RTD ! Set/ read in rotation values - these will be written out +!/RTD ! later with the rest of the grid info +!/RTD ! Default is a non-rotated lat-lon grid +!/RTD PLAT = 90. +!/RTD PLON = -180. +!/RTD UNROT = .FALSE. +!/RTD CALL READNL ( NDSS, 'ROTD', STATUS ) +!/RTD PLON = MOD( PLON + 180., 360. ) - 180. +!/RTD ! Ensure that a grid with pole at the geographic North is standard lat-lon +!/RTD IF ( PLAT == 90. .AND. ( PLON /= -180. .OR. UNROT ) ) THEN +!/RTD WRITE( NDSE, 1052 ) +!/RTD CALL EXTCDE ( 33 ) +!/RTD ENDIF +!/RTD ! Default poles of output b. c. are non-rotated: +!/RTD BPLAT = 90. +!/RTD BPLON = -180. +!/RTD CALL READNL ( NDSS, 'ROTB', STATUS ) +!/RTD ! A b. c. dest. grid with pole at the geographic North must be non-rotated +!/RTD DO I=1,9 +!/RTD IF ( BPLAT(I) == 90. ) THEN +!/RTD ! Require BPLON(I) == -180., but don't blaim the user if BPLON(I) == 180. +!/RTD IF ( BPLON(I) == 180. ) BPLON(I) = -180. +!/RTD IF ( BPLON(I) == -180. ) CYCLE +!/RTD END IF +!/RTD IF ( BPLAT(I) < 90. ) CYCLE +!/RTD WRITE( NDSE, 1053 ) +!/RTD CALL EXTCDE ( 34 ) +!/RTD END DO +! +! 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) +! +!/NCO/! NCEP operations retains first three swell systems. +!/NCO NOSW=3 + 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. +!/IS0 WRITE (NDSO,944) +!/IS1 ISC1 = 1. +!/IS1 ISC2 = 0. +!/IS1 CALL READNL ( NDSS, 'SIS1', STATUS ) +!/IS1 WRITE (NDSO,945) STATUS +!/IS1 WRITE (NDSO,946) ISC1, ISC2 +!/IS1 IS1C1 = ISC1 +!/IS1 IS1C2 = ISC2 +!/IS2 ISC1 = 1. +!/IS2 IS2C2 = 0. ! 0.025 +!/IS2 IS2C3 = 0. ! 2.4253 +!/IS2 IS2CONC = 0. +!/IS2 IS2BACKSCAT = 1. +!/IS2 IS2BREAK = .FALSE. +!/IS2 IS2BREAKF = 3.6 +!/IS2 IS2FLEXSTR=6.00E+05 ! value used in Ardhuin et al. 2020 +!/IS2 IS2ISOSCAT=.TRUE. ! uses isotropic back-scatter +!/IS2 IS2DISP=.FALSE. !not dispersion only attenuation following Liu disp. eq. +!/IS2 IS2DUPDATE=.TRUE. +!/IS2 IS2FRAGILITY=0.9 +!/IS2 IS2DMIN=20 +!/IS2 IS2DAMP=0. +!/IS2 IS2CREEPB=0. +!/IS2 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 +!/IS2 IS2CREEPD=0.5 +!/IS2 IS2CREEPN=3.0 +!/IS2 IS2BREAKE=1. +!/IS2 IS2WIM1=1. +!/IS2 IS2ANDISB=.TRUE. !anelastic instead of inelastic dissipation if IS2CREEPB>0 +!/IS2 IS2ANDISE=0.55 !energy of activation +!/IS2 IS2ANDISD=2.0E-9 !see Ardhuin et al. 2020 +!/IS2 IS2ANDISN=1. !dependency on stress. Equal to 1 normally? +!/IS2 CALL READNL ( NDSS, 'SIS2', STATUS ) +!/IS2 WRITE (NDSO,947) STATUS +!/IS2 WRITE (NDSO,2948) ISC1, IS2BACKSCAT, IS2ISOSCAT, IS2BREAK, IS2DUPDATE, IS2FLEXSTR, IS2DISP, & +!/IS2 IS2DAMP, IS2FRAGILITY, IS2DMIN, IS2C2, IS2C3, IS2CONC, IS2CREEPB,& +!/IS2 IS2CREEPC, IS2CREEPD, IS2CREEPN, IS2BREAKE, IS2BREAKF, IS2WIM1, & +!/IS2 IS2ANDISB, IS2ANDISE, IS2ANDISD, IS2ANDISN +! +!/REF1 REFCOAST=0. +!/REF1 REFMAP=0. +!/REF1 REFMAPD=0. +!/REF1 REFRMAX=1. +!/REF1 REFFREQPOW=2. +!/REF1 REFFREQ=0. +!/REF1 REFCOSP_STRAIGHT=4. +!/REF1 REFSLOPE=0.22 +!/REF1 REFSUBGRID=0. +!/REF1 REFICEBERG=0. +!/REF1 REFUNSTSOURCE=0. +! +!/REF1 CALL READNL ( NDSS, 'REF1', STATUS ) +!/REF1 WRITE (NDSO,969) STATUS +! +!/IG1 IGMETHOD = 2 +!/IG1 IGADDOUTP= 0 +!/IG1 IGSOURCE = 2 +!/IG1 IGSTERMS = 0 +!/IG1 IGMAXFREQ=0.03 +!/IG1 IGSOURCEATBP = 0 +!/IG1 IGBCOVERWRITE = .TRUE. +!/IG1 IGSWELLMAX = .TRUE. +!/IG1 IGKDMIN = 1.1 +!/IG1 IGFIXEDDEPTH = 0. +!/IG1 IGEMPIRICAL = 0.00125 +! +!/IG1 CALL READNL ( NDSS, 'SIG1 ', STATUS ) +!/IG1 WRITE (NDSO,970) STATUS +! +!/IC2 IC2DISPER = .FALSE. +!/IC2 IC2TURB = 1. +!/IC2 IC2TURBS = 0. +!/IC2 IC2ROUGH = 0.01 +!/IC2 IC2REYNOLDS = 1.5E5 +!/IC2 IC2SMOOTH = 2E5 +!/IC2 IC2VISC = 1. +!/IC2 IC2DMAX = 0. +! +!/IC3 IC3MAXTHK = 100.0 +!/IC3 IC3MAXCNC = 100.0 +!/IC3 IC2TURB = 2.0 ! from run_test example by F.A. +!/IC3 IC2TURBS = 0. +!/IC3 IC2ROUGH = 0.02 ! from run_test example by F.A. (alt:0.1) +!/IC3 IC2REYNOLDS = 1.5E5 +!/IC3 IC2SMOOTH = 7.0E4 +!/IC3 IC2VISC = 2.0 +!/IC3 IC3CHENG = .TRUE. +!/IC3 USECGICE = .FALSE. +!/IC3 IC3HILIM = 100.0 +!/IC3 IC3KILIM = 100.0 +!/IC3 IC3HICE = -1.0 +!/IC3 IC3VISC = -2.0 +!/IC3 IC3DENS = -3.0 +!/IC3 IC3ELAS = -4.0 +!fixme: if USECGICE = .TRUE., don't allow use of IC3MAXTHK<100.0 + +!/IC4 IC4METHOD = 1 !switch for methods within IC4 +!/IC4 IC4KI=0.0 +!/IC4 IC4FC=0.0 +! +!/IC5 IC5MINIG = 1. +!/IC5 IC5MINWT = 0. +!/IC5 IC5MAXKRATIO = 1E9 +!/IC5 IC5MAXKI = 100. +!/IC5 IC5MINHW = 300. +!/IC5 IC5MAXITER = 100. +!/IC5 IC5RKICK = 0. +!/IC5 IC5KFILTER = 0.0025 +! +!/IC2 CALL READNL ( NDSS, 'SIC2 ', STATUS ) +!/IC2 WRITE (NDSO,971) STATUS +! +!/IC3 CALL READNL ( NDSS, 'SIC3 ', STATUS ) +!/IC3 WRITE (NDSO,971) STATUS +! +!/IC4 CALL READNL ( NDSS, 'SIC4 ', STATUS ) +!/IC4 WRITE (NDSO,971) STATUS +! +!/IC5 CALL READNL ( NDSS, 'SIC5 ', STATUS ) +!/IC5 WRITE (NDSO,971) STATUS +!/IC5 WRITE (NDSO,2971) IC5MINIG, IC5MINWT, IC5MAXKRATIO, & +!/IC5 IC5MAXKI, IC5MINHW, IC5MAXITER, IC5RKICK, & +!/IC5 IC5KFILTER +! + 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 + + 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 +!/IC0 IF ( CICE0.EQ.CICEN .AND. FLAGTR.GE.3 ) FLAGTR = FLAGTR - 2 + 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 +!/MGG WRITE (NDSO,962) PMOVE +! +!/SEED XSEED = MAX ( 1. , XSEED ) +!/SEED WRITE (NDSO,964) XSEED +!/SCRIP WRITE (NDSO,963) GSHIFT + WRITE (NDSO,1972) TRCKCMPR + FACSD = XSEED +!/RWND RWINDC = RWNDC +!/WCOR WWCOR(1) = WCOR1 +!/WCOR WWCOR(2) = WCOR2 +! + 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 +!/MLIM J = 1 + 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 +! +!/FLD1 TAILTYPE = 0 +!/FLD1 TAILLEV = 0.006 +!/FLD1 TAILT1 = 1.25 +!/FLD1 TAILT2 = 3.00 +!/FLD2 TAILTYPE = 0 +!/FLD2 TAILLEV = 0.006 +!/FLD2 TAILT1 = 1.25 +!/FLD2 TAILT2 = 3.00 +! +!/FLD1 CALL READNL ( NDSS, 'FLD1', STATUS ) +!/FLD1 TAILLEV = MIN( MAX ( 0.0005 , TAILLEV ), 0.04) +!/FLD1 TAIL_LEV = TAILLEV +!/FLD1 TAIL_ID = TAILTYPE +!/FLD1 TAIL_TRAN1 = TAILT1 +!/FLD1 TAIL_TRAN2 = TAILT2 +!/FLD2 CALL READNL ( NDSS, 'FLD2', STATUS ) +!/FLD2 TAILLEV = MIN( MAX ( 0.0005 , TAILLEV ), 0.04) +!/FLD2 TAIL_LEV = TAILLEV +!/FLD2 TAIL_ID = TAILTYPE +!/FLD2 TAIL_TRAN1 = TAILT1 +!/FLD2 TAIL_TRAN2 = TAILT2 +! +! 6.o End of namelist processing +! + IF (FLGNML) THEN + CLOSE (NDSS) + ELSE + CLOSE (NDSS,STATUS='DELETE') + END IF +! + IF ( FLNMLO ) THEN + WRITE (NDSO,917) +!/FLX3 WRITE (NDSO,2810) CDMAX*1.E3, CTYPE +!/FLX4 WRITE (NDSO,2810) CDFAC +!/LN1 WRITE (NDSO,2820) CLIN, RFPM, RFHF +!/ST1 WRITE (NDSO,2920) CINP + IF ( .NOT. FLSTB2 ) THEN +!/ST2 WRITE (NDSO,2920) ZWND, SWELLF + ELSE +!/STAB2 WRITE (NDSO,2921) ZWND, SWELLF, STABSH, STABOF, & +!/STAB2 CNEG, CPOS, FNEG + END IF +! +!/ST3 WRITE (NDSO,2920) ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & +!/ST3 SWELLF +!/ST4 WRITE (NDSO,2920) ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & +!/ST4 TAUWSHELTER, SWELLFPAR, SWELLF, SWELLF2, SWELLF3, SWELLF4, & +!/ST4 SWELLF5, SWELLF6, SWELLF7, Z0RAT, SINBR +!/ST6 WRITE (NDSO,2920) SINA0, SINWS, SINFC +!/NL1 WRITE (NDSO,2922) LAMBDA, NLPROP, KDCONV, KDMIN, & +!/NL1 SNLCS1, SNLCS2, SNLCS3 +!/NL2 WRITE (NDSO,2922) IQTYPE, TAILNL, NDEPTH +!/NL2 IF ( IQTYPE .EQ. 3 ) THEN +!/NL2 IF ( NDEPTH .EQ. 1 ) THEN +!/NL2 WRITE (NDSO,3923) DPTHNL(1) +!/NL2 ELSE +!/NL2 WRITE (NDSO,4923) DPTHNL(1) +!/NL2 END IF +!/NL2 WRITE (NDSO,5923) DPTHNL(2:NDEPTH-1) +!/NL2 WRITE (NDSO,6923) DPTHNL(NDEPTH) +!/NL2 END IF +!/NL3 WRITE (NDSO,2922) NQDEF, MSC, NSC, KDFD, KDFS +!/NL3 IF ( NQDEF .EQ. 1 ) THEN +!/NL3 WRITE (NDSO,3923) QPARMS(1:5) +!/NL3 ELSE +!/NL3 WRITE (NDSO,4923) QPARMS(1:5) +!/NL3 DO J=2, NQDEF-1 +!/NL3 WRITE (NDSO,5923) QPARMS((J-1)*5+1:J*5) +!/NL3 END DO +!/NL3 WRITE (NDSO,6923) QPARMS((NQDEF-1)*5+1:NQDEF*5) +!/NL3 END IF +!/NL4 WRITE (NDSO,2922) INDTSA, ALTLP +!/NLS WRITE (NDSO,8922) A34, FHFC, DNM, FC1, FC2, FC3 +!/ST1 WRITE (NDSO,2924) CDIS, APM +!/ST2 WRITE (NDSO,2924) SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN +!/ST3 WRITE (NDSO,2924) SDSC1, WNMEANP, FXPM3, FXFM3, SDSDELTA1, & +!/ST3 SDSDELTA2 + +!/ST4 WRITE (NDSO,2924) SDSBCHOICE, SDSC2, SDSCUM, SDSC4, & +!/ST4 SDSC5, SDSC6, & +!/ST4 WNMEANP, FXPM3, FXFM3, FXFMAGE, & +!/ST4 SDSBINT, SDSBCK, SDSABK, SDSPBK, SDSHCK, & +!/ST4 SDSBR, SDSSTRAIN, SDSSTRAINA, SDSSTRAIN2, & +!/ST4 SDSBT, SDSP, SDSISO, SDSCOS, SDSDTH, SDSBRF1, & +!/ST4 SDSBRFDF, SDSBM0, SDSBM1, SDSBM2, SDSBM3, SDSBM4, & +!/ST4 SPMSS, SDKOF, SDSMWD, SDSFACMTF, SDSNMTF,SDSMWPOW,& +!/ST4 SDSCUMP, SDSNUW, WHITECAPWIDTH, WHITECAPDUR +!/ST6 WRITE (NDSO,2924) SDSET, SDSA1, SDSA2, SDSP1, SDSP2 +!/ST6 WRITE (NDSO,2937) SWLB1, CSTB1 +!/BT1 WRITE (NDSO,2926) GAMMA +!/BT4 WRITE (NDSO,2926) SEDMAPD50, SED_D50_UNIFORM, & +!/BT4 RIPFAC1,RIPFAC2,RIPFAC3,RIPFAC4, SIGDEPTH, & +!/BT4 BOTROUGHMIN, BOTROUGHFAC +!/DB1 IF ( BJFLAG ) THEN +!/DB1 WRITE (NDSO,2928) BJALFA, BJGAM, '.TRUE.' +!/DB1 ELSE +!/DB1 WRITE (NDSO,2928) BJALFA, BJGAM, '.FALSE.' +!/DB1 END IF +!/PR1 WRITE (NDSO,2953) CFLTM +!/PR2 WRITE (NDSO,2953) CFLTM, DTIME, LATMIN +!/SMC WRITE (NDSO,2953) CFLTM, DTIME, LATMIN, RFMAXD, UNO3, & +!/SMC AVERG, LvSMC, NBISMC, ISHFT, JEQT, SEAWND +!/PR3 WRITE (NDSO,2953) CFLTM, WDTHCG, WDTHTH +! + 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_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 +! +!/REF1 WRITE(NDSO,2986) REFCOAST, REFFREQ, REFSLOPE, REFMAP, & +!/REF1 REFMAPD, REFSUBGRID , REFRMAX, REFFREQPOW, & +!/REF1 REFICEBERG, REFCOSP_STRAIGHT, REFUNSTSOURCE +! +!/IG1 WRITE(NDSO,2977) IGMETHOD, IGADDOUTP, IGSOURCE, & +!/IG1 IGSTERMS, IGBCOVERWRITE, IGSWELLMAX, & +!/IG1 IGMAXFREQ, IGSOURCEATBP, IGKDMIN, & +!/IG1 IGFIXEDDEPTH, IGEMPIRICAL +! +!/IC2 WRITE(NDSO,2978) IC2DISPER, IC2TURB, IC2ROUGH, & +!/IC2 IC2REYNOLDS, IC2SMOOTH, IC2VISC, IC2TURBS, & +!/IC2 IC2DMAX +! +!/IC3 WRITE(NDSO,2979) IC3MAXTHK, IC3MAXCNC, IC2TURB, & +!/IC3 IC2ROUGH, IC2REYNOLDS, IC2SMOOTH, & +!/IC3 IC2VISC, IC2TURBS, IC3CHENG, & +!/IC3 USECGICE, IC3HILIM, IC3KILIM, & +!/IC3 IC3HICE, IC3VISC, IC3DENS, IC3ELAS +! +!/IC4 WRITE(NDSO,NML=SIC4) +! +!/IC5 WRITE(NDSO,2981) IC5MINIG, IC5MINWT, IC5MAXKRATIO, & +!/IC5 IC5MAXKI, IC5MINHW, IC5MAXITER, & +!/IC5 IC5RKICK, IC5KFILTER +! +!/IS1 WRITE (NDSO,2946) IS1C1, IS1C2 +! +!/IS2 WRITE (NDSO,948) ISC1, IS2BACKSCAT, IS2ISOSCAT, IS2BREAK, & +!/IS2 IS2DUPDATE, IS2FLEXSTR, IS2DISP, IS2DAMP, IS2FRAGILITY, IS2DMIN, IS2C2, & +!/IS2 IS2C3, IS2CONC, IS2CREEPB, IS2CREEPC, IS2CREEPD, & +!/IS2 IS2CREEPN, IS2BREAKE, IS2BREAKF, IS2WIM1, IS2ANDISB, & +!/IS2 IS2ANDISE, IS2ANDISD, IS2ANDISN +! +!/UOST WRITE (NDSO, 4502) ADJUSTL(TRIM(UOSTFILELOCAL)), ADJUSTL(TRIM(UOSTFILESHADOW)), & +!/UOST UOSTFACTORLOCAL, UOSTFACTORSHADOW + +! + 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 +! +!/FLD1 WRITE(NDSO,2987) TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 +!/FLD2 WRITE(NDSO,2987) TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 +!/RTD WRITE(NDSO,4991) PLAT, PLON, UNROT +!/RTD WRITE(NDSO,4992) BPLAT, BPLON +! + 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) +!/ST3 STXFTF = 1/(FACHF-1.-WNMEANP*2) & +!/ST3 * SIG(NK)**(2+WNMEANP*2) * DTH +!/ST3 STXFTFTAIL = 1/(FACHF-1.-WNMEANPTAIL*2) & +!/ST3 * SIG(NK)**(2+WNMEANPTAIL*2) * DTH +!/ST3 STXFTWN = 1/(FACHF-1.-WNMEANP*2) * SIG(NK)**(2) & +!/ST3 * (SIG(NK)/SQRT(GRAV))**(WNMEANP*2) * DTH +!/ST3 SSTXFTF = STXFTF +!/ST3 SSTXFTFTAIL = STXFTFTAIL +!/ST3 SSTXFTWN = STXFTWN +! +!/ST4 STXFTF = 1/(FACHF-1.-WNMEANP*2) & +!/ST4 * SIG(NK)**(2+WNMEANP*2) * DTH +!/ST4 STXFTFTAIL = 1/(FACHF-1.-WNMEANPTAIL*2) & +!/ST4 * SIG(NK)**(2+WNMEANPTAIL*2) * DTH +!/ST4 STXFTWN = 1/(FACHF-1.-WNMEANP*2) * SIG(NK)**(2) & +!/ST4 * (SIG(NK)/SQRT(GRAV))**(WNMEANP*2) * DTH +!/ST4 SSTXFTF = STXFTF +!/ST4 SSTXFTFTAIL = STXFTFTAIL +!/ST4 SSTXFTWN = STXFTWN +! +! ... High frequency cut-off +! + FXFM = 2.5 +!/ST6 FXFM = SIN6FC + FXPM = 4.0 + FXPM = FXPM * GRAV / 28. + FXFM = FXFM * TPI + XFC = 3.0 +!/ST2 XFH = 2.0 +!/ST2 XF1 = 1.75 +!/ST2 XF2 = 2.5 +!/ST2 XFT = XF2 +! + FACTI1 = 1. / LOG(XFR) + FACTI2 = 1. - LOG(TPI*FR1) * FACTI1 +! +! Setting of FACHF moved to before !/NL2 set-up for consistency +! +!/NL2 FACHF = -TAILNL + 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' + 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 ) + CASE ( RLGTYPE ) + 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 + UNSTSCHEME=-1 + DO IX=1,4 + 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) ' + END SELECT +! + IF (SUM(UNSTSCHEMES).GT.1) WRITE(NDSO,1035) + WRITE (NDSO,2951) PNAME2 + IF (IMPTOTAL) THEN + FSTOTALIMP = IMPTOTAL + PNAME2 = 'N Implicit (Fluctuation Splitting) for total implicit' + END IF + IF (EXPTOTAL) THEN + FSTOTALEXP = EXPTOTAL + PNAME2 = 'N Explicit (Fluctuation Splitting) for one exchange explicit DC HPCF ' + END IF + 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 = ' we change 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 +! + CASE ( RLGTYPE ) +! + 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', & + STATUS='OLD',ERR=2000,IOSTAT=IERR) + ELSE + OPEN (NDSG, & + FORM='UNFORMATTED', & + 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', & + STATUS='OLD',ERR=2000,IOSTAT=IERR) + ELSE + OPEN (NDSG, & + FORM='UNFORMATTED', & + 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) +! +! 7.e Read bottom depths +! + IF ( GTYPE.NE.UNGTYPE ) THEN +! +! Reading depths on structured grid +! +!Li Suspended for SMC grid, which uses depth stored in its cell array. +!Li JGLi15Oct2014 + IF( RGLGRD ) THEN +!Li + 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',& + STATUS='OLD',ERR=2000,IOSTAT=IERR) + ELSE + OPEN (NDSG, FORM='UNFORMATTED', & + 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 ) +! +!Li End of RGLGRD block + ENDIF +!Li +! + ALLOCATE ( ZBIN(NX,NY), OBSX(NX,NY), OBSY(NX,NY) ) +! +! Initialize subgrid obstructions with zeros. + ZBIN(:,:)=0. + OBSX(:,:)=0. + OBSY(:,:)=0. + +!Li Suspend read depth file. JGLi15Oct2014 + IF( RGLGRD ) THEN +!Li + CALL INA2R ( ZBIN, NX, NY, 1, NX, 1, NY, NDSG, NDST, NDSE, & + IDFM, RFORM, IDLA, VSC, 0.0) +!Li End of RGLGRD block + ENDIF +!Li +! + 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*XYB(:,3) +!/DEBUGSTP WRITE(740,*) 'VSC=', VSC +!/DEBUGSTP WRITE(740,*) 'Printing ZBIN 1' +!/DEBUGSTP DO IX=1,NX +!/DEBUGSTP WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) +!/DEBUGSTP END DO +! +! 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 +! +!/DEBUGSTP WRITE(740,*) 'Printing ZBIN 2' +!/DEBUGSTP DO IX=1,NX +!/DEBUGSTP WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) +!/DEBUGSTP END DO + 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( RGLGRD ) THEN +!Li +! +! 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',STATUS='OLD',ERR=2000, & + IOSTAT=IERR) + ELSE + OPEN (NDSTR, FORM='UNFORMATTED', & + 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 RGLGRD block + END IF +!Li +! +!/RTD ! 7.h Calculate rotation angles for configs with rotated pole +!/RTD PoLon = PLON +!/RTD PoLat = PLAT +!/RTD FLAGUNR = UNROT +!/RTD ! Default values PLON=-180, PLAT=90, UNROT=.FALSE. for standard lat-lon +!/RTD +!/RTD ALLOCATE( AnglDin(NX,NY) ) +!/RTD ! For standard lat-lon the rotation angles are zero +!/RTD IF ( PoLat == 90. ) THEN +!/RTD AnglDin = 0. +!/RTD ELSE +!/RTD ALLOCATE(StdLat(NX,NY), StdLon(NX,NY)) +!/RTD +!/RTD ! Calculate rotation angles; (StdLon/Lat are returned, but not used) +!/RTD ! The regular grid X/YGRDIN are used as equatorial lon and lat +!/RTD CALL W3EQTOLL( YGRDIN, XGRDIN, StdLat, StdLon, AnglDin, & +!/RTD PoLat, PoLon, NX*NY ) +!/RTD +!/RTD ! Clean up +!/RTD DEALLOCATE( StdLat, StdLon ) +!/RTD END IF +!/RTD ! Write out rotation information +!/RTD WRITE (NDSO,4203) PoLat, PoLon +!/RTD WRITE (NDSO,4200) +!/RTD WRITE (NDSO,4201) ( IX, IX=1,NX,NX/3) +!/RTD WRITE (NDSO,4202) 1,(AnglDin(IX, 1), IX=1,NX,NX/3) +!/RTD WRITE (NDSO,4202) NY,(AnglDin(IX,NY), IX=1,NX,NX/3) +!/RTD IF ( FLAGUNR ) WRITE (NDSO,4204) +!/RTD WRITE (NDSO,*) ' ' +!/RTD +! +!/SMC !! 7.i Read SMC grid cell and face integer arrays. +!/SMC IF (FLGNML) THEN +!/SMC NDSTR = NML_SMC%MCELS%IDF +!/SMC IDLA = NML_SMC%MCELS%IDLA +!/SMC IDFM = NML_SMC%MCELS%IDFM +!/SMC RFORM = TRIM(NML_SMC%MCELS%FORMAT) +!/SMC TNAME = TRIM(NML_SMC%MCELS%FILENAME) +!/SMC ELSE +!/SMC CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/SMC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME +!/SMC END IF +!/SMC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/SMC FORM='FORMATTED',STATUS='OLD',ERR=2000) +!/SMC ALLOCATE ( NLvCelsk( 0:NRLv ) ) +!/SMC READ (NDSTR,*) NLvCelsk +!/SMC NCel=NLvCelsk(0) +!/ARC NGLO=NCel +!/SMC WRITE (NDSO,4004) NCel, NLvCelsk +!/SMC +!/SMC ALLOCATE ( IJKCelin( 5, NCel) ) +!/SMC CALL INA2I ( IJKCelin, 5, NCel, 1, 5, 1, NCel, NDSTR, NDST, NDSE, & +!/SMC IDFM, RFORM, IDLA, 1, 0) +!/SMC CLOSE(NDSTR) +!/SMC !!Li Offset to change Equator index = 0 to regular grid index JEQT +!/SMC IJKCelin( 2, :) = IJKCelin( 2, :) + JEQT +!/SMC !!Li Offset to change i-index = 0 to regular grid index ISHFT +!/SMC IJKCelin( 1, :) = IJKCelin( 1, :) + ISHFT +!/SMC +!/SMC WRITE (NDSO,4005) TNAME +!/SMC WRITE (NDSO,4006) 1,(IJKCelin(ix, 1), ix=1,5) +!/SMC WRITE (NDSO,4006) NCel,(IJKCelin(ix, NCel), ix=1,5) +!/SMC WRITE (NDSO,*) ' ' +!/SMC +!/SMC IF (FLGNML) THEN +!/SMC NDSTR = NML_SMC%ISIDE%IDF +!/SMC IDLA = NML_SMC%ISIDE%IDLA +!/SMC IDFM = NML_SMC%ISIDE%IDFM +!/SMC RFORM = TRIM(NML_SMC%ISIDE%FORMAT) +!/SMC TNAME = TRIM(NML_SMC%ISIDE%FILENAME) +!/SMC ELSE +!/SMC CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/SMC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME +!/SMC END IF +!/SMC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/SMC FORM='FORMATTED',STATUS='OLD',ERR=2000) +!/SMC ALLOCATE ( NLvUFcsk( 0:NRLv ) ) +!/SMC READ (NDSTR,*) NLvUFcsk +!/SMC NUFc = NLvUFcsk(0) +!/SMC NGUI = NUFc +!/SMC WRITE (NDSO,4007) NUFc, NLvUFcsk +!/SMC +!/SMC ALLOCATE ( IJKUFcin( 7, NUFc) ) +!/SMC CALL INA2I ( IJKUFcin, 7, NUFc, 1, 7, 1, NUFc, NDSTR, NDST, NDSE, & +!/SMC IDFM, RFORM, IDLA, 1, 0) +!/SMC CLOSE(NDSTR) +!/SMC !!Li Offset to change Equator index = 0 to regular grid index +!/SMC IJKUFcin( 2, :) = IJKUFcin( 2, :) + JEQT +!/SMC IJKUFcin( 1, :) = IJKUFcin( 1, :) + ISHFT +!/SMC +!/SMC WRITE (NDSO,4008) TNAME +!/SMC WRITE (NDSO,4009) 1,(IJKUFcin(ix, 1), ix=1,7) +!/SMC WRITE (NDSO,4009) NUFc,(IJKUFcin(ix, NUFc), ix=1,7) +!/SMC WRITE (NDSO,*) ' ' +!/SMC +!/SMC IF (FLGNML) THEN +!/SMC NDSTR = NML_SMC%JSIDE%IDF +!/SMC IDLA = NML_SMC%JSIDE%IDLA +!/SMC IDFM = NML_SMC%JSIDE%IDFM +!/SMC RFORM = TRIM(NML_SMC%JSIDE%FORMAT) +!/SMC TNAME = TRIM(NML_SMC%JSIDE%FILENAME) +!/SMC ELSE +!/SMC CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/SMC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME +!/SMC END IF +!/SMC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/SMC FORM='FORMATTED',STATUS='OLD',ERR=2000) +!/SMC ALLOCATE ( NLvVFcsk( 0:NRLv ) ) +!/SMC READ (NDSTR,*) NLvVFcsk +!/SMC NVFc= NLvVFcsk(0) +!/SMC NGVJ= NVFc +!/SMC WRITE (NDSO,4010) NVFc, NLvVFcsk +!/SMC +!/SMC ALLOCATE ( IJKVFcin( 8, NVFc) ) +!/SMC CALL INA2I ( IJKVFcin, 8, NVFc, 1, 8, 1, NVFc, NDSTR, NDST, NDSE, & +!/SMC IDFM, RFORM, IDLA, 1, 0) +!/SMC CLOSE(NDSTR) +!/SMC !!Li Offset to change Equator index = 0 to regular grid index +!/SMC IJKVFcin( 2, :) = IJKVFcin( 2, :) + JEQT +!/SMC IJKVFcin( 1, :) = IJKVFcin( 1, :) + ISHFT +!/SMC +!/SMC WRITE (NDSO,4011) TNAME +!/SMC WRITE (NDSO,4012) 1,(IJKVFcin(ix, 1), ix=1,8) +!/SMC WRITE (NDSO,4012) NVFc,(IJKVFcin(ix, NVFc), ix=1,8) +!/SMC WRITE (NDSO,*) ' ' +!/SMC +!/SMC !!Li Subgrid obstruction for each SMCels. JGLi15Oct2014 +!/SMC IF (FLGNML) THEN +!/SMC NDSTR = NML_SMC%SUBTR%IDF +!/SMC IDLA = NML_SMC%SUBTR%IDLA +!/SMC IDFM = NML_SMC%SUBTR%IDFM +!/SMC RFORM = TRIM(NML_SMC%SUBTR%FORMAT) +!/SMC TNAME = TRIM(NML_SMC%SUBTR%FILENAME) +!/SMC ELSE +!/SMC CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/SMC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME +!/SMC END IF +!/SMC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/SMC FORM='FORMATTED',STATUS='OLD',ERR=2000) +!/SMC READ (NDSTR,*) NCObst, JObs +!/SMC WRITE (NDSO,4110) NCObst, JObs +!/SMC +!/SMC ALLOCATE ( IJKObstr( JObs, NCObst) ) +!/SMC CALL INA2I ( IJKObstr, JObs, NCObst, 1, JObs, 1, NCObst, NDSTR, NDST, & +!/SMC NDSE, IDFM, RFORM, IDLA, 1, 0) +!/SMC CLOSE(NDSTR) +!/SMC +!/SMC WRITE (NDSO,4111) TNAME +!/SMC WRITE (NDSO,4012) 1, (IJKObstr(ix, 1), ix=1,JObs) +!/SMC WRITE (NDSO,4012) NCObst, (IJKObstr(ix, NCObst), ix=1,JObs) +!/SMC WRITE (NDSO,*) ' ' +!/SMC +!/SMC !!Li Bounary cell sequential numbers are read only if NBISMC>0 +!/SMC IF( NBISMC .GT. 0 ) THEN +!/SMC IF (FLGNML) THEN +!/SMC NDSTR = NML_SMC%BUNDY%IDF +!/SMC IDLA = NML_SMC%BUNDY%IDLA +!/SMC IDFM = NML_SMC%BUNDY%IDFM +!/SMC RFORM = TRIM(NML_SMC%BUNDY%FORMAT) +!/SMC TNAME = TRIM(NML_SMC%BUNDY%FILENAME) +!/SMC ELSE +!/SMC CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/SMC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME +!/SMC END IF +!/SMC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/SMC FORM='FORMATTED',STATUS='OLD',ERR=2000) +!/SMC ALLOCATE ( NBICelin( NBISMC ) ) +!/SMC CALL INA2I ( NBICelin, 1, NBISMC, 1, 1, 1, NBISMC, NDSTR, NDST, & +!/SMC NDSE, IDFM, RFORM, IDLA, 1, 0) +!/SMC CLOSE(NDSTR) +!/SMC +!/SMC WRITE (NDSO,4013) TNAME +!/SMC WRITE (NDSO,4014) 1, NBICelin( 1) +!/SMC WRITE (NDSO,4014) NBISMC, NBICelin(NBISMC) +!/SMC WRITE (NDSO,*) ' ' +!/SMC ENDIF +!/SMC +! +!/ARC !! 7.j Read Arctic grid cell and boundary cell integer arrays. +!/ARC IF (FLGNML) THEN +!/ARC NDSTR = NML_SMC%MBARC%IDF +!/ARC IDLA = NML_SMC%MBARC%IDLA +!/ARC IDFM = NML_SMC%MBARC%IDFM +!/ARC RFORM = TRIM(NML_SMC%MBARC%FORMAT) +!/ARC TNAME = TRIM(NML_SMC%MBARC%FILENAME) +!/ARC ELSE +!/ARC CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/ARC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME +!/ARC END IF +!/ARC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/ARC FORM='FORMATTED',STATUS='OLD',ERR=2000) +!/ARC READ (NDSTR,*) NARC, NBGL, NBAC +!/ARC WRITE (NDSO,4015) NARC, NBGL, NBAC +!/ARC +!/ARC ALLOCATE ( IJKCelAC( 5, NARC) ) +!/ARC CALL INA2I ( IJKCelAC, 5, NARC, 1, 5, 1, NARC, NDSTR, NDST, NDSE, & +!/ARC IDFM, RFORM, IDLA, 1, 0) +!/ARC CLOSE(NDSTR) +!/ARC !!Li Offset to change Equator index = 0 to regular grid index JEQT +!/ARC IJKCelAC( 2, :) = IJKCelAC( 2, :) + JEQT +!/ARC IJKCelAC( 1, :) = IJKCelAC( 1, :) + ISHFT +!/ARC +!/ARC WRITE (NDSO,4016) TNAME +!/ARC WRITE (NDSO,4006) 1,(IJKCelAC(ix, 1), ix=1,5) +!/ARC WRITE (NDSO,4006) NARC,(IJKCelAC(ix, NARC), ix=1,5) +!/ARC WRITE (NDSO,*) ' ' +!/ARC +!/ARC IF (FLGNML) THEN +!/ARC NDSTR = NML_SMC%AISID%IDF +!/ARC IDLA = NML_SMC%AISID%IDLA +!/ARC IDFM = NML_SMC%AISID%IDFM +!/ARC RFORM = TRIM(NML_SMC%AISID%FORMAT) +!/ARC TNAME = TRIM(NML_SMC%AISID%FILENAME) +!/ARC ELSE +!/ARC CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/ARC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME +!/ARC END IF +!/ARC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/ARC FORM='FORMATTED',STATUS='OLD',ERR=2000) +!/ARC READ (NDSTR,*) NAUI +!/ARC WRITE (NDSO,4017) NAUI +!/ARC +!/ARC ALLOCATE ( IJKUFcAC( 7, NAUI) ) +!/ARC CALL INA2I ( IJKUFcAC, 7, NAUI, 1, 7, 1, NAUI, NDSTR, NDST, NDSE, & +!/ARC IDFM, RFORM, IDLA, 1, 0) +!/ARC CLOSE(NDSTR) +!/ARC !!Li Offset to change Equator index = 0 to regular grid index +!/ARC IJKUFcAC( 2, :) = IJKUFcAC( 2, :) + JEQT +!/ARC IJKUFcAC( 1, :) = IJKUFcAC( 1, :) + ISHFT +!/ARC !!Li Offset Arctic cell sequential numbers by global cell number NGLO +!/ARC DO IP=1, NAUI +!/ARC DO IX=4,7 +!/ARC IF( IJKUFcAC(IX,IP) > 0 ) IJKUFcAC(IX,IP) = IJKUFcAC(IX,IP) + NGLO +!/ARC ENDDO +!/ARC ENDDO +!/ARC +!/ARC WRITE (NDSO,4018) TNAME +!/ARC WRITE (NDSO,4009) 1,(IJKUFcAC(ix, 1), ix=1,7) +!/ARC WRITE (NDSO,4009) NAUI,(IJKUFcAC(ix, NAUI), ix=1,7) +!/ARC WRITE (NDSO,*) ' ' +!/ARC +!/ARC IF (FLGNML) THEN +!/ARC NDSTR = NML_SMC%AJSID%IDF +!/ARC IDLA = NML_SMC%AJSID%IDLA +!/ARC IDFM = NML_SMC%AJSID%IDFM +!/ARC RFORM = TRIM(NML_SMC%AJSID%FORMAT) +!/ARC TNAME = TRIM(NML_SMC%AJSID%FILENAME) +!/ARC ELSE +!/ARC CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/ARC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME +!/ARC END IF +!/ARC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/ARC FORM='FORMATTED',STATUS='OLD',ERR=2000) +!/ARC READ (NDSTR,*) NAVJ +!/ARC WRITE (NDSO,4019) NAVJ +!/ARC +!/ARC ALLOCATE ( IJKVFcAC( 8, NAVJ) ) +!/ARC CALL INA2I ( IJKVFcAC, 8, NAVJ, 1, 8, 1, NAVJ, NDSTR, NDST, NDSE, & +!/ARC IDFM, RFORM, IDLA, 1, 0) +!/ARC CLOSE(NDSTR) +!/ARC !!Li Offset to change Equator index = 0 to regular grid index +!/ARC IJKVFcAC( 2, :) = IJKVFcAC( 2, :) + JEQT +!/ARC IJKVFcAC( 1, :) = IJKVFcAC( 1, :) + ISHFT +!/ARC !!Li Offset Arctic cell sequential numbers by global cell number NGLO +!/ARC DO IP=1, NAVJ +!/ARC DO IY=4,7 +!/ARC IF( IJKVFcAC(IY,IP) > 0 ) IJKVFcAC(IY,IP) = IJKVFcAC(IY,IP) + NGLO +!/ARC ENDDO +!/ARC ENDDO +!/ARC +!/ARC WRITE (NDSO,4020) TNAME +!/ARC WRITE (NDSO,4012) 1,(IJKVFcAC(ix, 1), ix=1,8) +!/ARC WRITE (NDSO,4012) NAVJ,(IJKVFcAC(ix, NAVJ), ix=1,8) +!/ARC WRITE (NDSO,*) ' ' +!/ARC +!/ARC !!Li Reset total cell and face numbers +!/ARC NCel = NGLO + NARC +!/ARC NUFc = NGUI + NAUI +!/ARC NVFc = NGVJ + NAVJ +!/ARC !!Li Also append Arctic part into base level sub-loops +!/ARC NLvCelsk(NRLv)=NLvCelsk(NRLv)+NARC +!/ARC NLvUFcsk(NRLv)=NLvUFcsk(NRLv)+NAUI +!/ARC NLvVFcsk(NRLv)=NLvVFcsk(NRLv)+NAVJ +!/ARC !!Li Reset NBAC to total number of boundary cells. +!/ARC NBAC = NBGL + NBAC +!/ARC +!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! 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) +!/DEBUGSTP WRITE(740,*) 'Printing ZBIN 4' +!/DEBUGSTP DO IX=1,NX +!/DEBUGSTP WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) +!/DEBUGSTP END DO +! +! 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 +! +!/DEBUGGRID WRITE(740+IAPROC,*) 'FROM=', TRIM(FROM) + 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 +!/DEBUGGRID nbCase1=0 +!/DEBUGGRID nbCase2=0 +!/DEBUGGRID nbCase3=0 +!/DEBUGGRID nbCase4=0 +!/DEBUGGRID nbCase5=0 +!/DEBUGGRID nbCase6=0 +!/DEBUGGRID nbCase7=0 +!/DEBUGGRID nbCase8=0 + 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 +!/DEBUGGRID WRITE(740+IAPROC,*) 'read IX=', IX +!/DEBUGGRID WRITE(740+IAPROC,*) 'read IY=', IY +!/DEBUGGRID WRITE(740+IAPROC,*) 'read CONNCT=', CONNCT + +! +! ... 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. +! +!/DEBUGGRID WRITE(740+IAPROC,*) 'CONNCT=', CONNCT +!/DEBUGGRID WRITE(740+IAPROC,*) 'FIRST=', FIRST + 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 +!/DEBUGGRID nbCase2=nbCase2+1 + 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) +!/DEBUGGRID nbCase3=nbCase3 + 1 + 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 +!/DEBUGGRID nbCase4=nbCase4 + 1 + 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 +!/DEBUGGRID nbCase5=nbCase5 + 1 + 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 +!/DEBUGGRID nbCase6=nbCase6 + 1 + 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 +!/DEBUGGRID nbCase7=nbCase7 + 1 + 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 +!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase1=', nbCase1 +!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase2=', nbCase2 +!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase3=', nbCase3 +!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase4=', nbCase4 +!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase5=', nbCase5 +!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase6=', nbCase6 +!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase7=', nbCase7 +!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase8=', nbCase8 +!/DEBUGGRID nbTMPSTA0=0 +!/DEBUGGRID nbTMPSTA1=0 +!/DEBUGGRID nbTMPSTA2=0 +!/DEBUGGRID DO IX=1,NX +!/DEBUGGRID DO IY=1,NY +!/DEBUGGRID WRITE(740+IAPROC,*) 'IX/IY/TMPSTA=', IX, IY, TMPSTA(IY,IX) +!/DEBUGGRID IF (TMPSTA(IY,IX) .eq. 0) nbTMPSTA0=nbTMPSTA0+1 +!/DEBUGGRID IF (TMPSTA(IY,IX) .eq. 1) nbTMPSTA1=nbTMPSTA1+1 +!/DEBUGGRID IF (TMPSTA(IY,IX) .eq. 2) nbTMPSTA2=nbTMPSTA2+1 +!/DEBUGGRID END DO +!/DEBUGGRID END DO +!/DEBUGGRID WRITE(740+IAPROC,*) 'nbTMPSTA0=', nbTMPSTA0 +!/DEBUGGRID WRITE(740+IAPROC,*) 'nbTMPSTA1=', nbTMPSTA1 +!/DEBUGGRID WRITE(740+IAPROC,*) 'nbTMPSTA2=', nbTMPSTA2 +!/DEBUGGRID FLUSH(740+IAPROC) +! + 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( RGLGRD ) 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',STATUS='OLD',ERR=2000, & + IOSTAT=IERR) + ELSE + OPEN (NDSTR, FORM='UNFORMATTED', & + 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 !! RGLGRD +!!Li +! + 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 +! +!/SMC !Li Moved before FLBPI is defined with NBI value. JGLi05Jun2015 +!/SMC !Li Overwrite NSEA with NCel for SMC grid. +!/SMC NSEA = NCel +!/SMC !Li Use input NBI number for SMC grid because merged +!/SMC !Li cells are over-counted by model. +!/SMC NBI = NBISMC +!/SMC !Li No land points are used in SMC grid. JGLi26Feb2016 +!/SMC NLAND = 0 +! + WRITE (NDSO,980) + FLBPI = NBI .GT. 0 + IF ( .NOT. FLBPI ) THEN + WRITE (NDSO,985) + ELSE + WRITE (NDSO,986) NBI +!/O1 IF ( FLAGLL ) THEN +!/O1 WRITE (NDSO, 987) +!/O1 ELSE +!/O1 WRITE (NDSO,1987) +!/O1 END IF +!/O1 IBI = 1 +!/O1 DO IY=1, NY +!/O1 DO IX=1, NX +!/O1 IF (GTYPE.NE.UNGTYPE) THEN +!/O1 X = FACTOR * ( XGRDIN(IX,IY) ) +!/O1 Y = FACTOR * ( YGRDIN(IX,IY) ) +!/O1 ELSE +!/O1 X = FACTOR * XYB(IX,1) +!/O1 Y = FACTOR * XYB(IX,2) +!/O1 END IF +!/O1 IF ( TMPSTA(IY,IX).EQ.2 ) THEN +!/O1 IF ( FLAGLL ) THEN +!/O1 WRITE (NDSO, 988) IBI, IX, IY, X, Y +!/O1 ELSE +!/O1 WRITE (NDSO,1988) IBI, IX, IY, X, Y +!/O1 END IF +!/O1 IBI = IBI + 1 +!/O1 END IF +!/O1 END DO +!/O1 END DO + 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 +! +!!Li CALL W3DIMX ( 1, NX, NY, NSEA, NDSE, NDST ) + CALL W3DIMX ( 1, NX, NY, NSEA, NDSE, NDST & +!/SMC , NCel, NUFc, NVFc, NRLv & +!/ARC , NARC, NBAC, NSPEC & + ) +!/SMC WRITE (NDSO,4021) NCel +! +! 8.g Activation of reflections and scattering + FFACBERG=FACBERG +!/REF1 REFPARS(1)=REFCOAST +!/REF1 REFPARS(2)=REFSUBGRID +!/REF1 REFPARS(3)=REFUNSTSOURCE +!/REF1 REFPARS(4)=REFICEBERG +!/REF1 REFPARS(6)=REFFREQ +!/REF1 REFPARS(7)=REFSLOPE +!/REF1 REFPARS(8)=REFCOSP_STRAIGHT +!/REF1 REFPARS(9)=REFRMAX +!/REF1 REFPARS(10)=REFFREQPOW +!/REF1 IF (GTYPE.EQ.UNGTYPE) REFPARS(2:5)=0. +!/REF1 IF (REFMAP.EQ.0) THEN +!/REF1 REFLC(3,:)=REFPARS(7) +!/REF1 END IF + + + 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 +! +!FA: This distinction between structured and unstructured +! should be removed when XYB is replaced by XGRD and YGRD +! + DO IX=1, NX + XGRD(:,IX) = XYB(IX,1) + YGRD(:,IX) = XYB(IX,2) + END DO + END IF ! GTYPE +! +! +!!Li MAPSTA = TMPSTA +!!Li Shelter MAPSTA LLG definition for SMC by RGLGRD. + IF( RGLGRD ) MAPSTA = TMPSTA + MAPFS = 0 +! +!/T ALLOCATE ( MAPOUT(NX,NY) ) +!/T MAPOUT = 0 +! +!/T IX3 = 1 + NX/60 +!/T IY3 = 1 + NY/60 +!/T CALL PRTBLK (NDST, NX, NY, NX, ZBIN, MAPOUT, 1, 0., & +!/T 1, NX, IX3, 1, NY, IY3, 'Zb', 'm') +! +!/DEBUGSTP WRITE(740,*) 'Printing ZBIN 5' +!/DEBUGSTP DO IX=1,NX +!/DEBUGSTP WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) +!/DEBUGSTP END DO + TRNX = 0. + TRNY = 0. +! +!Li Shelter MAPSTA etc LLG definitions for SMC by logical RGLGRD ! +!AR This is only .FALSE. for SMC .. + IF( RGLGRD ) THEN + 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) +!/T MAPOUT(IX,IY) = 1 + 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 +!/DEBUGSTP DO ISEA=1,NSEA +!/DEBUGSTP WRITE(740,*) 'ISEA,ZB=', ISEA, ZB(ISEA) +!/DEBUGSTP END DO +!/DEBUGSTP FLUSH(740) + ENDIF +!!Li End of RGLGRD IF block +! +!/SMC !Li Pass refined level cell and face counts to NLv*(NRLv) +!/SMC NLvCel(0)=0 +!/SMC NLvUFc(0)=0 +!/SMC NLvVFc(0)=0 +!/SMC DO IP = 1, NRLv +!/SMC NLvCel(IP)=NLvCelsk(IP) + NLvCel(IP-1) +!/SMC NLvUFc(IP)=NLvUFcsk(IP) + NLvUFc(IP-1) +!/SMC NLvVFc(IP)=NLvVFcsk(IP) + NLvVFc(IP-1) +!/SMC ENDDO +!/SMC WRITE (NDSO,4022) NLvCel +!/SMC WRITE (NDSO,4023) NLvUFc +!/SMC WRITE (NDSO,4024) NLvVFc +!/SMC +!/SMC !Li Redefine MAPSF MAPFS MAPSTA MAPST2 CLATS and ZB for SMC Grid, +!/SMC !Li using SMC grid cell array and assuming NSEA=NCel. +!/SMC MAPSTA = 0 +!/SMC MAPST2 = 1 +!/SMC MAPFS = 0 +!/SMC +!/SMC !Li Pass input SMC arrays to newly declared grid arrays. +!/SMC WRITE (NDSO,4025) NCel +!/SMC JJ=NCel +!/ARC JJ=NGLO +!/SMC IJKCel(:, 1:JJ )=IJKCelin(:, 1:JJ ) +!/SMC IJKUFc(:, 1:NGUI)=IJKUFcin(:, 1:NGUI) +!/SMC IJKVFc(:, 1:NGVJ)=IJKVFcin(:, 1:NGVJ) +!/ARC !Li Append Arctic part +!/ARC IJKCel(:, NGLO+1:NCel)=IJKCelAC(:, 1:NARC) +!/ARC IJKUFc(:, NGUI+1:NUFc)=IJKUFcAC(:, 1:NAUI) +!/ARC IJKVFc(:, NGVJ+1:NVFc)=IJKVFcAC(:, 1:NAVJ) +!/SMC +!/SMC WRITE (NDSO,4026) +!/SMC WRITE (NDSO,4006) 1,(IJKCel(ix, 1), ix=1,5) +!/SMC JJ=NCel +!/SMC WRITE (NDSO,4006) JJ,(IJKCel(ix, JJ), ix=1,5) +!/SMC WRITE (NDSO,*) ' ' +!/SMC WRITE (NDSO,4027) +!/SMC WRITE (NDSO,4009) 1,(IJKUFc(ix, 1), ix=1,7) +!/SMC JJ=NUFc +!/SMC WRITE (NDSO,4009) JJ,(IJKUFc(ix, JJ), ix=1,7) +!/SMC WRITE (NDSO,*) ' ' +!/SMC WRITE (NDSO,4028) +!/SMC WRITE (NDSO,4012) 1,(IJKVFc(ix, 1), ix=1,8) +!/SMC JJ=NVFc +!/SMC WRITE (NDSO,4012) JJ,(IJKVFc(ix, JJ), ix=1,8) +!/SMC WRITE (NDSO,*) ' ' +!/SMC +!/SMC !Li Boundary -9 to 0 cells for cell x-size 2**n +!/SMC !Li Note the position indice for bounary cell are not used. +!/SMC IJKCel(1, -9:0)=0 +!/SMC !Li Use Equator Y index for boundary cells. JGLi04Apr2011 +!/SMC !Li IJKCel(2, -9:0)=0 +!/SMC IJKCel(2, -9:0)=JEQT +!/SMC IJKCel(3, 0)=1 +!/SMC IJKCel(4, 0)=1 +!/SMC !Li Use minimum 10 m depth for boundary cells. +!/SMC !Li Y-size is restricted below base-cell value. +!/SMC !Li For refined boundary cells, its y-size is replaced with +!/SMC !Li the inner cell y-size for flux gradient. +!/SMC IJKCel(5, 0)=10 +!/SMC DO ip=1,9 +!/SMC IJKCel(3,-ip)=IJKCel(3,-ip+1)*2 +!/SMC IK=MIN(ip, NRLv-1) +!/SMC IJKCel(4,-ip)=2**IK +!/SMC IJKCel(5,-ip)=10 +!/SMC ENDDO +!/SMC WRITE (NDSO,4029) +!/SMC DO ip=0, -9, -1 +!/SMC WRITE (NDSO,4030) IJKCel(:,ip) +!/SMC ENDDO +!/SMC +!/SMC WRITE (NDSO,4031) NCel +!/SMC !Li Multi-resolution SMC grid requires rounding of x, y indices +!/SMC !Li by a factor MRFct. +!/SMC MRFct = 2**(NRLv - 1) +!/SMC WRITE (NDSO,4032) MRFct +!/SMC +!/SMC !Li Cosine for SMC uses refined latitude increment. +!/SMC SYMR = SY*DERA/FLOAT( MRFct ) +!/SMC !Li Reference y point for adjusted cell j=0 in radian. JGLi16Feb2016 +!/SMC YJ0R = ( Y0 - 0.5*SY )*DERA +!/SMC +!/SMC DO ISEA=1, NCel +!/ARC !Li There is no polar cell row so it is mapped to last row. +!/ARC IF(ISEA .EQ. NCel) THEN +!/ARC IX=1 +!/ARC IY=NY +!/ARC IK=1 +!/ARC JS=1 +!/ARC ELSE +!/SMC IX=IJKCel(1,ISEA)/MRFct + 1 +!/SMC IY=IJKCel(2,ISEA)/MRFct + 1 +!/SMC IK=MAX(1, IJKCel(3,ISEA)/MRFct) +!/SMC JS=MAX(1, IJKCel(4,ISEA)/MRFct) +!/ARC ENDIF +!/ARC +!/SMC ! Check that IX, IY are in the bound of [1,NX] and [1,NY] respec. +!/SMC IF ((IX+IK-1 .GT. NX) .OR. (IX .LE. 0)) THEN +!/SMC WRITE (NDSE,1014) ISEA, IX, IX+IK-1, NX +!/SMC CALL EXTCDE(65) +!/SMC END IF +!/SMC +!/SMC IF ((IY+JS-1 .GT. NY) .OR. (IY .LE. 0)) THEN +!/SMC WRITE (NDSE,1015) ISEA, IY, IY+JS-1, NY +!/SMC CALL EXTCDE(65) +!/SMC END IF +!/SMC +!/SMC !Li Minimum DMIN depth is used as well for SMC. +!/SMC ZB(ISEA)= - MAX( DMIN, FLOAT( IJKCel(5, ISEA) ) ) +!/SMC MAPFS(IY:IY+JS-1,IX:IX+IK-1) = ISEA +!/SMC MAPSTA(IY:IY+JS-1,IX:IX+IK-1) = 1 +!/SMC MAPST2(IY:IY+JS-1,IX:IX+IK-1) = 0 +!/SMC MAPSF(ISEA,1) = IX +!/SMC MAPSF(ISEA,2) = IY +!/SMC MAPSF(ISEA,3) = IY + (IX -1)*NY +!/SMC !Li New variable CLATS to hold cosine latitude at cell centre. +!/SMC !Li Also added CLATIS and CTHG0S for version 4.08. +!/SMC ! JJ=IJKCel(2,ISEA) - JEQT +!/SMC ! Y = SYMR*( FLOAT(JJ)+0.5*FLOAT(IJKCel(4,ISEA)) ) +!/SMC !Li Use adjusted j-index to calculate cell centre y from YJ0R. +!/SMC Y = YJ0R + SYMR*( FLOAT(IJKCel(2,ISEA))+0.5*FLOAT(IJKCel(4,ISEA)) ) +!/ARC !Li Arctic polar cell does not need COS(LAT), set 1 row down. +!/ARC IF(Y .GE. HPI-0.1*SYMR) Y=HPI - SYMR*0.5*FLOAT( MRFct ) +!/ARC +!/SMC CLATS(ISEA) = COS( Y ) +!/SMC CLATIS(ISEA)= 1. / CLATS(ISEA) +!/SMC CTHG0S(ISEA)= - TAN( Y ) / RADIUS +!/SMC !!Li Subgrid obstruction is now defined directly from IJKObstr +!/SMC !!Li so old OBSX/Y are no longer used. JGLi15Oct2014 +!/SMC !!Li Transparency is minimum of all merged cells and >= 0.11 +!/SMC ! TRNMX=1.0 +!/SMC ! TRNMY=1.0 +!/SMC ! DO ip = IX, IX+IK-1 +!/SMC ! TRNMX = MIN( TRNMX, ABS(1.0-OBSX(ip,IY)) ) +!/SMC ! TRNMY = MIN( TRNMY, ABS(1.0-OBSY(ip,IY)) ) +!/SMC ! ENDDO +!/SMC !!Li Sub-grid obstruction is set zero beyond NCObst cells. +!/SMC IF(ISEA .GT. NCObst) THEN +!/SMC TRNMX=1.0 +!/SMC TRNMY=1.0 +!/SMC ELSE +!/SMC !!Li Present obstruction is isotropic and in percentage. +!/SMC TRNMX=1.0 - IJKObstr(1, ISEA)*0.01 +!/SMC TRNMY=1.0 - IJKObstr(JObs, ISEA)*0.01 +!/SMC ENDIF +!/SMC CTRNX(ISEA) = MAX(0.11, TRNMX) +!/SMC CTRNY(ISEA) = MAX(0.11, TRNMY) +!/SMC END DO +!/SMC !!Li Transparency for boundary cells are 1.0 JGLi16Jan2012 +!/SMC CTRNX(-9:0) = 1.0 +!/SMC CTRNY(-9:0) = 1.0 +!/SMC !!Li Check range of MAPSF and MAPFS +!/SMC WRITE (NDSO,4033) MINVAL( MAPSF(:,1) ), MAXVAL( MAPSF(:,1) ) +!/SMC WRITE (NDSO,4034) MINVAL( MAPSF(:,2) ), MAXVAL( MAPSF(:,2) ) +!/SMC WRITE (NDSO,4035) MINVAL( MAPSF(:,3) ), MAXVAL( MAPSF(:,3) ) +!/SMC WRITE (NDSO,4036) MINVAL( MAPFS(:,:) ), MAXVAL( MAPFS(:,:) ) +!/SMC +!/SMC !Li New variable CLATF to hold cosine latitude at cell V face. +!/SMC DO IP = 1, NVFC +!/SMC ! CLATF(IP) = COS( SYMR*FLOAT(IJKVFc(2,IP) - JEQT) ) +!/SMC !Li Use adjusted j-index to calculate cell face Y from YJ0R. +!/SMC CLATF(IP) = COS( SYMR*FLOAT(IJKVFc(2,IP)) + YJ0R ) +!/SMC ENDDO +!/SMC !Li Reset MAPSTA for boundary cells if any. +!/SMC IF(NBISMC .GT. 0) THEN +!/SMC DO IP=1, NBISMC +!/SMC ISEA = NBICelin(IP) +!/SMC IX=IJKCel(1,ISEA)/MRFct + 1 +!/SMC IY=IJKCel(2,ISEA)/MRFct + 1 +!/SMC IK=MAX(1, IJKCel(3,ISEA)/MRFct) +!/SMC JS=MAX(1, IJKCel(4,ISEA)/MRFct) +!/SMC MAPSTA(IY:IY+JS-1,IX:IX+IK-1) = 2 +!/SMC MAPST2(IY:IY+JS-1,IX:IX+IK-1) = 0 +!/SMC ENDDO +!/SMC ENDIF +!/SMC +! +!/ARC !Li Define rotation angle for Arctic cells. +!/ARC PoLonAC = 179.999 +!/ARC PoLatAC = 0.001 +!/ARC ALLOCATE( XLONAC(NARC),YLATAC(NARC),ELONAC(NARC),ELATAC(NARC) ) +!/ARC DO ISEA=NGLO+1, NCel +!/ARC !Li There is no polar cell row so it is mapped to last row. +!/ARC IF(ISEA .EQ. NCel) THEN +!/ARC IX=1 +!/ARC IY=NY +!/ARC IK=1 +!/ARC JS=1 +!/ARC ELSE +!/ARC IX=IJKCel(1,ISEA)/MRFct + 1 +!/ARC IY=IJKCel(2,ISEA)/MRFct + 1 +!/ARC IK=MAX(1, IJKCel(3,ISEA)/MRFct) +!/ARC JS=MAX(1, IJKCel(4,ISEA)/MRFct) +!/ARC ENDIF +!/ARC XLONAC(ISEA-NGLO)= X0 + REAL(IX-1+IK/2)*SX +!/ARC YLATAC(ISEA-NGLO)= Y0 + REAL(IY-1+JS/2)*SY +!/ARC ENDDO +!/ARC +!/ARC CALL W3LLTOEQ ( YLATAC, XLONAC, ELATAC, ELONAC, & +!/ARC & ANGARC, PoLatAC, PoLonAC, NARC ) +!/ARC +!/ARC WRITE (NDSO,4037) NARC +!/ARC WRITE (NDSO,4038) (ANGARC(ix), ix=1,NARC,NARC/8) +!/ARC +! +!/ARC !Li Mapping Arctic boundary cells with inner model cells +!/ARC DO IP=1, NBAC +!/ARC IX=IJKCel(1,IP+NGLO) +!/ARC IY=IJKCel(2,IP+NGLO) +!/ARC DO ISEA=1, NGLO +!/ARC IF( (IX .EQ. IJKCel(1,ISEA)) .AND. & +!/ARC & (IY .EQ. IJKCel(2,ISEA)) ) THEN +!/ARC ICLBAC(IP) = ISEA +!/ARC ENDIF +!/ARC ENDDO +!/ARC ENDDO +!/ARC WRITE (NDSO,4039) NBAC +!/ARC WRITE (NDSO,4040) (ICLBAC(ix), ix=1,NBAC,NBAC/8) +!/ARC +!/ARC !Li Redefine GCT term factor for Arctic part or the netative of +!/ARC !Li tangient of rotated latitude divided by radius. JGLi14Sep2015 +!/ARC DO ISEA=NGLO+1, NCel-1 +!/ARC CTHG0S(ISEA)= - TAN( ELATAC(ISEA-NGLO)*DERA ) / RADIUS +!/ARC ENDDO +!/ARC CTHG0S(NCel)=0.0 +!/ARC +! +!/RTD !Li Assign rotated grid angle for all sea points. JGLi01Feb2016 +!/RTD DO ISEA=1,NSEA +!/RTD IX = MAPSF(ISEA,1) +!/RTD IY = MAPSF(ISEA,2) +!/RTD AnglD(ISEA) = AnglDin(IX,IY) +!/RTD END DO +! +!/T CALL PRTBLK (NDST, NX, NY, NX, ZBIN, MAPOUT, 0, 0., & +!/T 1, NX, IX3, 1, NY, IY3, 'Sea points', 'm') +!/T DEALLOCATE ( MAPOUT ) +! + DO ISP=1, NSPEC+NTH + MAPWN(ISP) = 1 + (ISP-1)/NTH + MAPTH(ISP) = 1 + MOD(ISP-1,NTH) + END DO +! +!/O2 NMAP = 1 + (NX-1)/NCOL +!/O2 WRITE (NDSO,1100) NMAP +!/O2 DO IMAP=1, NMAP +!/O2 IX0 = 1 + (IMAP-1)*NCOL +!/O2 IXN = MIN ( NX , IMAP*NCOL ) +!/O2 DO IY=NY,1,-1 +!/O2 WRITE (NDSO,1101) (TMPSTA(IY,IX),IX=IX0,IXN) +!/O2 END DO +!/O2 WRITE (NDSO,*) ' ' +!/O2 END DO +!/O2 WRITE (NDSO,1102) + +!/O2a OPEN (NDSM,FILE=TRIM(FNMPRE)//'mask.ww3') +!/O2a DO IY=1, NY +!/O2a WRITE (NDSM,998) MIN(1,MAPSTA(IY,:)) +!/O2a END DO +!/O2a CLOSE (NDSM) +! +!/O2b IF ( TRFLAG .GT. 0 ) THEN +!/O2b NMAPB = 1 + (NX-1)/NCOL +!/O2b WRITE (NDSO,1103) 'X', NMAPB +!/O2b DO IMAPB=1, NMAPB +!/O2b IX0 = 1 + (IMAPB-1)*NCOL +!/O2b IXN = MIN ( NX , IMAPB*NCOL ) +!/O2b DO IY=NY,1,-1 +!/O2b WRITE (NDSO,1101) (NINT(10.*OBSX(IX,IY)),IX=IX0,IXN) +!/O2b END DO +!/O2b WRITE (NDSO,*) ' ' +!/O2b END DO +!/O2b WRITE (NDSO,1104) +!/O2b WRITE (NDSO,1103) 'Y', NMAPB +!/O2b DO IMAPB=1, NMAPB +!/O2b IX0 = 1 + (IMAPB-1)*NCOL +!/O2b IXN = MIN ( NX , IMAPB*NCOL ) +!/O2b DO IY=NY,1,-1 +!/O2b WRITE (NDSO,1101) (NINT(10.*OBSY(IX,IY)),IX=IX0,IXN) +!/O2b END DO +!/O2b WRITE (NDSO,*) ' ' +!/O2b END DO +!/O2b WRITE (NDSO,1104) +!/O2b END IF +! +!/O2c OPEN (NDSM,FILE=TRIM(FNMPRE)//'mapsta.ww3', RECL=2*NX*NY*50+1) +!/O2c DO IY=NY,1, -1 +!/O2c DO IX=1,NX +!/O2c DO I=1,50 +!/O2c WRITE (NDSM,1998,ADVANCE='NO') (TMPSTA(IY,IX)) +!/O2c END DO +!/O2c END DO +!/O2c END DO +!/O2c CLOSE (NDSM) +! + +!/IG1 IGPARS(1)=IGMETHOD +!/IG1 IGPARS(2)=IGADDOUTP +!/IG1 IGPARS(3)=IGSOURCE +!/IG1 IGPARS(4)=0 +!/IG1 IF (IGBCOVERWRITE) IGPARS(4)=IGPARS(4)+1 +!/IG1 IF (IGSWELLMAX) IGPARS(4)=IGPARS(4)+2 +!/IG1 IGPARS(5)=1 +!/IG1 DO IK=1,NK +!/IG1 IF (SIG(IK)*TPIINV.LT.IGMAXFREQ) IGPARS(5)=IK +!/IG1 END DO +!/IG1 IGMINDEP=MINVAL(ZB*(-1.)-2) ! -2 / +2 is there for water level changes +!/IG1 IGMAXDEP=MAXVAL(ZB*(-1.)+2) +!/IG1 IF (IGSOURCEATBP.EQ.1) IGMINDEP=1. ! should use true minimum depth ... +!/IG1 IGPARS(6)=1+NINT(LOG(MAX(IGMAXDEP,1.0)/MAX(IGMINDEP,1.0))/LOG(1.1)) +!/IG1 IGPARS(7)=MAX(IGMINDEP,1.0) +!/IG1 IGPARS(8)=IGSOURCEATBP +!/IG1 IGPARS(9)=IGKDMIN +!/IG1 IGPARS(10)=IGFIXEDDEPTH +!/IG1 IGPARS(11)=IGEMPIRICAL**2 +!/IG1 IGPARS(12)=IGSTERMS +! +!/IC2 IC2PARS(:)=0. +!/IC2 IF (IC2DISPER) IC2PARS(1)=1. +!/IC2 IC2PARS(2)=IC2TURB +!/IC2 IC2PARS(3)=IC2ROUGH +!/IC2 IC2PARS(4)=IC2REYNOLDS +!/IC2 IC2PARS(5)=IC2SMOOTH +!/IC2 IC2PARS(6)=IC2VISC +!/IC2 IC2PARS(7)=IC2TURBS +!/IC2 IC2PARS(8)=IC2DMAX +! +!/IC3 IC3PARS(:)=0. +!/IC3 IC3PARS(1)=IC3MAXTHK +!/IC3 IC3PARS(2)=IC2TURB +!/IC3 IC3PARS(3)=IC2ROUGH +!/IC3 IC3PARS(4)=IC2REYNOLDS +!/IC3 IC3PARS(5)=IC2SMOOTH +!/IC3 IC3PARS(6)=IC2VISC +!/IC3 IC3PARS(7)=IC2TURBS +!/IC3 IC3PARS(8)=IC3MAXCNC +!/IC3 IF (IC3CHENG) IC3PARS(9)=1.0 +!/IC3 IC3PARS(10)=IC3HILIM +!/IC3 IC3PARS(11)=IC3KILIM +!/IC3 IF (USECGICE) IC3PARS(12)=1.0 +!/IC3 IC3PARS(13)=IC3HICE +!/IC3 IC3PARS(14)=IC3VISC +!/IC3 IC3PARS(15)=IC3DENS +!/IC3 IC3PARS(16)=IC3ELAS +! +!/IC4 IC4PARS(1)=IC4METHOD +!/IC4 IC4_KI=IC4KI +!/IC4 IC4_FC=IC4FC +! +!/IC5 IC5PARS(:)=0. +!/IC5 IC5PARS(1)=IC5MINIG +!/IC5 IC5PARS(2)=IC5MINWT +!/IC5 IC5PARS(3)=IC5MAXKRATIO +!/IC5 IC5PARS(4)=IC5MAXKI +!/IC5 IC5PARS(5)=IC5MINHW +!/IC5 IC5PARS(6)=IC5MAXITER +!/IC5 IC5PARS(7)=IC5RKICK +!/IC5 IC5PARS(8)=IC5KFILTER +! +!/IS2 IS2PARS(1) = ISC1 +!/IS2 IS2PARS(2) = IS2BACKSCAT +!/IS2 IS2PARS(3)=0. +!/IS2 IF (IS2BREAK) IS2PARS(3)=1. +!/IS2 IS2PARS(4)=IS2C2 +!/IS2 IS2PARS(5)=IS2C3 +!/IS2 IS2PARS(6)=0. +!/IS2 IF (IS2DISP) IS2PARS(6)=1. +!/IS2 IS2PARS(7)=IS2DAMP +!/IS2 IS2PARS(8)=IS2FRAGILITY +!/IS2 IS2PARS(9)=IS2DMIN +!/IS2 IS2PARS(10)=0. +!/IS2 IF (IS2DUPDATE) IS2PARS(10)=1. +!/IS2 IS2PARS(11)=IS2CONC +!/IS2 IS2PARS(12)=ABS(IS2CREEPB) +!/IS2 IS2PARS(13)=IS2CREEPC +!/IS2 IS2PARS(14)=IS2CREEPD +!/IS2 IS2PARS(15)=IS2CREEPN +!/IS2 IS2PARS(16)=IS2BREAKE +!/IS2 IS2PARS(17)=IS2BREAKF +!/IS2 IS2PARS(18)=IS2WIM1 +!/IS2 IS2PARS(19)=IS2FLEXSTR +!/IS2 IS2PARS(20)=0. +!/IS2 IF (IS2ISOSCAT) IS2PARS(20)=1. +!/IS2 IS2PARS(21)=IS2ANDISD +!/IS2 IS2PARS(22)=IS2ANDISN +!/IS2 IS2PARS(23)=0. +!/IS2 IF (IS2ANDISB) IS2PARS(23)=1. +!/IS2 IS2PARS(24)=IS2ANDISE +! +! 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 SETUGIOBP +!/REF1 ELSE +!/REF1 CALL W3SETREF + END IF +!/REF1! +!/REF1! 9.a Reads shoreline slope (whith REF1 switch only) +!/REF1! +!/REF1 ALLOCATE ( REFD(NX,NY), REFD2(NX,NY), REFS(NX,NY) ) +!/REF1 IF (REFMAP.EQ.0) THEN +!/REF1 REFS(:,:)=1. +!/REF1 ELSE +!/REF1! +!/REF1! 9.b Info from input file +!/REF1! +!/REF1 IF (FLGNML) THEN +!/REF1 NDSTR = NML_SLOPE%IDF +!/REF1 VSC = NML_SLOPE%SF +!/REF1 IDLA = NML_SLOPE%IDLA +!/REF1 IDFT = NML_SLOPE%IDFM +!/REF1 RFORM = TRIM(NML_SLOPE%FORMAT) +!/REF1 FROM = TRIM(NML_SLOPE%FROM) +!/REF1 TNAME = TRIM(NML_SLOPE%FILENAME) +!/REF1 ELSE +!/REF1 CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/REF1 READ (NDSI,*,END=2001,ERR=2002) NDSTR, VSC, IDLA, IDFT, RFORM, & +!/REF1 FROM, TNAME +!/REF1 END IF +!/REF1! +!/REF1 IF ( ABS(VSC) .LT. 1.E-7 ) VSC = 1. +!/REF1 IF (IDLA.LT.1 .OR. IDLA.GT.4) IDLA = 1 +!/REF1 IF (IDFT.LT.1 .OR. IDFT.GT.3) IDFT = 1 +!/REF1! +!/REF1 WRITE (NDSO,1977) NDSTR, VSC, IDLA, IDFT +!/REF1 IF (IDFT.EQ.2) WRITE (NDSO,973) RFORM +!/REF1 IF (FROM.EQ.'NAME' .AND. NDSG.NE.NDSTR) WRITE (NDSO,974) TNAME +!/REF1! +!/REF1! 9;c Open file and check if necessary +!/REF1! +!/REF1 IF ( NDSTR .EQ. NDSI ) THEN +!/REF1 IF ( IDFT .EQ. 3 ) THEN +!/REF1 WRITE (NDSE,1004) NDSTR +!/REF1 CALL EXTCDE (23) +!/REF1 ELSE +!/REF1 CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/REF1 END IF +!/REF1 ELSE IF ( NDSTR .EQ. NDSG ) THEN +!/REF1 IF ( ( IDFM.EQ.3 .AND. IDFT.NE.3 ) .OR. & +!/REF1 ( IDFM.NE.3 .AND. IDFT.EQ.3 ) ) THEN +!/REF1 WRITE (NDSE,1005) IDFM, IDFT +!/REF1 CALL EXTCDE (24) +!/REF1 END IF +!/REF1 ELSE +!/REF1 IF ( IDFT .EQ. 3 ) THEN +!/REF1 IF (FROM.EQ.'NAME') THEN +!/REF1 OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/REF1 FORM='UNFORMATTED',STATUS='OLD',ERR=2000, & +!/REF1 IOSTAT=IERR) +!/REF1 ELSE +!/REF1 OPEN (NDSTR, FORM='UNFORMATTED', & +!/REF1 STATUS='OLD',ERR=2000,IOSTAT=IERR) +!/REF1 END IF +!/REF1 ELSE +!/REF1 IF (FROM.EQ.'NAME') THEN +!/REF1 OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/REF1 STATUS='OLD',ERR=2000,IOSTAT=IERR) +!/REF1 ELSE +!/REF1 OPEN (NDSTR, & +!/REF1 STATUS='OLD',ERR=2000,IOSTAT=IERR) +!/REF1 END IF !end of (FROM.EQ.'NAME') +!/REF1 END IF !end of ( IDFT .EQ. 3 ) +!/REF1 END IF !end of ( NDSTR .EQ. NDSG ) +!/REF1! +!/REF1! 9.d Read the data +!/REF1! +!/REF1! CALL INA2R ( REFD, NX, NY, 1, NX, 1, NY, NDSTR, NDST, NDSE, & +!/REF1! IDFM, RFORM, IDLA, VSC, 0.0) +!/REF1! +!/REF1 IF ( NDSTR .EQ. NDSI ) CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/REF1! +!/REF1! CALL INA2R ( REFD2, NX, NY, 1, NX, 1, NY, NDSTR, NDST, NDSE, & +!/REF1! IDFM, RFORM, IDLA, VSC, 0.0) +!/REF1 CALL INA2R ( REFS, NX, NY, 1, NX, 1, NY, NDSTR, NDST, NDSE, & +!/REF1 IDFM, RFORM, IDLA, VSC, 0.0) +!/REF1 DO ISEA=1,NSEA +!/REF1 IX = MAPSF(ISEA,1) +!/REF1 IY = MAPSF(ISEA,2) +!/REF1 REFLC(3,ISEA) = REFS(IX,IY)*REFMAP +!/REF1 END DO +! +!/REF1 NMAPB = 1 + (NX-1)/NCOL +!/REF1 WRITE (NDSO,1105) NMAPB +!/T!/REF1 WRITE(NDSO,*) 'Maximum slope for reflection:',MAXVAL(REFS*REFMAP) +! +!/REF1 DO IMAPB=1, NMAPB +!/REF1 IX0 = 1 + (IMAPB-1)*NCOL +!/REF1 IXN = MIN ( NX , IMAPB*NCOL ) +!/T!/REF1 DO IY=NY,1,-1 +!/T!/REF1 WRITE (NDSO,1101) (NINT(100.*REFS(IX,IY)*REFMAP),IX=IX0,IXN) +!/T!/REF1 END DO +!/REF1 WRITE (NDSO,*) ' ' +!/REF1 END DO +!/REF1 WRITE (NDSO,1106) +!/REF1! +!/REF1 WRITE (NDSO,*) +!/REF1! +!/REF1 END IF !end of (REFMAP.EQ.0) +! + DEALLOCATE ( ZBIN, TMPSTA, TMPMAP ) +!/RTD DEALLOCATE ( AnglDin ) +! +! 9.e Reads bottom information from file +! +!/BT4 ALLOCATE ( SED_D50FILE(NX,NY)) +!/BT4 IF ( SEDMAPD50 ) THEN +!/BT4 +!/BT4! +!/BT4! 9.e.1 Info from input file +!/BT4! +!/BT4 IF (FLGNML) THEN +!/BT4 NDSTR = NML_SED%IDF +!/BT4 VSC = NML_SED%SF +!/BT4 IDLA = NML_SED%IDLA +!/BT4 IDFT = NML_SED%IDFM +!/BT4 RFORM = TRIM(NML_SED%FORMAT) +!/BT4 FROM = TRIM(NML_SED%FROM) +!/BT4 TNAME = TRIM(NML_SED%FILENAME) +!/BT4 ELSE +!/BT4 CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/BT4 READ (NDSI,*,END=2001,ERR=2002) NDSTR, VSC, IDLA, IDFT, RFORM, & +!/BT4 FROM, TNAME +!/BT4 END IF +!/BT4! +!/BT4 IF ( ABS(VSC) .LT. 1.E-7 ) THEN +!/BT4 VSC = 1. +!/BT4 ELSE +!/BT4! WARNING TO BE ADDED ... +!/BT4 END IF +!/BT4 IF (IDLA.LT.1 .OR. IDLA.GT.4) IDLA = 1 +!/BT4 IF (IDFT.LT.1 .OR. IDFT.GT.3) IDFT = 1 +!/BT4! +!/BT4 WRITE (NDSO,1978) NDSTR, VSC, IDLA, IDFT +!/BT4 IF (IDFT.EQ.2) WRITE (NDSO,973) RFORM +!/BT4 IF (FROM.EQ.'NAME' .AND. NDSG.NE.NDSTR) WRITE (NDSO,974) TNAME +!/BT4! +!/BT4! 9.e.2 Open file and check if necessary +!/BT4! +!/BT4 IF ( NDSTR .EQ. NDSI ) THEN +!/BT4 IF ( IDFT .EQ. 3 ) THEN +!/BT4 WRITE (NDSE,1004) NDSTR +!/BT4 CALL EXTCDE (23) +!/BT4 ELSE +!/BT4 CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/BT4 END IF +!/BT4 ELSE IF ( NDSTR .EQ. NDSG ) THEN +!/BT4 IF ( ( IDFM.EQ.3 .AND. IDFT.NE.3 ) .OR. & +!/BT4 ( IDFM.NE.3 .AND. IDFT.EQ.3 ) ) THEN +!/BT4 WRITE (NDSE,1005) IDFM, IDFT +!/BT4 CALL EXTCDE (24) +!/BT4 END IF +!/BT4 ELSE +!/BT4 IF ( IDFT .EQ. 3 ) THEN +!/BT4 IF (FROM.EQ.'NAME') THEN +!/BT4 OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/BT4 FORM='UNFORMATTED',STATUS='OLD',ERR=2000, & +!/BT4 IOSTAT=IERR) +!/BT4 ELSE +!/BT4 OPEN (NDSTR, FORM='UNFORMATTED', & +!/BT4 STATUS='OLD',ERR=2000,IOSTAT=IERR) +!/BT4 END IF +!/BT4 ELSE +!/BT4 IF (FROM.EQ.'NAME') THEN +!/BT4 OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & +!/BT4 STATUS='OLD',ERR=2000,IOSTAT=IERR) +!/BT4 ELSE +!/BT4 OPEN (NDSTR, & +!/BT4 STATUS='OLD',ERR=2000,IOSTAT=IERR) +!/BT4 END IF +!/BT4 END IF +!/BT4 END IF +!/BT4! +!/BT4! 9.e.3 Read the data +!/BT4! +!/BT4 CALL INA2R ( SED_D50FILE, NX, NY, 1, NX, 1, NY, NDSTR, NDST, NDSE, & +!/BT4 IDFM, RFORM, IDLA, VSC, VOF) +!/BT4! +!/BT4 IF ( NDSTR .EQ. NDSI ) CALL NEXTLN ( COMSTR , NDSI , NDSE ) +!/BT4! +!/BT4 WRITE (NDSO,*) 'Min and Max values of grain sizes:',MINVAL(SED_D50FILE), MAXVAL(SED_D50FILE) +!/BT4 WRITE (NDSO,*) +!/BT4! +!/BT4 ELSE +!/BT4 SED_D50FILE(:,:)=SED_D50_UNIFORM +!/BT4 END IF +!/BT4! +!/BT4 DO IY=1, NY +!/BT4 DO IX=1, NX +!/BT4 ISEA = MAPFS (IY,IX) +!/BT4 SED_D50(ISEA) = SED_D50FILE(IX,IY) +!/BT4 SED_D50(ISEA) = MAX(SED_D50(ISEA),1E-5) +!/BT4 ! Critical Shields number, Soulsby, R.L. and R J S W Whitehouse +!/BT4 ! Threshold of sed. motion in coastal environments, Proc. Pacific Coasts and +!/BT4 ! ports, 1997 conference, Christchurch, p149-154, University of Cantebury, NZ +!/BT4 SED_DSTAR=(GRAV*(SED_SG-1)/nu_water**2)**(0.333333)*SED_D50(ISEA) +!/BT4 SED_PSIC(ISEA)=0.3/(1+1.2*SED_DSTAR)+0.55*(1-exp(-0.02*SED_DSTAR)) + + +!/BT4 END DO +!/BT4 END DO +! +!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! 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. +! +!/RTD IF ( NPO.NE.0 ) THEN +!/RTD ! Destination pole lat, lon from namelist +!/RTD bPolat = BPLAT(NFBPO+1) +!/RTD bPolon = BPLON(NFBPO+1) +!/RTD END IF +!/RTD ! + IF ( NFBPO.GE.1 .AND. ILOOP.EQ.2 ) THEN + WRITE (NDSO,991) NFBPO, NBO(NFBPO) - NBO(NFBPO-1), & + NBO2(NFBPO) - NBO2(NFBPO-1) +!/RTD ! Print dest. Pole lat/lon if either the dest or present grid is rotated +!/RTD IF ( BPLAT(NFBPO) < 90. .OR. Polat < 90. ) & +!/RTD WRITE (NDSO,1991) BPLAT(NFBPO), BPLON(NFBPO) +!/RTD ! +!/O1 IF ( NBO(NFBPO) - NBO(NFBPO-1) .EQ. 1 ) THEN +!/O1 IF ( FLAGLL ) THEN +!/O1 WRITE (NDSO,992) +!/O1 ELSE +!/O1 WRITE (NDSO,2992) +!/O1 END IF +!/O1 ELSE +!/O1 IF ( FLAGLL ) THEN +!/O1 WRITE (NDSO,1992) +!/O1 ELSE +!/O1 WRITE (NDSO,3992) +!/O1 END IF +!/O1 END IF +!/O1 IP0 = NBO(NFBPO-1)+1 +!/O1 IPN = NBO(NFBPO) +!/O1 IPH = IP0 + (IPN-IP0-1)/2 +!/O1 IPI = IPH -IP0 + 1 + MOD(IPN-IP0+1,2) +!/O1 DO IP=IP0, IPH +!/O1 IF ( FLAGLL ) THEN +!/O1 WRITE (NDSO,1993) IP-NBO(NFBPO-1), & +!/O1 FACTOR*XBPO(IP), & +!/O1 FACTOR*YBPO(IP), & +!/O1 IP+IPI-NBO(NFBPO-1), & +!/O1 FACTOR*XBPO(IP+IPI), & +!/O1 FACTOR*YBPO(IP+IPI) +!/O1 ELSE +!/O1 WRITE (NDSO,3993) IP-NBO(NFBPO-1), & +!/O1 FACTOR*XBPO(IP), & +!/O1 FACTOR*YBPO(IP), & +!/O1 IP+IPI-NBO(NFBPO-1), & +!/O1 FACTOR*XBPO(IP+IPI), & +!/O1 FACTOR*YBPO(IP+IPI) +!/O1 END IF +!/O1 END DO +!/O1 IF ( MOD(IPN-IP0+1,2) .EQ. 1 ) THEN +!/O1 IF ( FLAGLL ) THEN +!/O1 WRITE (NDSO, 993) IPH+1-NBO(NFBPO-1), & +!/O1 FACTOR*XBPO(IPH+1), & +!/O1 FACTOR*YBPO(IPH+1) +!/O1 ELSE +!/O1 WRITE (NDSO,2993) IPH+1-NBO(NFBPO-1), & +!/O1 FACTOR*XBPO(IPH+1), & +!/O1 FACTOR*YBPO(IPH+1) +!/O1 END IF +!/O1 END IF +!/O1 WRITE (NDSO,*) + 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 - - - - - - - - - - - - - - - - - - - - - +! +!/RTD ! If either base or destination grid is rotated lat-lon +!/RTD IF ( allocated(BDYLON) .eqv. .TRUE. ) THEN +!/RTD deallocate( BDYLON, BDYLAT ) +!/RTD IF ( bPolat < 90. .OR. Polat < 90. ) & +!/RTD deallocate( ELatbdy, ELonbdy, Anglbdy ) +!/RTD END IF +!/RTD allocate( BDYLON(NPO), BDYLAT(NPO)) +!/RTD IF ( bPolat < 90. .OR. Polat < 90. ) & +!/RTD allocate( ELatbdy(NPO), ELonbdy(NPO), Anglbdy(NPO) ) +!/RTD ! +!/T WRITE (NDST,9090) +! + DO IP=1, NPO +! + XO = XO0 + REAL(IP-1)*DXO + YO = YO0 + REAL(IP-1)*DYO +!/RTD ! +!/RTD ! Boundary points are specified in coordinates of the destination grid +!/RTD ! +!/RTD ! Collect the line segment points into arrays +!/RTD BDYLON(IP) = XO +!/RTD BDYLAT(IP) = YO +!/RTD ! Close the loop before calculating rotated lat-lon coordinates. +!/RTD END DO +!/RTD +!/RTD ! Create one or two sets of the segment points: +!/RTD ! 1. (BDYLAT, BDYLON) in standard lat-lon coordinates, +!/RTD ! 2. Also (ELatbdy, ELonbdy) in case the base grid is rotated +!/RTD +!/RTD IF ( bPolat < 90. ) THEN +!/RTD ! The destination grid is rotated (std->rot or rot->rot) +!/RTD ! Change BDYLAT, BDYLON to their standard lat-lon positions +!/RTD ! Let ELatbdy,ELonbdy contain the rotated lat-lon coordinates +!/RTD ELatbdy(:) = BDYLAT(:) +!/RTD ELonbdy(:) = BDYLON(:) +!/RTD CALL W3EQTOLL ( ELatbdy, ELonbdy, BDYLAT, BDYLON, & +!/RTD & Anglbdy, bPolat, bPolon, NPO ) +!/RTD ! Let the standard longitudes BDYLON be within the range [-180.,180.[ +!/RTD ! or [0., 360.[ depending on the grid pole +!/RTD IF ( Polon < -90. .OR. Polon > 90. ) THEN +!/RTD BDYLON(:) = MOD( BDYLON(:) + 180., 360. ) - 180. +!/RTD ELSE +!/RTD BDYLON(:) = MOD( BDYLON(:) + 360., 360. ) +!/RTD END IF +!/RTD END IF ! bPolat < 90. +!/RTD ! From now, BDYLAT, BDYLON are defined in standard lat-lon coordinates +!/RTD ! +!/RTD IF ( Polat < 90. ) THEN +!/RTD ! The base grid is rotated (rot->std or rot->rot) +!/RTD ! Find lat-lon in coordinates of the rotated base grid +!/RTD CALL W3LLTOEQ ( BDYLAT, BDYLON, ELatbdy, ELonbdy, & +!/RTD & Anglbdy, Polat, Polon, NPO ) +!/RTD END IF +!/RTD ! +!/RTD ! Take up again the loop over the line segment points +!/RTD DO IP=1, NPO +!/RTD IF ( Polat < 90. ) THEN +!/RTD ! The base grid is rotated (rot->std, rot->rot) +!/RTD ! (The std. lat-lon values BDYLAT, BDYLON go to YBPO, XBPO) +!/RTD XO = ELonbdy(IP) +!/RTD YO = ELatbdy(IP) +!/RTD ELSE +!/RTD ! The base grid is standard geographic (std->rot or std->std) +!/RTD XO = BDYLON(IP) +!/RTD YO = BDYLAT(IP) +!/RTD END IF +! +! ... 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 ; +! +!/T WRITE (NDST,9091) FACTOR*XO, FACTOR*YO, & +!/T (IXR(J), IYR(J), RD(J), J=1,4) +! +! ... 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 +! +!/RTD ! BDYLAT, BDYLON contain Y0, X0, which are remapped to standard lat/lon. +!/RTD ! BDYLAT, BDYLON are stored in the mod_def file. +!/RTD IF ( Polat < 90. ) THEN +!/RTD XO = BDYLON(IP) +!/RTD YO = BDYLAT(IP) +!/RTD END IF + 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 +! +!/T WRITE (NDST,9092) RDTOT, (RDBPO(NBOTOT,J),J=1,4) +! +! ... 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 +! +!/T WRITE (NDST,9093) ISEAI, (IPBPO(NBOTOT,J),J=1,4) +! +! ... 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 +! +!/T0 WRITE (NDST,9095) +!/T0 DO IFILE=1, NFBPO +!/T0 DO IP=NBO2(IFILE-1)+1, NBO2(IFILE) +!/T0 WRITE (NDST,9096) IFILE, IP-NBO2(IFILE-1), ISBPO(IP) +!/T0 END DO +!/T0 END DO +! +!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +!10. Write model definition file. +! + WRITE (NDSO,999) + CALL W3IOGR ( 'WRITE', NDSM ) +! + CLOSE (NDSM) +! + 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) + +!/SCRIP GRID1_UNITS='degrees' ! the other option is radians...we don't use this +!/SCRIP GRID1_NAME='src' ! this is not used, except for netcdf output +!/SCRIP CALL GET_SCRIP_INFO(1, & +!/SCRIP & GRID1_CENTER_LON, GRID1_CENTER_LAT, & +!/SCRIP & GRID1_CORNER_LON, GRID1_CORNER_LAT, GRID1_MASK, & +!/SCRIP & GRID1_DIMS, GRID1_SIZE, GRID1_CORNERS, GRID1_RANK) +!/SCRIP +!/SCRIP + +!/SCRIP IF (GTYPE .EQ. UNGTYPE) THEN +!/SCRIP GRID1_RANK=1 +!/SCRIP DEALLOCATE(GRID1_DIMS) +!/SCRIP ALLOCATE(GRID1_DIMS(GRID1_RANK)) +!/SCRIP GRID1_DIMS(1) = GRID1_SIZE +!/SCRIP ENDIF + +!/SCRIP DO I = 1,GRID1_SIZE +!/SCRIP IF (GRID1_CENTER_LON(I) < 0.0) THEN +!/SCRIP GRID1_CENTER_LON(I) = GRID1_CENTER_LON(I)+360.0 +!/SCRIP ENDIF +!/SCRIP DO J = 1,GRID1_CORNERS +!/SCRIP IF (GRID1_CORNER_LON(J,I) < 0.0) THEN +!/SCRIP GRID1_CORNER_LON(J,I) = GRID1_CORNER_LON(J,I)+360.0 +!/SCRIP ENDIF +!/SCRIP ENDDO +!/SCRIP ENDDO + +!/SCRIPNC IERR = NF90_CREATE(TRIM('scrip.nc'), NF90_NETCDF4, NCID) +!/SCRIPNC IERR = NF90_DEF_DIM(NCID, 'grid_size', GRID1_SIZE, grid_size_dimid) +!/SCRIPNC IERR = NF90_DEF_DIM(NCID, 'grid_corners', GRID1_CORNERS, grid_corners_dimid) +!/SCRIPNC IERR = NF90_DEF_DIM(NCID, 'grid_rank', GRID1_RANK, grid_rank_dimid) + +!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_center_lat', NF90_DOUBLE, & +!/SCRIPNC (/grid_size_dimid/),grid_center_lat_varid) +!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_center_lon', NF90_DOUBLE, & +!/SCRIPNC (/grid_size_dimid/),grid_center_lon_varid) +!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_corner_lat', NF90_DOUBLE, & +!/SCRIPNC (/grid_corners_dimid,grid_size_dimid/), & +!/SCRIPNC grid_corner_lat_varid) +!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_corner_lon', NF90_DOUBLE, & +!/SCRIPNC (/grid_corners_dimid,grid_size_dimid/), & +!/SCRIPNC grid_corner_lon_varid) +!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_imask', NF90_INT, & +!/SCRIPNC (/grid_size_dimid/),grid_imask_varid) +!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_dims', NF90_INT, & +!/SCRIPNC (/grid_rank_dimid/),grid_dims_varid) +!/SCRIPNC IERR = NF90_ENDDEF(NCID) + +!/SCRIP ALLOCATE(GRID1_IMASK(GRID1_DIMS(1))) +!/SCRIP GRID1_IMASK = 0 +!/SCRIP DO I = 1,GRID1_DIMS(1) +!/SCRIP IF (GRID1_MASK(I)) THEN +!/SCRIP GRID1_IMASK(I) = 1 +!/SCRIP ENDIF +!/SCRIP ENDDO + +!/SCRIPNC IERR = NF90_PUT_ATT(NCID,grid_center_lat_varid,'units',GRID1_UNITS) +!/SCRIPNC IERR = NF90_PUT_ATT(NCID,grid_center_lon_varid,'units',GRID1_UNITS) +!/SCRIPNC IERR = NF90_PUT_ATT(NCID,grid_corner_lat_varid,'units',GRID1_UNITS) +!/SCRIPNC IERR = NF90_PUT_ATT(NCID,grid_corner_lon_varid,'units',GRID1_UNITS) +!/SCRIPNC IERR = NF90_PUT_ATT(NCID,grid_imask_varid,'units','unitless') + +!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_center_lat_varid,GRID1_CENTER_LAT) +!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_center_lon_varid,GRID1_CENTER_LON) +!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_corner_lat_varid,GRID1_CORNER_LAT) +!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_corner_lon_varid,GRID1_CORNER_LON) +!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_imask_varid,GRID1_IMASK) +!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_dims_varid,GRID1_DIMS) +!/SCRIPNC IERR = NF90_CLOSE(NCID) + + +! +! 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.'/) +! +!/FLX1 810 FORMAT (/' Stresses (Wu 1980)'/ & +!/FLX1 ' --------------------------------------------------'/) +!/FLX2 810 FORMAT (/' Stresses (T&C 96)'/ & +!/FLX2 ' --------------------------------------------------'/) +!/FLX3 810 FORMAT (/' Stresses (T&C 96 capped) ',A/ & +!/FLX3 ' --------------------------------------------------') +!/FLX4 810 FORMAT (/' Stresses (Hwang 2011) ',A/ & +!/FLX4 ' --------------------------------------------------') +!/FLX4 811 FORMAT ( ' drag coefficient scaling :',F8.2 /) +!/FLX4 2810 FORMAT ( ' &FLX4 CDFAC =',F6.3,' /') +!/FLX3 811 FORMAT ( ' Max Cd * 10^3 :',F8.2/ & +!/FLX3 ' Cap type : ',A/) +!/FLX3 2810 FORMAT ( ' &FLX3 CDMAX =',F6.2,'E-3 , CTYPE = ',I1,' /') +! +!/LN0 820 FORMAT (/' Linear input not defined.'/) +!/SEED 820 FORMAT (/' Seeding as proxi for linear input.'/) +! +!/LN1 820 FORMAT (/' Linear input (C&M-R 82) ',A/ & +!/LN1 ' --------------------------------------------------') +!/LN1 821 FORMAT ( ' CLIN :',f8.2/ & +!/LN1 ' Factor for fPM in filter :',F8.2/ & +!/LN1 ' Factor for fh in filter :',F8.2/) +!/LN1 2820 FORMAT ( ' &SLN1 CLIN =',F6.1,', RFPM =',F6.2, & +!/LN1 ', RFHF =',F6.2,' /') +! +!/LNX 820 FORMAT (/' Experimental linear input.'/) +! +!/ST0 920 FORMAT (/' Wind input not defined.'/) +! +!/ST1 920 FORMAT (/' Wind input (WAM-3) ',A/ & +!/ST1 ' --------------------------------------------------') +!/ST1 921 FORMAT ( ' Cinp :',E10.3/) +!/ST1 2920 FORMAT ( ' &SIN1 CINP =',F7.3,' /') +! +!/ST2 920 FORMAT (/' Wind input (T&C 1996) ',A/ & +!/ST2 ' --------------------------------------------------') +!/ST2 921 FORMAT ( ' Height of input wind (m) :',F8.2/ & +!/ST2 ' Factor negative swell :',F9.3/) +!/STAB2 1921 FORMAT ( ' Effective wind mean factor :',F8.2/ & +!/STAB2 ' Stability par. offset :',F9.3/ & +!/STAB2 ' Stab. correction :',F9.3,F8.3/& +!/STAB2 ' Stab. correction stab. fac. :',F7.1,F9.1/) +!/ST2 2920 FORMAT ( ' &SIN2 ZWND =',F5.1,', SWELLF =',F6.3,' /') +!/STAB2 2921 FORMAT ( ' &SIN2 ZWND =',F5.1,', SWELLF =',F6.3,', STABSH =', & +!/STAB2 F6.3,', STABOF = ',E10.3,','/ & +!/STAB2 ' CNEG =',F7.3,', CPOS =',F7.3,', FNEG =',F7.1,' /') +! +!/ST3 920 FORMAT (/' Wind input (WAM 4+) ',A/ & +!/ST3 ' --------------------------------------------------') +!/ST3 921 FORMAT ( ' minimum Charnock coeff. :',F10.4/ & +!/ST3 ' betamax :',F9.3/ & +!/ST3 ' power of cos. in wind input :',F9.3/ & +!/ST3 ' z0max :',F9.3/ & +!/ST3 ' zalp :',F9.3/ & +!/ST3 ' Height of input wind (m) :',F8.2/ & +!/ST3 ' swell attenuation factor :',F9.3/ ) +!/ST3 2920 FORMAT ( ' &SIN3 ZWND =',F5.1,', ALPHA0 =',F8.5,', Z0MAX =',F8.5,', BETAMAX =', & +!/ST3 F8.5,','/ & +!/ST3 ' SINTHP =',F8.5,', ZALP =',F8.5,','/ & +!/ST3 ' SWELLF =',F8.5,'R /'/) +! +!/ST4 920 FORMAT (/' Wind input (WAM 4+) ',A/ & +!/ST4 ' --------------------------------------------------') +!/ST4 921 FORMAT ( ' minimum Charnock coeff. :',F10.4/ & +!/ST4 ' betamax :',F9.3/ & +!/ST4 ' power of cos. in wind input :',F9.3/ & +!/ST4 ' z0max :',F9.3/ & +!/ST4 ' zalp :',F9.3/ & +!/ST4 ' Height of input wind (m) :',F8.2/ & +!/ST4 ' wind stress sheltering :',F9.3/ & +!/ST4 ' swell attenuation param. :',I5/ & +!/ST4 ' swell attenuation factor :',F9.3/ & +!/ST4 ' swell attenuation factor2 :',F9.3/ & +!/ST4 ' swell attenuation factor3 :',F9.3/ & +!/ST4 ' critical Reynolds number :',F9.1/ & +!/ST4 ' swell attenuation factor5 :',F9.3/ & +!/ST4 ' swell attenuation factor6 :',F9.3/ & +!/ST4 ' swell attenuation factor7 :',F14.3/ & +!/ST4 ' ratio of z0 for orb. & mean :',F9.3/) +!/ST4 2920 FORMAT ( ' &SIN4 ZWND =',F5.1,', ALPHA0 =',F8.5,', Z0MAX =',F8.5,', BETAMAX =', & +!/ST4 F8.5,','/ & +!/ST4 ' SINTHP =',F8.5,', ZALP =',F8.5,', TAUWSHELTER =',F8.5, & +!/ST4 ', SWELLFPAR =',I2,','/ & +!/ST4 ' SWELLF =',F8.5,', SWELLF2 =',F8.5, & +!/ST4 ', SWELLF3 =',F8.5,', SWELLF4 =',F9.1,','/ & +!/ST4 ' SWELLF5 =',F8.5,', SWELLF6 =',F8.5, & +!/ST4 ', SWELLF7 =',F12.2,', Z0RAT =',F8.5,', SINBR =',F8.5,' /') +! +!/ST6 920 FORMAT (/' Wind input (Donelan et al, 2006) ',A/ & +!/ST6 ' --------------------------------------------------') +!/ST6 921 FORMAT ( ' negative wind input active : ',A/ & +!/ST6 ' attenuation factor : ',F6.2/ & +!/ST6 ' wind speed scaling factor : ',F6.2/ & +!/ST6 ' frequency cut-off factor : ',F6.2/) +!/ST6 2920 FORMAT ( ' &SIN6 SINA0 =', F6.3, ', SINWS =', F6.2, ', SINFC =', F6.2, ' /') +! +!/STX 920 FORMAT (/' Experimental wind input.'/) +! +!/NL0 922 FORMAT (/' Nonlinear interactions not defined.'/) +! +!/NL1 922 FORMAT (/' Nonlinear interactions (DIA) ',A/ & +!/NL1 ' --------------------------------------------------') +!/NL1 923 FORMAT ( ' Lambda :',F8.2/ & +!/NL1 ' Prop. constant :',E10.3/ & +!/NL1 ' kd conversion factor :',F8.2/ & +!/NL1 ' minimum kd :',F8.2/ & +!/NL1 ' shallow water constants :',F8.2,2F6.2/) +!/NL1 2922 FORMAT ( ' &SNL1 LAMBDA =',F7.3,', NLPROP =',E10.3, & +!/NL1 ', KDCONV =',F7.3,', KDMIN =',F7.3,','/ & +!/NL1 ' SNLCS1 =',F7.3,', SNLCS2 =',F7.3, & +!/NL1 ', SNLCS3 = ',F7.3,' /') +! +!/NL2 922 FORMAT (/' Nonlinear interactions (WRT) ',A/ & +!/NL2 ' --------------------------------------------------') +!/NL2 923 FORMAT ( ' Deep/shallow options : ',A/ & +!/NL2 ' Power of h-f tail : ',F6.1) +!/NL2 1923 FORMAT ( ' Number of depths used : ',I4/ & +!/NL2 ' Depths (m) :',5F7.1) +!/NL2 2923 FORMAT ( ' ',5F7.1) +!/NL2 2922 FORMAT ( ' &SNL2 IQTYPE =',I2,', TAILNL =',F5.1,',', & +!/NL2 ' NDEPTH =',I3,' /') +!/NL2 3923 FORMAT ( ' &SNL2 DEPTHS =',F9.2,' /') +!/NL2 4923 FORMAT ( ' &ANL2 DEPTHS =',F9.2,' ,') +!/NL2 5923 FORMAT ( ' ',F9.2,' ,') +!/NL2 6923 FORMAT ( ' ',F9.2,' /') +! +!/NL3 922 FORMAT (/' Nonlinear interactions (GMD) ',A/ & +!/NL3 ' --------------------------------------------------') +!/NL3 923 FORMAT ( ' Powers in scaling functions : ',2F7.2/ & +!/NL3 ' Nondimension filter depths : ',2F7.2) +!/NL3 1923 FORMAT ( ' Number of quad. definitions : ',I4) +!/NL3 2923 FORMAT ( ' ',2F8.3,F6.1,2E12.4) +!/NL3 2922 FORMAT ( ' &SNL3 NQDEF =',I3,', MSC =',F6.2,', NSC =', & +!/NL3 F6.2,', KDFD =',F6.2,', KDFS =',F6.2,' /') +!/NL3 3923 FORMAT ( ' &ANL3 QPARMS = ',2(F5.3,', '),F5.1,', ',E10.4, & +!/NL3 ', ',E10.4,' /') +!/NL3 4923 FORMAT ( ' &ANL3 QPARMS = ',2(F5.3,', '),F5.1,', ',E10.4, & +!/NL3 ', ',E10.4,' ,') +!/NL3 5923 FORMAT ( ' ',2(F5.3,', '),F5.1,', ',E10.4, & +!/NL3 ', ',E10.4,' ,') +!/NL3 6923 FORMAT ( ' ',2(F5.3,', '),F5.1,', ',E10.4, & +!/NL3 ', ',E10.4,' /') +! +!/NL4 922 FORMAT (/' Nonlinear interactions (TSA) ',A/ & +!/NL4 ' --------------------------------------------------') +!/NL4 923 FORMAT ( ' Source term computation (1=TSA,0=FBI) : ',I2/ & +!/NL4 ' Alternate loops (1=no,2=yes) : ',I2/ & +!/NL4 ' (To speed up computation) ') +!/NL4 2922 FORMAT ( ' &SNL4 ITSA =',I2,', IALT =',I2 ) +! +!/NLX 922 FORMAT (/' Experimental nonlinear interactions.'/) +! +!/NLS 9922 FORMAT (/' HF filter based on Snl ',A/ & +!/NLS ' --------------------------------------------------') +!/NLS 9923 FORMAT ( ' a34 (lambda) :',F9.3,F9.4/ & +!/NLS ' Prop. constant :',E10.3/ & +!/NLS ' maximum relative change :',F9.3/ & +!/NLS ' filter constants :',F8.2,2F6.2/) +!/NLS 8922 FORMAT ( ' &SNLS A34 =',F6.3,', FHFC =',E11.4, & +!/NLS ', DNM =',F6.3,','/' FC1 =',F6.3, & +!/NLS ', FC2 =',F6.3,', FC3 =',F6.3,' /') +! +!/ST0 924 FORMAT (/' Dissipation not defined.'/) +! +!/ST1 924 FORMAT (/' Dissipation (WAM-3) ',A/ & +!/ST1 ' --------------------------------------------------') +!/ST1 925 FORMAT ( ' Cdis :',E10.3/ & +!/ST1 ' Apm :',E10.3/) +!/ST1 2924 FORMAT ( ' &SDS1 CDIS =',E12.4,', APM =',E11.4,' /') +! +!/ST2 924 FORMAT (/' Dissipation (T&C 1996) ',A/ & +!/ST2 ' --------------------------------------------------') +!/ST2 925 FORMAT ( ' High-frequency constants :',F8.2,E11.3,F6.2/ & +!/ST2 ' Low-frequency constants :',E11.3,F6.2/& +!/ST2 ' ',E11.3,F6.2/& +!/ST2 ' Minimum input peak freq. (-):',F10.4/ & +!/ST2 ' Minimum PHI :',F10.4/) +!/ST2 2924 FORMAT ( ' &SDS2 SDSA0 =',E10.3,', SDSA1 =',E10.3,', SDSA2 =', & +!/ST2 E10.3,', '/ & +!/ST2 ' SDSB0 =',E10.3,', SDSB1 =',E10.3,', ', & +!/ST2 'PHIMIN =',E10.3,' /') +! +!/ST3 924 FORMAT (/' Dissipation (WAM Cycle 4+) ',A/ & +!/ST3 ' --------------------------------------------------') +!/ST3 925 FORMAT ( ' SDSC1 :',1E11.3/ & +!/ST3 ' Power of k in mean k :',F8.2/ & +!/ST3 ' weights of k and k^2 :',F9.3,F6.3/) +!/ST3 2924 FORMAT ( ' &SDS3 SDSC1 =',E12.4,', WNMEANP =',F4.2, & +!/ST3 ', FXPM3 =', F4.2,',FXFM3 =',F4.2,', '/ & +!/ST3 ' SDSDELTA1 =', F5.2,', SDSDELTA2 =',F5.2, & +!/ST3 ' /') +! +!/ST4 924 FORMAT (/' Dissipation (Ardhuin / Filipot / Romero ) ',A/ & +!/ST4 ' --------------------------------------------------') +!/ST4 925 FORMAT ( ' SDSC2, SDSBCK, SDSCUM :',3E11.3/ & +!/ST4 ' Power of k in mean k :',F8.2/) + + +!/ST4 2924 FORMAT ( ' &SDS4 SDSBCHOICE = ',F3.1, & +!/ST4 ', SDSC2 =',E12.4,', SDSCUM =',F6.2,', '/ & +!/ST4 ' SDSC4 =',F6.2,', SDSC5 =',E12.4, & +!/ST4 ', SDSC6 =',E12.4,','/ & +!/ST4 ' WNMEANP =',F4.2,', FXPM3 =', F4.2, & +!/ST4 ', FXFM3 =',F4.1,', FXFMAGE =',F6.3, ', '/ & +!/ST4 ' SDSBINT =',E12.4,', SDSBCK =',E12.4, & +!/ST4 ', SDSABK =',F6.3,', SDSPBK =',F6.3,', '/ & +!/ST4 ' SDSHCK =',F5.2,', SDSBR = ',E12.4, & +!/ST4 ', SDSSTRAIN =',F5.1,', SDSSTRAINA =',F4.1, & +!/ST4 ', SDSSTRAIN2 =',F5.1,', '/ & +!/ST4 ' SDSBT =',F5.2,', SDSP =',F5.2, & +!/ST4 ', SDSISO =',I2, & +!/ST4 ', SDSCOS =',F3.1,', SDSDTH =',F5.1,', '/ & +!/ST4 ' SDSBRF1 = ',F5.2,', SDSBRFDF =',I2,', '/ & +!/ST4 ' SDSBM0 = ',F5.2, ', SDSBM1 =',F5.2, & +!/ST4 ', SDSBM2 =',F5.2,', SDSBM3 =',F5.2,', SDSBM4 =', & +!/ST4 F5.2,', '/, & +!/ST4 ' SPMSS = ',F5.2, ', SDKOF =',F5.2, & +!/ST4 ', SDSMWD =',F5.2,', SDSFACMTF =',F5.1,', '/ & +!/ST4 ' SDSMWPOW =',F3.1,', SDSNMTF =', F5.2, & +!/ST4 ', SDSCUMP =', F3.1,', SDSNUW =', E8.3,', '/, & +!/ST4 ' WHITECAPWIDTH =',F5.2, ' WHITECAPDUR =',F5.2,' /') +! +!/ST6 924 FORMAT (/' Dissipation (Rogers et al. 2012) ',A/ & +!/ST6 ' --------------------------------------------------') +!/ST6 925 FORMAT ( ' normalise by threshold spectral density : ',A/& +!/ST6 ' normalise by spectral density : ',A/& +!/ST6 ' coefficient and exponent for '/ & +!/ST6 ' inherent breaking term a1, L as in (21) : ',E9.3,I3/ & +!/ST6 ' cumulative breaking term a2, M as in (22) : ',E9.3,I3/ & +!/ST6 ' ') +!/ST6 2924 FORMAT ( ' &SDS6 SDSET = ',L,', SDSA1 = ',E9.3, & +!/ST6 ', SDSA2 = ',E9.3,', SDSP1 = ',I2,', SDSP1 = ', & +!/ST6 I2,' /' ) +!/ST6 +!/ST6 937 FORMAT (/' Swell dissipation ',A/ & +!/ST6 ' --------------------------------------------------') +!/ST6 940 FORMAT ( ' subroutine W3SWL6 activated : ',A/ & +!/ST6 ' coefficient b1 ',A, ' : ',E9.3/ ) +!/ST6 2937 FORMAT ( ' &SWL6 SWLB1 = ',E9.3,', CSTB1 = ',L,' /') +! +!/STX 924 FORMAT (/' Experimental dissipation.'/) +! +!/BT0 926 FORMAT (/' Bottom friction not defined.'/) +! +!/BT1 926 FORMAT (/' Bottom friction (JONSWAP) ',A/ & +!/BT1 ' --------------------------------------------------') +!/BT1 927 FORMAT ( ' gamma :',F8.4/) +!/BT1 2926 FORMAT ( ' &SBT1 GAMMA =',E12.4,' /') +! +!/BT4 926 FORMAT (/' Bottom friction (SHOWEX) ',A/ & +!/BT4 ' --------------------------------------------------') +!/BT4 927 FORMAT ( ' SEDMAPD50, SED_D50_UNIFORM :',L3,1X,F8.6/ & +!/BT4 ' RIPFAC1,RIPFAC2,RIPFAC3,RIPFAC4 :',4F8.4/ & +!/BT4 ' SIGDEPTH, BOTROUGHMIN, BOTROUGHFAC:',3F8.4/) +!/BT4 2926 FORMAT ( ' &SBT4 SEDMAPD50 =',L3,', SED_D50_UNIFORM =',F8.6,','/ & +!/BT4 ' RIPFAC1 =',F8.4,', RIPFAC2 =',F8.4, & +!/BT4 ', RIPFAC3 =',F8.4,', RIPFAC4 =',F8.4,','/ & +!/BT4 ' SIGDEPTH =',F8.4,', BOTROUGHMIN =',F8.4, & +!/BT4 ', BOTROUGHFAC =',F4.1,' /') +!/BTX 926 FORMAT (/' Experimental bottom friction.'/) +! +!/DB0 928 FORMAT (/' Surf breaking not defined.'/) +! +!/DB1 928 FORMAT (/' Surf breaking (B&J 1978) ',A/ & +!/DB1 ' --------------------------------------------------') +!/DB1 929 FORMAT ( ' alpha :',F8.3/ & +!/DB1 ' gamma :',F8.3) +!/DB1 2928 FORMAT ( ' &SDB1 BJALFA =',F7.3,', BJGAM =',F7.3, & +!/DB1 ', BJFLAG = ',A,' /') +! +!/DBX 928 FORMAT (/' Experimental depth-induced breaking.'/) +! +!/TR0 930 FORMAT (/' Triad interactions not defined.'/) +!/TRX 930 FORMAT (/' Experimental triad interactions.'/) +! +!/BS0 932 FORMAT (/' Bottom scattering not defined.'/) +!/BS1 932 FORMAT (/' Experimental bottom scattering (F. Ardhuin).'/) +!/BSX 932 FORMAT (/' Experimental bottom scattering.'/) +! +!/XX0 934 FORMAT (/' Alternative source term slot not used.'/) +!/XXX 934 FORMAT (/' Experimental unclasified source term.'/) +! +!/IC1 935 FORMAT (/' Dissipation via ice parameters (SIC1).'& +!/IC1 ,/' --------------------------------------------------') +! +!/IC2 935 FORMAT (/' Dissipation via ice parameters (SIC2).'& +!/IC2 ,/' --------------------------------------------------') +! +!/IC3 935 FORMAT (/' Dissipation via ice parameters (SIC3).'& +!/IC3 ,/' --------------------------------------------------') +! +!/IC4 935 FORMAT (/' Dissipation via ice parameters (SIC4).'& +!/IC4 ,/' --------------------------------------------------') +! +!/IC5 935 FORMAT (/' Dissipation via ice parameters (SIC5).'& +!/IC5 ,/' --------------------------------------------------') +! +!/IS0 944 FORMAT (/' Ice scattering not defined.'/) +!/IS1 945 FORMAT (/' Ice scattering ',A,/ & +!/IS1 ' --------------------------------------------------') +!/IS1 946 FORMAT (' Isotropic (linear function of ice concentration)'/& +!/IS1 ' slope : ',E10.3/ & +!/IS1 ' offset : ',E10.3) +!/IS1 2946 FORMAT ( ' &SIS1 ISC1 =',E9.3,', ISC2 =',E9.3) +!/IS2 947 FORMAT (/' Ice scattering ',A,/ & +!/IS2 ' --------------------------------------------------') +!/IS2 948 FORMAT (' IS2 Scattering ... '/& +!/IS2 ' scattering coefficient : ',E9.3/ & +!/IS2 ' 0: no back-scattering : ',E9.3/ & +!/IS2 ' TRUE: istropic back-scattering : ',L3/ & +!/IS2 ' TRUE: update of ICEDMAX : ',L3/ & +!/IS2 ' TRUE: keeps updated ICEDMAX : ',L3/ & +!/IS2 ' flexural strength : ',E9.3/ & +!/IS2 ' TRUE: uses Robinson-Palmer disp.: ',L3/ & +!/IS2 ' attenuation : ',F5.2/ & +!/IS2 ' fragility : ',F5.2/ & +!/IS2 ' minimum floe size in meters : ',F5.2/ & +!/IS2 ' pack scattering coef 1 : ',F5.2/ & +!/IS2 ' pack scattering coef 2 : ',F5.2/ & +!/IS2 ' scaling by concentration : ',F5.2/ & +!/IS2 ' creep B coefficient : ',E9.3/ & +!/IS2 ' creep C coefficient : ',F5.2/ & +!/IS2 ' creep D coefficient : ',F5.2/ & +!/IS2 ' creep N power : ',F5.2/ & +!/IS2 ' elastic energy factor : ',F5.2/ & +!/IS2 ' factor for ice breakup : ',F5.2/ & +!/IS2 ' IS2WIM1 : ',F5.2/ & +!/IS2 ' anelastic dissipation : ',L3/ & +!/IS2 ' energy of activation : ',F5.2/ & +!/IS2 ' anelastic coefficient : ',E11.3/ & +!/IS2 ' anelastic exponent : ',F5.2) +!/IS2 2948 FORMAT ( ' &SIS2 ISC1 =',E9.3,', IS2BACKSCAT =',E9.3, & +!/IS2 ', IS2ISOSCAT =',L3,', IS2BREAK =',L3, & +!/IS2 ', IS2DUPDATE =',L3,','/ & +!/IS2 ' IS2FLEXSTR =',E11.3,', IS2DISP =',L3, & +!/IS2 ', IS2DAMP =',F3.1, & +!/IS2 ', IS2FRAGILITY =',F4.2,', IS2DMIN =',F5.2,','/ & +!/IS2 ' IS2C2 =',F12.8,', IS2C3 =',F8.4, & +!/IS2 ', IS2CONC =',F5.1,', IS2CREEPB =',E11.3,','/ & +!/IS2 ' IS2CREEPC =',F5.2,', IS2CREEPD =',F5.2, & +!/IS2 ', IS2CREEPN =',F5.2,','/ & +!/IS2 ' IS2BREAKE =',F5.2, & +!/IS2 ', IS2BREAKF =',F5.2,', IS2WIM1 =',F5.2,','/ & +!/IS2 ', IS2ANDISB =',L3,', IS2ANDISE =',F5.2, & +!/IS2 ', IS2ANDISD =',E11.3,', IS2ANDISN=',F5.2, ' /') +!/UOST 4500 FORMAT (/' Unresolved Obstacles Source Term (UOST) ',A,/ & +!/UOST ' --------------------------------------------------') +!/UOST 4501 FORMAT (' local alpha-beta file: ',A, & +!/UOST ' shadow alpha-beta file: ',A,/ & +!/UOST ' local calibration factor: ',F5.2, & +!/UOST ' shadow calibration factor: ',F5.2) +!/UOST 4502 FORMAT (' &UOST UOSTFILELOCAL = ',A,', UOSTFILESHADOW = ',A,/ & +!/UOST ' UOSTFACTORLOCAL = ',F5.2', UOSTFACTORSHADOW = ',F5.2,' /') +! + 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) +!/PR1 953 FORMAT ( ' CFLmax depth refraction :',F9.3/) +!/PR1 2953 FORMAT ( ' &PRO1 CFLTM =',F5.2,' /') +! +!/PR2 953 FORMAT ( ' CFLmax depth refraction :',F9.3/ & +!/PR2 ' Effective swell age (h) : switched off'/ & +!/PR2 ' Cut-off latitude (degr.) :',F7.1/) +!/PR2 954 FORMAT ( ' CFLmax depth refraction :',F9.3/ & +!/PR2 ' Effective swell age (h) :',F8.2/ & +!/PR2 ' Cut-off latitude (degr.) :',F7.1/) +!/PR2 2953 FORMAT ( ' &PRO2 CFLTM =',F5.2,', DTIME =',F8.0, & +!/PR2 ', LATMIN =',F5.1,' /') +! +!/SMC 953 FORMAT ( ' Max propagation CFL number :',F9.3/ & +!/SMC ' Effective swell age (h) : switched off'/ & +!/SMC ' Cut-off latitude (degr.) :',F8.2/ & +!/SMC ' Maximum refraction (degr.) :',F8.2/) +!/SMC 954 FORMAT ( ' Max propagation CFL number :',F9.3/ & +!/SMC ' Effective swell age (h) :',F8.2/ & +!/SMC ' Cut-off latitude (degr.) :',F8.2/ & +!/SMC ' Maximum refraction (degr.) :',F8.2/) +!/SMC 2953 FORMAT ( ' &PSMC CFLTM =',F5.2,', DTIME =', F9.1/ & +!/SMC ' LATMIN =',F5.1,', RFMAXD =', F9.2/ & +!/SMC ' UNO3 =',L5, ', AVERG =',L5/ & +!/SMC ' LvSMC =',i5, ', NBISMC =',i9/ & +!/SMC ' ISHFT =',i5, ', JEQT =',i9/ & +!/SMC ' SEAWND =',L5, ' /') +! +!/PR3 953 FORMAT ( ' CFLmax depth refraction :',F9.3/ & +!/PR3 ' Averaging area factor Cg :',F8.2) +!/PR3 954 FORMAT ( ' Averaging area factor theta :',F8.2) +!/PR3 955 FORMAT ( ' **** Internal maximum .GE.',F6.2,' ****') +!/PR3 2953 FORMAT ( ' &PRO3 CFLTM =',F5.2, & +!/PR3 ', WDTHCG = ',F4.2,', WDTHTH = ',F4.2,' /') +! + 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_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 :'/ & + ' CICE0.NE.CICEN 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) +!/MGG 962 FORMAT ( ' Moving grid GSE cor. power :',F8.2) +!/SCRIP 963 FORMAT( ' Grid offset for multi-grid w/SCRIP : ',E11.3) + 1972 FORMAT ( ' Compression of track output : ',L3) +!/SEED 964 FORMAT ( ' Xseed in seeding algorithm :',F8.2) + 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) +! +!/REF1 969 FORMAT (/' Shoreline reflection ',A/ & +!/REF1 ' --------------------------------------------------') +! +!/IG1 970 FORMAT (/' Second order and infragravity waves ',A/ & +!/IG1 ' --------------------------------------------------') +! + 5971 FORMAT (' Partitioning method : ',A) + 5972 FORMAT (' Namelist options overridden : ',A) +! +!/IC2 971 FORMAT (/' Boundary layer below ice ',A/ & +!/IC2 ' --------------------------------------------------') +!/IC3 971 FORMAT (/' Visco-elastic ice layer ',A/ & +!/IC3 ' --------------------------------------------------') +!/IC4 971 FORMAT (/' Empirical wave-ice physics ',A/ & +!/IC4 ' --------------------------------------------------') +!/IC5 971 FORMAT (/' Visco-elastic ice layer (SIC5) ',A/ & +!/IC5 ' --------------------------------------------------') +!/IC5 2971 FORMAT ( ' Min. Ice shear modulus G : ', E10.1/, & +!/IC5 ' Min. Wave period T : ', F7.2/, & +!/IC5 ' Max. Wavenumber Ratio (Ko/Kr): ', E10.1/, & +!/IC5 ' Max. Attenu. Rate (Ki) : ', E10.1/, & +!/IC5 ' Min. Water depth (d) : ', F5.0/, & +!/IC5 ' Max. # of Newton Iter. : ', F5.0/, & +!/IC5 ' Use Rand. Kick : ', F5.0/, & +!/IC5 ' Excluded Imag. Corridor : ', F9.4/ ) +! + 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 #',I02,' : ',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,' /') +! + 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,' /') +!/RTD +!/RTD 4991 FORMAT ( ' &ROTD PLAT =', F6.2,', PLON =', F7.2,', UNROT =',L3,' /') +!/RTD 4992 FORMAT ( ' &ROTB BPLAT =',9(F6.1,",")/ & +!/RTD ' BPLON =',9(F6.1,","),' /') + + 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) +!/SMC 4001 FORMAT ( ' SMC refined levels NRLv = ',I8) +!/SMC 4002 FORMAT ( ' SMC Equator j shift no. = ',I8) +!/SMC 4302 FORMAT ( ' SMC I-index shift number = ',I8) +!/SMC 4003 FORMAT ( ' SMC input boundary no. = ',I8) +!/SMC 4004 FORMAT ( ' SMC NCel = ',6I9) +!/SMC 4005 FORMAT ( ' IJKCel(5,NCel) read from ', A) +!/SMC 4006 FORMAT (6I8) +!/SMC 4007 FORMAT ( ' SMC NUFc = ',6I9) +!/SMC 4008 FORMAT ( ' IJKUFc(7,NCel) read from ', A) +!/SMC 4009 FORMAT (8I8) +!/SMC 4010 FORMAT ( ' SMC NVFc = ',6I9) +!/SMC 4011 FORMAT ( ' IJKVFc(8,NCel) read from ', A) +!/SMC 4110 FORMAT ( ' SMC NCObsr = ',6I9) +!/SMC 4111 FORMAT ( ' IJKObstr(1,NCel) read from ', A) +!/SMC 4012 FORMAT (9I8) +!/SMC 4013 FORMAT ( ' NBICelin(NBISMC) read from ', A) +!/SMC 4014 FORMAT (2I8) +!/ARC 4015 FORMAT ( ' ARC NARC = ',6I9) +!/ARC 4016 FORMAT ( ' IJKCel(5,NARC) read from ', A) +!/ARC 4017 FORMAT ( ' ARC NAUI = ',6I9) +!/ARC 4018 FORMAT ( ' IJKUFc(7,NAUI) read from ', A) +!/ARC 4019 FORMAT ( ' ARC NAVJ = ',6I9) +!/ARC 4020 FORMAT ( ' IJKVFc(8,NAVJ) read from ', A) +!/SMC 4021 FORMAT ( ' Varables by W3DIMX NCel = ',I9) +!/SMC 4022 FORMAT ( ' Defined NLvCel ',6I9) +!/SMC 4023 FORMAT ( ' Defined NLvUFc ',6I9) +!/SMC 4024 FORMAT ( ' Defined NLvVFc ',6I9) +!/SMC 4025 FORMAT ( ' Define IJKCel from -9 to ',I9) +!/SMC 4026 FORMAT ( ' IJKCel(5,NCel) defined : ') +!/SMC 4027 FORMAT ( ' IJKUFc(7,NUFc) defined : ') +!/SMC 4028 FORMAT ( ' IJKVFc(8,NVFc) defined : ') +!/SMC 4029 FORMAT ( ' Boundary cells IJKCel(:,-9:0) : ') +!/SMC 4030 FORMAT (5I8) +!/SMC 4031 FORMAT ( ' Define MAPSF ... 1 to ',I9) +!/SMC 4032 FORMAT ( ' Multi-Resolution factor = ',I6) +!/SMC 4033 FORMAT ( ' Range of MAPSF(:,1) : ',2I9) +!/SMC 4034 FORMAT ( ' Range of MAPSF(:,2) : ',2I9) +!/SMC 4035 FORMAT ( ' Range of MAPSF(:,3) : ',2I9) +!/SMC 4036 FORMAT ( ' Range of MAPFS(:,:) : ',2I9) +!/ARC 4037 FORMAT ( ' Arctic AngArc defined as ',I6) +!/ARC 4038 FORMAT (9F8.2) +!/ARC 4039 FORMAT ( ' Arctic ICLBAC defined as ',I6) +!/ARC 4040 FORMAT (9I8) +!/RTD 4200 FORMAT ( ' AnglDin(NX,NY) defn checks : ') +!/RTD 4201 FORMAT ( ' JY/IX',4I8) +!/RTD 4202 FORMAT (I12,4F8.2) +!/RTD 4203 FORMAT ( ' Rotated pole lat/lon (deg.) : ',2F9.3) +!/RTD 4204 FORMAT ( ' Output dirns and x-y vectors will be set to True North') + 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/) +! +!/O2a 998 FORMAT (50I2) +!/O2c 1998 FORMAT (50I2) +! + 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 ***'/) +! + 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/) +! + 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) + 1029 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/ & + ' ILLEGAL NUMBER OF !/XXn 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) +!/RTD 1052 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/ & +!/RTD ' WITH NAMELIST VALUE PLAT == 90, PLON MUST BE -180'/ & +!/RTD ' AND UNROT MUST BE .FALSE.' ) +! +!/RTD 1053 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/ & +!/RTD ' WITH NAMELIST VALUE BPLAT == 90, BPLON MUST BE -180') +! + 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 '/) +! +!/T 9090 FORMAT ( ' TEST W3GRID : OUTPUT BOUND. POINT DATA LINE SEG.') +!/T 9091 FORMAT ( ' ',2F8.2,4(2I4,F7.2)) +!/T 9092 FORMAT ( ' ',F7.2,2X,4F7.2) +!/T 9093 FORMAT ( ' ',4I7/ & +!/T ' ',4I7) +! +!/T0 9095 FORMAT ( ' TEST W3GRID : OUTPUT BOUND. POINT SPEC DATA ') +!/T0 9096 FORMAT ( ' ',I3,2I8) + + END SUBROUTINE +!/ +!/ 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 +!/ +!/ ------------------------------------------------------------------- / +!/ +!/S CALL STRACE (IENT, 'READNL') +! + 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) +!/FLD1 CASE('FLD1') +!/FLD1 READ (NDS,NML=FLD1,END=801,ERR=802,IOSTAT=J) +!/FLD2 CASE('FLD2') +!/FLD2 READ (NDS,NML=FLD2,END=801,ERR=802,IOSTAT=J) +!/FLX3 CASE('FLX3') +!/FLX3 READ (NDS,NML=FLX3,END=801,ERR=802,IOSTAT=J) +!/FLX4 CASE('FLX4') +!/FLX4 READ (NDS,NML=FLX4,END=801,ERR=802,IOSTAT=J) +!/LN1 CASE('SLN1') +!/LN1 READ (NDS,NML=SLN1,END=801,ERR=802,IOSTAT=J) +!/ST1 CASE('SIN1') +!/ST1 READ (NDS,NML=SIN1,END=801,ERR=802,IOSTAT=J) +!/ST2 CASE('SIN2') +!/ST2 READ (NDS,NML=SIN2,END=801,ERR=802,IOSTAT=J) +!/ST3 CASE('SIN3') +!/ST3 READ (NDS,NML=SIN3,END=801,ERR=802,IOSTAT=J) +!/ST4 CASE('SIN4') +!/ST4 READ (NDS,NML=SIN4,END=801,ERR=802,IOSTAT=J) +!/ST6 CASE('SIN6') +!/ST6 READ (NDS,NML=SIN6,END=801,ERR=802,IOSTAT=J) +!/NL1 CASE('SNL1') +!/NL1 READ (NDS,NML=SNL1,END=801,ERR=802,IOSTAT=J) +!/NL2 CASE('SNL2') +!/NL2 READ (NDS,NML=SNL2,END=801,ERR=802,IOSTAT=J) +!/NL2 CASE('ANL2') +!/NL2 IF ( NDEPTH .GT. 100 ) GOTO 804 +!/NL2 DEPTHS(1:NDEPTH) = DPTHNL +!/NL2 READ (NDS,NML=ANL2,END=801,ERR=802,IOSTAT=J) +!/NL2 DPTHNL = DEPTHS(1:NDEPTH) +!/NL3 CASE('SNL3') +!/NL3 READ (NDS,NML=SNL3,END=801,ERR=802,IOSTAT=J) +!/NL3 CASE('ANL3') +!/NL3 IF ( NQDEF .GT. 100 ) GOTO 804 +!/NL3 READ (NDS,NML=ANL3,END=801,ERR=802,IOSTAT=J) +!/NL4 CASE('SNL4') +!/NL4 READ (NDS,NML=SNL4,END=801,ERR=802,IOSTAT=J) +!/NLS CASE('SNLS') +!/NLS READ (NDS,NML=SNLS,END=801,ERR=802,IOSTAT=J) +!/ST1 CASE('SDS1') +!/ST1 READ (NDS,NML=SDS1,END=801,ERR=802,IOSTAT=J) +!/ST2 CASE('SDS2') +!/ST2 READ (NDS,NML=SDS2,END=801,ERR=802,IOSTAT=J) +!/ST3 CASE('SDS3') +!/ST3 READ (NDS,NML=SDS3,END=801,ERR=802,IOSTAT=J) +!/ST4 CASE('SDS4') +!/ST4 READ (NDS,NML=SDS4,END=801,ERR=802,IOSTAT=J) +!/ST6 CASE('SDS6') +!/ST6 READ (NDS,NML=SDS6,END=801,ERR=802,IOSTAT=J) +!/ST6 CASE('SWL6') +!/ST6 READ (NDS,NML=SWL6,END=801,ERR=802,IOSTAT=J) +!/BT1 CASE('SBT1') +!/BT1 READ (NDS,NML=SBT1,END=801,ERR=802,IOSTAT=J) +!/BT4 CASE('SBT4') +!/BT4 READ (NDS,NML=SBT4,END=801,ERR=802,IOSTAT=J) +!/IS1 CASE('SIS1') +!/IS1 READ (NDS,NML=SIS1,END=801,ERR=802,IOSTAT=J) +!/IS2 CASE('SIS2') +!/IS2 READ (NDS,NML=SIS2,END=801,ERR=802,IOSTAT=J) +!/DB1 CASE('SDB1') +!/DB1 READ (NDS,NML=SDB1,END=801,ERR=802,IOSTAT=J) +!/UOST CASE('UOST') +!/UOST READ (NDS,NML=UOST,END=801,ERR=802,IOSTAT=J) +!/PR1 CASE('PRO1') +!/PR1 READ (NDS,NML=PRO1,END=801,ERR=802,IOSTAT=J) +!/PR2 CASE('PRO2') +!/PR2 READ (NDS,NML=PRO2,END=801,ERR=802,IOSTAT=J) +!/SMC CASE('PSMC') +!/SMC READ (NDS,NML=PSMC,END=801,ERR=802,IOSTAT=J) +!/PR3 CASE('PRO3') +!/PR3 READ (NDS,NML=PRO3,END=801,ERR=802,IOSTAT=J) +!/RTD CASE('ROTD') +!/RTD READ (NDS,NML=ROTD,END=801,ERR=802,IOSTAT=J) +!/RTD CASE('ROTB') +!/RTD READ (NDS,NML=ROTB,END=801,ERR=802,IOSTAT=J) +!/REF1 CASE('REF1') +!/REF1 READ (NDS,NML=REF1,END=801,ERR=802,IOSTAT=J) +!/IG1 CASE('SIG1') +!/IG1 READ (NDS,NML=SIG1,END=801,ERR=802,IOSTAT=J) +!/IC2 CASE('SIC2') +!/IC2 READ (NDS,NML=SIC2,END=801,ERR=802,IOSTAT=J) +!/IC3 CASE('SIC3') +!/IC3 READ (NDS,NML=SIC3,END=801,ERR=802,IOSTAT=J) +!/IC4 CASE('SIC4 ') +!/IC4 READ (NDS,NML=SIC4,END=801,ERR=802,IOSTAT=J) +!/IC5 CASE('SIC5 ') +!/IC5 READ (NDS,NML=SIC5,END=801,ERR=802,IOSTAT=J) + 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 +! +!/NL2 804 CONTINUE +!/NL2 WRITE (NDSE,1004) NDEPTH +!/NL2 CALL EXTCDE(4) +!/NL2 RETURN +! +!/NL3 804 CONTINUE +!/NL3 WRITE (NDSE,1004) NQDEF +!/NL3 CALL EXTCDE(4) +!/NL3 RETURN +! +! 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'/) +!/NL2 1004 FORMAT (/' *** WAVEWATCH III ERROR IN READNL : '/ & +!/NL2 ' TEMP DEPTH ARRAY TOO SMALL, .LE. ',I8/) +!/NL3 1004 FORMAT (/' *** WAVEWATCH-III ERROR IN READNL : '/ & +!/NL3 ' TEMP QPARMS ARRAY TOO SMALL, .LE. ',I8/) +!/ +!/ End of READNL ----------------------------------------------------- / +!/ + END SUBROUTINE +!/ +!/ End of W3GRID ----------------------------------------------------- / +!/ + END MODULE W3GRIDMD diff --git a/model/ftn/ww3_grid.ftn b/model/ftn/ww3_grid.ftn index d5bfdf18d8..e9cf01601a 100644 --- a/model/ftn/ww3_grid.ftn +++ b/model/ftn/ww3_grid.ftn @@ -1,6591 +1,10 @@ #include "w3macros.h" !/ ------------------------------------------------------------------- / - PROGRAM W3GRID -!/ -!/ +-----------------------------------+ -!/ | WAVEWATCH III NOAA/NCEP | -!/ | H. L. Tolman | -!/ | J. H. Alves | -!/ | F. Ardhuin | -!/ | FORTRAN 90 | -!/ | Last update : 15-Apr-2020 | -!/ +-----------------------------------+ -!/ -!/ 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 ) -!/ -!/ 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 program, 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 program. 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 : -! -! None, stand-alone 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(NCel, 5), each row holds i, j, di, dj, 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(NUFc, 7) and -! IJKVFc(NVFc,8), 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 another option -! ARC is activated along with the SMC option. ARC 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). -! -! !/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. -! !/LNX Open slot. -! -! !/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. -! !/STX Open slot. -! -! !/NL0 No nonlinear interactions. -! !/NL1 Discrete interaction approximation (DIA). -! !/NL2 Exact interactions (WRT). -! !/NL3 Generalized Multiple DIA (GMD). -! !/NL4 Two Scale Approximation -! !/NLX Open slot. -! !/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) -! !/BTX Open slot. -! -! !/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 (Mosig et al. method) -! (Mosig et al. 2015: JGR) -! -! !/UOST Unresolved Obstacles Source Term (UOST), Mentaschi et al. 2015 -! -! !/DB0 No depth-induced breaking included. -! !/DB1 Battjes-Janssen depth-limited breaking. -! !/DBX Open slot. -! !/MLIM Mich-style limiter. -! -! !/TR0 No triad interactions included. -! !/TRX Open slot. -! -! !/BS0 No bottom scattering included. -! !/BS1 Routines from F. Ardhuin. -! !/BSX Open slot. -! -! !/XX0 No unclasified source term included. -! !/XXX Open slot. -! -! !/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 UNO2 scheme on Spherical Multiple-Cell grid. -! !/ARC Append the Arctic part to the SMC grid. -! -! !/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 : -! + PROGRAM WW3GRID !/ ------------------------------------------------------------------- / - USE CONSTANTS -!/ - USE W3TRIAMD - USE W3GSRUMD, ONLY: W3GRMP - USE W3ODATMD, ONLY: W3NOUT, W3SETO, W3DMO5 - USE W3IOGRMD, ONLY: W3IOGR - USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE -!/RTD USE W3SERVMD, ONLY: W3EQTOLL, W3LLTOEQ -!/ARC USE W3SERVMD, ONLY: W3LLTOEQ -!/S USE W3SERVMD, ONLY: STRACE - USE W3ARRYMD, ONLY: INA2R, INA2I -!/T USE W3ARRYMD, ONLY: PRTBLK - 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 -!/SCRIP USE SCRIP_GRIDS, ONLY: GRID1_UNITS, GRID1_NAME, & -!/SCRIP GRID1_CENTER_LON, GRID1_CENTER_LAT, & -!/SCRIP GRID1_CORNER_LON, GRID1_CORNER_LAT, & -!/SCRIP GRID1_MASK, GRID1_SIZE, GRID1_RANK, & -!/SCRIP GRID1_IMASK, & -!/SCRIP GRID1_CORNERS, GRID1_DIMS -!/SCRIP USE SCRIP_KINDSMOD -!/SCRIP USE WMSCRPMD -!/SCRIPNC USE NETCDF -! -!/NL3 USE W3SNL3MD, ONLY: LAMMAX, DELTHM -!/NLS USE W3SNLSMD, ONLY: ABMAX -! + USE W3GRIDMD 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, NRXX, 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 -!/NL2 INTEGER :: IDEPTH -!/O1 INTEGER :: IBI, IP0, IPN, IPH, IPI - INTEGER :: NCOL = 78 -!/SMC !!Li Offset to change Equator index = 0 to regular index JEQT -!/SMC !!Li LvSMC levels of refinded resolutions for SMC grid. -!/SMC !!Li NBISMC number of boundary point for regional SMC grid. -!/SMC !!Li ISHFT for SMC i-index from smc origin to regular grid west edge. -!/SMC !!Li SMC cell only subgrid obstruction array dimensions NCObst, JObs. -!/SMC INTEGER :: JEQT, LvSMC, NBISMC, JS, NCObst, JObs, ISHFT -!/SMC INTEGER :: NGUI, NGVJ -!/ARC INTEGER :: NAUI, NAVJ -! -!/O2 INTEGER :: NMAP, IMAP -!/T INTEGER :: IX3, IY3 -!/T0 INTEGER :: IFILE -!/S INTEGER, SAVE :: IENT = 0 -! - INTEGER, ALLOCATABLE :: TMPSTA(:,:), TMPMAP(:,:), READMP(:,:) -!/T INTEGER, ALLOCATABLE :: MAPOUT(:,:) -! - 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) - -!/DEBUGGRID INTEGER :: nbCase1, nbCase2, nbCase3, & -!/DEBUGGRID nbCase4, nbCase5, nbCase6, & -!/DEBUGGRID nbCase7, nbCase8 -!/DEBUGGRID INTEGER :: nbTMPSTA0, nbTMPSTA1, nbTMPSTA2 -!/DEBUGGRID INTEGER :: IAPROC -! -!/LN1 REAL :: CLIN, RFPM, RFHF -!/ST1 REAL :: CINP, CDIS, APM -!/ST2 REAL :: PHIMIN, FPIA, FPIB, DPHID -!/NL1 REAL :: NLPROP -!/NL2 REAL :: DPTFAC, DEPTHS(100) -!/NL3 REAL :: QPARMS(500) -!/NLS REAL :: A34, FHFC, DNM, FC1, FC2, FC3 -!/BT1 REAL :: GAMMA -!/PR2 REAL :: LATMIN -! -!/SMC REAL :: LATMIN, TRNMX, TRNMY -!/SMC INTEGER, ALLOCATABLE :: NLvCelsk(:), NLvUFcsk(:), NLvVFcsk(:) -!/SMC INTEGER, ALLOCATABLE :: IJKCelin(:,:),IJKUFcin(:,:),IJKVFcin(:,:) -!/SMC INTEGER, ALLOCATABLE :: NBICelin(:), IJKObstr(:,:) -!/ARC REAL :: PoLonAC, PoLatAC -!/ARC INTEGER, ALLOCATABLE :: IJKCelAC(:,:),IJKUFcAC(:,:),IJKVFcAC(:,:) -!/ARC REAL, ALLOCATABLE :: XLONAC(:),YLATAC(:),ELONAC(:),ELATAC(:) -! -!/RTD REAL, ALLOCATABLE :: AnglDin(:,:),StdLon(:,:),StdLat(:,:) -!/RTD ! 1-dim boundary sectors -!/RTD REAL, ALLOCATABLE :: BDYLON(:), BDYLAT(:), & -!/RTD ELatbdy(:), ELonbdy(:), Anglbdy(:) -!/RTD ! If the destination grid for an output b.c. is rotated, its pole is: -!/RTD REAL :: bPolat, bPolon -!/RTD! - REAL, ALLOCATABLE :: XGRDIN(:,:), YGRDIN(:,:) - REAL, ALLOCATABLE :: ZBIN(:,:), OBSX(:,:), OBSY(:,:) - REAL, ALLOCATABLE :: REFD(:,:), REFD2(:,:), REFS(:,:) -!/BT4 REAL, ALLOCATABLE :: SED_D50FILE(:,:), SED_POROFILE(:,:) -!/BT4 LOGICAL :: SEDMAPD50 -!/BT4 REAL :: SED_D50_UNIFORM, SED_DSTAR, RIPFAC1, & -!/BT4 RIPFAC2, RIPFAC3, RIPFAC4, SIGDEPTH, & -!/BT4 BOTROUGHMIN, BOTROUGHFAC -! - LOGICAL :: FLLIN, FLINDS, FLNL, FLBT, FLDB, & - FLTR, FLBS, FLXX, FLPROP, FLREF, & - FIRST, CONNCT, FLNEW, INGRID,FLIC, & - FLIS, FLGNML - LOGICAL :: FLTC96 = .FALSE. - LOGICAL :: FLNMLO = .FALSE. - LOGICAL :: FLSTB2 = .FALSE. - LOGICAL :: FLST4 = .FALSE. - LOGICAL :: FLST6 = .FALSE. - -!!Li Add a logical variable to shelter regular grid lines from SMC grid. - LOGICAL :: RGLGRD = .TRUE. -!!Li - REAL :: FACBERG, REFSLOPE -!/IS1 REAL :: ISC1, ISC2 -!/IS2 REAL :: ISC1, IS2BACKSCAT, IS2C2, IS2C3,& -!/IS2 IS2FRAGILITY, IS2DMIN, IS2DAMP, & -!/IS2 IS2CONC, IS2CREEPB, IS2CREEPC, & -!/IS2 IS2CREEPD, IS2CREEPN, IS2BREAKE,& -!/IS2 IS2WIM1, IS2BREAKF, IS2FLEXSTR, & -!/IS2 IS2ANDISN, IS2ANDISE, IS2ANDISD -!/IS2 LOGICAL :: IS2BREAK, IS2DISP, IS2DUPDATE, & -!/IS2 IS2ISOSCAT, IS2ANDISB -! -!/REF1 REAL :: REFCOAST, REFFREQ, REFMAP, & -!/REF1 REFSUBGRID, REFRMAX, REFMAPD, & -!/REF1 REFICEBERG, REFCOSP_STRAIGHT, & -!/REF1 REFFREQPOW, REFUNSTSOURCE -! -!/IG1 LOGICAL :: IGSWELLMAX, IGBCOVERWRITE -!/IG1 INTEGER :: IGMETHOD, IGADDOUTP, IGSOURCE, & -!/IG1 IGSOURCEATBP, IGSTERMS -!/IG1 REAL :: IGMAXFREQ, IGMINDEP, IGMAXDEP, & -!/IG1 IGKDMIN, IGFIXEDDEPTH, IGEMPIRICAL -! -!/IC2 LOGICAL :: IC2DISPER -!/IC2 REAL :: IC2TURB, IC2ROUGH, IC2REYNOLDS, & -!/IC2 IC2SMOOTH, IC2VISC, IC2TURBS, IC2DMAX - -!/IC3 REAL :: IC2TURB, IC2ROUGH, IC2REYNOLDS, & -!/IC3 IC2SMOOTH, IC2VISC, IC2TURBS, & -!/IC3 IC3MAXTHK, IC3MAXCNC, & -!/IC3 IC3HILIM, IC3KILIM, & -!/IC3 IC3VISC, IC3ELAS, IC3DENS, IC3HICE -!/IC3 LOGICAL :: IC3CHENG,USECGICE - -!/IC4 INTEGER :: IC4METHOD -!/IC4 REAL :: IC4KI(NIC4), IC4FC(NIC4) -! -!/IC5 REAL :: IC5MINIG, IC5MINWT, & -!/IC5 IC5MAXKRATIO, IC5MAXKI, IC5MINHW, & -!/IC5 IC5MAXITER, IC5RKICK, IC5KFILTER - - 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) -!/FLX3 CHARACTER(LEN=18) :: TYPEID - -!/SCRIP INTEGER :: NCID -!/SCRIP INTEGER :: grid_size_dimid, grid_rank_dimid, grid_corners_dimid -!/SCRIP INTEGER :: grid_center_lat_varid, grid_center_lon_varid -!/SCRIP INTEGER :: grid_corner_lat_varid, grid_corner_lon_varid -!/SCRIP INTEGER :: grid_area_varid, grid_imask_varid -!/SCRIP INTEGER :: grid_dims_varid -!/SCRIP REAL (SCRIP_R8) :: CONV_DX,CONV_DY,OFFSET - -!/ ------------------------------------------------------------------- / -!/ 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. -!/FLD1 INTEGER :: TAILTYPE -!/FLD1 REAL :: TAILLEV, TAILT1, TAILT2 -!/FLD2 INTEGER :: TAILTYPE -!/FLD2 REAL :: TAILLEV, TAILT1, TAILT2 -!/FLX3 INTEGER :: CTYPE -!/FLX3 REAL :: CDMAX -!/FLX4 REAL :: CDFAC -!/ST2 REAL :: ZWND, SWELLF, STABSH, STABOF, & -!/ST2 CNEG, CPOS, FNEG, FPOS -!/ST2 REAL :: SDSA0, SDSA1, SDSA2, & -!/ST2 SDSB0, SDSB1, SDSB2, SDSB3 -!/ST3 REAL :: ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP,& -!/ST3 ZALP, SWELLF, FXPM3, FXFM3, & -!/ST3 WNMEANPTAIL, WNMEANP, STXFTF, STXFTWN -!/ST3 REAL :: STXFTFTAIL, SDSC1, & -!/ST3 SDSDELTA1, SDSDELTA2 -! -!/ST4 INTEGER :: SWELLFPAR, SDSISO, SDSBRFDF -!/ST4 REAL :: SDSBCHOICE -!/ST4 REAL :: ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP,& -!/ST4 ZALP, Z0RAT, TAUWSHELTER, SWELLF, & -!/ST4 SWELLF2,SWELLF3,SWELLF4, SWELLF5, & -!/ST4 SWELLF6, SWELLF7, FXPM3, FXFM3, & -!/ST4 WNMEANPTAIL, WNMEANP, STXFTF, STXFTFTAIL, & -!/ST4 STXFTWN, SINBR, FXFMAGE, & -!/ST4 SDSC2, SDSCUM, SDSC4, SDSC5, SDSC6, WHITECAPWIDTH, WHITECAPDUR, & -!/ST4 SDSSTRAIN, SDSSTRAINA, SDSSTRAIN2, & -!/ST4 SDSBR, SDSP, SDSBT, SDS4A, SDKOF, & -!/ST4 SDSCOS, SDSDTH, SDSBCK, SDSABK, & -!/ST4 SDSPBK, SDSBINT, SDSHCK, & -!/ST4 SDSBRF1, & -!/ST4 SDSBM0, SDSBM1, SDSBM2, SDSBM3, & -!/ST4 SDSBM4, SDSFACMTF, SDSCUMP, SDSNUW, & -!/ST4 SDSL, SDSMWD, SDSMWPOW, SPMSS, SDSNMTF -! -!/ST6 REAL :: SINA0, SINWS, SINFC, & -!/ST6 SDSA1, SDSA2, SWLB1 -!/ST6 INTEGER :: SDSP1, SDSP2 -!/ST6 LOGICAL :: SDSET, CSTB1 -! -!/NL1 REAL :: LAMBDA, KDCONV, KDMIN, & -!/NL1 SNLCS1, SNLCS2, SNLCS3 -!/NL2 INTEGER :: IQTYPE, NDEPTH -!/NL2 REAL :: TAILNL -!/NL3 INTEGER :: NQDEF -!/NL3 REAL :: MSC, NSC, KDFD, KDFS -!/NL4 INTEGER :: INDTSA, ALTLP -!/DB1 REAL :: BJALFA, BJGAM -!/DB1 LOGICAL :: BJFLAG -!/PR2 REAL :: DTIME -! -!/SMC REAL :: DTIME, RFMAXD, SYMR, YJ0R -!/SMC LOGICAL :: UNO3, AVERG, SEAWND -! -!/PR3 REAL :: WDTHCG, WDTHTH - LOGICAL :: JGS_TERMINATE_MAXITER = .TRUE. - LOGICAL :: JGS_TERMINATE_DIFFERENCE = .TRUE. - LOGICAL :: JGS_TERMINATE_NORM = .TRUE. - LOGICAL :: JGS_LIMITER = .FALSE. - LOGICAL :: JGS_BLOCK_GAUSS_SEIDEL = .TRUE. - LOGICAL :: JGS_USE_JACOBI = .TRUE. - LOGICAL :: JGS_SOURCE_NONLINEAR = .FALSE. - LOGICAL :: UGOBCAUTO = .FALSE. - LOGICAL :: UGBCCFL = .FALSE. - LOGICAL :: EXPFSN = .TRUE. - LOGICAL :: EXPFSPSI = .FALSE. - LOGICAL :: EXPFSFCT = .FALSE. - LOGICAL :: IMPFSN = .FALSE. - LOGICAL :: EXPTOTAL = .FALSE. - LOGICAL :: IMPTOTAL = .FALSE. - LOGICAL :: IMPREFRACTION = .FALSE. - LOGICAL :: IMPFREQSHIFT = .FALSE. - LOGICAL :: IMPSOURCE = .FALSE. - LOGICAL :: SETUP_APPLY_WLV = .FALSE. - INTEGER :: JGS_MAXITER=100 - INTEGER :: nbSel - INTEGER :: UNSTSCHEMES(4) - INTEGER :: UNSTSCHEME - INTEGER :: JGS_NLEVEL = 0 - REAL*8 :: JGS_PMIN = 0. - REAL*8 :: JGS_DIFF_THR = 1.E-10 - REAL*8 :: JGS_NORM_THR = 1.E-20 - REAL*8 :: SOLVERTHR_SETUP = 1.E-20 - REAL*8 :: CRIT_DEP_SETUP = 0. -! - CHARACTER :: UGOBCFILE*60 - REAL :: UGOBCDEPTH - LOGICAL :: UGOBCOK - -!/RTD REAL :: PLAT, PLON -!/RTD LOGICAL :: UNROT -!/RTD ! Poles of the output nested grids. May be a mix of rotated and standard -!/RTD REAL, DIMENSION(9) :: BPLAT, BPLON -! -!/FLD1 NAMELIST /FLD1/ TAILTYPE, TAILLEV, TAILT1, TAILT2 -!/FLD2 NAMELIST /FLD2/ TAILTYPE, TAILLEV, TAILT1, TAILT2 -!/FLX3 NAMELIST /FLX3/ CDMAX, CTYPE -!/FLX4 NAMELIST /FLX4/ CDFAC -!/IC2 NAMELIST /SIC2/ IC2DISPER, IC2TURB, IC2ROUGH, IC2REYNOLDS, & -!/IC2 IC2SMOOTH, IC2VISC, IC2TURBS, IC2DMAX -!/IC3 NAMELIST /SIC3/ IC3MAXTHK, IC2TURB, IC2ROUGH, IC2REYNOLDS, & -!/IC3 IC2SMOOTH, IC2VISC, IC2TURBS, IC3MAXCNC, & -!/IC3 IC3CHENG, USECGICE, IC3HILIM, IC3KILIM, & -!/IC3 IC3VISC, IC3ELAS, IC3DENS, IC3HICE -!/IC4 NAMELIST /SIC4/ IC4METHOD, IC4KI, IC4FC -!/IC5 NAMELIST /SIC5/ IC5MINIG, IC5MINWT, IC5MAXKRATIO, & -!/IC5 IC5MAXKI, IC5MINHW, IC5MAXITER, IC5RKICK,& -!/IC5 IC5KFILTER -!/IG1 NAMELIST /SIG1/ IGMETHOD, IGADDOUTP, IGSOURCE, IGBCOVERWRITE, & -!/IG1 IGMAXFREQ, IGSTERMS, IGSWELLMAX, & -!/IG1 IGSOURCEATBP, IGKDMIN, IGFIXEDDEPTH, IGEMPIRICAL -!/LN1 NAMELIST /SLN1/ CLIN, RFPM, RFHF -!/ST1 NAMELIST /SIN1/ CINP -!/ST2 NAMELIST /SIN2/ ZWND, SWELLF, STABSH, STABOF, CNEG, CPOS, FNEG -!/ST3 NAMELIST /SIN3/ ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & -!/ST3 SWELLF -!/ST4 NAMELIST /SIN4/ ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & -!/ST4 TAUWSHELTER, SWELLFPAR, SWELLF, & -!/ST4 SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, & -!/ST4 SWELLF7, Z0RAT, SINBR -!/NL1 NAMELIST /SNL1/ LAMBDA, NLPROP, KDCONV, KDMIN, & -!/NL1 SNLCS1, SNLCS2, SNLCS3 -!/NL2 NAMELIST /SNL2/ IQTYPE, TAILNL, NDEPTH -!/NL2 NAMELIST /ANL2/ DEPTHS -!/NL3 NAMELIST /SNL3/ NQDEF, MSC, NSC, KDFD, KDFS -!/NL3 NAMELIST /ANL3/ QPARMS -!/NL4 NAMELIST /SNL4/ INDTSA, ALTLP -!/NLS NAMELIST /SNLS/ A34, FHFC, DNM, FC1, FC2, FC3 -!/ST1 NAMELIST /SDS1/ CDIS, APM -!/ST2 NAMELIST /SDS2/ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN -!/ST3 NAMELIST /SDS3/ SDSC1, WNMEANP, FXPM3, FXFM3, SDSDELTA1, & -!/ST3 SDSDELTA2 -!/ST4 NAMELIST /SDS4/ SDSBCHOICE, WNMEANP, WNMEANPTAIL, FXPM3, FXFM3, & -!/ST4 FXFMAGE, SDSC2, SDSCUM, SDSSTRAIN, SDSSTRAINA, & -!/ST4 SDSSTRAIN2, SDSC4, SDSFACMTF, SDSNMTF,SDSCUMP, & -!/ST4 SDSC5, SDSC6, SDSBR, SDSBT, SDSP, SDSISO, & -!/ST4 SDSBCK, SDSABK, SDSPBK, SDSBINT, SDSHCK, & -!/ST4 SDSDTH, SDSCOS, SDSBRF1, SDSBRFDF, SDSNUW, & -!/ST4 SDSBM0, SDSBM1, SDSBM2, SDSBM3, SDSBM4, & -!/ST4 WHITECAPWIDTH, WHITECAPDUR, SDSMWD, SDSMWPOW, SDKOF - -!/ST6 NAMELIST /SIN6/ SINA0, SINWS, SINFC -!/ST6 NAMELIST /SDS6/ SDSET, SDSA1, SDSA2, SDSP1, SDSP2 -!/ST6 NAMELIST /SWL6/ SWLB1, CSTB1 -!/BT1 NAMELIST /SBT1/ GAMMA -!/BT4 NAMELIST /SBT4/ SEDMAPD50, SED_D50_UNIFORM, RIPFAC1, & -!/BT4 RIPFAC2, RIPFAC3, RIPFAC4, SIGDEPTH, & -!/BT4 BOTROUGHMIN, BOTROUGHFAC -!/DB1 NAMELIST /SDB1/ BJALFA, BJGAM, BJFLAG -!/UOST NAMELIST /UOST/ UOSTFILELOCAL, UOSTFILESHADOW, & -!/UOST UOSTFACTORLOCAL, UOSTFACTORSHADOW -! -!/PR1 NAMELIST /PRO1/ CFLTM -!/PR2 NAMELIST /PRO2/ CFLTM, DTIME, LATMIN -!/SMC NAMELIST /PSMC/ CFLTM, DTIME, LATMIN, RFMAXD, UNO3, AVERG, & -!/SMC LvSMC, ISHFT, JEQT, NBISMC, SEAWND -! -!/PR3 NAMELIST /PRO3/ CFLTM, WDTHCG, WDTHTH - 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_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 -!/IS1 NAMELIST /SIS1/ ISC1, ISC2 -!/IS2 NAMELIST /SIS2/ ISC1, IS2C2, IS2C3, IS2BACKSCAT, IS2ISOSCAT, IS2BREAK, & -!/IS2 IS2DISP, IS2FRAGILITY, IS2CONC, IS2DMIN, & -!/IS2 IS2DAMP, IS2DUPDATE, IS2CREEPB, IS2CREEPC, & -!/IS2 IS2CREEPD, IS2CREEPN, IS2BREAKE, IS2BREAKF, & -!/IS2 IS2WIM1, IS2FLEXSTR, IS2ANDISB, IS2ANDISE, IS2ANDISD, & -!/IS2 IS2ANDISN -!/REF1 NAMELIST /REF1/ REFCOAST, REFFREQ, REFMAP, REFMAPD, & -!/REF1 REFSUBGRID, REFICEBERG, & -!/REF1 REFCOSP_STRAIGHT, REFSLOPE, REFRMAX, & -!/REF1 REFFREQPOW, REFUNSTSOURCE -!/ -!/RTD NAMELIST /ROTD/ PLAT, PLON, UNROT -!/RTD! Poles of destination grids for boundary conditions output -!/RTD NAMELIST /ROTB/ BPLAT, BPLON -!/ -!/ ------------------------------------------------------------------- / -!/ - DATA YESXNO / 'YES/--' , '---/NO' / -!/O0 FLNMLO = .TRUE. -!/STAB2 FLSTB2 = .TRUE. -! -!/SMC !!Li Switch off regular grid lines by setting the logical -!/SMC RGLGRD = .FALSE. -! -!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! 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. -! -!/DEBUGGRID IAPROC = 1 - 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 ) -! -!/S CALL STRACE (IENT, 'W3GRID') - 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 -!/SEC1 IF (DTMAX.LT.1.) THEN -!/SEC1 NITERSEC1=CEILING(1./DTMAX) -!/SEC1 WRITE (NDSO,913) NITERSEC1 -!/SEC1 ELSE -!/SEC1 NITERSEC1=1 -!/SEC1 END IF - - 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 - NRXX = 0 -! - FLLIN = .TRUE. - FLINDS = .TRUE. - FLNL = .TRUE. - FLBT = .TRUE. - FLIC = .FALSE. - FLIS = .FALSE. - FLDB = .TRUE. - FLTR = .TRUE. - FLBS = .TRUE. - FLREF = .FALSE. - FLXX = .TRUE. -! -!/LN0 NRLIN = NRLIN + 1 -!/LN0 FLLIN = .FALSE. -!/SEED NRLIN = NRLIN + 1 -!/LN1 NRLIN = NRLIN + 1 -!/LNX NRLIN = NRLIN + 1 -! -!/ST0 NRSRCE = NRSRCE + 1 -!/ST0 FLINDS = .FALSE. -!/ST1 NRSRCE = NRSRCE + 1 -!/ST2 NRSRCE = NRSRCE + 1 -!/ST2 FLTC96 = .TRUE. -!/ST3 NRSRCE = NRSRCE + 1 -!/ST4 NRSRCE = NRSRCE + 1 -!/ST4 FLST4 = .TRUE. -!/ST6 NRSRCE = NRSRCE + 1 -!/ST6 FLST6 = .TRUE. -!/STX NRSRCE = NRSRCE + 1 -! -!/NL0 NRNL = NRNL + 1 -!/NL0 FLNL = .FALSE. -!/NL1 NRNL = NRNL + 1 -!/NL2 NRNL = NRNL + 1 -!/NL3 NRNL = NRNL + 1 -!/NL4 NRNL = NRNL + 1 -!/NLX NRNL = NRNL + 1 -! -!/BT0 NRBT = NRBT + 1 -!/BT0 FLBT = .FALSE. -!/BT1 NRBT = NRBT + 1 -!/BT4 NRBT = NRBT + 1 -!/BT8 NRBT = NRBT + 1 -!/BT9 NRBT = NRBT + 1 -!/BTX NRBT = NRBT + 1 -! -!/IC1 NRIC = NRIC + 1 -!/IC1 FLIC = .TRUE. -!/IC2 NRIC = NRIC + 1 -!/IC2 FLIC = .TRUE. -!/IC3 NRIC = NRIC + 1 -!/IC3 FLIC = .TRUE. -!/IC4 NRIC = NRIC + 1 -!/IC4 FLIC = .TRUE. -!/IC5 NRIC = NRIC + 1 -!/IC5 FLIC = .TRUE. -! -!/IS1 NRIS = NRIS + 1 -!/IS1 FLIS = .TRUE. -!/IS2 NRIS = NRIS + 1 -!/IS2 FLIS = .TRUE. -! -!/DB0 NRDB = NRDB + 1 -!/DB0 FLDB = .FALSE. -!/DB1 NRDB = NRDB + 1 -!/DBX NRDB = NRDB + 1 -! -!/TR0 NRTR = NRTR + 1 -!/TR0 FLTR = .FALSE. -!/TR1 NRTR = NRTR + 1 -!/TRX NRTR = NRTR + 1 -! -!/BS0 NRBS = NRBS + 1 -!/BS0 FLBS = .FALSE. -!/BS1 NRBS = NRBS + 1 -!/BSX NRBS = NRBS + 1 -! -!/REF1 FLREF = .TRUE. -! -!/XX0 NRXX = NRXX + 1 -!/XX0 FLXX = .FALSE. -!/XXX NRXX = NRXX + 1 -! - 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.FLXX .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. FLXX .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 ( NRXX .NE. 1 ) THEN - WRITE (NDSE,1029) NRXX - CALL EXTCDE ( 18 ) - 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 -! -!/FLX1 WRITE (NDSO,810) -!/FLX2 WRITE (NDSO,810) -! -!/FLX2 CINXSI = 0.20 -!/FLX2 NITTIN = 3 -!/FLX3 CINXSI = 0.20 -!/FLX3 NITTIN = 3 -!/FLX3 CDMAX = 2.5E-3 -!/FLX3 CTYPE = 0 -! -!/FLX3 CALL READNL ( NDSS, 'FLX3', STATUS ) -!/FLX3 WRITE (NDSO,810) STATUS -!/FLX3 CDMAX = MAX ( 0. , CDMAX ) -!/FLX3 IF ( CTYPE .EQ. 1 ) THEN -!/FLX3 TYPEID = 'hyperbolic tangent' -!/FLX3 ELSE -!/FLX3 CTYPE = 0 -!/FLX3 TYPEID = 'discontinuous ' -!/FLX3 END IF -!/FLX3 WRITE (NDSO,811) CDMAX*1.E3, TYPEID -!/FLX3 CD_MAX = CDMAX -!/FLX3 CAP_ID = CTYPE -! -!/FLX4 CDFAC = 1.0 -!/FLX4 CALL READNL ( NDSS, 'FLX4', STATUS ) -!/FLX4 WRITE (NDSO,810) STATUS -!/FLX4 WRITE (NDSO,811) CDFAC -!/FLX4 FLX4A0 = CDFAC -! -! 6.d.2 Linear input -! -!/LN0 WRITE (NDSO,820) -!/SEED WRITE (NDSO,820) -!/LNX WRITE (NDSO,820) -! -!/LN1 CLIN = 80. -!/LN1 RFPM = 1. -!/LN1 RFHF = 0.5 -! -!/LN1 CALL READNL ( NDSS, 'SLN1', STATUS ) -!/LN1 WRITE (NDSO,820) STATUS -!/LN1 CLIN = MAX (0.,CLIN) -!/LN1 RFPM = MAX (0.,RFPM) -!/LN1 RFHF = MAX(0.,MIN (1.,RFHF)) -!/LN1 WRITE (NDSO,821) CLIN, RFPM, RFHF -!/LN1 SLNC1 = CLIN * (DAIR/DWAT)**2 / GRAV**2 -!/LN1 FSPM = RFPM -!/LN1 FSHF = RFHF -! -! 6.d.3 Exponential input -! -!/ST0 WRITE (NDSO,920) -!/STX WRITE (NDSO,920) -! -!/ST1 CINP = 0.25 -!/ST2 ZWND = 10. -!/ST2 SWELLF = 0.100 -!/ST2 STABSH = 1.38 -!/ST2 STABOF = -0.01 -!/ST2 CNEG = -0.1 -!/ST2 CPOS = 0.1 -!/ST2 FNEG = 150. -! -!/ST3 ZWND = 10. -!/ST3 ALPHA0 = 0.0095 -!/ST3 Z0MAX = 0.0 -!/ST3 BETAMAX = 1.2 ! default WAM4 / WAM4 + is 1.2 with rhow=1000 -!/ST3 SINTHP = 2. -!/ST3 SWELLF = 0. -!/ST3 ZALP = 0.0110 -! -!/ST4 ZWND = 10. -!/ST4 ALPHA0 = 0.0095 -!/ST4 Z0MAX = 0.0 -!/ST4 Z0RAT = 0.04 -!/ST4 BETAMAX = 1.43 -!/ST4 SINTHP = 2. -!/ST4 SWELLF = 0.66 -!/ST4 SWELLFPAR = 1 -!/ST4 SWELLF2 = -0.018 -!/ST4 SWELLF3 = 0.022 -!/ST4 SWELLF4 = 1.5E5 -!/ST4 SWELLF5 = 1.2 -!/ST4 SWELLF6 = 0. -!/ST4 SWELLF7 = 360000. -!/ST4 TAUWSHELTER = 0.3 -!/ST4 ZALP = 0.006 -!/ST4 SINBR = 0. -! -!/ST6 SINA0 = 0.09 -!/ST6 SINWS = 32.0 -!/ST6 SINFC = 6.0 -! -!/ST1 CALL READNL ( NDSS, 'SIN1', STATUS ) -!/ST1 WRITE (NDSO,920) STATUS -!/ST1 WRITE (NDSO,921) CINP -!/ST1 SINC1 = 28. * CINP * DAIR / DWAT -! -!/ST2 CALL READNL ( NDSS, 'SIN2', STATUS ) -!/ST2 WRITE (NDSO,920) STATUS -!/ST2 IF ( SWELLF.LT.0. .OR. SWELLF.GT.1. ) SWELLF = 1. -!/ST2 WRITE (NDSO,921) ZWND, SWELLF -!/ST2 IF ( STABSH .LT. 0.1 ) STABSH = 1. -!/ST2 IF ( CNEG*CPOS .EQ. 0. ) THEN -!/ST2 CNEG = 0. -!/ST2 CPOS = 0. -!/ST2 FNEG = 0. -!/ST2 FPOS = 0. -!/ST2 ELSE -!/ST2 CPOS = - ABS(CPOS) * ABS(CNEG)/CNEG -!/ST2 FNEG = - MAX(1.,ABS(FNEG)) -!/ST2 FPOS = FNEG * CNEG/CPOS -!/ST2 END IF -!/STAB2 WRITE (NDSO,1921) STABSH, STABOF, CNEG, CPOS, FNEG, FPOS -!/ST2 ZWIND = ZWND -!/ST2 FSWELL = SWELLF -!/ST2 SHSTAB = STABSH -!/ST2 OFSTAB = STABOF -!/ST2 CCNG = CNEG -!/ST2 CCPS = CPOS -!/ST2 FFNG = FNEG -!/ST2 FFPS = FPOS -! -!/ST3 CALL READNL ( NDSS, 'SIN3', STATUS ) -!/ST3 WRITE (NDSO,920) STATUS -!/ST3 WRITE (NDSO,921) ALPHA0, BETAMAX, SINTHP, Z0MAX, ZALP, ZWND, & -!/ST3 SWELLF -!/ST3 ZZWND = ZWND -!/ST3 AALPHA = ALPHA0 -!/ST3 BBETA = BETAMAX -!/ST3 SSINTHP = SINTHP -!/ST3 ZZ0MAX = Z0MAX -!/ST3 ZZALP = ZALP -!/ST3 SSWELLF(1) = SWELLF -! -!/ST4 CALL READNL ( NDSS, 'SIN4', STATUS ) -!/ST4 WRITE (NDSO,920) STATUS -!/ST4 WRITE (NDSO,921) ALPHA0, BETAMAX, SINTHP, Z0MAX, ZALP, ZWND, TAUWSHELTER, & -!/ST4 SWELLFPAR, SWELLF, SWELLF2, SWELLF3, SWELLF4, SWELLF5, & -!/ST4 SWELLF6, SWELLF7, Z0RAT -!/ST4 ZZWND = ZWND -!/ST4 AALPHA = ALPHA0 -!/ST4 BBETA = BETAMAX -!/ST4 SSINBR = SINBR -!/ST4 SSINTHP = SINTHP -!/ST4 ZZ0MAX = Z0MAX -!/ST4 ZZ0RAT = Z0RAT -!/ST4 ZZALP = ZALP -!/ST4 TTAUWSHELTER = TAUWSHELTER -!/ST4 SSWELLF(1) = SWELLF -!/ST4 SSWELLF(2) = SWELLF2 -!/ST4 SSWELLF(3) = SWELLF3 -!/ST4 SSWELLF(4) = SWELLF4 -!/ST4 SSWELLF(5) = SWELLF5 -!/ST4 SSWELLF(6) = SWELLF6 -!/ST4 SSWELLF(7) = SWELLF7 -!/ST4 SSWELLFPAR = SWELLFPAR -! -!/ST6 CALL READNL ( NDSS, 'SIN6', STATUS ) -!/ST6 WRITE (NDSO,920) STATUS -!/ST6 SIN6A0 = SINA0 -!/ST6 SIN6WS = SINWS -!/ST6 SIN6FC = SINFC -!/ST6 J = 1 -!/ST6 IF ( SIN6A0.LE.0. ) J = 2 -!/ST6 WRITE (NDSO,921) YESXNO(J), SIN6A0, SIN6WS, SIN6FC -! -! 6.e Define Snl. -! -!/NL0 WRITE (NDSO,922) -! -!/NL1 LAMBDA = 0.25 -!/NL1 IF ( FLTC96 ) THEN -!/NL1 NLPROP = 1.00E7 -!/NL1 ELSE IF ( FLST4 ) THEN -!/NL1 NLPROP = 2.50E7 -!/NL1 ELSE IF ( FLST6 ) THEN -!/NL1 NLPROP = 3.00E7 -!/NL1 ELSE -!/NL1 NLPROP = 2.78E7 -!/NL1 END IF -! -!/NL1 KDCONV = 0.75 -!/NL1 KDMIN = 0.50 -!/NL1 SNLCS1 = 5.5 -!/NL1 SNLCS2 = 0.833 -!/NL1 SNLCS3 = -1.25 -! -!/NL1 CALL READNL ( NDSS, 'SNL1', STATUS ) -!/NL1 WRITE (NDSO,922) STATUS -!/NL1 WRITE (NDSO,923) LAMBDA, NLPROP, KDCONV, KDMIN, & -!/NL1 SNLCS1, SNLCS2, SNLCS3 -!/NL1 SNLC1 = NLPROP / GRAV**4 -!/NL1 LAM = LAMBDA -!/NL1 KDCON = KDCONV -!/NL1 KDMN = KDMIN -!/NL1 SNLS1 = SNLCS1 -!/NL1 SNLS2 = SNLCS2 -!/NL1 SNLS3 = SNLCS3 -! -!/ST0 FACHF = 5. -!/ST1 FACHF = 4.5 -!/ST2 FACHF = 5. -!/ST3 FACHF = 5. -!/ST4 FACHF = 5. -!/ST6 FACHF = 5. -!/STX FACHF = 5. -!/NL2 IQTYPE = 2 -!/NL2 TAILNL = -FACHF -!/NL2 NDEPTH = 0 -!/NL3 NQDEF = 0 -!/NL3 MSC = 0. -!/NL3 NSC = -3.5 -!/NL3 KDFD = 0.20 -!/NL3 KDFS = 5.00 -!/NL4 INDTSA = 1 -!/NL4 ALTLP = 2 -!/NLS A34 = 0.05 -!/NLS FHFC = 1.E10 -!/NLS DNM = 0.25 -!/NLS FC1 = 1.25 -!/NLS FC2 = 1.50 -!/NLS FC3 = 6.00 -! -!/NL2 CALL READNL ( NDSS, 'SNL2', STATUS ) -!/NL2 WRITE (NDSO,922) STATUS -!/NL2 TAILNL = MIN ( MAX ( TAILNL, -5. ) , -4. ) -!/NL2 IF ( IQTYPE .EQ. 3 ) THEN -!/NL2 WRITE (NDSO,923) 'Shallow water', TAILNL -!/NL2 ELSE IF ( IQTYPE .EQ. 2 ) THEN -!/NL2 WRITE (NDSO,923) 'Deep water with scaling', TAILNL -!/NL2 ELSE -!/NL2 WRITE (NDSO,923) 'Deep water', TAILNL -!/NL2 IQTYPE = 1 -!/NL2 END IF -! -!/NL2 IF ( IQTYPE .NE. 3 ) THEN -!/NL2 NDEPTH = 1 -!/NL2 ALLOCATE ( MPARS(1)%SNLPS%DPTHNL(NDEPTH) ) -!/NL2 DPTHNL => MPARS(1)%SNLPS%DPTHNL -!/NL2 DPTHNL = 1000. -!/NL2 ELSE -!/NL2 IF ( NDEPTH .EQ. 0 ) NDEPTH = 7 -!/NL2 NDEPTH = MAX ( 1 , NDEPTH ) -!/NL2 ALLOCATE ( MPARS(1)%SNLPS%DPTHNL(NDEPTH) ) -!/NL2 DPTHNL => MPARS(1)%SNLPS%DPTHNL -!/NL2 DPTHNL(1) = 640. -!/NL2 DPTHNL(NDEPTH) = 10. -!/NL2 IF ( NDEPTH .GT. 1 ) THEN -!/NL2 DPTFAC = (DPTHNL(NDEPTH)/DPTHNL(1))**(1./(REAL(NDEPTH-1))) -!/NL2 DO IDEPTH=2, NDEPTH-1 -!/NL2 DPTHNL(IDEPTH) = DPTFAC*DPTHNL(IDEPTH-1) -!/NL2 END DO -!/NL2 END IF -!/NL2 CALL READNL ( NDSS, 'ANL2', STATUS ) -!/NL2 WRITE (NDSO,1923) NDEPTH, DPTHNL(1:MIN(5,NDEPTH)) -!/NL2 IF (NDEPTH .GT. 5 )WRITE (NDSO,2923) DPTHNL(6:NDEPTH) -!/NL2 END IF -!/NL2 WRITE (NDST,*) -!/NL2 IQTPE = IQTYPE -!/NL2 NDPTHS = NDEPTH -!/NL2 NLTAIL = TAILNL -! -!/NL3 CALL READNL ( NDSS, 'SNL3', STATUS ) -!/NL3 WRITE (NDSO,922) STATUS -!!/NL3 MSC = MAX ( 0. , MIN ( 8. , MSC ) ) ! Disabled HLT ca. 2009 -!/NL3 KDFD = MAX ( 0.001 , MIN ( 10. , KDFD ) ) -!/NL3 KDFS = MAX ( KDFD , MIN ( 10. , KDFS ) ) -!/NL3 WRITE (NDSO,923) MSC, NSC, KDFD, KDFS -! -!/NL3 NQDEF = MAX ( 0 , NQDEF ) -!/NL3 IF ( NQDEF .EQ. 0 ) THEN -!/NL3 NQDEF = 1 -!/NL3 QPARMS(1:5) = [ 0.25 , 0.00, -1., 1.E7, 0.00 ] -!/NL3 ELSE -!/NL3 DO J=1, NQDEF -!/NL3 QPARMS((J-1)*5+1:J*5) = [ 0.25, 0.00, -1., 1.E7, 1.E6 ] -!/NL3 END DO -!/NL3 CALL READNL ( NDSS, 'ANL3', STATUS ) -!/NL3 END IF -!/NL3 DO J=1, NQDEF -!/NL3 QPARMS((J-1)*5+1) = MAX(0.,MIN (LAMMAX,QPARMS((J-1)*5+1))) -!/NL3 QPARMS((J-1)*5+2) = MAX(0.,MIN (QPARMS((J-1)*5+1), & -!/NL3 QPARMS((J-1)*5+2))) -!/NL3 QPARMS((J-1)*5+3) = MIN (DELTHM,QPARMS((J-1)*5+3)) -!/NL3 QPARMS((J-1)*5+4) = MAX (0.,QPARMS((J-1)*5+4)) -!/NL3 QPARMS((J-1)*5+5) = MAX (0.,QPARMS((J-1)*5+5)) -!/NL3 END DO -!/NL3 WRITE (NDSO,1923) NQDEF -!/NL3 WRITE (NDSO,2923) QPARMS(1:NQDEF*5) -!/NL3 WRITE (NDSO,*) -!/NL3 SNLNQ = NQDEF -!/NL3 SNLMSC = MSC -!/NL3 SNLNSC = NSC -!/NL3 SNLSFD = SQRT ( KDFD * TANH(KDFD) ) -!/NL3 SNLSFS = SQRT ( KDFS * TANH(KDFS) ) -!/NL3 ALLOCATE ( MPARS(1)%SNLPS%SNLL(NQDEF), & -!/NL3 MPARS(1)%SNLPS%SNLM(NQDEF), & -!/NL3 MPARS(1)%SNLPS%SNLT(NQDEF), & -!/NL3 MPARS(1)%SNLPS%SNLCD(NQDEF), & -!/NL3 MPARS(1)%SNLPS%SNLCS(NQDEF) ) -!/NL3 SNLL => MPARS(1)%SNLPS%SNLL -!/NL3 SNLL = QPARMS(1:NQDEF*5:5) -!/NL3 SNLM => MPARS(1)%SNLPS%SNLM -!/NL3 SNLM = QPARMS(2:NQDEF*5:5) -!/NL3 SNLT => MPARS(1)%SNLPS%SNLT -!/NL3 SNLT = QPARMS(3:NQDEF*5:5) -!/NL3 SNLCD => MPARS(1)%SNLPS%SNLCD -!/NL3 SNLCD = QPARMS(4:NQDEF*5:5) -!/NL3 SNLCS => MPARS(1)%SNLPS%SNLCS -!/NL3 SNLCS = QPARMS(5:NQDEF*5:5) -! -!/NL4 CALL READNL ( NDSS, 'SNL4', STATUS ) -!/NL4 WRITE (NDSO,922) STATUS -!/NL4 WRITE (NDSO,923) INDTSA, ALTLP -!/NL4 ITSA = INDTSA -!/NL4 IALT = ALTLP -! -!/NLS CALL READNL ( NDSS, 'SNLS', STATUS ) -!/NLS WRITE (NDSO,9922) STATUS -!/NLS A34 = MAX ( 0. , MIN ( A34 , ABMAX ) ) -!/NLS FHFC = MAX ( 0. , FHFC ) -!/NLS DNM = MAX ( 0., DNM ) -!/NLS WRITE (NDSO,9923) A34, (XFR-1.)*A34, FHFC, DNM, FC1, FC2, FC3 -!/NLS CNLSA = A34 -!/NLS CNLSC = FHFC -!/NLS CNLSFM = DNM -!/NLS CNLSC1 = FC1 -!/NLS CNLSC2 = FC2 -!/NLS CNLSC3 = FC3 -! -! 6.f Define Sds. -! -!/ST0 WRITE (NDSO,924) -!/STX WRITE (NDSO,924) -! -!/ST1 CDIS = -2.36E-5 -!/ST1 APM = 3.02E-3 -!/ST2 SDSA0 = 4.8 -!/ST2 SDSA1 = 1.7e-4 -!/ST2 SDSA2 = 2.0 -!/ST2 SDSB0 = 0.3e-3 -!/ST2 SDSB1 = 0.47 -!/ST2 PHIMIN = 0.003 -!/ST2 SDSALN = 0.002 -!/ST2 FPIMIN = 0.009 -!/ST3 SDSC1 = -2.1 !! This is Bidlot et al. 2005, Otherwise WAM4 uses -4.5 -!/ST3 WNMEANP = 0.5 !! This is Bidlot et al. 2005, Otherwise WAM4 uses -0.5 -!/ST3 FXFM3 = 2.5 -!/ST3 FXPM3 = 4. -!/ST3 WNMEANPTAIL = 0.5 -!/ST3 SDSDELTA1 = 0.4 !! This is Bidlot et al. 2005, Otherwise WAM4 uses 0.5 -!/ST3 SDSDELTA2 = 0.6 !! This is Bidlot et al. 2005, Otherwise WAM4 uses 0.5 -! -!/ST4 WNMEANP = 0.5 ! taken from Bidlot et al. 2005 -!/ST4 FXFM3 = 2.5 -!/ST4 FXFMAGE = 0. -!/ST4 FXPM3 = 4. -!/ST4 WNMEANPTAIL = -0.5 -!/ST4 SDSBCHOICE =1 ! 1: Ardhuin et al., 2: Filipot & Ardhuin, 3: Romero -!/ST4 SDSC2 = -2.2E-5 ! -3.8 for Romero -!/ST4 SDSCUM = -0.40344 -!/ST4 SDSC4 = 1. -!/ST4 SDSC5 = 0. -!/ST4 SDSNUW = 0. -!/ST4 SDSC6 = 0.3 -!/ST4 SDSBR = 0.90E-3 ! 0.005 for Romero -!/ST4 SDSBRFDF = 0 -!/ST4 SDSBRF1 = 0.5 -!/ST4 SDSP = 2. ! this is now fixed in w3sds4, should be cleaned up -!/ST4 SDSDTH = 80. -!/ST4 SDSCOS = 2. -!/ST4 SDSISO = 2 -!/ST4 SDSBM0 = 1. -!/ST4 SDSBM1 = 0. -!/ST4 SDSBM2 = 0. -!/ST4 SDSBM3 = 0. -!/ST4 SDSBM4 = 0. -!/ST4 SDSBCK = 0. -!/ST4 SDSABK = 1.5 -!/ST4 SDSPBK = 4. -!/ST4 SDSBINT = 0.3 -!/ST4 SDSHCK = 1.5 -!/ST4 WHITECAPWIDTH = 0.3 -!/ST4 SDSSTRAIN = 0. -!/ST4 SDSFACMTF = 400 ! MTF factor for Lambda , Romero (2019) -!/ST4 SDSSTRAINA = 15. -!/ST4 SDSSTRAIN2 = 0. -!/ST4 WHITECAPDUR = 0.56 ! breaking duration factor -!/ST4! b (strength of breaking) -!/ST4 SDSBT = 1.100E-3 ! B_T (sturation threshold for dissipation rate b) -!/ST4! Lambda parameters -!/ST4 SDSL = 3.5000e-05 ! L scaling -!/ST4! MTF -!/ST4 SPMSS = 0.5 ! cmss^SPMSS -!/ST4 SDSNMTF = 1.5 ! MTF power -!/ST4 SDSCUMP = 2. -!/ST4! MW -!/ST4 SDSMWD = .9 ! new AFo -!/ST4 SDSMWPOW = 1. ! (k )^pow -!/ST4 SDKOF = 3. ! ko factor such that ko= g (SDKOF/(28 us))^2 -! -!/ST6 SDSET = .TRUE. -!/ST6 SDSA1 = 4.75E-06 -!/ST6 SDSP1 = 4 -!/ST6 SDSA2 = 7.00E-05 -!/ST6 SDSP2 = 4 -!/ST6 CSTB1 = .FALSE. -!/ST6 SWLB1 = 0.41E-02 -! -!/ST1 CALL READNL ( NDSS, 'SDS1', STATUS ) -!/ST1 WRITE (NDSO,924) STATUS -!/ST1 WRITE (NDSO,925) CDIS, APM -!/ST1 SDSC1 = TPI * CDIS / APM**2 -! -!/ST2 CALL READNL ( NDSS, 'SDS2', STATUS ) -!/ST2 WRITE (NDSO,924) STATUS -!/ST2 IF ( PHIMIN .LE. 0. ) THEN -!/ST2 SDSB2 = 0. -!/ST2 SDSB3 = 0. -!/ST2 PHIMIN = SDSB0 + SDSB1*FPIMIN -!/ST2 ELSE -!/ST2 FPIA = ( PHIMIN - SDSB0 ) / SDSB1 -!/ST2 IF ( FPIA .LT. FPIMIN ) THEN -!/ST2 SDSB3 = 4. -!/ST2 SDSB2 = FPIMIN**SDSB3 * (PHIMIN-SDSB0-SDSB1*FPIMIN) -!/ST2 ELSE -!/ST2 FPIB = MAX ( FPIA-0.0025 , FPIMIN ) -!/ST2 DPHID = MAX ( PHIMIN - SDSB0 - SDSB1*FPIB , 1.E-15 ) -!/ST2 SDSB3 = MIN ( 10. , SDSB1*FPIB / DPHID ) -!/ST2 SDSB2 = FPIB**SDSB3 * DPHID -!/ST2 FPIMIN = FPIB -!/ST2 END IF -!/ST2 END IF -!/ST2 WRITE (NDSO,925) SDSA0, SDSA1, SDSA2, & -!/ST2 SDSB0, SDSB1, SDSB2, SDSB3, FPIMIN, PHIMIN -!/ST2 CDSA0 = SDSA0 -!/ST2 CDSA1 = SDSA1 -!/ST2 CDSA2 = SDSA2 -!/ST2 CDSB0 = SDSB0 -!/ST2 CDSB1 = SDSB1 -!/ST2 CDSB2 = SDSB2 -!/ST2 CDSB3 = SDSB3 -! -!/ST3 CALL READNL ( NDSS, 'SDS3', STATUS ) -!/ST3 WRITE (NDSO,924) STATUS -!/ST3 WRITE (NDSO,925) SDSC1, WNMEANP, SDSDELTA1, & -!/ST3 SDSDELTA2 -!/ST3 SSDSC1 = SDSC1 -!/ST3 WWNMEANP = WNMEANP -!/ST3 FFXFM = FXFM3 * TPI -!/ST3 FFXPM = FXPM3 * GRAV / 28. -!/ST3 WWNMEANPTAIL = WNMEANPTAIL -!/ST3 DDELTA1 = SDSDELTA1 -!/ST3 DDELTA2 = SDSDELTA2 -! -!/ST4 CALL READNL ( NDSS, 'SDS4', STATUS ) -!/ST4 WRITE (NDSO,924) STATUS -!/ST4 WRITE (NDSO,925) SDSC2, SDSBCK, SDSCUM, WNMEANP -!/ST4 SSDSC(1) = REAL(SDSBCHOICE) -!/ST4 SSDSC(2) = SDSC2 -!/ST4 SSDSC(3) = SDSCUM -!/ST4 SSDSC(4) = SDSC4 -!/ST4 SSDSC(5) = SDSC5 -!/ST4 SSDSC(6) = SDSC6 -!/ST4 SSDSC(7) = WHITECAPWIDTH -!/ST4 SSDSC(8) = SDSSTRAIN ! Straining constant ... -!/ST4 SSDSC(9) = SDSL -!/ST4 SSDSC(10) = SDSSTRAINA*NTH/360. ! angle Aor enhanced straining -!/ST4 SSDSC(11) = SDSSTRAIN2 ! straining constant for directional part -!/ST4 SSDSC(12) = SDSBT -!/ST4 SSDSC(13) = SDSMWD -!/ST4 SSDSC(14) = SPMSS -!/ST4 SSDSC(15) = SDSMWPOW -!/ST4 SSDSC(16) = SDKOF -!/ST4 SSDSC(17) = WHITECAPDUR -!/ST4 SSDSC(18) = SDSFACMTF -!/ST4 SSDSC(19) = SDSNMTF -!/ST4 SSDSC(20) = SDSCUMP -!/ST4 SSDSC(21) = SDSNUW -! -!/ST4 SSDSBR = SDSBR -!/ST4 SSDSBRF1 = SDSBRF1 -!/ST4 SSDSBRFDF= SDSBRFDF -!/ST4 SSDSBM(0) = SDSBM0 -!/ST4 SSDSBM(1) = SDSBM1 -!/ST4 SSDSBM(2) = SDSBM2 -!/ST4 SSDSBM(3) = SDSBM3 -!/ST4 SSDSBM(4) = SDSBM4 -!/ST4 SSDSBT = SDSBT -!/ST4 SSDSISO = SDSISO -!/ST4 SSDSCOS = SDSCOS -!/ST4 SSDSP = SDSP -!/ST4 SSDSDTH = SDSDTH -!/ST4 WWNMEANP = WNMEANP -!/ST4 FFXFM = FXFM3 * TPI -!/ST4 FFXFA = FXFMAGE * TPI -!/ST4 FFXPM = FXPM3 * GRAV / 28. -!/ST4 WWNMEANPTAIL = WNMEANPTAIL -!/ST4 SSDSBCK = SDSBCK -!/ST4 SSDSABK = SDSABK -!/ST4 SSDSPBK = SDSPBK -!/ST4 SSDSBINT = SDSBINT -!/ST4 SSDSHCK = SDSHCK -! -!/ST6 CALL READNL ( NDSS, 'SDS6', STATUS ) -!/ST6 WRITE (NDSO,924) STATUS -!/ST6 SDS6ET = SDSET -!/ST6 SDS6A1 = SDSA1 -!/ST6 SDS6P1 = SDSP1 -!/ST6 SDS6A2 = SDSA2 -!/ST6 SDS6P2 = SDSP2 -!/ST6 J = 2 -!/ST6 IF (SDSET) J = 1 -!/ST6 WRITE (NDSO,925) YESXNO(J), YESXNO(3-J), SDS6A1, SDS6P1, SDS6A2, SDS6P2 -!/ST6 -!/ST6 CALL READNL ( NDSS, 'SWL6', STATUS ) -!/ST6 WRITE (NDSO,937) STATUS -!/ST6 J = 1 -!/ST6 SWL6S6 = SWLB1.GT.0.0 -!/ST6 IF (.NOT.SWL6S6) J = 2 -!/ST6 SWL6B1 = SWLB1 -!/ST6 SWL6CSTB1 = CSTB1 -!/ST6 IF (CSTB1) THEN -!/ST6 WRITE (NDSO,940) YESXNO(J), '(constant) ' ,SWL6B1 -!/ST6 ELSE -!/ST6 WRITE (NDSO,940) YESXNO(J), '(steepness dependent)' ,SWL6B1 -!/ST6 END IF -! -! 6.g Define Sbt. -! -!/BT0 WRITE (NDSO,926) -!/BT4 WRITE (NDSO,926) -!/BTX WRITE (NDSO,926) -! -!/BT1 GAMMA = -0.067 -! -!/BT1 CALL READNL ( NDSS, 'SBT1', STATUS ) -!/BT1 WRITE (NDSO,926) STATUS -!/BT1 WRITE (NDSO,927) GAMMA -!/BT1 SBTC1 = 2. * GAMMA / GRAV -! -!/BT4 SEDMAPD50=.FALSE. -!/BT4 SED_D50_UNIFORM=2.E-4 ! default grain size: medium sand 200 microns -!/BT4 RIPFAC1=0.4 ! A1 in Ardhuin et al. 2003 -!/BT4 RIPFAC2=-2.5 ! A2 in Ardhuin et al. 2003 -!/BT4 RIPFAC3=1.2 ! A3 in Ardhuin et al. 2003 -!/BT4 RIPFAC4=0.05 ! A4 in Ardhuin et al. 2003 -!/BT4 SIGDEPTH=0.05 -!/BT4 BOTROUGHMIN=0.01 -!/BT4 BOTROUGHFAC=1.00 -!/BT4 CALL READNL ( NDSS, 'SBT4', STATUS ) -!/BT4 WRITE (NDSO,926) STATUS -!/BT4 WRITE (NDSO,927) SEDMAPD50, SED_D50_UNIFORM, & -!/BT4 RIPFAC1,RIPFAC2,RIPFAC3,RIPFAC4,SIGDEPTH, & -!/BT4 BOTROUGHMIN, BOTROUGHFAC -!/BT4 SBTCX(1)=RIPFAC1 -!/BT4 SBTCX(2)=RIPFAC2 -!/BT4 SBTCX(3)=RIPFAC3 -!/BT4 SBTCX(4)=RIPFAC4 -!/BT4 SBTCX(5)=SIGDEPTH -!/BT4 SBTCX(6)=BOTROUGHMIN -!/BT4 SBTCX(7)=BOTROUGHFAC -! -! -! 6.h Define Sdb. -! -!/DB0 WRITE (NDSO,928) -!/DBX WRITE (NDSO,928) -! -!/DB1 BJALFA = 1. -!/DB1 BJGAM = 0.73 -!/DB1 BJFLAG = .TRUE. -! -!/DB1 CALL READNL ( NDSS, 'SDB1', STATUS ) -!/DB1 WRITE (NDSO,928) STATUS -!/DB1 BJALFA = MAX ( 0. , BJALFA ) -!/DB1 BJGAM = MAX ( 0. , BJGAM ) -!/DB1 WRITE (NDSO,929) BJALFA, BJGAM -!/DB1 IF ( BJFLAG ) THEN -!/DB1 WRITE (NDSO,*) ' Using Hmax/d ratio only.' -!/DB1 ELSE -!/DB1 WRITE (NDSO,*) & -!/DB1 ' Using Hmax/d in Miche style formulation.' -!/DB1 END IF -!/DB1 WRITE (NDSO,*) -!/DB1 SDBC1 = BJALFA -!/DB1 SDBC2 = BJGAM -!/DB1 FDONLY = BJFLAG -! -! -!/UOST UOSTFILELOCAL = 'obstructions_local.'//ADJUSTL(TRIM(GNAME))//'.in' -!/UOST UOSTFILESHADOW = 'obstructions_shadow.'//ADJUSTL(TRIM(GNAME))//'.in' -!/UOST UOSTFACTORLOCAL = 1 -!/UOST UOSTFACTORSHADOW = 1 -!/UOST CALL READNL ( NDSS, 'UOST', STATUS ) -!/UOST WRITE (NDSO,4500) STATUS -!/UOST WRITE (NDSO,4501) ADJUSTL(TRIM(UOSTFILELOCAL)), ADJUSTL(TRIM(UOSTFILESHADOW)), & -!/UOST UOSTFACTORLOCAL, UOSTFACTORSHADOW -! -! 6.i Define Str. -! -!/TR0 WRITE (NDSO,930) -!/TRX WRITE (NDSO,930) -! -! 6.j Define Sbs. -! -!/BS0 WRITE (NDSO,932) -!/BS1 WRITE (NDSO,932) -!/BSX WRITE (NDSO,932) -! -! 6.k Define Sxx and Sic. -! -! !/XX0 WRITE (NDSO,934) -!/XXX WRITE (NDSO,934) -! -!/IC1 WRITE (NDSO,935) -!/IC1 WRITE(NDSO,'(A/A)')' Sice will be calculated using ' & -!/IC1 //'user-specified ki values.',' Required ' & -!/IC1 //'field input: ice parameter 1.' -! -!/IC2 WRITE (NDSO,935) -!/IC2 WRITE(NDSO,'(A/A)')' Sice will be calculated using ' & -!/IC2 //'under-ice boundary layer method.',' Required ' & -!/IC2 //'field input: ice parameters 1 and 2.' -! -!/IC3 WRITE (NDSO,935) -!/IC3 WRITE(NDSO,'(A/A)')' Sice will be calculated using '& -!/IC3 //'Wang and Shen method.',' '& -!/IC3 //'Required field input: ice parameters 1, 2, 3 and 4.' -! -!/IC4 WRITE (NDSO,935) -!/IC4 WRITE(NDSO,'(A/A)')' Sice will be calculated using '& -!/IC4 //'Empirical method.',' '& -!/IC4 //'Required field input: ice parameters (varies).' -! -!/IC5 WRITE (NDSO,935) -!/IC5 WRITE(NDSO,'(A/A/)')' Sice will be calculated using '& -!/IC5 //'Mosig et al. method.',' '& -!/IC5 //'Required field input: ice parameters 1, 2, 3 and 4.' -! -! 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 = .FALSE. - SOLVERTHR_SETUP=1E-14 - CRIT_DEP_SETUP=0.1 - JGS_TERMINATE_MAXITER = .TRUE. - JGS_TERMINATE_DIFFERENCE = .TRUE. - JGS_TERMINATE_NORM = .FALSE. - JGS_LIMITER = .FALSE. - 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_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 - - IF ((EXPFSN .eqv. .FALSE.).and.(EXPFSPSI .eqv. .FALSE.) & - .and.(EXPFSFCT .eqv. .FALSE.) & - .and.(IMPFSN .eqv. .FALSE.) & - .and.(EXPTOTAL .eqv. .FALSE.) & - .and.(IMPTOTAL .eqv. .FALSE.)) THEN - EXPFSN=.TRUE. ! This is the default scheme ... - END IF - 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 - WRITE(NDSE,*) ' *** WAVEWATCH III ERROR IN WW3_GRID:' - IF (nbSel .gt. 1) THEN - WRITE (NDSE,*) 'More than one scheme selected' - ELSE IF (nbSel .eq. 0) THEN - WRITE (NDSE,*) 'no scheme selected' - END IF - WRITE (NDSE,*)'Select only one of EXPFSN, EXPFSFCT, EXPFSPSI' - WRITE (NDSE,*)'IMPFSN, IMPTOTAL' - CALL EXTCDE ( 30 ) - END IF - END IF -! -! 6.m Select propagation scheme -! - WRITE (NDSO,950) -! - NRPROP = 0 - FLPROP = .TRUE. - PNAME = ' ' -!/PR0 PNAME = 'Not defined ' -!/PR0 NRPROP = NRPROP + 1 -!/PR0 FLPROP = .FALSE. -!/PR1 PNAME = 'First order upstream ' -!/PR1 NRPROP = NRPROP + 1 -!/UQ PNAME = '3rd order UQ' -!/UNO PNAME = '2nd order UNO' - J = LEN_TRIM(PNAME) -!/PR2 PNAME = PNAME(1:J)//' + GSE diffusion ' -!/PR2 NRPROP = NRPROP + 1 -!/PR3 PNAME = PNAME(1:J)//' + GSE averaging ' -!/PR3 NRPROP = NRPROP + 1 -! -!/SMC PNAME = 'UNO2 on SMC grid + diffusion ' -!/SMC NRPROP = NRPROP + 1 -! -!/PRX PNAME = 'Experimental ' -!/PRX NRPROP = NRPROP + 1 -! - 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 -! -!/PR2 DTIME = 0. -!/PR2 LATMIN = 70. -! -!/SMC !Li Default values of smc grid parameters. JGLi23Nov2015 -!/SMC LvSMC = 1 -!/SMC ISHFT = 0 -!/SMC JEQT = 0 -!/SMC NBISMC = 0 -!/SMC DTIME = 0.0 -!/SMC LATMIN = 86.0 -!/SMC RFMAXD = 80.0 -!/SMC UNO3 = .FALSE. -!/SMC AVERG = .FALSE. -!/SMC SEAWND = .FALSE. -! -!/PR3 WDTHCG = 1.5 -!/PR3 WDTHTH = WDTHCG -! -!/PR1 CALL READNL ( NDSS, 'PRO1', STATUS ) -!/PR1 IF ( STATUS(18:18) .EQ. ':' ) STATUS(18:18) = ' ' -!/PR1 WRITE (NDSO,952) STATUS(1:18) -!/PR1 CFLTM = MAX ( 0. , CFLTM ) -!/PR1 WRITE (NDSO,953) CFLTM -! -!/PR2 CALL READNL ( NDSS, 'PRO2', STATUS ) -!/PR2 IF ( STATUS(18:18) .EQ. ':' ) STATUS(18:18) = ' ' -!/PR2 WRITE (NDSO,952) STATUS(1:18) -!/PR2 CFLTM = MAX ( 0. , CFLTM ) -!/PR2 DTIME = MAX ( 0. , DTIME ) -!/PR2 LATMIN = MIN ( 89. , ABS(LATMIN) ) -!/PR2 CLATMN = COS ( LATMIN * DERA ) -!/PR2 IF ( DTIME .EQ. 0. ) THEN -!/PR2 WRITE (NDSO,953) CFLTM, LATMIN -!/PR2 ELSE -!/PR2 WRITE (NDSO,954) CFLTM, DTIME/3600., LATMIN -!/PR2 END IF -!/PR2 DTME = DTIME -! -!/SMC CALL READNL ( NDSS, 'PSMC', STATUS ) -!/SMC IF ( STATUS(18:18) .EQ. ':' ) STATUS(18:18) = ' ' -!/SMC WRITE (NDSO,952) STATUS(1:18) -!/SMC CFLTM = MAX ( 0. , CFLTM ) -!/SMC DTIME = MAX ( 0. , DTIME ) -!/SMC LATMIN = MIN ( 89. , ABS(LATMIN) ) -!/SMC CLATMN = COS ( LATMIN * DERA ) -!/SMC RFMAXD = MIN ( 80.0, ABS(RFMAXD) ) -!/SMC IF ( DTIME .EQ. 0. ) THEN -!/SMC WRITE (NDSO,953) CFLTM, LATMIN, RFMAXD -!/SMC ELSE -!/SMC WRITE (NDSO,954) CFLTM, DTIME/3600., LATMIN, RFMAXD -!/SMC END IF -!/SMC DTME = DTIME -!/SMC Refran = RFMAXD * DERA -!/SMC FUNO3 = UNO3 -!/SMC FVERG = AVERG -!/SMC FSWND = SEAWND -!/SMC IF( UNO3 ) WRITE (NDSO,*) & -!/SMC " Advection use 3rd order UNO3 instead of UNO2 scheme." -!/SMC IF( AVERG ) WRITE (NDSO,*) & -!/SMC " Extra 1-2-1 average smoothing activated on SMC grid." -!/SMC IF( SEAWND ) WRITE (NDSO,*) & -!/SMC " Sea-point only wind input is required for SMC grid. " -!/SMC NRLv = LvSMC -!/SMC WRITE (NDSO,4001) NRLv -!/SMC WRITE (NDSO,4002) JEQT -!/SMC WRITE (NDSO,4302) ISHFT -!/SMC WRITE (NDSO,4003) NBISMC -! -!/PR3 CALL READNL ( NDSS, 'PRO3', STATUS ) -!/PR3 IF ( STATUS(18:18) .EQ. ':' ) STATUS(18:18) = ' ' - IF (GTYPE.NE.UNGTYPE) THEN -!/PR3 WRITE (NDSO,952) STATUS(1:18) -!/PR3 CFLTM = MAX ( 0. , CFLTM ) -!/PR3 WRITE (NDSO,953) CFLTM, WDTHCG -!/PR3 IF ( WDTHCG*(XFR-1.) .GT. 1. ) WRITE (NDSO,955) 1./(XFR-1.) -!/PR3 WRITE (NDSO,954) WDTHTH -!/PR3 IF ( WDTHTH*DTH .GT. 1. ) WRITE (NDSO,955) 1./DTH -!/PR3 WRITE (NDSO,*) - ENDIF -!/PR3 WDCG = WDTHCG -!/PR3 WDTH = WDTHTH -! - CTMAX = CFLTM -! -!/RTD ! Set/ read in rotation values - these will be written out -!/RTD ! later with the rest of the grid info -!/RTD ! Default is a non-rotated lat-lon grid -!/RTD PLAT = 90. -!/RTD PLON = -180. -!/RTD UNROT = .FALSE. -!/RTD CALL READNL ( NDSS, 'ROTD', STATUS ) -!/RTD PLON = MOD( PLON + 180., 360. ) - 180. -!/RTD ! Ensure that a grid with pole at the geographic North is standard lat-lon -!/RTD IF ( PLAT == 90. .AND. ( PLON /= -180. .OR. UNROT ) ) THEN -!/RTD WRITE( NDSE, 1052 ) -!/RTD CALL EXTCDE ( 33 ) -!/RTD ENDIF -!/RTD ! Default poles of output b. c. are non-rotated: -!/RTD BPLAT = 90. -!/RTD BPLON = -180. -!/RTD CALL READNL ( NDSS, 'ROTB', STATUS ) -!/RTD ! A b. c. dest. grid with pole at the geographic North must be non-rotated -!/RTD DO I=1,9 -!/RTD IF ( BPLAT(I) == 90. ) THEN -!/RTD ! Require BPLON(I) == -180., but don't blaim the user if BPLON(I) == 180. -!/RTD IF ( BPLON(I) == 180. ) BPLON(I) = -180. -!/RTD IF ( BPLON(I) == -180. ) CYCLE -!/RTD END IF -!/RTD IF ( BPLAT(I) < 90. ) CYCLE -!/RTD WRITE( NDSE, 1053 ) -!/RTD CALL EXTCDE ( 34 ) -!/RTD END DO -! -! 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) -! -!/NCO/! NCEP operations retains first three swell systems. -!/NCO NOSW=3 - 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. -!/IS0 WRITE (NDSO,944) -!/IS1 ISC1 = 1. -!/IS1 ISC2 = 0. -!/IS1 CALL READNL ( NDSS, 'SIS1', STATUS ) -!/IS1 WRITE (NDSO,945) STATUS -!/IS1 WRITE (NDSO,946) ISC1, ISC2 -!/IS1 IS1C1 = ISC1 -!/IS1 IS1C2 = ISC2 -!/IS2 ISC1 = 1. -!/IS2 IS2C2 = 0. ! 0.025 -!/IS2 IS2C3 = 0. ! 2.4253 -!/IS2 IS2CONC = 0. -!/IS2 IS2BACKSCAT = 1. -!/IS2 IS2BREAK = .FALSE. -!/IS2 IS2BREAKF = 3.6 -!/IS2 IS2FLEXSTR=6.00E+05 ! value used in Ardhuin et al. 2020 -!/IS2 IS2ISOSCAT=.TRUE. ! uses isotropic back-scatter -!/IS2 IS2DISP=.FALSE. !not dispersion only attenuation following Liu disp. eq. -!/IS2 IS2DUPDATE=.TRUE. -!/IS2 IS2FRAGILITY=0.9 -!/IS2 IS2DMIN=20 -!/IS2 IS2DAMP=0. -!/IS2 IS2CREEPB=0. -!/IS2 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 -!/IS2 IS2CREEPD=0.5 -!/IS2 IS2CREEPN=3.0 -!/IS2 IS2BREAKE=1. -!/IS2 IS2WIM1=1. -!/IS2 IS2ANDISB=.TRUE. !anelastic instead of inelastic dissipation if IS2CREEPB>0 -!/IS2 IS2ANDISE=0.55 !energy of activation -!/IS2 IS2ANDISD=2.0E-9 !see Ardhuin et al. 2020 -!/IS2 IS2ANDISN=1. !dependency on stress. Equal to 1 normally? -!/IS2 CALL READNL ( NDSS, 'SIS2', STATUS ) -!/IS2 WRITE (NDSO,947) STATUS -!/IS2 WRITE (NDSO,2948) ISC1, IS2BACKSCAT, IS2ISOSCAT, IS2BREAK, IS2DUPDATE, IS2FLEXSTR, IS2DISP, & -!/IS2 IS2DAMP, IS2FRAGILITY, IS2DMIN, IS2C2, IS2C3, IS2CONC, IS2CREEPB,& -!/IS2 IS2CREEPC, IS2CREEPD, IS2CREEPN, IS2BREAKE, IS2BREAKF, IS2WIM1, & -!/IS2 IS2ANDISB, IS2ANDISE, IS2ANDISD, IS2ANDISN -! -!/REF1 REFCOAST=0. -!/REF1 REFMAP=0. -!/REF1 REFMAPD=0. -!/REF1 REFRMAX=1. -!/REF1 REFFREQPOW=2. -!/REF1 REFFREQ=0. -!/REF1 REFCOSP_STRAIGHT=4. -!/REF1 REFSLOPE=0.22 -!/REF1 REFSUBGRID=0. -!/REF1 REFICEBERG=0. -!/REF1 REFUNSTSOURCE=0. -! -!/REF1 CALL READNL ( NDSS, 'REF1', STATUS ) -!/REF1 WRITE (NDSO,969) STATUS -! -!/IG1 IGMETHOD = 2 -!/IG1 IGADDOUTP= 0 -!/IG1 IGSOURCE = 2 -!/IG1 IGSTERMS = 0 -!/IG1 IGMAXFREQ=0.03 -!/IG1 IGSOURCEATBP = 0 -!/IG1 IGBCOVERWRITE = .TRUE. -!/IG1 IGSWELLMAX = .TRUE. -!/IG1 IGKDMIN = 1.1 -!/IG1 IGFIXEDDEPTH = 0. -!/IG1 IGEMPIRICAL = 0.00125 -! -!/IG1 CALL READNL ( NDSS, 'SIG1 ', STATUS ) -!/IG1 WRITE (NDSO,970) STATUS -! -!/IC2 IC2DISPER = .FALSE. -!/IC2 IC2TURB = 1. -!/IC2 IC2TURBS = 0. -!/IC2 IC2ROUGH = 0.01 -!/IC2 IC2REYNOLDS = 1.5E5 -!/IC2 IC2SMOOTH = 2E5 -!/IC2 IC2VISC = 1. -!/IC2 IC2DMAX = 0. -! -!/IC3 IC3MAXTHK = 100.0 -!/IC3 IC3MAXCNC = 100.0 -!/IC3 IC2TURB = 2.0 ! from run_test example by F.A. -!/IC3 IC2TURBS = 0. -!/IC3 IC2ROUGH = 0.02 ! from run_test example by F.A. (alt:0.1) -!/IC3 IC2REYNOLDS = 1.5E5 -!/IC3 IC2SMOOTH = 7.0E4 -!/IC3 IC2VISC = 2.0 -!/IC3 IC3CHENG = .TRUE. -!/IC3 USECGICE = .FALSE. -!/IC3 IC3HILIM = 100.0 -!/IC3 IC3KILIM = 100.0 -!/IC3 IC3HICE = -1.0 -!/IC3 IC3VISC = -2.0 -!/IC3 IC3DENS = -3.0 -!/IC3 IC3ELAS = -4.0 -!fixme: if USECGICE = .TRUE., don't allow use of IC3MAXTHK<100.0 - -!/IC4 IC4METHOD = 1 !switch for methods within IC4 -!/IC4 IC4KI=0.0 -!/IC4 IC4FC=0.0 -! -!/IC5 IC5MINIG = 1. -!/IC5 IC5MINWT = 0. -!/IC5 IC5MAXKRATIO = 1E9 -!/IC5 IC5MAXKI = 100. -!/IC5 IC5MINHW = 300. -!/IC5 IC5MAXITER = 100. -!/IC5 IC5RKICK = 0. -!/IC5 IC5KFILTER = 0.0025 -! -!/IC2 CALL READNL ( NDSS, 'SIC2 ', STATUS ) -!/IC2 WRITE (NDSO,971) STATUS -! -!/IC3 CALL READNL ( NDSS, 'SIC3 ', STATUS ) -!/IC3 WRITE (NDSO,971) STATUS -! -!/IC4 CALL READNL ( NDSS, 'SIC4 ', STATUS ) -!/IC4 WRITE (NDSO,971) STATUS -! -!/IC5 CALL READNL ( NDSS, 'SIC5 ', STATUS ) -!/IC5 WRITE (NDSO,971) STATUS -!/IC5 WRITE (NDSO,2971) IC5MINIG, IC5MINWT, IC5MAXKRATIO, & -!/IC5 IC5MAXKI, IC5MINHW, IC5MAXITER, IC5RKICK, & -!/IC5 IC5KFILTER -! - 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 - - 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 -!/IC0 IF ( CICE0.EQ.CICEN .AND. FLAGTR.GE.3 ) FLAGTR = FLAGTR - 2 - 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 -!/MGG WRITE (NDSO,962) PMOVE -! -!/SEED XSEED = MAX ( 1. , XSEED ) -!/SEED WRITE (NDSO,964) XSEED -!/SCRIP WRITE (NDSO,963) GSHIFT - WRITE (NDSO,1972) TRCKCMPR - FACSD = XSEED -!/RWND RWINDC = RWNDC -!/WCOR WWCOR(1) = WCOR1 -!/WCOR WWCOR(2) = WCOR2 -! - 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 -!/MLIM J = 1 - 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 -! -!/FLD1 TAILTYPE = 0 -!/FLD1 TAILLEV = 0.006 -!/FLD1 TAILT1 = 1.25 -!/FLD1 TAILT2 = 3.00 -!/FLD2 TAILTYPE = 0 -!/FLD2 TAILLEV = 0.006 -!/FLD2 TAILT1 = 1.25 -!/FLD2 TAILT2 = 3.00 -! -!/FLD1 CALL READNL ( NDSS, 'FLD1', STATUS ) -!/FLD1 TAILLEV = MIN( MAX ( 0.0005 , TAILLEV ), 0.04) -!/FLD1 TAIL_LEV = TAILLEV -!/FLD1 TAIL_ID = TAILTYPE -!/FLD1 TAIL_TRAN1 = TAILT1 -!/FLD1 TAIL_TRAN2 = TAILT2 -!/FLD2 CALL READNL ( NDSS, 'FLD2', STATUS ) -!/FLD2 TAILLEV = MIN( MAX ( 0.0005 , TAILLEV ), 0.04) -!/FLD2 TAIL_LEV = TAILLEV -!/FLD2 TAIL_ID = TAILTYPE -!/FLD2 TAIL_TRAN1 = TAILT1 -!/FLD2 TAIL_TRAN2 = TAILT2 -! -! 6.o End of namelist processing -! - IF (FLGNML) THEN - CLOSE (NDSS) - ELSE - CLOSE (NDSS,STATUS='DELETE') - END IF -! - IF ( FLNMLO ) THEN - WRITE (NDSO,917) -!/FLX3 WRITE (NDSO,2810) CDMAX*1.E3, CTYPE -!/FLX4 WRITE (NDSO,2810) CDFAC -!/LN1 WRITE (NDSO,2820) CLIN, RFPM, RFHF -!/ST1 WRITE (NDSO,2920) CINP - IF ( .NOT. FLSTB2 ) THEN -!/ST2 WRITE (NDSO,2920) ZWND, SWELLF - ELSE -!/STAB2 WRITE (NDSO,2921) ZWND, SWELLF, STABSH, STABOF, & -!/STAB2 CNEG, CPOS, FNEG - END IF -! -!/ST3 WRITE (NDSO,2920) ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & -!/ST3 SWELLF -!/ST4 WRITE (NDSO,2920) ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & -!/ST4 TAUWSHELTER, SWELLFPAR, SWELLF, SWELLF2, SWELLF3, SWELLF4, & -!/ST4 SWELLF5, SWELLF6, SWELLF7, Z0RAT, SINBR -!/ST6 WRITE (NDSO,2920) SINA0, SINWS, SINFC -!/NL1 WRITE (NDSO,2922) LAMBDA, NLPROP, KDCONV, KDMIN, & -!/NL1 SNLCS1, SNLCS2, SNLCS3 -!/NL2 WRITE (NDSO,2922) IQTYPE, TAILNL, NDEPTH -!/NL2 IF ( IQTYPE .EQ. 3 ) THEN -!/NL2 IF ( NDEPTH .EQ. 1 ) THEN -!/NL2 WRITE (NDSO,3923) DPTHNL(1) -!/NL2 ELSE -!/NL2 WRITE (NDSO,4923) DPTHNL(1) -!/NL2 END IF -!/NL2 WRITE (NDSO,5923) DPTHNL(2:NDEPTH-1) -!/NL2 WRITE (NDSO,6923) DPTHNL(NDEPTH) -!/NL2 END IF -!/NL3 WRITE (NDSO,2922) NQDEF, MSC, NSC, KDFD, KDFS -!/NL3 IF ( NQDEF .EQ. 1 ) THEN -!/NL3 WRITE (NDSO,3923) QPARMS(1:5) -!/NL3 ELSE -!/NL3 WRITE (NDSO,4923) QPARMS(1:5) -!/NL3 DO J=2, NQDEF-1 -!/NL3 WRITE (NDSO,5923) QPARMS((J-1)*5+1:J*5) -!/NL3 END DO -!/NL3 WRITE (NDSO,6923) QPARMS((NQDEF-1)*5+1:NQDEF*5) -!/NL3 END IF -!/NL4 WRITE (NDSO,2922) INDTSA, ALTLP -!/NLS WRITE (NDSO,8922) A34, FHFC, DNM, FC1, FC2, FC3 -!/ST1 WRITE (NDSO,2924) CDIS, APM -!/ST2 WRITE (NDSO,2924) SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN -!/ST3 WRITE (NDSO,2924) SDSC1, WNMEANP, FXPM3, FXFM3, SDSDELTA1, & -!/ST3 SDSDELTA2 - -!/ST4 WRITE (NDSO,2924) SDSBCHOICE, SDSC2, SDSCUM, SDSC4, & -!/ST4 SDSC5, SDSC6, & -!/ST4 WNMEANP, FXPM3, FXFM3, FXFMAGE, & -!/ST4 SDSBINT, SDSBCK, SDSABK, SDSPBK, SDSHCK, & -!/ST4 SDSBR, SDSSTRAIN, SDSSTRAINA, SDSSTRAIN2, & -!/ST4 SDSBT, SDSP, SDSISO, SDSCOS, SDSDTH, SDSBRF1, & -!/ST4 SDSBRFDF, SDSBM0, SDSBM1, SDSBM2, SDSBM3, SDSBM4, & -!/ST4 SPMSS, SDKOF, SDSMWD, SDSFACMTF, SDSNMTF,SDSMWPOW,& -!/ST4 SDSCUMP, SDSNUW, WHITECAPWIDTH, WHITECAPDUR -!/ST6 WRITE (NDSO,2924) SDSET, SDSA1, SDSA2, SDSP1, SDSP2 -!/ST6 WRITE (NDSO,2937) SWLB1, CSTB1 -!/BT1 WRITE (NDSO,2926) GAMMA -!/BT4 WRITE (NDSO,2926) SEDMAPD50, SED_D50_UNIFORM, & -!/BT4 RIPFAC1,RIPFAC2,RIPFAC3,RIPFAC4, SIGDEPTH, & -!/BT4 BOTROUGHMIN, BOTROUGHFAC -!/DB1 IF ( BJFLAG ) THEN -!/DB1 WRITE (NDSO,2928) BJALFA, BJGAM, '.TRUE.' -!/DB1 ELSE -!/DB1 WRITE (NDSO,2928) BJALFA, BJGAM, '.FALSE.' -!/DB1 END IF -!/PR1 WRITE (NDSO,2953) CFLTM -!/PR2 WRITE (NDSO,2953) CFLTM, DTIME, LATMIN -!/SMC WRITE (NDSO,2953) CFLTM, DTIME, LATMIN, RFMAXD, UNO3, & -!/SMC AVERG, LvSMC, NBISMC, ISHFT, JEQT, SEAWND -!/PR3 WRITE (NDSO,2953) CFLTM, WDTHCG, WDTHTH -! - 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_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 -! -!/REF1 WRITE(NDSO,2986) REFCOAST, REFFREQ, REFSLOPE, REFMAP, & -!/REF1 REFMAPD, REFSUBGRID , REFRMAX, REFFREQPOW, & -!/REF1 REFICEBERG, REFCOSP_STRAIGHT, REFUNSTSOURCE -! -!/IG1 WRITE(NDSO,2977) IGMETHOD, IGADDOUTP, IGSOURCE, & -!/IG1 IGSTERMS, IGBCOVERWRITE, IGSWELLMAX, & -!/IG1 IGMAXFREQ, IGSOURCEATBP, IGKDMIN, & -!/IG1 IGFIXEDDEPTH, IGEMPIRICAL -! -!/IC2 WRITE(NDSO,2978) IC2DISPER, IC2TURB, IC2ROUGH, & -!/IC2 IC2REYNOLDS, IC2SMOOTH, IC2VISC, IC2TURBS, & -!/IC2 IC2DMAX -! -!/IC3 WRITE(NDSO,2979) IC3MAXTHK, IC3MAXCNC, IC2TURB, & -!/IC3 IC2ROUGH, IC2REYNOLDS, IC2SMOOTH, & -!/IC3 IC2VISC, IC2TURBS, IC3CHENG, & -!/IC3 USECGICE, IC3HILIM, IC3KILIM, & -!/IC3 IC3HICE, IC3VISC, IC3DENS, IC3ELAS -! -!/IC4 WRITE(NDSO,NML=SIC4) -! -!/IC5 WRITE(NDSO,2981) IC5MINIG, IC5MINWT, IC5MAXKRATIO, & -!/IC5 IC5MAXKI, IC5MINHW, IC5MAXITER, & -!/IC5 IC5RKICK, IC5KFILTER -! -!/IS1 WRITE (NDSO,2946) IS1C1, IS1C2 -! -!/IS2 WRITE (NDSO,948) ISC1, IS2BACKSCAT, IS2ISOSCAT, IS2BREAK, & -!/IS2 IS2DUPDATE, IS2FLEXSTR, IS2DISP, IS2DAMP, IS2FRAGILITY, IS2DMIN, IS2C2, & -!/IS2 IS2C3, IS2CONC, IS2CREEPB, IS2CREEPC, IS2CREEPD, & -!/IS2 IS2CREEPN, IS2BREAKE, IS2BREAKF, IS2WIM1, IS2ANDISB, & -!/IS2 IS2ANDISE, IS2ANDISD, IS2ANDISN -! -!/UOST WRITE (NDSO, 4502) ADJUSTL(TRIM(UOSTFILELOCAL)), ADJUSTL(TRIM(UOSTFILESHADOW)), & -!/UOST UOSTFACTORLOCAL, UOSTFACTORSHADOW - -! - 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 -! -!/FLD1 WRITE(NDSO,2987) TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 -!/FLD2 WRITE(NDSO,2987) TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 -!/RTD WRITE(NDSO,4991) PLAT, PLON, UNROT -!/RTD WRITE(NDSO,4992) BPLAT, BPLON -! - 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) -!/ST3 STXFTF = 1/(FACHF-1.-WNMEANP*2) & -!/ST3 * SIG(NK)**(2+WNMEANP*2) * DTH -!/ST3 STXFTFTAIL = 1/(FACHF-1.-WNMEANPTAIL*2) & -!/ST3 * SIG(NK)**(2+WNMEANPTAIL*2) * DTH -!/ST3 STXFTWN = 1/(FACHF-1.-WNMEANP*2) * SIG(NK)**(2) & -!/ST3 * (SIG(NK)/SQRT(GRAV))**(WNMEANP*2) * DTH -!/ST3 SSTXFTF = STXFTF -!/ST3 SSTXFTFTAIL = STXFTFTAIL -!/ST3 SSTXFTWN = STXFTWN -! -!/ST4 STXFTF = 1/(FACHF-1.-WNMEANP*2) & -!/ST4 * SIG(NK)**(2+WNMEANP*2) * DTH -!/ST4 STXFTFTAIL = 1/(FACHF-1.-WNMEANPTAIL*2) & -!/ST4 * SIG(NK)**(2+WNMEANPTAIL*2) * DTH -!/ST4 STXFTWN = 1/(FACHF-1.-WNMEANP*2) * SIG(NK)**(2) & -!/ST4 * (SIG(NK)/SQRT(GRAV))**(WNMEANP*2) * DTH -!/ST4 SSTXFTF = STXFTF -!/ST4 SSTXFTFTAIL = STXFTFTAIL -!/ST4 SSTXFTWN = STXFTWN -! -! ... High frequency cut-off -! - FXFM = 2.5 -!/ST6 FXFM = SIN6FC - FXPM = 4.0 - FXPM = FXPM * GRAV / 28. - FXFM = FXFM * TPI - XFC = 3.0 -!/ST2 XFH = 2.0 -!/ST2 XF1 = 1.75 -!/ST2 XF2 = 2.5 -!/ST2 XFT = XF2 -! - FACTI1 = 1. / LOG(XFR) - FACTI2 = 1. - LOG(TPI*FR1) * FACTI1 -! -! Setting of FACHF moved to before !/NL2 set-up for consistency -! -!/NL2 FACHF = -TAILNL - 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' - 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 ) - CASE ( RLGTYPE ) - 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 - UNSTSCHEME=-1 - DO IX=1,4 - 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) ' - END SELECT -! - IF (SUM(UNSTSCHEMES).GT.1) WRITE(NDSO,1035) - WRITE (NDSO,2951) PNAME2 - IF (IMPTOTAL) THEN - FSTOTALIMP = IMPTOTAL - PNAME2 = 'N Implicit (Fluctuation Splitting) for total implicit' - END IF - IF (EXPTOTAL) THEN - FSTOTALEXP = EXPTOTAL - PNAME2 = 'N Explicit (Fluctuation Splitting) for one exchange explicit DC HPCF ' - END IF - 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 = ' we change 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 -! - CASE ( RLGTYPE ) -! - 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', & - STATUS='OLD',ERR=2000,IOSTAT=IERR) - ELSE - OPEN (NDSG, & - FORM='UNFORMATTED', & - 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', & - STATUS='OLD',ERR=2000,IOSTAT=IERR) - ELSE - OPEN (NDSG, & - FORM='UNFORMATTED', & - 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) -! -! 7.e Read bottom depths -! - IF ( GTYPE.NE.UNGTYPE ) THEN -! -! Reading depths on structured grid -! -!Li Suspended for SMC grid, which uses depth stored in its cell array. -!Li JGLi15Oct2014 - IF( RGLGRD ) THEN -!Li - 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',& - STATUS='OLD',ERR=2000,IOSTAT=IERR) - ELSE - OPEN (NDSG, FORM='UNFORMATTED', & - 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 ) -! -!Li End of RGLGRD block - ENDIF -!Li -! - ALLOCATE ( ZBIN(NX,NY), OBSX(NX,NY), OBSY(NX,NY) ) -! -! Initialize subgrid obstructions with zeros. - ZBIN(:,:)=0. - OBSX(:,:)=0. - OBSY(:,:)=0. -!Li Suspend read depth file. JGLi15Oct2014 - IF( RGLGRD ) THEN -!Li - CALL INA2R ( ZBIN, NX, NY, 1, NX, 1, NY, NDSG, NDST, NDSE, & - IDFM, RFORM, IDLA, VSC, 0.0) -!Li End of RGLGRD block - ENDIF -!Li -! - 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*XYB(:,3) -!/DEBUGSTP WRITE(740,*) 'VSC=', VSC -!/DEBUGSTP WRITE(740,*) 'Printing ZBIN 1' -!/DEBUGSTP DO IX=1,NX -!/DEBUGSTP WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) -!/DEBUGSTP END DO -! -! subgrid obstructions are not yet handled in unstructured grids -! - OBSX(:,:)=0. - OBSY(:,:)=0. + CALL W3GRID - END IF -! -! 7.f Set up temporary map -! - ALLOCATE ( TMPSTA(NY,NX), TMPMAP(NY,NX) ) - TMPSTA = 0 -! -!/DEBUGSTP WRITE(740,*) 'Printing ZBIN 2' -!/DEBUGSTP DO IX=1,NX -!/DEBUGSTP WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) -!/DEBUGSTP END DO - 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( RGLGRD ) THEN -!Li -! -! 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',STATUS='OLD',ERR=2000, & - IOSTAT=IERR) - ELSE - OPEN (NDSTR, FORM='UNFORMATTED', & - 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 RGLGRD block - END IF -!Li -! -!/RTD ! 7.h Calculate rotation angles for configs with rotated pole -!/RTD PoLon = PLON -!/RTD PoLat = PLAT -!/RTD FLAGUNR = UNROT -!/RTD ! Default values PLON=-180, PLAT=90, UNROT=.FALSE. for standard lat-lon -!/RTD -!/RTD ALLOCATE( AnglDin(NX,NY) ) -!/RTD ! For standard lat-lon the rotation angles are zero -!/RTD IF ( PoLat == 90. ) THEN -!/RTD AnglDin = 0. -!/RTD ELSE -!/RTD ALLOCATE(StdLat(NX,NY), StdLon(NX,NY)) -!/RTD -!/RTD ! Calculate rotation angles; (StdLon/Lat are returned, but not used) -!/RTD ! The regular grid X/YGRDIN are used as equatorial lon and lat -!/RTD CALL W3EQTOLL( YGRDIN, XGRDIN, StdLat, StdLon, AnglDin, & -!/RTD PoLat, PoLon, NX*NY ) -!/RTD -!/RTD ! Clean up -!/RTD DEALLOCATE( StdLat, StdLon ) -!/RTD END IF -!/RTD ! Write out rotation information -!/RTD WRITE (NDSO,4203) PoLat, PoLon -!/RTD WRITE (NDSO,4200) -!/RTD WRITE (NDSO,4201) ( IX, IX=1,NX,NX/3) -!/RTD WRITE (NDSO,4202) 1,(AnglDin(IX, 1), IX=1,NX,NX/3) -!/RTD WRITE (NDSO,4202) NY,(AnglDin(IX,NY), IX=1,NX,NX/3) -!/RTD IF ( FLAGUNR ) WRITE (NDSO,4204) -!/RTD WRITE (NDSO,*) ' ' -!/RTD -! -!/SMC !! 7.i Read SMC grid cell and face integer arrays. -!/SMC IF (FLGNML) THEN -!/SMC NDSTR = NML_SMC%MCELS%IDF -!/SMC IDLA = NML_SMC%MCELS%IDLA -!/SMC IDFM = NML_SMC%MCELS%IDFM -!/SMC RFORM = TRIM(NML_SMC%MCELS%FORMAT) -!/SMC TNAME = TRIM(NML_SMC%MCELS%FILENAME) -!/SMC ELSE -!/SMC CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/SMC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME -!/SMC END IF -!/SMC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/SMC FORM='FORMATTED',STATUS='OLD',ERR=2000) -!/SMC ALLOCATE ( NLvCelsk( 0:NRLv ) ) -!/SMC READ (NDSTR,*) NLvCelsk -!/SMC NCel=NLvCelsk(0) -!/ARC NGLO=NCel -!/SMC WRITE (NDSO,4004) NCel, NLvCelsk -!/SMC -!/SMC ALLOCATE ( IJKCelin( 5, NCel) ) -!/SMC CALL INA2I ( IJKCelin, 5, NCel, 1, 5, 1, NCel, NDSTR, NDST, NDSE, & -!/SMC IDFM, RFORM, IDLA, 1, 0) -!/SMC CLOSE(NDSTR) -!/SMC !!Li Offset to change Equator index = 0 to regular grid index JEQT -!/SMC IJKCelin( 2, :) = IJKCelin( 2, :) + JEQT -!/SMC !!Li Offset to change i-index = 0 to regular grid index ISHFT -!/SMC IJKCelin( 1, :) = IJKCelin( 1, :) + ISHFT -!/SMC -!/SMC WRITE (NDSO,4005) TNAME -!/SMC WRITE (NDSO,4006) 1,(IJKCelin(ix, 1), ix=1,5) -!/SMC WRITE (NDSO,4006) NCel,(IJKCelin(ix, NCel), ix=1,5) -!/SMC WRITE (NDSO,*) ' ' -!/SMC -!/SMC IF (FLGNML) THEN -!/SMC NDSTR = NML_SMC%ISIDE%IDF -!/SMC IDLA = NML_SMC%ISIDE%IDLA -!/SMC IDFM = NML_SMC%ISIDE%IDFM -!/SMC RFORM = TRIM(NML_SMC%ISIDE%FORMAT) -!/SMC TNAME = TRIM(NML_SMC%ISIDE%FILENAME) -!/SMC ELSE -!/SMC CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/SMC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME -!/SMC END IF -!/SMC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/SMC FORM='FORMATTED',STATUS='OLD',ERR=2000) -!/SMC ALLOCATE ( NLvUFcsk( 0:NRLv ) ) -!/SMC READ (NDSTR,*) NLvUFcsk -!/SMC NUFc = NLvUFcsk(0) -!/SMC NGUI = NUFc -!/SMC WRITE (NDSO,4007) NUFc, NLvUFcsk -!/SMC -!/SMC ALLOCATE ( IJKUFcin( 7, NUFc) ) -!/SMC CALL INA2I ( IJKUFcin, 7, NUFc, 1, 7, 1, NUFc, NDSTR, NDST, NDSE, & -!/SMC IDFM, RFORM, IDLA, 1, 0) -!/SMC CLOSE(NDSTR) -!/SMC !!Li Offset to change Equator index = 0 to regular grid index -!/SMC IJKUFcin( 2, :) = IJKUFcin( 2, :) + JEQT -!/SMC IJKUFcin( 1, :) = IJKUFcin( 1, :) + ISHFT -!/SMC -!/SMC WRITE (NDSO,4008) TNAME -!/SMC WRITE (NDSO,4009) 1,(IJKUFcin(ix, 1), ix=1,7) -!/SMC WRITE (NDSO,4009) NUFc,(IJKUFcin(ix, NUFc), ix=1,7) -!/SMC WRITE (NDSO,*) ' ' -!/SMC -!/SMC IF (FLGNML) THEN -!/SMC NDSTR = NML_SMC%JSIDE%IDF -!/SMC IDLA = NML_SMC%JSIDE%IDLA -!/SMC IDFM = NML_SMC%JSIDE%IDFM -!/SMC RFORM = TRIM(NML_SMC%JSIDE%FORMAT) -!/SMC TNAME = TRIM(NML_SMC%JSIDE%FILENAME) -!/SMC ELSE -!/SMC CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/SMC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME -!/SMC END IF -!/SMC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/SMC FORM='FORMATTED',STATUS='OLD',ERR=2000) -!/SMC ALLOCATE ( NLvVFcsk( 0:NRLv ) ) -!/SMC READ (NDSTR,*) NLvVFcsk -!/SMC NVFc= NLvVFcsk(0) -!/SMC NGVJ= NVFc -!/SMC WRITE (NDSO,4010) NVFc, NLvVFcsk -!/SMC -!/SMC ALLOCATE ( IJKVFcin( 8, NVFc) ) -!/SMC CALL INA2I ( IJKVFcin, 8, NVFc, 1, 8, 1, NVFc, NDSTR, NDST, NDSE, & -!/SMC IDFM, RFORM, IDLA, 1, 0) -!/SMC CLOSE(NDSTR) -!/SMC !!Li Offset to change Equator index = 0 to regular grid index -!/SMC IJKVFcin( 2, :) = IJKVFcin( 2, :) + JEQT -!/SMC IJKVFcin( 1, :) = IJKVFcin( 1, :) + ISHFT -!/SMC -!/SMC WRITE (NDSO,4011) TNAME -!/SMC WRITE (NDSO,4012) 1,(IJKVFcin(ix, 1), ix=1,8) -!/SMC WRITE (NDSO,4012) NVFc,(IJKVFcin(ix, NVFc), ix=1,8) -!/SMC WRITE (NDSO,*) ' ' -!/SMC -!/SMC !!Li Subgrid obstruction for each SMCels. JGLi15Oct2014 -!/SMC IF (FLGNML) THEN -!/SMC NDSTR = NML_SMC%SUBTR%IDF -!/SMC IDLA = NML_SMC%SUBTR%IDLA -!/SMC IDFM = NML_SMC%SUBTR%IDFM -!/SMC RFORM = TRIM(NML_SMC%SUBTR%FORMAT) -!/SMC TNAME = TRIM(NML_SMC%SUBTR%FILENAME) -!/SMC ELSE -!/SMC CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/SMC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME -!/SMC END IF -!/SMC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/SMC FORM='FORMATTED',STATUS='OLD',ERR=2000) -!/SMC READ (NDSTR,*) NCObst, JObs -!/SMC WRITE (NDSO,4110) NCObst, JObs -!/SMC -!/SMC ALLOCATE ( IJKObstr( JObs, NCObst) ) -!/SMC CALL INA2I ( IJKObstr, JObs, NCObst, 1, JObs, 1, NCObst, NDSTR, NDST, & -!/SMC NDSE, IDFM, RFORM, IDLA, 1, 0) -!/SMC CLOSE(NDSTR) -!/SMC -!/SMC WRITE (NDSO,4111) TNAME -!/SMC WRITE (NDSO,4012) 1, (IJKObstr(ix, 1), ix=1,JObs) -!/SMC WRITE (NDSO,4012) NCObst, (IJKObstr(ix, NCObst), ix=1,JObs) -!/SMC WRITE (NDSO,*) ' ' -!/SMC -!/SMC !!Li Bounary cell sequential numbers are read only if NBISMC>0 -!/SMC IF( NBISMC .GT. 0 ) THEN -!/SMC IF (FLGNML) THEN -!/SMC NDSTR = NML_SMC%BUNDY%IDF -!/SMC IDLA = NML_SMC%BUNDY%IDLA -!/SMC IDFM = NML_SMC%BUNDY%IDFM -!/SMC RFORM = TRIM(NML_SMC%BUNDY%FORMAT) -!/SMC TNAME = TRIM(NML_SMC%BUNDY%FILENAME) -!/SMC ELSE -!/SMC CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/SMC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME -!/SMC END IF -!/SMC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/SMC FORM='FORMATTED',STATUS='OLD',ERR=2000) -!/SMC ALLOCATE ( NBICelin( NBISMC ) ) -!/SMC CALL INA2I ( NBICelin, 1, NBISMC, 1, 1, 1, NBISMC, NDSTR, NDST, & -!/SMC NDSE, IDFM, RFORM, IDLA, 1, 0) -!/SMC CLOSE(NDSTR) -!/SMC -!/SMC WRITE (NDSO,4013) TNAME -!/SMC WRITE (NDSO,4014) 1, NBICelin( 1) -!/SMC WRITE (NDSO,4014) NBISMC, NBICelin(NBISMC) -!/SMC WRITE (NDSO,*) ' ' -!/SMC ENDIF -!/SMC -! -!/ARC !! 7.j Read Arctic grid cell and boundary cell integer arrays. -!/ARC IF (FLGNML) THEN -!/ARC NDSTR = NML_SMC%MBARC%IDF -!/ARC IDLA = NML_SMC%MBARC%IDLA -!/ARC IDFM = NML_SMC%MBARC%IDFM -!/ARC RFORM = TRIM(NML_SMC%MBARC%FORMAT) -!/ARC TNAME = TRIM(NML_SMC%MBARC%FILENAME) -!/ARC ELSE -!/ARC CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/ARC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME -!/ARC END IF -!/ARC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/ARC FORM='FORMATTED',STATUS='OLD',ERR=2000) -!/ARC READ (NDSTR,*) NARC, NBGL, NBAC -!/ARC WRITE (NDSO,4015) NARC, NBGL, NBAC -!/ARC -!/ARC ALLOCATE ( IJKCelAC( 5, NARC) ) -!/ARC CALL INA2I ( IJKCelAC, 5, NARC, 1, 5, 1, NARC, NDSTR, NDST, NDSE, & -!/ARC IDFM, RFORM, IDLA, 1, 0) -!/ARC CLOSE(NDSTR) -!/ARC !!Li Offset to change Equator index = 0 to regular grid index JEQT -!/ARC IJKCelAC( 2, :) = IJKCelAC( 2, :) + JEQT -!/ARC IJKCelAC( 1, :) = IJKCelAC( 1, :) + ISHFT -!/ARC -!/ARC WRITE (NDSO,4016) TNAME -!/ARC WRITE (NDSO,4006) 1,(IJKCelAC(ix, 1), ix=1,5) -!/ARC WRITE (NDSO,4006) NARC,(IJKCelAC(ix, NARC), ix=1,5) -!/ARC WRITE (NDSO,*) ' ' -!/ARC -!/ARC IF (FLGNML) THEN -!/ARC NDSTR = NML_SMC%AISID%IDF -!/ARC IDLA = NML_SMC%AISID%IDLA -!/ARC IDFM = NML_SMC%AISID%IDFM -!/ARC RFORM = TRIM(NML_SMC%AISID%FORMAT) -!/ARC TNAME = TRIM(NML_SMC%AISID%FILENAME) -!/ARC ELSE -!/ARC CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/ARC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME -!/ARC END IF -!/ARC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/ARC FORM='FORMATTED',STATUS='OLD',ERR=2000) -!/ARC READ (NDSTR,*) NAUI -!/ARC WRITE (NDSO,4017) NAUI -!/ARC -!/ARC ALLOCATE ( IJKUFcAC( 7, NAUI) ) -!/ARC CALL INA2I ( IJKUFcAC, 7, NAUI, 1, 7, 1, NAUI, NDSTR, NDST, NDSE, & -!/ARC IDFM, RFORM, IDLA, 1, 0) -!/ARC CLOSE(NDSTR) -!/ARC !!Li Offset to change Equator index = 0 to regular grid index -!/ARC IJKUFcAC( 2, :) = IJKUFcAC( 2, :) + JEQT -!/ARC IJKUFcAC( 1, :) = IJKUFcAC( 1, :) + ISHFT -!/ARC !!Li Offset Arctic cell sequential numbers by global cell number NGLO -!/ARC DO IP=1, NAUI -!/ARC DO IX=4,7 -!/ARC IF( IJKUFcAC(IX,IP) > 0 ) IJKUFcAC(IX,IP) = IJKUFcAC(IX,IP) + NGLO -!/ARC ENDDO -!/ARC ENDDO -!/ARC -!/ARC WRITE (NDSO,4018) TNAME -!/ARC WRITE (NDSO,4009) 1,(IJKUFcAC(ix, 1), ix=1,7) -!/ARC WRITE (NDSO,4009) NAUI,(IJKUFcAC(ix, NAUI), ix=1,7) -!/ARC WRITE (NDSO,*) ' ' -!/ARC -!/ARC IF (FLGNML) THEN -!/ARC NDSTR = NML_SMC%AJSID%IDF -!/ARC IDLA = NML_SMC%AJSID%IDLA -!/ARC IDFM = NML_SMC%AJSID%IDFM -!/ARC RFORM = TRIM(NML_SMC%AJSID%FORMAT) -!/ARC TNAME = TRIM(NML_SMC%AJSID%FILENAME) -!/ARC ELSE -!/ARC CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/ARC READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME -!/ARC END IF -!/ARC OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/ARC FORM='FORMATTED',STATUS='OLD',ERR=2000) -!/ARC READ (NDSTR,*) NAVJ -!/ARC WRITE (NDSO,4019) NAVJ -!/ARC -!/ARC ALLOCATE ( IJKVFcAC( 8, NAVJ) ) -!/ARC CALL INA2I ( IJKVFcAC, 8, NAVJ, 1, 8, 1, NAVJ, NDSTR, NDST, NDSE, & -!/ARC IDFM, RFORM, IDLA, 1, 0) -!/ARC CLOSE(NDSTR) -!/ARC !!Li Offset to change Equator index = 0 to regular grid index -!/ARC IJKVFcAC( 2, :) = IJKVFcAC( 2, :) + JEQT -!/ARC IJKVFcAC( 1, :) = IJKVFcAC( 1, :) + ISHFT -!/ARC !!Li Offset Arctic cell sequential numbers by global cell number NGLO -!/ARC DO IP=1, NAVJ -!/ARC DO IY=4,7 -!/ARC IF( IJKVFcAC(IY,IP) > 0 ) IJKVFcAC(IY,IP) = IJKVFcAC(IY,IP) + NGLO -!/ARC ENDDO -!/ARC ENDDO -!/ARC -!/ARC WRITE (NDSO,4020) TNAME -!/ARC WRITE (NDSO,4012) 1,(IJKVFcAC(ix, 1), ix=1,8) -!/ARC WRITE (NDSO,4012) NAVJ,(IJKVFcAC(ix, NAVJ), ix=1,8) -!/ARC WRITE (NDSO,*) ' ' -!/ARC -!/ARC !!Li Reset total cell and face numbers -!/ARC NCel = NGLO + NARC -!/ARC NUFc = NGUI + NAUI -!/ARC NVFc = NGVJ + NAVJ -!/ARC !!Li Also append Arctic part into base level sub-loops -!/ARC NLvCelsk(NRLv)=NLvCelsk(NRLv)+NARC -!/ARC NLvUFcsk(NRLv)=NLvUFcsk(NRLv)+NAUI -!/ARC NLvVFcsk(NRLv)=NLvVFcsk(NRLv)+NAVJ -!/ARC !!Li Reset NBAC to total number of boundary cells. -!/ARC NBAC = NBGL + NBAC -!/ARC -!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! 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) -!/DEBUGSTP WRITE(740,*) 'Printing ZBIN 4' -!/DEBUGSTP DO IX=1,NX -!/DEBUGSTP WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) -!/DEBUGSTP END DO -! -! 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 -! -!/DEBUGGRID WRITE(740+IAPROC,*) 'FROM=', TRIM(FROM) - 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 -!/DEBUGGRID nbCase1=0 -!/DEBUGGRID nbCase2=0 -!/DEBUGGRID nbCase3=0 -!/DEBUGGRID nbCase4=0 -!/DEBUGGRID nbCase5=0 -!/DEBUGGRID nbCase6=0 -!/DEBUGGRID nbCase7=0 -!/DEBUGGRID nbCase8=0 - 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 -!/DEBUGGRID WRITE(740+IAPROC,*) 'read IX=', IX -!/DEBUGGRID WRITE(740+IAPROC,*) 'read IY=', IY -!/DEBUGGRID WRITE(740+IAPROC,*) 'read CONNCT=', CONNCT - -! -! ... 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. -! -!/DEBUGGRID WRITE(740+IAPROC,*) 'CONNCT=', CONNCT -!/DEBUGGRID WRITE(740+IAPROC,*) 'FIRST=', FIRST - 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 -!/DEBUGGRID nbCase2=nbCase2+1 - 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) -!/DEBUGGRID nbCase3=nbCase3 + 1 - 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 -!/DEBUGGRID nbCase4=nbCase4 + 1 - 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 -!/DEBUGGRID nbCase5=nbCase5 + 1 - 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 -!/DEBUGGRID nbCase6=nbCase6 + 1 - 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 -!/DEBUGGRID nbCase7=nbCase7 + 1 - 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 -!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase1=', nbCase1 -!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase2=', nbCase2 -!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase3=', nbCase3 -!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase4=', nbCase4 -!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase5=', nbCase5 -!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase6=', nbCase6 -!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase7=', nbCase7 -!/DEBUGGRID WRITE(740+IAPROC,*) 'nbCase8=', nbCase8 -!/DEBUGGRID nbTMPSTA0=0 -!/DEBUGGRID nbTMPSTA1=0 -!/DEBUGGRID nbTMPSTA2=0 -!/DEBUGGRID DO IX=1,NX -!/DEBUGGRID DO IY=1,NY -!/DEBUGGRID WRITE(740+IAPROC,*) 'IX/IY/TMPSTA=', IX, IY, TMPSTA(IY,IX) -!/DEBUGGRID IF (TMPSTA(IY,IX) .eq. 0) nbTMPSTA0=nbTMPSTA0+1 -!/DEBUGGRID IF (TMPSTA(IY,IX) .eq. 1) nbTMPSTA1=nbTMPSTA1+1 -!/DEBUGGRID IF (TMPSTA(IY,IX) .eq. 2) nbTMPSTA2=nbTMPSTA2+1 -!/DEBUGGRID END DO -!/DEBUGGRID END DO -!/DEBUGGRID WRITE(740+IAPROC,*) 'nbTMPSTA0=', nbTMPSTA0 -!/DEBUGGRID WRITE(740+IAPROC,*) 'nbTMPSTA1=', nbTMPSTA1 -!/DEBUGGRID WRITE(740+IAPROC,*) 'nbTMPSTA2=', nbTMPSTA2 -!/DEBUGGRID FLUSH(740+IAPROC) -! - 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( RGLGRD ) 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',STATUS='OLD',ERR=2000, & - IOSTAT=IERR) - ELSE - OPEN (NDSTR, FORM='UNFORMATTED', & - 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 !! RGLGRD -!!Li -! - 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 -! -!/SMC !Li Moved before FLBPI is defined with NBI value. JGLi05Jun2015 -!/SMC !Li Overwrite NSEA with NCel for SMC grid. -!/SMC NSEA = NCel -!/SMC !Li Use input NBI number for SMC grid because merged -!/SMC !Li cells are over-counted by model. -!/SMC NBI = NBISMC -!/SMC !Li No land points are used in SMC grid. JGLi26Feb2016 -!/SMC NLAND = 0 -! - WRITE (NDSO,980) - FLBPI = NBI .GT. 0 - IF ( .NOT. FLBPI ) THEN - WRITE (NDSO,985) - ELSE - WRITE (NDSO,986) NBI -!/O1 IF ( FLAGLL ) THEN -!/O1 WRITE (NDSO, 987) -!/O1 ELSE -!/O1 WRITE (NDSO,1987) -!/O1 END IF -!/O1 IBI = 1 -!/O1 DO IY=1, NY -!/O1 DO IX=1, NX -!/O1 IF (GTYPE.NE.UNGTYPE) THEN -!/O1 X = FACTOR * ( XGRDIN(IX,IY) ) -!/O1 Y = FACTOR * ( YGRDIN(IX,IY) ) -!/O1 ELSE -!/O1 X = FACTOR * XYB(IX,1) -!/O1 Y = FACTOR * XYB(IX,2) -!/O1 END IF -!/O1 IF ( TMPSTA(IY,IX).EQ.2 ) THEN -!/O1 IF ( FLAGLL ) THEN -!/O1 WRITE (NDSO, 988) IBI, IX, IY, X, Y -!/O1 ELSE -!/O1 WRITE (NDSO,1988) IBI, IX, IY, X, Y -!/O1 END IF -!/O1 IBI = IBI + 1 -!/O1 END IF -!/O1 END DO -!/O1 END DO - 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 -! -!!Li CALL W3DIMX ( 1, NX, NY, NSEA, NDSE, NDST ) - CALL W3DIMX ( 1, NX, NY, NSEA, NDSE, NDST & -!/SMC , NCel, NUFc, NVFc, NRLv & -!/ARC , NARC, NBAC, NSPEC & - ) -!/SMC WRITE (NDSO,4021) NCel -! -! 8.g Activation of reflections and scattering - FFACBERG=FACBERG -!/REF1 REFPARS(1)=REFCOAST -!/REF1 REFPARS(2)=REFSUBGRID -!/REF1 REFPARS(3)=REFUNSTSOURCE -!/REF1 REFPARS(4)=REFICEBERG -!/REF1 REFPARS(6)=REFFREQ -!/REF1 REFPARS(7)=REFSLOPE -!/REF1 REFPARS(8)=REFCOSP_STRAIGHT -!/REF1 REFPARS(9)=REFRMAX -!/REF1 REFPARS(10)=REFFREQPOW -!/REF1 IF (GTYPE.EQ.UNGTYPE) REFPARS(2:5)=0. -!/REF1 IF (REFMAP.EQ.0) THEN -!/REF1 REFLC(3,:)=REFPARS(7) -!/REF1 END IF - - - 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 -! -!FA: This distinction between structured and unstructured -! should be removed when XYB is replaced by XGRD and YGRD -! - DO IX=1, NX - XGRD(:,IX) = XYB(IX,1) - YGRD(:,IX) = XYB(IX,2) - END DO - END IF ! GTYPE -! -! -!!Li MAPSTA = TMPSTA -!!Li Shelter MAPSTA LLG definition for SMC by RGLGRD. - IF( RGLGRD ) MAPSTA = TMPSTA - MAPFS = 0 -! -!/T ALLOCATE ( MAPOUT(NX,NY) ) -!/T MAPOUT = 0 -! -!/T IX3 = 1 + NX/60 -!/T IY3 = 1 + NY/60 -!/T CALL PRTBLK (NDST, NX, NY, NX, ZBIN, MAPOUT, 1, 0., & -!/T 1, NX, IX3, 1, NY, IY3, 'Zb', 'm') -! -!/DEBUGSTP WRITE(740,*) 'Printing ZBIN 5' -!/DEBUGSTP DO IX=1,NX -!/DEBUGSTP WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) -!/DEBUGSTP END DO - TRNX = 0. - TRNY = 0. -! -!Li Shelter MAPSTA etc LLG definitions for SMC by logical RGLGRD ! -!AR This is only .FALSE. for SMC .. - IF( RGLGRD ) THEN - 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) -!/T MAPOUT(IX,IY) = 1 - 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 -!/DEBUGSTP DO ISEA=1,NSEA -!/DEBUGSTP WRITE(740,*) 'ISEA,ZB=', ISEA, ZB(ISEA) -!/DEBUGSTP END DO -!/DEBUGSTP FLUSH(740) - ENDIF -!!Li End of RGLGRD IF block -! -!/SMC !Li Pass refined level cell and face counts to NLv*(NRLv) -!/SMC NLvCel(0)=0 -!/SMC NLvUFc(0)=0 -!/SMC NLvVFc(0)=0 -!/SMC DO IP = 1, NRLv -!/SMC NLvCel(IP)=NLvCelsk(IP) + NLvCel(IP-1) -!/SMC NLvUFc(IP)=NLvUFcsk(IP) + NLvUFc(IP-1) -!/SMC NLvVFc(IP)=NLvVFcsk(IP) + NLvVFc(IP-1) -!/SMC ENDDO -!/SMC WRITE (NDSO,4022) NLvCel -!/SMC WRITE (NDSO,4023) NLvUFc -!/SMC WRITE (NDSO,4024) NLvVFc -!/SMC -!/SMC !Li Redefine MAPSF MAPFS MAPSTA MAPST2 CLATS and ZB for SMC Grid, -!/SMC !Li using SMC grid cell array and assuming NSEA=NCel. -!/SMC MAPSTA = 0 -!/SMC MAPST2 = 1 -!/SMC MAPFS = 0 -!/SMC -!/SMC !Li Pass input SMC arrays to newly declared grid arrays. -!/SMC WRITE (NDSO,4025) NCel -!/SMC JJ=NCel -!/ARC JJ=NGLO -!/SMC IJKCel(:, 1:JJ )=IJKCelin(:, 1:JJ ) -!/SMC IJKUFc(:, 1:NGUI)=IJKUFcin(:, 1:NGUI) -!/SMC IJKVFc(:, 1:NGVJ)=IJKVFcin(:, 1:NGVJ) -!/ARC !Li Append Arctic part -!/ARC IJKCel(:, NGLO+1:NCel)=IJKCelAC(:, 1:NARC) -!/ARC IJKUFc(:, NGUI+1:NUFc)=IJKUFcAC(:, 1:NAUI) -!/ARC IJKVFc(:, NGVJ+1:NVFc)=IJKVFcAC(:, 1:NAVJ) -!/SMC -!/SMC WRITE (NDSO,4026) -!/SMC WRITE (NDSO,4006) 1,(IJKCel(ix, 1), ix=1,5) -!/SMC JJ=NCel -!/SMC WRITE (NDSO,4006) JJ,(IJKCel(ix, JJ), ix=1,5) -!/SMC WRITE (NDSO,*) ' ' -!/SMC WRITE (NDSO,4027) -!/SMC WRITE (NDSO,4009) 1,(IJKUFc(ix, 1), ix=1,7) -!/SMC JJ=NUFc -!/SMC WRITE (NDSO,4009) JJ,(IJKUFc(ix, JJ), ix=1,7) -!/SMC WRITE (NDSO,*) ' ' -!/SMC WRITE (NDSO,4028) -!/SMC WRITE (NDSO,4012) 1,(IJKVFc(ix, 1), ix=1,8) -!/SMC JJ=NVFc -!/SMC WRITE (NDSO,4012) JJ,(IJKVFc(ix, JJ), ix=1,8) -!/SMC WRITE (NDSO,*) ' ' -!/SMC -!/SMC !Li Boundary -9 to 0 cells for cell x-size 2**n -!/SMC !Li Note the position indice for bounary cell are not used. -!/SMC IJKCel(1, -9:0)=0 -!/SMC !Li Use Equator Y index for boundary cells. JGLi04Apr2011 -!/SMC !Li IJKCel(2, -9:0)=0 -!/SMC IJKCel(2, -9:0)=JEQT -!/SMC IJKCel(3, 0)=1 -!/SMC IJKCel(4, 0)=1 -!/SMC !Li Use minimum 10 m depth for boundary cells. -!/SMC !Li Y-size is restricted below base-cell value. -!/SMC !Li For refined boundary cells, its y-size is replaced with -!/SMC !Li the inner cell y-size for flux gradient. -!/SMC IJKCel(5, 0)=10 -!/SMC DO ip=1,9 -!/SMC IJKCel(3,-ip)=IJKCel(3,-ip+1)*2 -!/SMC IK=MIN(ip, NRLv-1) -!/SMC IJKCel(4,-ip)=2**IK -!/SMC IJKCel(5,-ip)=10 -!/SMC ENDDO -!/SMC WRITE (NDSO,4029) -!/SMC DO ip=0, -9, -1 -!/SMC WRITE (NDSO,4030) IJKCel(:,ip) -!/SMC ENDDO -!/SMC -!/SMC WRITE (NDSO,4031) NCel -!/SMC !Li Multi-resolution SMC grid requires rounding of x, y indices -!/SMC !Li by a factor MRFct. -!/SMC MRFct = 2**(NRLv - 1) -!/SMC WRITE (NDSO,4032) MRFct -!/SMC -!/SMC !Li Cosine for SMC uses refined latitude increment. -!/SMC SYMR = SY*DERA/FLOAT( MRFct ) -!/SMC !Li Reference y point for adjusted cell j=0 in radian. JGLi16Feb2016 -!/SMC YJ0R = ( Y0 - 0.5*SY )*DERA -!/SMC -!/SMC DO ISEA=1, NCel -!/ARC !Li There is no polar cell row so it is mapped to last row. -!/ARC IF(ISEA .EQ. NCel) THEN -!/ARC IX=1 -!/ARC IY=NY -!/ARC IK=1 -!/ARC JS=1 -!/ARC ELSE -!/SMC IX=IJKCel(1,ISEA)/MRFct + 1 -!/SMC IY=IJKCel(2,ISEA)/MRFct + 1 -!/SMC IK=MAX(1, IJKCel(3,ISEA)/MRFct) -!/SMC JS=MAX(1, IJKCel(4,ISEA)/MRFct) -!/ARC ENDIF -!/ARC -!/SMC ! Check that IX, IY are in the bound of [1,NX] and [1,NY] respec. -!/SMC IF ((IX+IK-1 .GT. NX) .OR. (IX .LE. 0)) THEN -!/SMC WRITE (NDSE,1014) ISEA, IX, IX+IK-1, NX -!/SMC CALL EXTCDE(65) -!/SMC END IF -!/SMC -!/SMC IF ((IY+JS-1 .GT. NY) .OR. (IY .LE. 0)) THEN -!/SMC WRITE (NDSE,1015) ISEA, IY, IY+JS-1, NY -!/SMC CALL EXTCDE(65) -!/SMC END IF -!/SMC -!/SMC !Li Minimum DMIN depth is used as well for SMC. -!/SMC ZB(ISEA)= - MAX( DMIN, FLOAT( IJKCel(5, ISEA) ) ) -!/SMC MAPFS(IY:IY+JS-1,IX:IX+IK-1) = ISEA -!/SMC MAPSTA(IY:IY+JS-1,IX:IX+IK-1) = 1 -!/SMC MAPST2(IY:IY+JS-1,IX:IX+IK-1) = 0 -!/SMC MAPSF(ISEA,1) = IX -!/SMC MAPSF(ISEA,2) = IY -!/SMC MAPSF(ISEA,3) = IY + (IX -1)*NY -!/SMC !Li New variable CLATS to hold cosine latitude at cell centre. -!/SMC !Li Also added CLATIS and CTHG0S for version 4.08. -!/SMC ! JJ=IJKCel(2,ISEA) - JEQT -!/SMC ! Y = SYMR*( FLOAT(JJ)+0.5*FLOAT(IJKCel(4,ISEA)) ) -!/SMC !Li Use adjusted j-index to calculate cell centre y from YJ0R. -!/SMC Y = YJ0R + SYMR*( FLOAT(IJKCel(2,ISEA))+0.5*FLOAT(IJKCel(4,ISEA)) ) -!/ARC !Li Arctic polar cell does not need COS(LAT), set 1 row down. -!/ARC IF(Y .GE. HPI-0.1*SYMR) Y=HPI - SYMR*0.5*FLOAT( MRFct ) -!/ARC -!/SMC CLATS(ISEA) = COS( Y ) -!/SMC CLATIS(ISEA)= 1. / CLATS(ISEA) -!/SMC CTHG0S(ISEA)= - TAN( Y ) / RADIUS -!/SMC !!Li Subgrid obstruction is now defined directly from IJKObstr -!/SMC !!Li so old OBSX/Y are no longer used. JGLi15Oct2014 -!/SMC !!Li Transparency is minimum of all merged cells and >= 0.11 -!/SMC ! TRNMX=1.0 -!/SMC ! TRNMY=1.0 -!/SMC ! DO ip = IX, IX+IK-1 -!/SMC ! TRNMX = MIN( TRNMX, ABS(1.0-OBSX(ip,IY)) ) -!/SMC ! TRNMY = MIN( TRNMY, ABS(1.0-OBSY(ip,IY)) ) -!/SMC ! ENDDO -!/SMC !!Li Sub-grid obstruction is set zero beyond NCObst cells. -!/SMC IF(ISEA .GT. NCObst) THEN -!/SMC TRNMX=1.0 -!/SMC TRNMY=1.0 -!/SMC ELSE -!/SMC !!Li Present obstruction is isotropic and in percentage. -!/SMC TRNMX=1.0 - IJKObstr(1, ISEA)*0.01 -!/SMC TRNMY=1.0 - IJKObstr(JObs, ISEA)*0.01 -!/SMC ENDIF -!/SMC CTRNX(ISEA) = MAX(0.11, TRNMX) -!/SMC CTRNY(ISEA) = MAX(0.11, TRNMY) -!/SMC END DO -!/SMC !!Li Transparency for boundary cells are 1.0 JGLi16Jan2012 -!/SMC CTRNX(-9:0) = 1.0 -!/SMC CTRNY(-9:0) = 1.0 -!/SMC !!Li Check range of MAPSF and MAPFS -!/SMC WRITE (NDSO,4033) MINVAL( MAPSF(:,1) ), MAXVAL( MAPSF(:,1) ) -!/SMC WRITE (NDSO,4034) MINVAL( MAPSF(:,2) ), MAXVAL( MAPSF(:,2) ) -!/SMC WRITE (NDSO,4035) MINVAL( MAPSF(:,3) ), MAXVAL( MAPSF(:,3) ) -!/SMC WRITE (NDSO,4036) MINVAL( MAPFS(:,:) ), MAXVAL( MAPFS(:,:) ) -!/SMC -!/SMC !Li New variable CLATF to hold cosine latitude at cell V face. -!/SMC DO IP = 1, NVFC -!/SMC ! CLATF(IP) = COS( SYMR*FLOAT(IJKVFc(2,IP) - JEQT) ) -!/SMC !Li Use adjusted j-index to calculate cell face Y from YJ0R. -!/SMC CLATF(IP) = COS( SYMR*FLOAT(IJKVFc(2,IP)) + YJ0R ) -!/SMC ENDDO -!/SMC !Li Reset MAPSTA for boundary cells if any. -!/SMC IF(NBISMC .GT. 0) THEN -!/SMC DO IP=1, NBISMC -!/SMC ISEA = NBICelin(IP) -!/SMC IX=IJKCel(1,ISEA)/MRFct + 1 -!/SMC IY=IJKCel(2,ISEA)/MRFct + 1 -!/SMC IK=MAX(1, IJKCel(3,ISEA)/MRFct) -!/SMC JS=MAX(1, IJKCel(4,ISEA)/MRFct) -!/SMC MAPSTA(IY:IY+JS-1,IX:IX+IK-1) = 2 -!/SMC MAPST2(IY:IY+JS-1,IX:IX+IK-1) = 0 -!/SMC ENDDO -!/SMC ENDIF -!/SMC -! -!/ARC !Li Define rotation angle for Arctic cells. -!/ARC PoLonAC = 179.999 -!/ARC PoLatAC = 0.001 -!/ARC ALLOCATE( XLONAC(NARC),YLATAC(NARC),ELONAC(NARC),ELATAC(NARC) ) -!/ARC DO ISEA=NGLO+1, NCel -!/ARC !Li There is no polar cell row so it is mapped to last row. -!/ARC IF(ISEA .EQ. NCel) THEN -!/ARC IX=1 -!/ARC IY=NY -!/ARC IK=1 -!/ARC JS=1 -!/ARC ELSE -!/ARC IX=IJKCel(1,ISEA)/MRFct + 1 -!/ARC IY=IJKCel(2,ISEA)/MRFct + 1 -!/ARC IK=MAX(1, IJKCel(3,ISEA)/MRFct) -!/ARC JS=MAX(1, IJKCel(4,ISEA)/MRFct) -!/ARC ENDIF -!/ARC XLONAC(ISEA-NGLO)= X0 + REAL(IX-1+IK/2)*SX -!/ARC YLATAC(ISEA-NGLO)= Y0 + REAL(IY-1+JS/2)*SY -!/ARC ENDDO -!/ARC -!/ARC CALL W3LLTOEQ ( YLATAC, XLONAC, ELATAC, ELONAC, & -!/ARC & ANGARC, PoLatAC, PoLonAC, NARC ) -!/ARC -!/ARC WRITE (NDSO,4037) NARC -!/ARC WRITE (NDSO,4038) (ANGARC(ix), ix=1,NARC,NARC/8) -!/ARC -! -!/ARC !Li Mapping Arctic boundary cells with inner model cells -!/ARC DO IP=1, NBAC -!/ARC IX=IJKCel(1,IP+NGLO) -!/ARC IY=IJKCel(2,IP+NGLO) -!/ARC DO ISEA=1, NGLO -!/ARC IF( (IX .EQ. IJKCel(1,ISEA)) .AND. & -!/ARC & (IY .EQ. IJKCel(2,ISEA)) ) THEN -!/ARC ICLBAC(IP) = ISEA -!/ARC ENDIF -!/ARC ENDDO -!/ARC ENDDO -!/ARC WRITE (NDSO,4039) NBAC -!/ARC WRITE (NDSO,4040) (ICLBAC(ix), ix=1,NBAC,NBAC/8) -!/ARC -!/ARC !Li Redefine GCT term factor for Arctic part or the netative of -!/ARC !Li tangient of rotated latitude divided by radius. JGLi14Sep2015 -!/ARC DO ISEA=NGLO+1, NCel-1 -!/ARC CTHG0S(ISEA)= - TAN( ELATAC(ISEA-NGLO)*DERA ) / RADIUS -!/ARC ENDDO -!/ARC CTHG0S(NCel)=0.0 -!/ARC -! -!/RTD !Li Assign rotated grid angle for all sea points. JGLi01Feb2016 -!/RTD DO ISEA=1,NSEA -!/RTD IX = MAPSF(ISEA,1) -!/RTD IY = MAPSF(ISEA,2) -!/RTD AnglD(ISEA) = AnglDin(IX,IY) -!/RTD END DO -! -!/T CALL PRTBLK (NDST, NX, NY, NX, ZBIN, MAPOUT, 0, 0., & -!/T 1, NX, IX3, 1, NY, IY3, 'Sea points', 'm') -!/T DEALLOCATE ( MAPOUT ) -! - DO ISP=1, NSPEC+NTH - MAPWN(ISP) = 1 + (ISP-1)/NTH - MAPTH(ISP) = 1 + MOD(ISP-1,NTH) - END DO -! -!/O2 NMAP = 1 + (NX-1)/NCOL -!/O2 WRITE (NDSO,1100) NMAP -!/O2 DO IMAP=1, NMAP -!/O2 IX0 = 1 + (IMAP-1)*NCOL -!/O2 IXN = MIN ( NX , IMAP*NCOL ) -!/O2 DO IY=NY,1,-1 -!/O2 WRITE (NDSO,1101) (TMPSTA(IY,IX),IX=IX0,IXN) -!/O2 END DO -!/O2 WRITE (NDSO,*) ' ' -!/O2 END DO -!/O2 WRITE (NDSO,1102) - -!/O2a OPEN (NDSM,FILE=TRIM(FNMPRE)//'mask.ww3') -!/O2a DO IY=1, NY -!/O2a WRITE (NDSM,998) MIN(1,MAPSTA(IY,:)) -!/O2a END DO -!/O2a CLOSE (NDSM) -! -!/O2b IF ( TRFLAG .GT. 0 ) THEN -!/O2b NMAPB = 1 + (NX-1)/NCOL -!/O2b WRITE (NDSO,1103) 'X', NMAPB -!/O2b DO IMAPB=1, NMAPB -!/O2b IX0 = 1 + (IMAPB-1)*NCOL -!/O2b IXN = MIN ( NX , IMAPB*NCOL ) -!/O2b DO IY=NY,1,-1 -!/O2b WRITE (NDSO,1101) (NINT(10.*OBSX(IX,IY)),IX=IX0,IXN) -!/O2b END DO -!/O2b WRITE (NDSO,*) ' ' -!/O2b END DO -!/O2b WRITE (NDSO,1104) -!/O2b WRITE (NDSO,1103) 'Y', NMAPB -!/O2b DO IMAPB=1, NMAPB -!/O2b IX0 = 1 + (IMAPB-1)*NCOL -!/O2b IXN = MIN ( NX , IMAPB*NCOL ) -!/O2b DO IY=NY,1,-1 -!/O2b WRITE (NDSO,1101) (NINT(10.*OBSY(IX,IY)),IX=IX0,IXN) -!/O2b END DO -!/O2b WRITE (NDSO,*) ' ' -!/O2b END DO -!/O2b WRITE (NDSO,1104) -!/O2b END IF -! -!/O2c OPEN (NDSM,FILE=TRIM(FNMPRE)//'mapsta.ww3', RECL=2*NX*NY*50+1) -!/O2c DO IY=NY,1, -1 -!/O2c DO IX=1,NX -!/O2c DO I=1,50 -!/O2c WRITE (NDSM,1998,ADVANCE='NO') (TMPSTA(IY,IX)) -!/O2c END DO -!/O2c END DO -!/O2c END DO -!/O2c CLOSE (NDSM) -! - -!/IG1 IGPARS(1)=IGMETHOD -!/IG1 IGPARS(2)=IGADDOUTP -!/IG1 IGPARS(3)=IGSOURCE -!/IG1 IGPARS(4)=0 -!/IG1 IF (IGBCOVERWRITE) IGPARS(4)=IGPARS(4)+1 -!/IG1 IF (IGSWELLMAX) IGPARS(4)=IGPARS(4)+2 -!/IG1 IGPARS(5)=1 -!/IG1 DO IK=1,NK -!/IG1 IF (SIG(IK)*TPIINV.LT.IGMAXFREQ) IGPARS(5)=IK -!/IG1 END DO -!/IG1 IGMINDEP=MINVAL(ZB*(-1.)-2) ! -2 / +2 is there for water level changes -!/IG1 IGMAXDEP=MAXVAL(ZB*(-1.)+2) -!/IG1 IF (IGSOURCEATBP.EQ.1) IGMINDEP=1. ! should use true minimum depth ... -!/IG1 IGPARS(6)=1+NINT(LOG(MAX(IGMAXDEP,1.0)/MAX(IGMINDEP,1.0))/LOG(1.1)) -!/IG1 IGPARS(7)=MAX(IGMINDEP,1.0) -!/IG1 IGPARS(8)=IGSOURCEATBP -!/IG1 IGPARS(9)=IGKDMIN -!/IG1 IGPARS(10)=IGFIXEDDEPTH -!/IG1 IGPARS(11)=IGEMPIRICAL**2 -!/IG1 IGPARS(12)=IGSTERMS -! -!/IC2 IC2PARS(:)=0. -!/IC2 IF (IC2DISPER) IC2PARS(1)=1. -!/IC2 IC2PARS(2)=IC2TURB -!/IC2 IC2PARS(3)=IC2ROUGH -!/IC2 IC2PARS(4)=IC2REYNOLDS -!/IC2 IC2PARS(5)=IC2SMOOTH -!/IC2 IC2PARS(6)=IC2VISC -!/IC2 IC2PARS(7)=IC2TURBS -!/IC2 IC2PARS(8)=IC2DMAX -! -!/IC3 IC3PARS(:)=0. -!/IC3 IC3PARS(1)=IC3MAXTHK -!/IC3 IC3PARS(2)=IC2TURB -!/IC3 IC3PARS(3)=IC2ROUGH -!/IC3 IC3PARS(4)=IC2REYNOLDS -!/IC3 IC3PARS(5)=IC2SMOOTH -!/IC3 IC3PARS(6)=IC2VISC -!/IC3 IC3PARS(7)=IC2TURBS -!/IC3 IC3PARS(8)=IC3MAXCNC -!/IC3 IF (IC3CHENG) IC3PARS(9)=1.0 -!/IC3 IC3PARS(10)=IC3HILIM -!/IC3 IC3PARS(11)=IC3KILIM -!/IC3 IF (USECGICE) IC3PARS(12)=1.0 -!/IC3 IC3PARS(13)=IC3HICE -!/IC3 IC3PARS(14)=IC3VISC -!/IC3 IC3PARS(15)=IC3DENS -!/IC3 IC3PARS(16)=IC3ELAS -! -!/IC4 IC4PARS(1)=IC4METHOD -!/IC4 IC4_KI=IC4KI -!/IC4 IC4_FC=IC4FC -! -!/IC5 IC5PARS(:)=0. -!/IC5 IC5PARS(1)=IC5MINIG -!/IC5 IC5PARS(2)=IC5MINWT -!/IC5 IC5PARS(3)=IC5MAXKRATIO -!/IC5 IC5PARS(4)=IC5MAXKI -!/IC5 IC5PARS(5)=IC5MINHW -!/IC5 IC5PARS(6)=IC5MAXITER -!/IC5 IC5PARS(7)=IC5RKICK -!/IC5 IC5PARS(8)=IC5KFILTER -! -!/IS2 IS2PARS(1) = ISC1 -!/IS2 IS2PARS(2) = IS2BACKSCAT -!/IS2 IS2PARS(3)=0. -!/IS2 IF (IS2BREAK) IS2PARS(3)=1. -!/IS2 IS2PARS(4)=IS2C2 -!/IS2 IS2PARS(5)=IS2C3 -!/IS2 IS2PARS(6)=0. -!/IS2 IF (IS2DISP) IS2PARS(6)=1. -!/IS2 IS2PARS(7)=IS2DAMP -!/IS2 IS2PARS(8)=IS2FRAGILITY -!/IS2 IS2PARS(9)=IS2DMIN -!/IS2 IS2PARS(10)=0. -!/IS2 IF (IS2DUPDATE) IS2PARS(10)=1. -!/IS2 IS2PARS(11)=IS2CONC -!/IS2 IS2PARS(12)=ABS(IS2CREEPB) -!/IS2 IS2PARS(13)=IS2CREEPC -!/IS2 IS2PARS(14)=IS2CREEPD -!/IS2 IS2PARS(15)=IS2CREEPN -!/IS2 IS2PARS(16)=IS2BREAKE -!/IS2 IS2PARS(17)=IS2BREAKF -!/IS2 IS2PARS(18)=IS2WIM1 -!/IS2 IS2PARS(19)=IS2FLEXSTR -!/IS2 IS2PARS(20)=0. -!/IS2 IF (IS2ISOSCAT) IS2PARS(20)=1. -!/IS2 IS2PARS(21)=IS2ANDISD -!/IS2 IS2PARS(22)=IS2ANDISN -!/IS2 IS2PARS(23)=0. -!/IS2 IF (IS2ANDISB) IS2PARS(23)=1. -!/IS2 IS2PARS(24)=IS2ANDISE -! -! 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 SETUGIOBP -!/REF1 ELSE -!/REF1 CALL W3SETREF - END IF -!/REF1! -!/REF1! 9.a Reads shoreline slope (whith REF1 switch only) -!/REF1! -!/REF1 ALLOCATE ( REFD(NX,NY), REFD2(NX,NY), REFS(NX,NY) ) -!/REF1 IF (REFMAP.EQ.0) THEN -!/REF1 REFS(:,:)=1. -!/REF1 ELSE -!/REF1! -!/REF1! 9.b Info from input file -!/REF1! -!/REF1 IF (FLGNML) THEN -!/REF1 NDSTR = NML_SLOPE%IDF -!/REF1 VSC = NML_SLOPE%SF -!/REF1 IDLA = NML_SLOPE%IDLA -!/REF1 IDFT = NML_SLOPE%IDFM -!/REF1 RFORM = TRIM(NML_SLOPE%FORMAT) -!/REF1 FROM = TRIM(NML_SLOPE%FROM) -!/REF1 TNAME = TRIM(NML_SLOPE%FILENAME) -!/REF1 ELSE -!/REF1 CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/REF1 READ (NDSI,*,END=2001,ERR=2002) NDSTR, VSC, IDLA, IDFT, RFORM, & -!/REF1 FROM, TNAME -!/REF1 END IF -!/REF1! -!/REF1 IF ( ABS(VSC) .LT. 1.E-7 ) VSC = 1. -!/REF1 IF (IDLA.LT.1 .OR. IDLA.GT.4) IDLA = 1 -!/REF1 IF (IDFT.LT.1 .OR. IDFT.GT.3) IDFT = 1 -!/REF1! -!/REF1 WRITE (NDSO,1977) NDSTR, VSC, IDLA, IDFT -!/REF1 IF (IDFT.EQ.2) WRITE (NDSO,973) RFORM -!/REF1 IF (FROM.EQ.'NAME' .AND. NDSG.NE.NDSTR) WRITE (NDSO,974) TNAME -!/REF1! -!/REF1! 9;c Open file and check if necessary -!/REF1! -!/REF1 IF ( NDSTR .EQ. NDSI ) THEN -!/REF1 IF ( IDFT .EQ. 3 ) THEN -!/REF1 WRITE (NDSE,1004) NDSTR -!/REF1 CALL EXTCDE (23) -!/REF1 ELSE -!/REF1 CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/REF1 END IF -!/REF1 ELSE IF ( NDSTR .EQ. NDSG ) THEN -!/REF1 IF ( ( IDFM.EQ.3 .AND. IDFT.NE.3 ) .OR. & -!/REF1 ( IDFM.NE.3 .AND. IDFT.EQ.3 ) ) THEN -!/REF1 WRITE (NDSE,1005) IDFM, IDFT -!/REF1 CALL EXTCDE (24) -!/REF1 END IF -!/REF1 ELSE -!/REF1 IF ( IDFT .EQ. 3 ) THEN -!/REF1 IF (FROM.EQ.'NAME') THEN -!/REF1 OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/REF1 FORM='UNFORMATTED',STATUS='OLD',ERR=2000, & -!/REF1 IOSTAT=IERR) -!/REF1 ELSE -!/REF1 OPEN (NDSTR, FORM='UNFORMATTED', & -!/REF1 STATUS='OLD',ERR=2000,IOSTAT=IERR) -!/REF1 END IF -!/REF1 ELSE -!/REF1 IF (FROM.EQ.'NAME') THEN -!/REF1 OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/REF1 STATUS='OLD',ERR=2000,IOSTAT=IERR) -!/REF1 ELSE -!/REF1 OPEN (NDSTR, & -!/REF1 STATUS='OLD',ERR=2000,IOSTAT=IERR) -!/REF1 END IF !end of (FROM.EQ.'NAME') -!/REF1 END IF !end of ( IDFT .EQ. 3 ) -!/REF1 END IF !end of ( NDSTR .EQ. NDSG ) -!/REF1! -!/REF1! 9.d Read the data -!/REF1! -!/REF1! CALL INA2R ( REFD, NX, NY, 1, NX, 1, NY, NDSTR, NDST, NDSE, & -!/REF1! IDFM, RFORM, IDLA, VSC, 0.0) -!/REF1! -!/REF1 IF ( NDSTR .EQ. NDSI ) CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/REF1! -!/REF1! CALL INA2R ( REFD2, NX, NY, 1, NX, 1, NY, NDSTR, NDST, NDSE, & -!/REF1! IDFM, RFORM, IDLA, VSC, 0.0) -!/REF1 CALL INA2R ( REFS, NX, NY, 1, NX, 1, NY, NDSTR, NDST, NDSE, & -!/REF1 IDFM, RFORM, IDLA, VSC, 0.0) -!/REF1 DO ISEA=1,NSEA -!/REF1 IX = MAPSF(ISEA,1) -!/REF1 IY = MAPSF(ISEA,2) -!/REF1 REFLC(3,ISEA) = REFS(IX,IY)*REFMAP -!/REF1 END DO -! -!/REF1 NMAPB = 1 + (NX-1)/NCOL -!/REF1 WRITE (NDSO,1105) NMAPB -!/T!/REF1 WRITE(NDSO,*) 'Maximum slope for reflection:',MAXVAL(REFS*REFMAP) -! -!/REF1 DO IMAPB=1, NMAPB -!/REF1 IX0 = 1 + (IMAPB-1)*NCOL -!/REF1 IXN = MIN ( NX , IMAPB*NCOL ) -!/T!/REF1 DO IY=NY,1,-1 -!/T!/REF1 WRITE (NDSO,1101) (NINT(100.*REFS(IX,IY)*REFMAP),IX=IX0,IXN) -!/T!/REF1 END DO -!/REF1 WRITE (NDSO,*) ' ' -!/REF1 END DO -!/REF1 WRITE (NDSO,1106) -!/REF1! -!/REF1 WRITE (NDSO,*) -!/REF1! -!/REF1 END IF !end of (REFMAP.EQ.0) -! - DEALLOCATE ( ZBIN, TMPSTA, TMPMAP ) -!/RTD DEALLOCATE ( AnglDin ) -! -! 9.e Reads bottom information from file -! -!/BT4 ALLOCATE ( SED_D50FILE(NX,NY)) -!/BT4 IF ( SEDMAPD50 ) THEN -!/BT4 -!/BT4! -!/BT4! 9.e.1 Info from input file -!/BT4! -!/BT4 IF (FLGNML) THEN -!/BT4 NDSTR = NML_SED%IDF -!/BT4 VSC = NML_SED%SF -!/BT4 IDLA = NML_SED%IDLA -!/BT4 IDFT = NML_SED%IDFM -!/BT4 RFORM = TRIM(NML_SED%FORMAT) -!/BT4 FROM = TRIM(NML_SED%FROM) -!/BT4 TNAME = TRIM(NML_SED%FILENAME) -!/BT4 ELSE -!/BT4 CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/BT4 READ (NDSI,*,END=2001,ERR=2002) NDSTR, VSC, IDLA, IDFT, RFORM, & -!/BT4 FROM, TNAME -!/BT4 END IF -!/BT4! -!/BT4 IF ( ABS(VSC) .LT. 1.E-7 ) THEN -!/BT4 VSC = 1. -!/BT4 ELSE -!/BT4! WARNING TO BE ADDED ... -!/BT4 END IF -!/BT4 IF (IDLA.LT.1 .OR. IDLA.GT.4) IDLA = 1 -!/BT4 IF (IDFT.LT.1 .OR. IDFT.GT.3) IDFT = 1 -!/BT4! -!/BT4 WRITE (NDSO,1978) NDSTR, VSC, IDLA, IDFT -!/BT4 IF (IDFT.EQ.2) WRITE (NDSO,973) RFORM -!/BT4 IF (FROM.EQ.'NAME' .AND. NDSG.NE.NDSTR) WRITE (NDSO,974) TNAME -!/BT4! -!/BT4! 9.e.2 Open file and check if necessary -!/BT4! -!/BT4 IF ( NDSTR .EQ. NDSI ) THEN -!/BT4 IF ( IDFT .EQ. 3 ) THEN -!/BT4 WRITE (NDSE,1004) NDSTR -!/BT4 CALL EXTCDE (23) -!/BT4 ELSE -!/BT4 CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/BT4 END IF -!/BT4 ELSE IF ( NDSTR .EQ. NDSG ) THEN -!/BT4 IF ( ( IDFM.EQ.3 .AND. IDFT.NE.3 ) .OR. & -!/BT4 ( IDFM.NE.3 .AND. IDFT.EQ.3 ) ) THEN -!/BT4 WRITE (NDSE,1005) IDFM, IDFT -!/BT4 CALL EXTCDE (24) -!/BT4 END IF -!/BT4 ELSE -!/BT4 IF ( IDFT .EQ. 3 ) THEN -!/BT4 IF (FROM.EQ.'NAME') THEN -!/BT4 OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/BT4 FORM='UNFORMATTED',STATUS='OLD',ERR=2000, & -!/BT4 IOSTAT=IERR) -!/BT4 ELSE -!/BT4 OPEN (NDSTR, FORM='UNFORMATTED', & -!/BT4 STATUS='OLD',ERR=2000,IOSTAT=IERR) -!/BT4 END IF -!/BT4 ELSE -!/BT4 IF (FROM.EQ.'NAME') THEN -!/BT4 OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & -!/BT4 STATUS='OLD',ERR=2000,IOSTAT=IERR) -!/BT4 ELSE -!/BT4 OPEN (NDSTR, & -!/BT4 STATUS='OLD',ERR=2000,IOSTAT=IERR) -!/BT4 END IF -!/BT4 END IF -!/BT4 END IF -!/BT4! -!/BT4! 9.e.3 Read the data -!/BT4! -!/BT4 CALL INA2R ( SED_D50FILE, NX, NY, 1, NX, 1, NY, NDSTR, NDST, NDSE, & -!/BT4 IDFM, RFORM, IDLA, VSC, VOF) -!/BT4! -!/BT4 IF ( NDSTR .EQ. NDSI ) CALL NEXTLN ( COMSTR , NDSI , NDSE ) -!/BT4! -!/BT4 WRITE (NDSO,*) 'Min and Max values of grain sizes:',MINVAL(SED_D50FILE), MAXVAL(SED_D50FILE) -!/BT4 WRITE (NDSO,*) -!/BT4! -!/BT4 ELSE -!/BT4 SED_D50FILE(:,:)=SED_D50_UNIFORM -!/BT4 END IF -!/BT4! -!/BT4 DO IY=1, NY -!/BT4 DO IX=1, NX -!/BT4 ISEA = MAPFS (IY,IX) -!/BT4 SED_D50(ISEA) = SED_D50FILE(IX,IY) -!/BT4 SED_D50(ISEA) = MAX(SED_D50(ISEA),1E-5) -!/BT4 ! Critical Shields number, Soulsby, R.L. and R J S W Whitehouse -!/BT4 ! Threshold of sed. motion in coastal environments, Proc. Pacific Coasts and -!/BT4 ! ports, 1997 conference, Christchurch, p149-154, University of Cantebury, NZ -!/BT4 SED_DSTAR=(GRAV*(SED_SG-1)/nu_water**2)**(0.333333)*SED_D50(ISEA) -!/BT4 SED_PSIC(ISEA)=0.3/(1+1.2*SED_DSTAR)+0.55*(1-exp(-0.02*SED_DSTAR)) - - -!/BT4 END DO -!/BT4 END DO -! -!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! 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. -! -!/RTD IF ( NPO.NE.0 ) THEN -!/RTD ! Destination pole lat, lon from namelist -!/RTD bPolat = BPLAT(NFBPO+1) -!/RTD bPolon = BPLON(NFBPO+1) -!/RTD END IF -!/RTD ! - IF ( NFBPO.GE.1 .AND. ILOOP.EQ.2 ) THEN - WRITE (NDSO,991) NFBPO, NBO(NFBPO) - NBO(NFBPO-1), & - NBO2(NFBPO) - NBO2(NFBPO-1) -!/RTD ! Print dest. Pole lat/lon if either the dest or present grid is rotated -!/RTD IF ( BPLAT(NFBPO) < 90. .OR. Polat < 90. ) & -!/RTD WRITE (NDSO,1991) BPLAT(NFBPO), BPLON(NFBPO) -!/RTD ! -!/O1 IF ( NBO(NFBPO) - NBO(NFBPO-1) .EQ. 1 ) THEN -!/O1 IF ( FLAGLL ) THEN -!/O1 WRITE (NDSO,992) -!/O1 ELSE -!/O1 WRITE (NDSO,2992) -!/O1 END IF -!/O1 ELSE -!/O1 IF ( FLAGLL ) THEN -!/O1 WRITE (NDSO,1992) -!/O1 ELSE -!/O1 WRITE (NDSO,3992) -!/O1 END IF -!/O1 END IF -!/O1 IP0 = NBO(NFBPO-1)+1 -!/O1 IPN = NBO(NFBPO) -!/O1 IPH = IP0 + (IPN-IP0-1)/2 -!/O1 IPI = IPH -IP0 + 1 + MOD(IPN-IP0+1,2) -!/O1 DO IP=IP0, IPH -!/O1 IF ( FLAGLL ) THEN -!/O1 WRITE (NDSO,1993) IP-NBO(NFBPO-1), & -!/O1 FACTOR*XBPO(IP), & -!/O1 FACTOR*YBPO(IP), & -!/O1 IP+IPI-NBO(NFBPO-1), & -!/O1 FACTOR*XBPO(IP+IPI), & -!/O1 FACTOR*YBPO(IP+IPI) -!/O1 ELSE -!/O1 WRITE (NDSO,3993) IP-NBO(NFBPO-1), & -!/O1 FACTOR*XBPO(IP), & -!/O1 FACTOR*YBPO(IP), & -!/O1 IP+IPI-NBO(NFBPO-1), & -!/O1 FACTOR*XBPO(IP+IPI), & -!/O1 FACTOR*YBPO(IP+IPI) -!/O1 END IF -!/O1 END DO -!/O1 IF ( MOD(IPN-IP0+1,2) .EQ. 1 ) THEN -!/O1 IF ( FLAGLL ) THEN -!/O1 WRITE (NDSO, 993) IPH+1-NBO(NFBPO-1), & -!/O1 FACTOR*XBPO(IPH+1), & -!/O1 FACTOR*YBPO(IPH+1) -!/O1 ELSE -!/O1 WRITE (NDSO,2993) IPH+1-NBO(NFBPO-1), & -!/O1 FACTOR*XBPO(IPH+1), & -!/O1 FACTOR*YBPO(IPH+1) -!/O1 END IF -!/O1 END IF -!/O1 WRITE (NDSO,*) - 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 - - - - - - - - - - - - - - - - - - - - - -! -!/RTD ! If either base or destination grid is rotated lat-lon -!/RTD IF ( allocated(BDYLON) .eqv. .TRUE. ) THEN -!/RTD deallocate( BDYLON, BDYLAT ) -!/RTD IF ( bPolat < 90. .OR. Polat < 90. ) & -!/RTD deallocate( ELatbdy, ELonbdy, Anglbdy ) -!/RTD END IF -!/RTD allocate( BDYLON(NPO), BDYLAT(NPO)) -!/RTD IF ( bPolat < 90. .OR. Polat < 90. ) & -!/RTD allocate( ELatbdy(NPO), ELonbdy(NPO), Anglbdy(NPO) ) -!/RTD ! -!/T WRITE (NDST,9090) -! - DO IP=1, NPO -! - XO = XO0 + REAL(IP-1)*DXO - YO = YO0 + REAL(IP-1)*DYO -!/RTD ! -!/RTD ! Boundary points are specified in coordinates of the destination grid -!/RTD ! -!/RTD ! Collect the line segment points into arrays -!/RTD BDYLON(IP) = XO -!/RTD BDYLAT(IP) = YO -!/RTD ! Close the loop before calculating rotated lat-lon coordinates. -!/RTD END DO -!/RTD -!/RTD ! Create one or two sets of the segment points: -!/RTD ! 1. (BDYLAT, BDYLON) in standard lat-lon coordinates, -!/RTD ! 2. Also (ELatbdy, ELonbdy) in case the base grid is rotated -!/RTD -!/RTD IF ( bPolat < 90. ) THEN -!/RTD ! The destination grid is rotated (std->rot or rot->rot) -!/RTD ! Change BDYLAT, BDYLON to their standard lat-lon positions -!/RTD ! Let ELatbdy,ELonbdy contain the rotated lat-lon coordinates -!/RTD ELatbdy(:) = BDYLAT(:) -!/RTD ELonbdy(:) = BDYLON(:) -!/RTD CALL W3EQTOLL ( ELatbdy, ELonbdy, BDYLAT, BDYLON, & -!/RTD & Anglbdy, bPolat, bPolon, NPO ) -!/RTD ! Let the standard longitudes BDYLON be within the range [-180.,180.[ -!/RTD ! or [0., 360.[ depending on the grid pole -!/RTD IF ( Polon < -90. .OR. Polon > 90. ) THEN -!/RTD BDYLON(:) = MOD( BDYLON(:) + 180., 360. ) - 180. -!/RTD ELSE -!/RTD BDYLON(:) = MOD( BDYLON(:) + 360., 360. ) -!/RTD END IF -!/RTD END IF ! bPolat < 90. -!/RTD ! From now, BDYLAT, BDYLON are defined in standard lat-lon coordinates -!/RTD ! -!/RTD IF ( Polat < 90. ) THEN -!/RTD ! The base grid is rotated (rot->std or rot->rot) -!/RTD ! Find lat-lon in coordinates of the rotated base grid -!/RTD CALL W3LLTOEQ ( BDYLAT, BDYLON, ELatbdy, ELonbdy, & -!/RTD & Anglbdy, Polat, Polon, NPO ) -!/RTD END IF -!/RTD ! -!/RTD ! Take up again the loop over the line segment points -!/RTD DO IP=1, NPO -!/RTD IF ( Polat < 90. ) THEN -!/RTD ! The base grid is rotated (rot->std, rot->rot) -!/RTD ! (The std. lat-lon values BDYLAT, BDYLON go to YBPO, XBPO) -!/RTD XO = ELonbdy(IP) -!/RTD YO = ELatbdy(IP) -!/RTD ELSE -!/RTD ! The base grid is standard geographic (std->rot or std->std) -!/RTD XO = BDYLON(IP) -!/RTD YO = BDYLAT(IP) -!/RTD END IF -! -! ... 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 ; -! -!/T WRITE (NDST,9091) FACTOR*XO, FACTOR*YO, & -!/T (IXR(J), IYR(J), RD(J), J=1,4) -! -! ... 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 -! -!/RTD ! BDYLAT, BDYLON contain Y0, X0, which are remapped to standard lat/lon. -!/RTD ! BDYLAT, BDYLON are stored in the mod_def file. -!/RTD IF ( Polat < 90. ) THEN -!/RTD XO = BDYLON(IP) -!/RTD YO = BDYLAT(IP) -!/RTD END IF - 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 -! -!/T WRITE (NDST,9092) RDTOT, (RDBPO(NBOTOT,J),J=1,4) -! -! ... 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 -! -!/T WRITE (NDST,9093) ISEAI, (IPBPO(NBOTOT,J),J=1,4) -! -! ... 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 -! -!/T0 WRITE (NDST,9095) -!/T0 DO IFILE=1, NFBPO -!/T0 DO IP=NBO2(IFILE-1)+1, NBO2(IFILE) -!/T0 WRITE (NDST,9096) IFILE, IP-NBO2(IFILE-1), ISBPO(IP) -!/T0 END DO -!/T0 END DO -! -!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -!10. Write model definition file. -! - WRITE (NDSO,999) - CALL W3IOGR ( 'WRITE', NDSM ) -! - CLOSE (NDSM) -! - 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) - -!/SCRIP GRID1_UNITS='degrees' ! the other option is radians...we don't use this -!/SCRIP GRID1_NAME='src' ! this is not used, except for netcdf output -!/SCRIP CALL GET_SCRIP_INFO(1, & -!/SCRIP & GRID1_CENTER_LON, GRID1_CENTER_LAT, & -!/SCRIP & GRID1_CORNER_LON, GRID1_CORNER_LAT, GRID1_MASK, & -!/SCRIP & GRID1_DIMS, GRID1_SIZE, GRID1_CORNERS, GRID1_RANK) -!/SCRIP -!/SCRIP - -!/SCRIP IF (GTYPE .EQ. UNGTYPE) THEN -!/SCRIP GRID1_RANK=1 -!/SCRIP DEALLOCATE(GRID1_DIMS) -!/SCRIP ALLOCATE(GRID1_DIMS(GRID1_RANK)) -!/SCRIP GRID1_DIMS(1) = GRID1_SIZE -!/SCRIP ENDIF - -!/SCRIP DO I = 1,GRID1_SIZE -!/SCRIP IF (GRID1_CENTER_LON(I) < 0.0) THEN -!/SCRIP GRID1_CENTER_LON(I) = GRID1_CENTER_LON(I)+360.0 -!/SCRIP ENDIF -!/SCRIP DO J = 1,GRID1_CORNERS -!/SCRIP IF (GRID1_CORNER_LON(J,I) < 0.0) THEN -!/SCRIP GRID1_CORNER_LON(J,I) = GRID1_CORNER_LON(J,I)+360.0 -!/SCRIP ENDIF -!/SCRIP ENDDO -!/SCRIP ENDDO - -!/SCRIPNC IERR = NF90_CREATE(TRIM('scrip.nc'), NF90_NETCDF4, NCID) -!/SCRIPNC IERR = NF90_DEF_DIM(NCID, 'grid_size', GRID1_SIZE, grid_size_dimid) -!/SCRIPNC IERR = NF90_DEF_DIM(NCID, 'grid_corners', GRID1_CORNERS, grid_corners_dimid) -!/SCRIPNC IERR = NF90_DEF_DIM(NCID, 'grid_rank', GRID1_RANK, grid_rank_dimid) - -!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_center_lat', NF90_DOUBLE, & -!/SCRIPNC (/grid_size_dimid/),grid_center_lat_varid) -!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_center_lon', NF90_DOUBLE, & -!/SCRIPNC (/grid_size_dimid/),grid_center_lon_varid) -!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_corner_lat', NF90_DOUBLE, & -!/SCRIPNC (/grid_corners_dimid,grid_size_dimid/), & -!/SCRIPNC grid_corner_lat_varid) -!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_corner_lon', NF90_DOUBLE, & -!/SCRIPNC (/grid_corners_dimid,grid_size_dimid/), & -!/SCRIPNC grid_corner_lon_varid) -!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_imask', NF90_INT, & -!/SCRIPNC (/grid_size_dimid/),grid_imask_varid) -!/SCRIPNC IERR = NF90_DEF_VAR(NCID, 'grid_dims', NF90_INT, & -!/SCRIPNC (/grid_rank_dimid/),grid_dims_varid) -!/SCRIPNC IERR = NF90_ENDDEF(NCID) - -!/SCRIP ALLOCATE(GRID1_IMASK(GRID1_DIMS(1))) -!/SCRIP GRID1_IMASK = 0 -!/SCRIP DO I = 1,GRID1_DIMS(1) -!/SCRIP IF (GRID1_MASK(I)) THEN -!/SCRIP GRID1_IMASK(I) = 1 -!/SCRIP ENDIF -!/SCRIP ENDDO - -!/SCRIPNC IERR = NF90_PUT_ATT(NCID,grid_center_lat_varid,'units',GRID1_UNITS) -!/SCRIPNC IERR = NF90_PUT_ATT(NCID,grid_center_lon_varid,'units',GRID1_UNITS) -!/SCRIPNC IERR = NF90_PUT_ATT(NCID,grid_corner_lat_varid,'units',GRID1_UNITS) -!/SCRIPNC IERR = NF90_PUT_ATT(NCID,grid_corner_lon_varid,'units',GRID1_UNITS) -!/SCRIPNC IERR = NF90_PUT_ATT(NCID,grid_imask_varid,'units','unitless') - -!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_center_lat_varid,GRID1_CENTER_LAT) -!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_center_lon_varid,GRID1_CENTER_LON) -!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_corner_lat_varid,GRID1_CORNER_LAT) -!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_corner_lon_varid,GRID1_CORNER_LON) -!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_imask_varid,GRID1_IMASK) -!/SCRIPNC IERR = NF90_PUT_VAR(NCID,grid_dims_varid,GRID1_DIMS) -!/SCRIPNC IERR = NF90_CLOSE(NCID) - - -! -! 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.'/) -! -!/FLX1 810 FORMAT (/' Stresses (Wu 1980)'/ & -!/FLX1 ' --------------------------------------------------'/) -!/FLX2 810 FORMAT (/' Stresses (T&C 96)'/ & -!/FLX2 ' --------------------------------------------------'/) -!/FLX3 810 FORMAT (/' Stresses (T&C 96 capped) ',A/ & -!/FLX3 ' --------------------------------------------------') -!/FLX4 810 FORMAT (/' Stresses (Hwang 2011) ',A/ & -!/FLX4 ' --------------------------------------------------') -!/FLX4 811 FORMAT ( ' drag coefficient scaling :',F8.2 /) -!/FLX4 2810 FORMAT ( ' &FLX4 CDFAC =',F6.3,' /') -!/FLX3 811 FORMAT ( ' Max Cd * 10^3 :',F8.2/ & -!/FLX3 ' Cap type : ',A/) -!/FLX3 2810 FORMAT ( ' &FLX3 CDMAX =',F6.2,'E-3 , CTYPE = ',I1,' /') -! -!/LN0 820 FORMAT (/' Linear input not defined.'/) -!/SEED 820 FORMAT (/' Seeding as proxi for linear input.'/) -! -!/LN1 820 FORMAT (/' Linear input (C&M-R 82) ',A/ & -!/LN1 ' --------------------------------------------------') -!/LN1 821 FORMAT ( ' CLIN :',f8.2/ & -!/LN1 ' Factor for fPM in filter :',F8.2/ & -!/LN1 ' Factor for fh in filter :',F8.2/) -!/LN1 2820 FORMAT ( ' &SLN1 CLIN =',F6.1,', RFPM =',F6.2, & -!/LN1 ', RFHF =',F6.2,' /') -! -!/LNX 820 FORMAT (/' Experimental linear input.'/) -! -!/ST0 920 FORMAT (/' Wind input not defined.'/) -! -!/ST1 920 FORMAT (/' Wind input (WAM-3) ',A/ & -!/ST1 ' --------------------------------------------------') -!/ST1 921 FORMAT ( ' Cinp :',E10.3/) -!/ST1 2920 FORMAT ( ' &SIN1 CINP =',F7.3,' /') -! -!/ST2 920 FORMAT (/' Wind input (T&C 1996) ',A/ & -!/ST2 ' --------------------------------------------------') -!/ST2 921 FORMAT ( ' Height of input wind (m) :',F8.2/ & -!/ST2 ' Factor negative swell :',F9.3/) -!/STAB2 1921 FORMAT ( ' Effective wind mean factor :',F8.2/ & -!/STAB2 ' Stability par. offset :',F9.3/ & -!/STAB2 ' Stab. correction :',F9.3,F8.3/& -!/STAB2 ' Stab. correction stab. fac. :',F7.1,F9.1/) -!/ST2 2920 FORMAT ( ' &SIN2 ZWND =',F5.1,', SWELLF =',F6.3,' /') -!/STAB2 2921 FORMAT ( ' &SIN2 ZWND =',F5.1,', SWELLF =',F6.3,', STABSH =', & -!/STAB2 F6.3,', STABOF = ',E10.3,','/ & -!/STAB2 ' CNEG =',F7.3,', CPOS =',F7.3,', FNEG =',F7.1,' /') -! -!/ST3 920 FORMAT (/' Wind input (WAM 4+) ',A/ & -!/ST3 ' --------------------------------------------------') -!/ST3 921 FORMAT ( ' minimum Charnock coeff. :',F10.4/ & -!/ST3 ' betamax :',F9.3/ & -!/ST3 ' power of cos. in wind input :',F9.3/ & -!/ST3 ' z0max :',F9.3/ & -!/ST3 ' zalp :',F9.3/ & -!/ST3 ' Height of input wind (m) :',F8.2/ & -!/ST3 ' swell attenuation factor :',F9.3/ ) -!/ST3 2920 FORMAT ( ' &SIN3 ZWND =',F5.1,', ALPHA0 =',F8.5,', Z0MAX =',F8.5,', BETAMAX =', & -!/ST3 F8.5,','/ & -!/ST3 ' SINTHP =',F8.5,', ZALP =',F8.5,','/ & -!/ST3 ' SWELLF =',F8.5,'R /'/) -! -!/ST4 920 FORMAT (/' Wind input (WAM 4+) ',A/ & -!/ST4 ' --------------------------------------------------') -!/ST4 921 FORMAT ( ' minimum Charnock coeff. :',F10.4/ & -!/ST4 ' betamax :',F9.3/ & -!/ST4 ' power of cos. in wind input :',F9.3/ & -!/ST4 ' z0max :',F9.3/ & -!/ST4 ' zalp :',F9.3/ & -!/ST4 ' Height of input wind (m) :',F8.2/ & -!/ST4 ' wind stress sheltering :',F9.3/ & -!/ST4 ' swell attenuation param. :',I5/ & -!/ST4 ' swell attenuation factor :',F9.3/ & -!/ST4 ' swell attenuation factor2 :',F9.3/ & -!/ST4 ' swell attenuation factor3 :',F9.3/ & -!/ST4 ' critical Reynolds number :',F9.1/ & -!/ST4 ' swell attenuation factor5 :',F9.3/ & -!/ST4 ' swell attenuation factor6 :',F9.3/ & -!/ST4 ' swell attenuation factor7 :',F14.3/ & -!/ST4 ' ratio of z0 for orb. & mean :',F9.3/) -!/ST4 2920 FORMAT ( ' &SIN4 ZWND =',F5.1,', ALPHA0 =',F8.5,', Z0MAX =',F8.5,', BETAMAX =', & -!/ST4 F8.5,','/ & -!/ST4 ' SINTHP =',F8.5,', ZALP =',F8.5,', TAUWSHELTER =',F8.5, & -!/ST4 ', SWELLFPAR =',I2,','/ & -!/ST4 ' SWELLF =',F8.5,', SWELLF2 =',F8.5, & -!/ST4 ', SWELLF3 =',F8.5,', SWELLF4 =',F9.1,','/ & -!/ST4 ' SWELLF5 =',F8.5,', SWELLF6 =',F8.5, & -!/ST4 ', SWELLF7 =',F12.2,', Z0RAT =',F8.5,', SINBR =',F8.5,' /') -! -!/ST6 920 FORMAT (/' Wind input (Donelan et al, 2006) ',A/ & -!/ST6 ' --------------------------------------------------') -!/ST6 921 FORMAT ( ' negative wind input active : ',A/ & -!/ST6 ' attenuation factor : ',F6.2/ & -!/ST6 ' wind speed scaling factor : ',F6.2/ & -!/ST6 ' frequency cut-off factor : ',F6.2/) -!/ST6 2920 FORMAT ( ' &SIN6 SINA0 =', F6.3, ', SINWS =', F6.2, ', SINFC =', F6.2, ' /') -! -!/STX 920 FORMAT (/' Experimental wind input.'/) -! -!/NL0 922 FORMAT (/' Nonlinear interactions not defined.'/) -! -!/NL1 922 FORMAT (/' Nonlinear interactions (DIA) ',A/ & -!/NL1 ' --------------------------------------------------') -!/NL1 923 FORMAT ( ' Lambda :',F8.2/ & -!/NL1 ' Prop. constant :',E10.3/ & -!/NL1 ' kd conversion factor :',F8.2/ & -!/NL1 ' minimum kd :',F8.2/ & -!/NL1 ' shallow water constants :',F8.2,2F6.2/) -!/NL1 2922 FORMAT ( ' &SNL1 LAMBDA =',F7.3,', NLPROP =',E10.3, & -!/NL1 ', KDCONV =',F7.3,', KDMIN =',F7.3,','/ & -!/NL1 ' SNLCS1 =',F7.3,', SNLCS2 =',F7.3, & -!/NL1 ', SNLCS3 = ',F7.3,' /') -! -!/NL2 922 FORMAT (/' Nonlinear interactions (WRT) ',A/ & -!/NL2 ' --------------------------------------------------') -!/NL2 923 FORMAT ( ' Deep/shallow options : ',A/ & -!/NL2 ' Power of h-f tail : ',F6.1) -!/NL2 1923 FORMAT ( ' Number of depths used : ',I4/ & -!/NL2 ' Depths (m) :',5F7.1) -!/NL2 2923 FORMAT ( ' ',5F7.1) -!/NL2 2922 FORMAT ( ' &SNL2 IQTYPE =',I2,', TAILNL =',F5.1,',', & -!/NL2 ' NDEPTH =',I3,' /') -!/NL2 3923 FORMAT ( ' &SNL2 DEPTHS =',F9.2,' /') -!/NL2 4923 FORMAT ( ' &ANL2 DEPTHS =',F9.2,' ,') -!/NL2 5923 FORMAT ( ' ',F9.2,' ,') -!/NL2 6923 FORMAT ( ' ',F9.2,' /') -! -!/NL3 922 FORMAT (/' Nonlinear interactions (GMD) ',A/ & -!/NL3 ' --------------------------------------------------') -!/NL3 923 FORMAT ( ' Powers in scaling functions : ',2F7.2/ & -!/NL3 ' Nondimension filter depths : ',2F7.2) -!/NL3 1923 FORMAT ( ' Number of quad. definitions : ',I4) -!/NL3 2923 FORMAT ( ' ',2F8.3,F6.1,2E12.4) -!/NL3 2922 FORMAT ( ' &SNL3 NQDEF =',I3,', MSC =',F6.2,', NSC =', & -!/NL3 F6.2,', KDFD =',F6.2,', KDFS =',F6.2,' /') -!/NL3 3923 FORMAT ( ' &ANL3 QPARMS = ',2(F5.3,', '),F5.1,', ',E10.4, & -!/NL3 ', ',E10.4,' /') -!/NL3 4923 FORMAT ( ' &ANL3 QPARMS = ',2(F5.3,', '),F5.1,', ',E10.4, & -!/NL3 ', ',E10.4,' ,') -!/NL3 5923 FORMAT ( ' ',2(F5.3,', '),F5.1,', ',E10.4, & -!/NL3 ', ',E10.4,' ,') -!/NL3 6923 FORMAT ( ' ',2(F5.3,', '),F5.1,', ',E10.4, & -!/NL3 ', ',E10.4,' /') -! -!/NL4 922 FORMAT (/' Nonlinear interactions (TSA) ',A/ & -!/NL4 ' --------------------------------------------------') -!/NL4 923 FORMAT ( ' Source term computation (1=TSA,0=FBI) : ',I2/ & -!/NL4 ' Alternate loops (1=no,2=yes) : ',I2/ & -!/NL4 ' (To speed up computation) ') -!/NL4 2922 FORMAT ( ' &SNL4 ITSA =',I2,', IALT =',I2 ) -! -!/NLX 922 FORMAT (/' Experimental nonlinear interactions.'/) -! -!/NLS 9922 FORMAT (/' HF filter based on Snl ',A/ & -!/NLS ' --------------------------------------------------') -!/NLS 9923 FORMAT ( ' a34 (lambda) :',F9.3,F9.4/ & -!/NLS ' Prop. constant :',E10.3/ & -!/NLS ' maximum relative change :',F9.3/ & -!/NLS ' filter constants :',F8.2,2F6.2/) -!/NLS 8922 FORMAT ( ' &SNLS A34 =',F6.3,', FHFC =',E11.4, & -!/NLS ', DNM =',F6.3,','/' FC1 =',F6.3, & -!/NLS ', FC2 =',F6.3,', FC3 =',F6.3,' /') -! -!/ST0 924 FORMAT (/' Dissipation not defined.'/) -! -!/ST1 924 FORMAT (/' Dissipation (WAM-3) ',A/ & -!/ST1 ' --------------------------------------------------') -!/ST1 925 FORMAT ( ' Cdis :',E10.3/ & -!/ST1 ' Apm :',E10.3/) -!/ST1 2924 FORMAT ( ' &SDS1 CDIS =',E12.4,', APM =',E11.4,' /') -! -!/ST2 924 FORMAT (/' Dissipation (T&C 1996) ',A/ & -!/ST2 ' --------------------------------------------------') -!/ST2 925 FORMAT ( ' High-frequency constants :',F8.2,E11.3,F6.2/ & -!/ST2 ' Low-frequency constants :',E11.3,F6.2/& -!/ST2 ' ',E11.3,F6.2/& -!/ST2 ' Minimum input peak freq. (-):',F10.4/ & -!/ST2 ' Minimum PHI :',F10.4/) -!/ST2 2924 FORMAT ( ' &SDS2 SDSA0 =',E10.3,', SDSA1 =',E10.3,', SDSA2 =', & -!/ST2 E10.3,', '/ & -!/ST2 ' SDSB0 =',E10.3,', SDSB1 =',E10.3,', ', & -!/ST2 'PHIMIN =',E10.3,' /') -! -!/ST3 924 FORMAT (/' Dissipation (WAM Cycle 4+) ',A/ & -!/ST3 ' --------------------------------------------------') -!/ST3 925 FORMAT ( ' SDSC1 :',1E11.3/ & -!/ST3 ' Power of k in mean k :',F8.2/ & -!/ST3 ' weights of k and k^2 :',F9.3,F6.3/) -!/ST3 2924 FORMAT ( ' &SDS3 SDSC1 =',E12.4,', WNMEANP =',F4.2, & -!/ST3 ', FXPM3 =', F4.2,',FXFM3 =',F4.2,', '/ & -!/ST3 ' SDSDELTA1 =', F5.2,', SDSDELTA2 =',F5.2, & -!/ST3 ' /') -! -!/ST4 924 FORMAT (/' Dissipation (Ardhuin / Filipot / Romero ) ',A/ & -!/ST4 ' --------------------------------------------------') -!/ST4 925 FORMAT ( ' SDSC2, SDSBCK, SDSCUM :',3E11.3/ & -!/ST4 ' Power of k in mean k :',F8.2/) - - -!/ST4 2924 FORMAT ( ' &SDS4 SDSBCHOICE = ',F3.1, & -!/ST4 ', SDSC2 =',E12.4,', SDSCUM =',F6.2,', '/ & -!/ST4 ' SDSC4 =',F6.2,', SDSC5 =',E12.4, & -!/ST4 ', SDSC6 =',E12.4,','/ & -!/ST4 ' WNMEANP =',F4.2,', FXPM3 =', F4.2, & -!/ST4 ', FXFM3 =',F4.1,', FXFMAGE =',F6.3, ', '/ & -!/ST4 ' SDSBINT =',E12.4,', SDSBCK =',E12.4, & -!/ST4 ', SDSABK =',F6.3,', SDSPBK =',F6.3,', '/ & -!/ST4 ' SDSHCK =',F5.2,', SDSBR = ',E12.4, & -!/ST4 ', SDSSTRAIN =',F5.1,', SDSSTRAINA =',F4.1, & -!/ST4 ', SDSSTRAIN2 =',F5.1,', '/ & -!/ST4 ' SDSBT =',F5.2,', SDSP =',F5.2, & -!/ST4 ', SDSISO =',I2, & -!/ST4 ', SDSCOS =',F3.1,', SDSDTH =',F5.1,', '/ & -!/ST4 ' SDSBRF1 = ',F5.2,', SDSBRFDF =',I2,', '/ & -!/ST4 ' SDSBM0 = ',F5.2, ', SDSBM1 =',F5.2, & -!/ST4 ', SDSBM2 =',F5.2,', SDSBM3 =',F5.2,', SDSBM4 =', & -!/ST4 F5.2,', '/, & -!/ST4 ' SPMSS = ',F5.2, ', SDKOF =',F5.2, & -!/ST4 ', SDSMWD =',F5.2,', SDSFACMTF =',F5.1,', '/ & -!/ST4 ' SDSMWPOW =',F3.1,', SDSNMTF =', F5.2, & -!/ST4 ', SDSCUMP =', F3.1,', SDSNUW =', E8.3,', '/, & -!/ST4 ' WHITECAPWIDTH =',F5.2, ' WHITECAPDUR =',F5.2,' /') -! -!/ST6 924 FORMAT (/' Dissipation (Rogers et al. 2012) ',A/ & -!/ST6 ' --------------------------------------------------') -!/ST6 925 FORMAT ( ' normalise by threshold spectral density : ',A/& -!/ST6 ' normalise by spectral density : ',A/& -!/ST6 ' coefficient and exponent for '/ & -!/ST6 ' inherent breaking term a1, L as in (21) : ',E9.3,I3/ & -!/ST6 ' cumulative breaking term a2, M as in (22) : ',E9.3,I3/ & -!/ST6 ' ') -!/ST6 2924 FORMAT ( ' &SDS6 SDSET = ',L,', SDSA1 = ',E9.3, & -!/ST6 ', SDSA2 = ',E9.3,', SDSP1 = ',I2,', SDSP1 = ', & -!/ST6 I2,' /' ) -!/ST6 -!/ST6 937 FORMAT (/' Swell dissipation ',A/ & -!/ST6 ' --------------------------------------------------') -!/ST6 940 FORMAT ( ' subroutine W3SWL6 activated : ',A/ & -!/ST6 ' coefficient b1 ',A, ' : ',E9.3/ ) -!/ST6 2937 FORMAT ( ' &SWL6 SWLB1 = ',E9.3,', CSTB1 = ',L,' /') -! -!/STX 924 FORMAT (/' Experimental dissipation.'/) -! -!/BT0 926 FORMAT (/' Bottom friction not defined.'/) -! -!/BT1 926 FORMAT (/' Bottom friction (JONSWAP) ',A/ & -!/BT1 ' --------------------------------------------------') -!/BT1 927 FORMAT ( ' gamma :',F8.4/) -!/BT1 2926 FORMAT ( ' &SBT1 GAMMA =',E12.4,' /') -! -!/BT4 926 FORMAT (/' Bottom friction (SHOWEX) ',A/ & -!/BT4 ' --------------------------------------------------') -!/BT4 927 FORMAT ( ' SEDMAPD50, SED_D50_UNIFORM :',L3,1X,F8.6/ & -!/BT4 ' RIPFAC1,RIPFAC2,RIPFAC3,RIPFAC4 :',4F8.4/ & -!/BT4 ' SIGDEPTH, BOTROUGHMIN, BOTROUGHFAC:',3F8.4/) -!/BT4 2926 FORMAT ( ' &SBT4 SEDMAPD50 =',L3,', SED_D50_UNIFORM =',F8.6,','/ & -!/BT4 ' RIPFAC1 =',F8.4,', RIPFAC2 =',F8.4, & -!/BT4 ', RIPFAC3 =',F8.4,', RIPFAC4 =',F8.4,','/ & -!/BT4 ' SIGDEPTH =',F8.4,', BOTROUGHMIN =',F8.4, & -!/BT4 ', BOTROUGHFAC =',F4.1,' /') -!/BTX 926 FORMAT (/' Experimental bottom friction.'/) -! -!/DB0 928 FORMAT (/' Surf breaking not defined.'/) -! -!/DB1 928 FORMAT (/' Surf breaking (B&J 1978) ',A/ & -!/DB1 ' --------------------------------------------------') -!/DB1 929 FORMAT ( ' alpha :',F8.3/ & -!/DB1 ' gamma :',F8.3) -!/DB1 2928 FORMAT ( ' &SDB1 BJALFA =',F7.3,', BJGAM =',F7.3, & -!/DB1 ', BJFLAG = ',A,' /') -! -!/DBX 928 FORMAT (/' Experimental depth-induced breaking.'/) -! -!/TR0 930 FORMAT (/' Triad interactions not defined.'/) -!/TRX 930 FORMAT (/' Experimental triad interactions.'/) -! -!/BS0 932 FORMAT (/' Bottom scattering not defined.'/) -!/BS1 932 FORMAT (/' Experimental bottom scattering (F. Ardhuin).'/) -!/BSX 932 FORMAT (/' Experimental bottom scattering.'/) -! -!/XX0 934 FORMAT (/' Alternative source term slot not used.'/) -!/XXX 934 FORMAT (/' Experimental unclasified source term.'/) -! -!/IC1 935 FORMAT (/' Dissipation via ice parameters (SIC1).'& -!/IC1 ,/' --------------------------------------------------') -! -!/IC2 935 FORMAT (/' Dissipation via ice parameters (SIC2).'& -!/IC2 ,/' --------------------------------------------------') -! -!/IC3 935 FORMAT (/' Dissipation via ice parameters (SIC3).'& -!/IC3 ,/' --------------------------------------------------') -! -!/IC4 935 FORMAT (/' Dissipation via ice parameters (SIC4).'& -!/IC4 ,/' --------------------------------------------------') -! -!/IC5 935 FORMAT (/' Dissipation via ice parameters (SIC5).'& -!/IC5 ,/' --------------------------------------------------') -! -!/IS0 944 FORMAT (/' Ice scattering not defined.'/) -!/IS1 945 FORMAT (/' Ice scattering ',A,/ & -!/IS1 ' --------------------------------------------------') -!/IS1 946 FORMAT (' Isotropic (linear function of ice concentration)'/& -!/IS1 ' slope : ',E10.3/ & -!/IS1 ' offset : ',E10.3) -!/IS1 2946 FORMAT ( ' &SIS1 ISC1 =',E9.3,', ISC2 =',E9.3) -!/IS2 947 FORMAT (/' Ice scattering ',A,/ & -!/IS2 ' --------------------------------------------------') -!/IS2 948 FORMAT (' IS2 Scattering ... '/& -!/IS2 ' scattering coefficient : ',E9.3/ & -!/IS2 ' 0: no back-scattering : ',E9.3/ & -!/IS2 ' TRUE: istropic back-scattering : ',L3/ & -!/IS2 ' TRUE: update of ICEDMAX : ',L3/ & -!/IS2 ' TRUE: keeps updated ICEDMAX : ',L3/ & -!/IS2 ' flexural strength : ',E9.3/ & -!/IS2 ' TRUE: uses Robinson-Palmer disp.: ',L3/ & -!/IS2 ' attenuation : ',F5.2/ & -!/IS2 ' fragility : ',F5.2/ & -!/IS2 ' minimum floe size in meters : ',F5.2/ & -!/IS2 ' pack scattering coef 1 : ',F5.2/ & -!/IS2 ' pack scattering coef 2 : ',F5.2/ & -!/IS2 ' scaling by concentration : ',F5.2/ & -!/IS2 ' creep B coefficient : ',E9.3/ & -!/IS2 ' creep C coefficient : ',F5.2/ & -!/IS2 ' creep D coefficient : ',F5.2/ & -!/IS2 ' creep N power : ',F5.2/ & -!/IS2 ' elastic energy factor : ',F5.2/ & -!/IS2 ' factor for ice breakup : ',F5.2/ & -!/IS2 ' IS2WIM1 : ',F5.2/ & -!/IS2 ' anelastic dissipation : ',L3/ & -!/IS2 ' energy of activation : ',F5.2/ & -!/IS2 ' anelastic coefficient : ',E11.3/ & -!/IS2 ' anelastic exponent : ',F5.2) -!/IS2 2948 FORMAT ( ' &SIS2 ISC1 =',E9.3,', IS2BACKSCAT =',E9.3, & -!/IS2 ', IS2ISOSCAT =',L3,', IS2BREAK =',L3, & -!/IS2 ', IS2DUPDATE =',L3,','/ & -!/IS2 ' IS2FLEXSTR =',E11.3,', IS2DISP =',L3, & -!/IS2 ', IS2DAMP =',F3.1, & -!/IS2 ', IS2FRAGILITY =',F4.2,', IS2DMIN =',F5.2,','/ & -!/IS2 ' IS2C2 =',F12.8,', IS2C3 =',F8.4, & -!/IS2 ', IS2CONC =',F5.1,', IS2CREEPB =',E11.3,','/ & -!/IS2 ' IS2CREEPC =',F5.2,', IS2CREEPD =',F5.2, & -!/IS2 ', IS2CREEPN =',F5.2,','/ & -!/IS2 ' IS2BREAKE =',F5.2, & -!/IS2 ', IS2BREAKF =',F5.2,', IS2WIM1 =',F5.2,','/ & -!/IS2 ', IS2ANDISB =',L3,', IS2ANDISE =',F5.2, & -!/IS2 ', IS2ANDISD =',E11.3,', IS2ANDISN=',F5.2, ' /') -!/UOST 4500 FORMAT (/' Unresolved Obstacles Source Term (UOST) ',A,/ & -!/UOST ' --------------------------------------------------') -!/UOST 4501 FORMAT (' local alpha-beta file: ',A, & -!/UOST ' shadow alpha-beta file: ',A,/ & -!/UOST ' local calibration factor: ',F5.2, & -!/UOST ' shadow calibration factor: ',F5.2) -!/UOST 4502 FORMAT (' &UOST UOSTFILELOCAL = ',A,', UOSTFILESHADOW = ',A,/ & -!/UOST ' UOSTFACTORLOCAL = ',F5.2', UOSTFACTORSHADOW = ',F5.2,' /') -! - 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) -!/PR1 953 FORMAT ( ' CFLmax depth refraction :',F9.3/) -!/PR1 2953 FORMAT ( ' &PRO1 CFLTM =',F5.2,' /') -! -!/PR2 953 FORMAT ( ' CFLmax depth refraction :',F9.3/ & -!/PR2 ' Effective swell age (h) : switched off'/ & -!/PR2 ' Cut-off latitude (degr.) :',F7.1/) -!/PR2 954 FORMAT ( ' CFLmax depth refraction :',F9.3/ & -!/PR2 ' Effective swell age (h) :',F8.2/ & -!/PR2 ' Cut-off latitude (degr.) :',F7.1/) -!/PR2 2953 FORMAT ( ' &PRO2 CFLTM =',F5.2,', DTIME =',F8.0, & -!/PR2 ', LATMIN =',F5.1,' /') -! -!/SMC 953 FORMAT ( ' Max propagation CFL number :',F9.3/ & -!/SMC ' Effective swell age (h) : switched off'/ & -!/SMC ' Cut-off latitude (degr.) :',F8.2/ & -!/SMC ' Maximum refraction (degr.) :',F8.2/) -!/SMC 954 FORMAT ( ' Max propagation CFL number :',F9.3/ & -!/SMC ' Effective swell age (h) :',F8.2/ & -!/SMC ' Cut-off latitude (degr.) :',F8.2/ & -!/SMC ' Maximum refraction (degr.) :',F8.2/) -!/SMC 2953 FORMAT ( ' &PSMC CFLTM =',F5.2,', DTIME =', F9.1/ & -!/SMC ' LATMIN =',F5.1,', RFMAXD =', F9.2/ & -!/SMC ' UNO3 =',L5, ', AVERG =',L5/ & -!/SMC ' LvSMC =',i5, ', NBISMC =',i9/ & -!/SMC ' ISHFT =',i5, ', JEQT =',i9/ & -!/SMC ' SEAWND =',L5, ' /') -! -!/PR3 953 FORMAT ( ' CFLmax depth refraction :',F9.3/ & -!/PR3 ' Averaging area factor Cg :',F8.2) -!/PR3 954 FORMAT ( ' Averaging area factor theta :',F8.2) -!/PR3 955 FORMAT ( ' **** Internal maximum .GE.',F6.2,' ****') -!/PR3 2953 FORMAT ( ' &PRO3 CFLTM =',F5.2, & -!/PR3 ', WDTHCG = ',F4.2,', WDTHTH = ',F4.2,' /') -! - 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_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 :'/ & - ' CICE0.NE.CICEN 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) -!/MGG 962 FORMAT ( ' Moving grid GSE cor. power :',F8.2) -!/SCRIP 963 FORMAT( ' Grid offset for multi-grid w/SCRIP : ',E11.3) - 1972 FORMAT ( ' Compression of track output : ',L3) -!/SEED 964 FORMAT ( ' Xseed in seeding algorithm :',F8.2) - 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) -! -!/REF1 969 FORMAT (/' Shoreline reflection ',A/ & -!/REF1 ' --------------------------------------------------') -! -!/IG1 970 FORMAT (/' Second order and infragravity waves ',A/ & -!/IG1 ' --------------------------------------------------') -! - 5971 FORMAT (' Partitioning method : ',A) - 5972 FORMAT (' Namelist options overridden : ',A) -! -!/IC2 971 FORMAT (/' Boundary layer below ice ',A/ & -!/IC2 ' --------------------------------------------------') -!/IC3 971 FORMAT (/' Visco-elastic ice layer ',A/ & -!/IC3 ' --------------------------------------------------') -!/IC4 971 FORMAT (/' Empirical wave-ice physics ',A/ & -!/IC4 ' --------------------------------------------------') -!/IC5 971 FORMAT (/' Visco-elastic ice layer (SIC5) ',A/ & -!/IC5 ' --------------------------------------------------') -!/IC5 2971 FORMAT ( ' Min. Ice shear modulus G : ', E10.1/, & -!/IC5 ' Min. Wave period T : ', F7.2/, & -!/IC5 ' Max. Wavenumber Ratio (Ko/Kr): ', E10.1/, & -!/IC5 ' Max. Attenu. Rate (Ki) : ', E10.1/, & -!/IC5 ' Min. Water depth (d) : ', F5.0/, & -!/IC5 ' Max. # of Newton Iter. : ', F5.0/, & -!/IC5 ' Use Rand. Kick : ', F5.0/, & -!/IC5 ' Excluded Imag. Corridor : ', F9.4/ ) -! - 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 #',I02,' : ',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,' /') -! - 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,' /') -!/RTD -!/RTD 4991 FORMAT ( ' &ROTD PLAT =', F6.2,', PLON =', F7.2,', UNROT =',L3,' /') -!/RTD 4992 FORMAT ( ' &ROTB BPLAT =',9(F6.1,",")/ & -!/RTD ' BPLON =',9(F6.1,","),' /') - - 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) -!/SMC 4001 FORMAT ( ' SMC refined levels NRLv = ',I8) -!/SMC 4002 FORMAT ( ' SMC Equator j shift no. = ',I8) -!/SMC 4302 FORMAT ( ' SMC I-index shift number = ',I8) -!/SMC 4003 FORMAT ( ' SMC input boundary no. = ',I8) -!/SMC 4004 FORMAT ( ' SMC NCel = ',6I9) -!/SMC 4005 FORMAT ( ' IJKCel(5,NCel) read from ', A) -!/SMC 4006 FORMAT (6I8) -!/SMC 4007 FORMAT ( ' SMC NUFc = ',6I9) -!/SMC 4008 FORMAT ( ' IJKUFc(7,NCel) read from ', A) -!/SMC 4009 FORMAT (8I8) -!/SMC 4010 FORMAT ( ' SMC NVFc = ',6I9) -!/SMC 4011 FORMAT ( ' IJKVFc(8,NCel) read from ', A) -!/SMC 4110 FORMAT ( ' SMC NCObsr = ',6I9) -!/SMC 4111 FORMAT ( ' IJKObstr(1,NCel) read from ', A) -!/SMC 4012 FORMAT (9I8) -!/SMC 4013 FORMAT ( ' NBICelin(NBISMC) read from ', A) -!/SMC 4014 FORMAT (2I8) -!/ARC 4015 FORMAT ( ' ARC NARC = ',6I9) -!/ARC 4016 FORMAT ( ' IJKCel(5,NARC) read from ', A) -!/ARC 4017 FORMAT ( ' ARC NAUI = ',6I9) -!/ARC 4018 FORMAT ( ' IJKUFc(7,NAUI) read from ', A) -!/ARC 4019 FORMAT ( ' ARC NAVJ = ',6I9) -!/ARC 4020 FORMAT ( ' IJKVFc(8,NAVJ) read from ', A) -!/SMC 4021 FORMAT ( ' Varables by W3DIMX NCel = ',I9) -!/SMC 4022 FORMAT ( ' Defined NLvCel ',6I9) -!/SMC 4023 FORMAT ( ' Defined NLvUFc ',6I9) -!/SMC 4024 FORMAT ( ' Defined NLvVFc ',6I9) -!/SMC 4025 FORMAT ( ' Define IJKCel from -9 to ',I9) -!/SMC 4026 FORMAT ( ' IJKCel(5,NCel) defined : ') -!/SMC 4027 FORMAT ( ' IJKUFc(7,NUFc) defined : ') -!/SMC 4028 FORMAT ( ' IJKVFc(8,NVFc) defined : ') -!/SMC 4029 FORMAT ( ' Boundary cells IJKCel(:,-9:0) : ') -!/SMC 4030 FORMAT (5I8) -!/SMC 4031 FORMAT ( ' Define MAPSF ... 1 to ',I9) -!/SMC 4032 FORMAT ( ' Multi-Resolution factor = ',I6) -!/SMC 4033 FORMAT ( ' Range of MAPSF(:,1) : ',2I9) -!/SMC 4034 FORMAT ( ' Range of MAPSF(:,2) : ',2I9) -!/SMC 4035 FORMAT ( ' Range of MAPSF(:,3) : ',2I9) -!/SMC 4036 FORMAT ( ' Range of MAPFS(:,:) : ',2I9) -!/ARC 4037 FORMAT ( ' Arctic AngArc defined as ',I6) -!/ARC 4038 FORMAT (9F8.2) -!/ARC 4039 FORMAT ( ' Arctic ICLBAC defined as ',I6) -!/ARC 4040 FORMAT (9I8) -!/RTD 4200 FORMAT ( ' AnglDin(NX,NY) defn checks : ') -!/RTD 4201 FORMAT ( ' JY/IX',4I8) -!/RTD 4202 FORMAT (I12,4F8.2) -!/RTD 4203 FORMAT ( ' Rotated pole lat/lon (deg.) : ',2F9.3) -!/RTD 4204 FORMAT ( ' Output dirns and x-y vectors will be set to True North') - 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/) -! -!/O2a 998 FORMAT (50I2) -!/O2c 1998 FORMAT (50I2) -! - 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 ***'/) -! - 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/) -! - 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) - 1029 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/ & - ' ILLEGAL NUMBER OF !/XXn 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) -!/RTD 1052 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/ & -!/RTD ' WITH NAMELIST VALUE PLAT == 90, PLON MUST BE -180'/ & -!/RTD ' AND UNROT MUST BE .FALSE.' ) -! -!/RTD 1053 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/ & -!/RTD ' WITH NAMELIST VALUE BPLAT == 90, BPLON MUST BE -180') -! - 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 '/) -! -!/T 9090 FORMAT ( ' TEST W3GRID : OUTPUT BOUND. POINT DATA LINE SEG.') -!/T 9091 FORMAT ( ' ',2F8.2,4(2I4,F7.2)) -!/T 9092 FORMAT ( ' ',F7.2,2X,4F7.2) -!/T 9093 FORMAT ( ' ',4I7/ & -!/T ' ',4I7) -! -!/T0 9095 FORMAT ( ' TEST W3GRID : OUTPUT BOUND. POINT SPEC DATA ') -!/T0 9096 FORMAT ( ' ',I3,2I8) -!/ -!/ Internal function READNL ------------------------------------------ / -!/ - CONTAINS -!/ ------------------------------------------------------------------- / - 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 -!/ -!/ ------------------------------------------------------------------- / -!/ -!/S CALL STRACE (IENT, 'READNL') -! - 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) -!/FLD1 CASE('FLD1') -!/FLD1 READ (NDS,NML=FLD1,END=801,ERR=802,IOSTAT=J) -!/FLD2 CASE('FLD2') -!/FLD2 READ (NDS,NML=FLD2,END=801,ERR=802,IOSTAT=J) -!/FLX3 CASE('FLX3') -!/FLX3 READ (NDS,NML=FLX3,END=801,ERR=802,IOSTAT=J) -!/FLX4 CASE('FLX4') -!/FLX4 READ (NDS,NML=FLX4,END=801,ERR=802,IOSTAT=J) -!/LN1 CASE('SLN1') -!/LN1 READ (NDS,NML=SLN1,END=801,ERR=802,IOSTAT=J) -!/ST1 CASE('SIN1') -!/ST1 READ (NDS,NML=SIN1,END=801,ERR=802,IOSTAT=J) -!/ST2 CASE('SIN2') -!/ST2 READ (NDS,NML=SIN2,END=801,ERR=802,IOSTAT=J) -!/ST3 CASE('SIN3') -!/ST3 READ (NDS,NML=SIN3,END=801,ERR=802,IOSTAT=J) -!/ST4 CASE('SIN4') -!/ST4 READ (NDS,NML=SIN4,END=801,ERR=802,IOSTAT=J) -!/ST6 CASE('SIN6') -!/ST6 READ (NDS,NML=SIN6,END=801,ERR=802,IOSTAT=J) -!/NL1 CASE('SNL1') -!/NL1 READ (NDS,NML=SNL1,END=801,ERR=802,IOSTAT=J) -!/NL2 CASE('SNL2') -!/NL2 READ (NDS,NML=SNL2,END=801,ERR=802,IOSTAT=J) -!/NL2 CASE('ANL2') -!/NL2 IF ( NDEPTH .GT. 100 ) GOTO 804 -!/NL2 DEPTHS(1:NDEPTH) = DPTHNL -!/NL2 READ (NDS,NML=ANL2,END=801,ERR=802,IOSTAT=J) -!/NL2 DPTHNL = DEPTHS(1:NDEPTH) -!/NL3 CASE('SNL3') -!/NL3 READ (NDS,NML=SNL3,END=801,ERR=802,IOSTAT=J) -!/NL3 CASE('ANL3') -!/NL3 IF ( NQDEF .GT. 100 ) GOTO 804 -!/NL3 READ (NDS,NML=ANL3,END=801,ERR=802,IOSTAT=J) -!/NL4 CASE('SNL4') -!/NL4 READ (NDS,NML=SNL4,END=801,ERR=802,IOSTAT=J) -!/NLS CASE('SNLS') -!/NLS READ (NDS,NML=SNLS,END=801,ERR=802,IOSTAT=J) -!/ST1 CASE('SDS1') -!/ST1 READ (NDS,NML=SDS1,END=801,ERR=802,IOSTAT=J) -!/ST2 CASE('SDS2') -!/ST2 READ (NDS,NML=SDS2,END=801,ERR=802,IOSTAT=J) -!/ST3 CASE('SDS3') -!/ST3 READ (NDS,NML=SDS3,END=801,ERR=802,IOSTAT=J) -!/ST4 CASE('SDS4') -!/ST4 READ (NDS,NML=SDS4,END=801,ERR=802,IOSTAT=J) -!/ST6 CASE('SDS6') -!/ST6 READ (NDS,NML=SDS6,END=801,ERR=802,IOSTAT=J) -!/ST6 CASE('SWL6') -!/ST6 READ (NDS,NML=SWL6,END=801,ERR=802,IOSTAT=J) -!/BT1 CASE('SBT1') -!/BT1 READ (NDS,NML=SBT1,END=801,ERR=802,IOSTAT=J) -!/BT4 CASE('SBT4') -!/BT4 READ (NDS,NML=SBT4,END=801,ERR=802,IOSTAT=J) -!/IS1 CASE('SIS1') -!/IS1 READ (NDS,NML=SIS1,END=801,ERR=802,IOSTAT=J) -!/IS2 CASE('SIS2') -!/IS2 READ (NDS,NML=SIS2,END=801,ERR=802,IOSTAT=J) -!/DB1 CASE('SDB1') -!/DB1 READ (NDS,NML=SDB1,END=801,ERR=802,IOSTAT=J) -!/UOST CASE('UOST') -!/UOST READ (NDS,NML=UOST,END=801,ERR=802,IOSTAT=J) -!/PR1 CASE('PRO1') -!/PR1 READ (NDS,NML=PRO1,END=801,ERR=802,IOSTAT=J) -!/PR2 CASE('PRO2') -!/PR2 READ (NDS,NML=PRO2,END=801,ERR=802,IOSTAT=J) -!/SMC CASE('PSMC') -!/SMC READ (NDS,NML=PSMC,END=801,ERR=802,IOSTAT=J) -!/PR3 CASE('PRO3') -!/PR3 READ (NDS,NML=PRO3,END=801,ERR=802,IOSTAT=J) -!/RTD CASE('ROTD') -!/RTD READ (NDS,NML=ROTD,END=801,ERR=802,IOSTAT=J) -!/RTD CASE('ROTB') -!/RTD READ (NDS,NML=ROTB,END=801,ERR=802,IOSTAT=J) -!/REF1 CASE('REF1') -!/REF1 READ (NDS,NML=REF1,END=801,ERR=802,IOSTAT=J) -!/IG1 CASE('SIG1') -!/IG1 READ (NDS,NML=SIG1,END=801,ERR=802,IOSTAT=J) -!/IC2 CASE('SIC2') -!/IC2 READ (NDS,NML=SIC2,END=801,ERR=802,IOSTAT=J) -!/IC3 CASE('SIC3') -!/IC3 READ (NDS,NML=SIC3,END=801,ERR=802,IOSTAT=J) -!/IC4 CASE('SIC4 ') -!/IC4 READ (NDS,NML=SIC4,END=801,ERR=802,IOSTAT=J) -!/IC5 CASE('SIC5 ') -!/IC5 READ (NDS,NML=SIC5,END=801,ERR=802,IOSTAT=J) - 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 -! -!/NL2 804 CONTINUE -!/NL2 WRITE (NDSE,1004) NDEPTH -!/NL2 CALL EXTCDE(4) -!/NL2 RETURN -! -!/NL3 804 CONTINUE -!/NL3 WRITE (NDSE,1004) NQDEF -!/NL3 CALL EXTCDE(4) -!/NL3 RETURN -! -! 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'/) -!/NL2 1004 FORMAT (/' *** WAVEWATCH III ERROR IN READNL : '/ & -!/NL2 ' TEMP DEPTH ARRAY TOO SMALL, .LE. ',I8/) -!/NL3 1004 FORMAT (/' *** WAVEWATCH-III ERROR IN READNL : '/ & -!/NL3 ' TEMP QPARMS ARRAY TOO SMALL, .LE. ',I8/) -!/ -!/ End of READNL ----------------------------------------------------- / -!/ - END SUBROUTINE -!/ -!/ End of W3GRID ----------------------------------------------------- / -!/ - END PROGRAM W3GRID + END PROGRAM WW3GRID