#include "w3macros.h" !/ ------------------------------------------------------------------- / PROGRAM W3GRID !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | J. H. Alves | !/ | F. Ardhuin | !/ | FORTRAN 90 | !/ | Last update : 06-Jun-2018 | !/ +-----------------------------------+ !/ !/ 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 ) !/ !/ 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 Ardhuin et al. (2009,2010) input and dissipation ! !/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. ! !/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 !/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: NOLEAP USE W3NMLGRIDMD ! !/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(:,:) 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 !/ ------------------------------------------------------------------- / !/ 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) 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 :: ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP,& !/ST4 ZALP, Z0RAT, TAUWSHELTER, SWELLF, & !/ST4 SWELLF2,SWELLF3,SWELLF4, SWELLF5, & !/ST4 SWELLF6, SWELLF7, FXPM3, FXFM3, & !/ST4 WNMEANPTAIL, WNMEANP, STXFTF, & !/ST4 STXFTWN, SINBR, FXFMAGE, FXINCUT, & !/ST4 FXDSCUT !/ST4 REAL :: STXFTFTAIL, SDSC1, SDSC2, SDSCUM, & !/ST4 SDSC4, SDSC5, SDSC6, WHITECAPWIDTH, & !/ST4 SDSSTRAIN, SDSSTRAINA, SDSSTRAIN2, & !/ST4 SDSBR, SDSP, & !/ST4 SDSCOS, SDSDTH, SDSBCK, SDSABK, & !/ST4 SDSPBK, SDSBINT, SDSHCK, & !/ST4 SDSBR2, SDSBRF1, & !/ST4 SDSBM0, SDSBM1, SDSBM2, SDSBM3, & !/ST4 SDSBM4, SDSLFGEN, SDSHFGEN ! !/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 :: 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 ! !/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/ SDSC1, WNMEANP, WNMEANPTAIL, FXPM3, FXFM3, & !/ST4 FXFMAGE, SDSC2, SDSCUM, SDSSTRAIN, SDSSTRAINA, & !/ST4 SDSSTRAIN2, SDSC4, & !/ST4 SDSC5, SDSC6, SDSBR, SDSBR2, SDSP, SDSISO, & !/ST4 SDSBCK, SDSABK, SDSPBK, SDSBINT, SDSHCK, & !/ST4 SDSDTH, SDSCOS, SDSBRF1, SDSBRFDF, & !/ST4 SDSBM0, SDSBM1, SDSBM2, SDSBM3, SDSBM4, & !/ST4 SDSHFGEN, SDSLFGEN, WHITECAPWIDTH, FXINCUT, FXDSCUT !/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, & 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, NOLEAP, 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 !/ !/ ------------------------------------------------------------------- / !/ 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 SDSC1 = 0.0 ! not used in ST4, should be cleaned up !/ST4 WNMEANP = 0.5 ! taken from Bidlot et al. 2005 !/ST4 FXFM3 = 2.5 !/ST4 FXFMAGE = 0. !/ST4 FXINCUT = 0. !/ST4 FXDSCUT = 0. !/ST4 FXPM3 = 4. !/ST4 WNMEANPTAIL = -0.5 !/ST4 SDSC2 = -2.2E-5 !/ST4 SDSCUM = -0.40344 !/ST4 SDSC4 = 1. !/ST4 SDSC5 = 0. !/ST4 SDSC6 = 0.3 !/ST4 SDSBR = 0.90E-3 !/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 SDSBR2 = 0.8 !/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 SDSSTRAINA = 0. !/ST4 SDSSTRAIN2 = 0. !/ST4 SDSHFGEN = 0. !/ST4 SDSLFGEN = 0. ! !/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) = SDSLFGEN !/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) = SDSHFGEN !/ST4 SSDSC(10) = SDSSTRAINA*NTH/360. ! angle for enhanced straining !/ST4 SSDSC(11) = SDSSTRAIN2 ! enhanced straining constant ... !/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 SSDSBR2 = SDSBR2 !/ST4 SSDSISO = SDSISO !/ST4 SSDSCOS = SDSCOS !/ST4 SSDSP = SDSP !/ST4 SSDSDTH = SDSDTH !/ST4 WWNMEANP = WNMEANP !/ST4 FFXFM = FXFM3 * TPI !/ST4 FFXFA = FXFMAGE * TPI !/ST4 FFXFI = FXINCUT * TPI !/ST4 FFXFD = FXDSCUT * 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. 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 ! out later with the rest of the grid info !/RTD PLAT = -999.9 !/RTD PLON = -999.9 !/RTD UNROT = .TRUE. !/RTD CALL READNL ( NDSS, 'ROTD', STATUS ) ! ! 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 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. NOLEAP = .FALSE. ! 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=2.7414E+05 ! value used in Boutin et al. JGR 2018. !/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.2 !/IS2 IS2CREEPD=0.4 !/IS2 IS2CREEPN=3.0 !/IS2 IS2BREAKE=1. !/IS2 IS2WIM1=1. !/IS2 IS2ANDISB=.FALSE. !anelastic instead of inelastic dissipation if IS2CREEPB>0 !/IS2 IS2ANDISE=0.55 !energy of activation !/IS2 IS2ANDISD=1.672E-9! !/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.) ! ! 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) 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) SDSC1, SDSC2, SDSCUM, SDSC4, SDSC5, SDSC6, & !/ST4 WNMEANP, FXPM3, FXFM3, FXFMAGE, FXINCUT, FXDSCUT, & !/ST4 SDSBINT, SDSBCK, SDSABK, SDSPBK, SDSHCK, & !/ST4 SDSBR, SDSSTRAIN, SDSSTRAINA, SDSSTRAIN2, & !/ST4 SDSBR2, SDSP, SDSISO, SDSCOS, & !/ST4 SDSDTH, SDSBRF1, SDSBRFDF, & !/ST4 SDSBM0, SDSBM1, SDSBM2, SDSBM3, SDSBM4, & !/ST4 WHITECAPWIDTH, SDSLFGEN, SDSHFGEN !/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) 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, NOLEAP, 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, NOLEAP, 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 ! 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 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 ! Check that pole lat/lon values have been read in !/RTD ! and exit the program if they have not !/RTD PoLon = PLON !/RTD PoLat = PLAT !/RTD FLAGUNR = UNROT !/RTD IF( PoLon .EQ. -999.9 .OR. PoLat .EQ. -999.9 ) THEN !/RTD WRITE( NDSE, 1050 ) !/RTD CALL EXTCDE ( 63 ) !/RTD ENDIF !/RTD !/RTD ALLOCATE( AnglDin(NX,NY) ) !/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 ! 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 !/RTD ! Clean up !/RTD DEALLOCATE( StdLat, StdLon ) ! !/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 !!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') !/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) 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. REWIND (NDSS) IF ( ILOOP .EQ. 1 ) THEN NDSI2 = NDSI ELSE NDSI2 = NDSS 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 EXIT END IF ELSE CALL NEXTLN ( COMSTR , NDSI2 , NDSE ) READ (NDSI2,*,END=2001,ERR=2002) XO0, YO0, DXO, DYO, NPO END IF ! IF ( ILOOP .EQ. 1 ) THEN IF (FLGNML) THEN WRITE(NDSS,'(A)') NML_OUTBND_LINE(I-1) ELSE BACKSPACE (NDSI) READ (NDSI,'(A)') LINE WRITE (NDSS,'(A)') LINE END IF 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. ! IF ( NFBPO.GE.1 .AND. ILOOP.EQ.2 ) THEN WRITE (NDSO,991) NFBPO, NBO(NFBPO) - NBO(NFBPO-1), & NBO2(NFBPO) - NBO2(NFBPO-1) !/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 - - - - - - - - - - - - - - - - - - - - - ! !/T WRITE (NDST,9090) ! DO IP=1, NPO ! XO = XO0 + REAL(IP-1)*DXO YO = YO0 + REAL(IP-1)*DYO ! ! ... 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 ! 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 WRITE (NDSE,995) FACTOR*XO, FACTOR*YO END IF ELSE WRITE (NDSE,994) FACTOR*XO, FACTOR*YO END IF ! END DO ! NBO(NFBPO) = NBOTOT ! ! ... Branch back to read. ! END DO ! ! ... End of ILOOP loop ! END DO ! 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 ) ! 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) ! ! 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 et al. 2010) ',A/ & !/ST4 ' --------------------------------------------------') !/ST4 925 FORMAT ( ' SDSC2, SDSBCK, SDSCUM :',3E11.3/ & !/ST4 ' Power of k in mean k :',F8.2/) !/ST4 2924 FORMAT ( ' &SDS4 SDSC1 =',E12.4,', SDSC2 =',E12.4, & !/ST4 ', SDSCUM =',F6.2,', '/ & !/ST4 ' SDSC4 =',F6.2,', SDSC5 =',E12.4, & !/ST4 ', SDSC6 =',E12.4,','/ & !/ST4 ' WNMEANP =',F4.2,', FXPM3 =', F4.2, & !/ST4 ', FXFM3 =',F4.2,', FXFMAGE =',F6.3, & !/ST4 ', FXINCUT =',F6.3,', FXDSCUT =',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 =',F4.1,', SDSSTRAINA =',F4.1, & !/ST4 ', SDSSTRAIN2 =',F5.1,', '/ & !/ST4 ' SDSBR2 =',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 ' WHITECAPWIDTH =',F5.2,', SDSLFGEN = ', & !/ST4 F5.2,', SDSHFGEN = ',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 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 ***') ! !/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, & ', NOLEAP = ',L3,' , 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,' /') 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) 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 =',2F7.2) 995 FORMAT ( ' *** POINT ON LAND (SKIPPED) : X,Y =',2F7.2) 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/) ! 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 ***'/) ! 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 1050 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID :'/ & !/RTD ' ROTATED POLE SWITCH IS SET (RTD), BUT'/ & !/RTD ' PLAT/PLON NAMELIST VALUES NOT SET IN ROTD' ) ! 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) !/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