From d85b6f12cebb4d55c5b2cad738f16eec1c9554ff Mon Sep 17 00:00:00 2001 From: afahadabdullah Date: Tue, 23 Apr 2024 09:11:46 -0700 Subject: [PATCH] new GEOS-MITgcm configs that has shelfice --- .../configs/c90_llc90_03/code/CPP_EEOPTIONS.h | 156 ++ .../configs/c90_llc90_03/code/CPP_OPTIONS.h | 149 ++ .../c90_llc90_03/code/DIAGNOSTICS_SIZE.h | 32 + .../configs/c90_llc90_03/code/GGL90_OPTIONS.h | 31 + .../c90_llc90_03/code/GMREDI_OPTIONS.h | 69 + .../c90_llc90_03/code/MOM_COMMON_OPTIONS.h | 25 + .../c90_llc90_03/code/SALT_PLUME_OPTIONS.h | 27 + .../configs/c90_llc90_03/code/SEAICE_LAYERS.h | 86 + .../c90_llc90_03/code/SEAICE_OPTIONS.h | 264 +++ .../configs/c90_llc90_03/code/SEAICE_SIZE.h | 54 + .../configs/c90_llc90_03/code/SHELFICE.h | 313 ++++ .../c90_llc90_03/code/SHELFICE_OPTIONS.h | 41 + .../configs/c90_llc90_03/code/SIZE.h | 70 + .../configs/c90_llc90_03/code/ggl90_calc.F | 1216 +++++++++++++ .../configs/c90_llc90_03/code/ini_masks_etc.F | 532 ++++++ .../configs/c90_llc90_03/code/ini_parms.F | 1601 +++++++++++++++++ .../c90_llc90_03/code/initialise_varia.F | 378 ++++ .../configs/c90_llc90_03/code/mom_calc_visc.F | 805 +++++++++ .../configs/c90_llc90_03/code/packages.conf | 8 + .../c90_llc90_03/code/seaice_advdiff.F | 771 ++++++++ .../c90_llc90_03/code/seaice_diag_init_add.h | 120 ++ .../code/seaice_diagnostics_init.F | 838 +++++++++ .../configs/c90_llc90_03/code/seaice_model.F | 390 ++++ .../c90_llc90_03/code/seaice_save4gmao.F | 261 +++ .../c90_llc90_03/code/shelfice_forcing.F | 221 +++ .../c90_llc90_03/code/shelfice_forcing_surf.F | 155 ++ .../c90_llc90_03/code/shelfice_init_depths.F | 125 ++ .../c90_llc90_03/code/shelfice_init_fixed.F | 677 +++++++ .../c90_llc90_03/code/shelfice_init_varia.F | 184 ++ .../c90_llc90_03/code/shelfice_readparms.F | 221 +++ .../c90_llc90_03/code/shelfice_solve4fluxes.F | 287 +++ .../code/shelfice_thermodynamics.F | 566 ++++++ .../configs/c90_llc90_03/input/data | 147 ++ .../configs/c90_llc90_03/input/data.cal | 10 + .../c90_llc90_03/input/data.diagnostics | 127 ++ .../configs/c90_llc90_03/input/data.exch2 | 43 + .../configs/c90_llc90_03/input/data.ggl90 | 15 + .../configs/c90_llc90_03/input/data.gmredi | 39 + .../configs/c90_llc90_03/input/data.mypackage | 6 + .../configs/c90_llc90_03/input/data.pkg | 9 + .../c90_llc90_03/input/data.salt_plume | 6 + .../configs/c90_llc90_03/input/data.seaice | 50 + .../configs/c90_llc90_03/input/data.shelfice | 18 + .../configs/c90_llc90_03/input/eedata | 13 + MIT_GEOS5PlugMod/configs/c90_llc90_03/readme | 7 + 45 files changed, 11163 insertions(+) create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/CPP_EEOPTIONS.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/CPP_OPTIONS.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/DIAGNOSTICS_SIZE.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/GGL90_OPTIONS.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/GMREDI_OPTIONS.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/MOM_COMMON_OPTIONS.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SALT_PLUME_OPTIONS.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_LAYERS.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_OPTIONS.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_SIZE.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SHELFICE.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SHELFICE_OPTIONS.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SIZE.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ggl90_calc.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ini_masks_etc.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ini_parms.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/initialise_varia.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/mom_calc_visc.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/packages.conf create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_advdiff.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_diag_init_add.h create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_diagnostics_init.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_model.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_save4gmao.F create mode 100755 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_forcing.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_forcing_surf.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_depths.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_fixed.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_varia.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_readparms.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_solve4fluxes.F create mode 100755 MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_thermodynamics.F create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data create mode 100755 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.cal create mode 100755 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.diagnostics create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.exch2 create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.ggl90 create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.gmredi create mode 100755 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.mypackage create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.pkg create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.salt_plume create mode 100755 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.seaice create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.shelfice create mode 100755 MIT_GEOS5PlugMod/configs/c90_llc90_03/input/eedata create mode 100644 MIT_GEOS5PlugMod/configs/c90_llc90_03/readme diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/CPP_EEOPTIONS.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/CPP_EEOPTIONS.h new file mode 100644 index 0000000..883fe0d --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/CPP_EEOPTIONS.h @@ -0,0 +1,156 @@ +#ifndef _CPP_EEOPTIONS_H_ +#define _CPP_EEOPTIONS_H_ + +CBOP +C !ROUTINE: CPP_EEOPTIONS.h +C !INTERFACE: +C include "CPP_EEOPTIONS.h" +C +C !DESCRIPTION: +C *==========================================================* +C | CPP\_EEOPTIONS.h | +C *==========================================================* +C | C preprocessor "execution environment" supporting | +C | flags. Use this file to set flags controlling the | +C | execution environment in which a model runs - as opposed | +C | to the dynamical problem the model solves. | +C | Note: Many options are implemented with both compile time| +C | and run-time switches. This allows options to be | +C | removed altogether, made optional at run-time or | +C | to be permanently enabled. This convention helps | +C | with the data-dependence analysis performed by the | +C | adjoint model compiler. This data dependency | +C | analysis can be upset by runtime switches that it | +C | is unable to recoginise as being fixed for the | +C | duration of an integration. | +C | A reasonable way to use these flags is to | +C | set all options as selectable at runtime but then | +C | once an experimental configuration has been | +C | identified, rebuild the code with the appropriate | +C | options set at compile time. | +C *==========================================================* +CEOP + +C In general the following convention applies: +C ALLOW - indicates an feature will be included but it may +C CAN have a run-time flag to allow it to be switched +C on and off. +C If ALLOW or CAN directives are "undef'd" this generally +C means that the feature will not be available i.e. it +C will not be included in the compiled code and so no +C run-time option to use the feature will be available. +C +C ALWAYS - indicates the choice will be fixed at compile time +C so no run-time option will be present + +C=== Macro related options === +C-- Control storage of floating point operands +C On many systems it improves performance only to use +C 8-byte precision for time stepped variables. +C Constant in time terms ( geometric factors etc.. ) +C can use 4-byte precision, reducing memory utilisation and +C boosting performance because of a smaller working set size. +C However, on vector CRAY systems this degrades performance. +C Enable to switch REAL4_IS_SLOW from genmake2 (with LET_RS_BE_REAL4): +#ifdef LET_RS_BE_REAL4 +#undef REAL4_IS_SLOW +#else /* LET_RS_BE_REAL4 */ +#define REAL4_IS_SLOW +#endif /* LET_RS_BE_REAL4 */ + +C-- Control use of "double" precision constants. +C Use D0 where it means REAL*8 but not where it means REAL*16 +#define D0 d0 + +C=== IO related options === +C-- Flag used to indicate whether Fortran formatted write +C and read are threadsafe. On SGI the routines can be thread +C safe, on Sun it is not possible - if you are unsure then +C undef this option. +#undef FMTFTN_IO_THREAD_SAFE + +C-- Flag used to indicate whether Binary write to Local file (i.e., +C a different file for each tile) and read are thread-safe. +#undef LOCBIN_IO_THREAD_SAFE + +C-- Flag to turn off the writing of error message to ioUnit zero +#undef DISABLE_WRITE_TO_UNIT_ZERO + +C-- Alternative formulation of BYTESWAP, faster than +C compiler flag -byteswapio on the Altix. +#undef FAST_BYTESWAP + +C-- Flag to turn on old default of opening scratch files with the +C STATUS='SCRATCH' option. This method, while perfectly FORTRAN-standard, +C caused filename conflicts on some multi-node/multi-processor platforms +C in the past and has been replace by something (hopefully) more robust. +#undef USE_FORTRAN_SCRATCH_FILES + +C-- Flag defined for eeboot_minimal.F, eeset_parms.F and open_copy_data_file.F +C to write STDOUT, STDERR and scratch files from process 0 only. +C WARNING: to use only when absolutely confident that the setup is working +C since any message (error/warning/print) from any proc <> 0 will be lost. +#undef SINGLE_DISK_IO + +C=== MPI, EXCH and GLOBAL_SUM related options === +C-- Flag turns off MPI_SEND ready_to_receive polling in the +C gather_* subroutines to speed up integrations. +#undef DISABLE_MPI_READY_TO_RECEIVE + +C-- Control MPI based parallel processing +CXXX We no longer select the use of MPI via this file (CPP_EEOPTIONS.h) +CXXX To use MPI, use an appropriate genmake2 options file or use +CXXX genmake2 -mpi . +CXXX #undef ALLOW_USE_MPI + +C-- Control use of communication that might overlap computation. +C Under MPI selects/deselects "non-blocking" sends and receives. +#undef ALLOW_ASYNC_COMMUNICATION +#undef ALWAYS_USE_ASYNC_COMMUNICATION +C-- Control use of communication that is atomic to computation. +C Under MPI selects/deselects "blocking" sends and receives. +#define ALLOW_SYNC_COMMUNICATION +#undef ALWAYS_USE_SYNC_COMMUNICATION + +C-- Control XY periodicity in processor to grid mappings +C Note: Model code does not need to know whether a domain is +C periodic because it has overlap regions for every box. +C Model assume that these values have been +C filled in some way. +#undef ALWAYS_PREVENT_X_PERIODICITY +#undef ALWAYS_PREVENT_Y_PERIODICITY +#define CAN_PREVENT_X_PERIODICITY +#define CAN_PREVENT_Y_PERIODICITY + +C-- disconnect tiles (no exchange between tiles, just fill-in edges +C assuming locally periodic subdomain) +#undef DISCONNECTED_TILES + +C-- Always cumulate tile local-sum in the same order by applying MPI allreduce +C to array of tiles ; can get slower with large number of tiles (big set-up) +#define GLOBAL_SUM_ORDER_TILES + +C-- Alternative way of doing global sum without MPI allreduce call +C but instead, explicit MPI send & recv calls. Expected to be slower. +#undef GLOBAL_SUM_SEND_RECV + +C-- Alternative way of doing global sum on a single CPU +C to eliminate tiling-dependent roundoff errors. Note: This is slow. +#undef CG2D_SINGLECPU_SUM + +C=== Other options (to add/remove pieces of code) === +C-- Flag to turn on checking for errors from all threads and procs +C (calling S/R STOP_IF_ERROR) before stopping. +#define USE_ERROR_STOP + +C-- Control use of communication with other component: +C allow to import and export from/to Coupler interface. +#undef COMPONENT_MODULE + +C-- Activate some pieces of code for coupling to GEOS AGCM +#define HACK_FOR_GMAO_CPL + +C=== And define Macros === +#include "CPP_EEMACROS.h" + +#endif /* _CPP_EEOPTIONS_H_ */ diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/CPP_OPTIONS.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/CPP_OPTIONS.h new file mode 100644 index 0000000..634f6b3 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/CPP_OPTIONS.h @@ -0,0 +1,149 @@ +#ifndef CPP_OPTIONS_H +#define CPP_OPTIONS_H + +CBOP +C !ROUTINE: CPP_OPTIONS.h +C !INTERFACE: +C #include "CPP_OPTIONS.h" + +C !DESCRIPTION: +C *==================================================================* +C | main CPP options file for the model: +C | Control which optional features to compile in model/src code. +C *==================================================================* +CEOP + +C CPP flags controlling particular source code features + +C o Turn off capping of precip with snowprecip. This will elimnates one +C forward loop in the adjoint code. +#define Turnoff_capping_precip_by_snowprecip + +C o Use 3d shiTransCoeffT and shiTransCoeffS +#define ALLOW_shiTransCoeff_3d + +C o Shortwave heating as extra term in external_forcing.F +C Note: this should be a run-time option +#define SHORTWAVE_HEATING + +C o Include/exclude Geothermal Heat Flux at the bottom of the ocean +#define ALLOW_GEOTHERMAL_FLUX + +C o Include/exclude phi_hyd calculation code +#define INCLUDE_PHIHYD_CALCULATION_CODE + +C o Include/exclude call to S/R CONVECT +#define INCLUDE_CONVECT_CALL + + +C o Include/exclude call to S/R CALC_DIFFUSIVITY +#define INCLUDE_CALC_DIFFUSIVITY_CALL + +C o Allow full 3D specification of vertical diffusivity +#define ALLOW_3D_DIFFKR + +C o Allow latitudinally varying BryanLewis79 vertical diffusivity +#undef ALLOW_BL79_LAT_VARY + +C o Include/exclude Implicit vertical advection code +#define INCLUDE_IMPLVERTADV_CODE + +C o Include/exclude AdamsBashforth-3rd-Order code +#undef ALLOW_ADAMSBASHFORTH_3 + +C o Include/exclude nonHydrostatic code +#undef ALLOW_NONHYDROSTATIC +#undef ALLOW_QHYD_STAGGER_TS + +C o Allow to account for heating due to friction (and momentum dissipation) +#undef ALLOW_FRICTION_HEATING + +C o Allow mass source or sink of Fluid in the interior +C (3-D generalisation of oceanic real-fresh water flux) +#define ALLOW_ADDFLUID + +C o Include pressure loading code +#define ATMOSPHERIC_LOADING +#ifdef ATMOSPHERIC_LOADING +#define ALLOW_IB_CORR +#endif + +C o Calculate Phi-Hydrostatic at r-lower boundary during initialization. +C Needed for obp cost. Otherwise, the first record of m_bp is wrong, +C because phiHydLow is zero. +#define CALC_PHI_RLOW_INI + +C o exclude/allow external forcing-fields load +C this allows to read & do simple linear time interpolation of oceanic +C forcing fields, if no specific pkg (e.g., EXF) is used to compute them. +#undef EXCLUDE_FFIELDS_LOAD + +C o Include/exclude balancing surface forcing fluxes code +#undef ALLOW_BALANCE_FLUXES + +C o Include/exclude balancing surface forcing relaxation code +#undef ALLOW_BALANCE_RELAX + +C o Include/exclude GM-like eddy stress in momentum code +#undef ALLOW_EDDYPSI + +C o Use "Exact Convervation" of fluid in Free-Surface formulation +C so that d/dt(eta) is exactly equal to - Div.Transport +#define EXACT_CONSERV + +C o Allow the use of Non-Linear Free-Surface formulation +C this implies that surface thickness (hFactors) vary with time +#define NONLIN_FRSURF +# undef DISABLE_RSTAR_CODE +#undef DISABLE_SIGMA_CODE + +C o Include/exclude code for single reduction Conjugate-Gradient solver +#undef ALLOW_SRCG + +C o Choices for implicit solver routines solve_*diagonal.F +C The following has low memory footprint, but not suitable for AD +#undef SOLVE_DIAGONAL_LOWMEMORY +C The following one suitable for AD but does not vectorize +#define SOLVE_DIAGONAL_KINNER + +C o ALLOW isotropic scaling of harmonic and bi-harmonic terms when +C using an locally isotropic spherical grid with (dlambda) x (dphi*cos(phi)) +C *only for use on a lat-lon grid* +C Setting this flag here affects both momentum and tracer equation unless +C it is set/unset again in other header fields (e.g., GAD_OPTIONS.h). +C The definition of the flag is commented to avoid interference with +C such other header files. +C The preferred method is specifying a value for viscAhGrid or viscA4Grid +C in data which is then automatically scaled by the grid size; +C the old method of specifying viscAh/viscA4 and this flag is provided +C for completeness only (and for use with the adjoint). +C#define ISOTROPIC_COS_SCALING + +C o This flag selects the form of COSINE(lat) scaling of bi-harmonic term. +C *only for use on a lat-lon grid* +C Has no effect if ISOTROPIC_COS_SCALING is undefined. +C Has no effect on vector invariant momentum equations. +C Setting this flag here affects both momentum and tracer equation unless +C it is set/unset again in other header fields (e.g., GAD_OPTIONS.h). +C The definition of the flag is commented to avoid interference with +C such other header files. +C#define COSINEMETH_III + +C o Use "OLD" UV discretisation near boundaries (*not* recommended) +C Note - only works with pkg/mom_fluxform and "no_slip_sides=.FALSE." +C because the old code did not have no-slip BCs +#undef OLD_ADV_BCS + +C o Use LONG.bin, LATG.bin, etc., initialization for ini_curviliear_grid.F +C Default is to use "new" grid files (OLD_GRID_IO undef) but OLD_GRID_IO +C is still useful with, e.g., single-domain curvilinear configurations. +#undef OLD_GRID_IO + +C o Use old EXTERNAL_FORCING_U,V,T,S subroutines (for backward compatibility) +#undef USE_OLD_EXTERNAL_FORCING + +C o Execution environment support options +#include "CPP_EEOPTIONS.h" + +#endif /* CPP_OPTIONS_H */ + diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/DIAGNOSTICS_SIZE.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/DIAGNOSTICS_SIZE.h new file mode 100644 index 0000000..59424f6 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/DIAGNOSTICS_SIZE.h @@ -0,0 +1,32 @@ +C $Header: /u/gcmpack/MITgcm_contrib/ecco_utils/ecco_v4_release3_devel/code/DIAGNOSTICS_SIZE.h,v 1.1 2017/05/04 17:46:37 ou.wang Exp $ +C $Name: $ + + +C Diagnostics Array Dimension +C --------------------------- +C ndiagMax :: maximum total number of available diagnostics +C numlists :: maximum number of diagnostics list (in data.diagnostics) +C numperlist :: maximum number of active diagnostics per list (data.diagnostics) +C numLevels :: maximum number of levels to write (data.diagnostics) +C numDiags :: maximum size of the storage array for active 2D/3D diagnostics +C nRegions :: maximum number of regions (statistics-diagnostics) +C sizRegMsk :: maximum size of the regional-mask (statistics-diagnostics) +C nStats :: maximum number of statistics (e.g.: aver,min,max ...) +C diagSt_size:: maximum size of the storage array for statistics-diagnostics +C Note : may need to increase "numDiags" when using several 2D/3D diagnostics, +C and "diagSt_size" (statistics-diags) since values here are deliberately small. + INTEGER ndiagMax + INTEGER numlists, numperlist, numLevels + INTEGER numDiags + INTEGER nRegions, sizRegMsk, nStats + INTEGER diagSt_size + PARAMETER( ndiagMax = 700 ) + PARAMETER( numlists = 300, numperlist = 30, numLevels=5*Nr ) + PARAMETER( numDiags = 4000 ) + PARAMETER( nRegions = 20 , sizRegMsk = 1 , nStats = 4 ) + PARAMETER( diagSt_size = 50*Nr ) + + +CEH3 ;;; Local Variables: *** +CEH3 ;;; mode:fortran *** +CEH3 ;;; End: *** diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/GGL90_OPTIONS.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/GGL90_OPTIONS.h new file mode 100644 index 0000000..64ecd78 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/GGL90_OPTIONS.h @@ -0,0 +1,31 @@ +C *=============================================================* +C | GGL90_OPTIONS.h +C | o CPP options file for GGL90 package. +C *=============================================================* +C | Use this file for selecting options within the GGL90 +C | package. +C *=============================================================* + +#ifndef GGL90_OPTIONS_H +#define GGL90_OPTIONS_H +#include "PACKAGES_CONFIG.h" +#include "CPP_OPTIONS.h" + +#ifdef ALLOW_GGL90 +C Package-specific Options & Macros go here + +C Enable horizontal diffusion of TKE. +#undef ALLOW_GGL90_HORIZDIFF + +C Use horizontal averaging for viscosity and diffusivity as +C originally implemented in OPA. +#define ALLOW_GGL90_SMOOTH + +C allow IDEMIX model +#undef ALLOW_GGL90_IDEMIX + +C include Langmuir circulation parameterization +#undef ALLOW_GGL90_LANGMUIR + +#endif /* ALLOW_GGL90 */ +#endif /* GGL90_OPTIONS_H */ diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/GMREDI_OPTIONS.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/GMREDI_OPTIONS.h new file mode 100644 index 0000000..4ff989d --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/GMREDI_OPTIONS.h @@ -0,0 +1,69 @@ +#ifndef GMREDI_OPTIONS_H +#define GMREDI_OPTIONS_H +#include "PACKAGES_CONFIG.h" +#include "CPP_OPTIONS.h" + +CBOP +C !ROUTINE: GMREDI_OPTIONS.h +C !INTERFACE: +C #include "GMREDI_OPTIONS.h" + +C !DESCRIPTION: +C *==================================================================* +C | CPP options file for GM/Redi package: +C | Control which optional features to compile in this package code. +C *==================================================================* +CEOP + +#ifdef ALLOW_GMREDI +C Package-specific Options & Macros go here + +C Designed to simplify the Ajoint code: +#define GMREDI_WITH_STABLE_ADJOINT +C -- exclude the clipping/tapering part of the code that is not used +#define GM_EXCLUDE_CLIPPING +#define GM_EXCLUDE_FM07_TAP +#define GM_EXCLUDE_AC02_TAP +C #define GM_EXCLUDE_TAPERING +#define GM_EXCLUDE_SUBMESO + +C Allows to read-in background 3-D Redi and GM diffusivity coefficients +C Note: need these to be defined for use as control (pkg/ctrl) parameters +#define GM_READ_K3D_REDI +#define GM_READ_K3D_GM + +C This allows to use Visbeck et al formulation to compute K_GM+Redi +#undef GM_VISBECK_VARIABLE_K +C Use old calculation (before 2007/05/24) of Visbeck etal K_GM+Redi +C (which depends on tapering scheme) +#undef OLD_VISBECK_CALC + +C This allows the Bates et al formulation to calculate the +C bolus transport and K for Redi +#undef GM_BATES_K3D +#undef GM_BATES_PASSIVE + +C This allows the leading diagonal (top two rows) to be non-unity +C (a feature required when tapering adiabatically). +#define GM_NON_UNITY_DIAGONAL + +C Allows to use different values of K_GM and K_Redi ; also to +C be used with the advective form (Bolus velocity) of GM +#define GM_EXTRA_DIAGONAL + +C Allows to use the advective form (Bolus velocity) of GM +C instead of the Skew-Flux form (=default) +#define GM_BOLUS_ADVEC + +C Allows to use the Boundary-Value-Problem method to evaluate GM Bolus transport +#undef GM_BOLUS_BVP + +C Allow QG Leith variable viscosity to be added to GMRedi coefficient +#undef ALLOW_GM_LEITH_QG + +C Related to Adjoint-code: +#undef GM_AUTODIFF_EXCESSIVE_STORE +#undef GMREDI_MASK_SLOPES + +#endif /* ALLOW_GMREDI */ +#endif /* GMREDI_OPTIONS_H */ diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/MOM_COMMON_OPTIONS.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/MOM_COMMON_OPTIONS.h new file mode 100644 index 0000000..f80a356 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/MOM_COMMON_OPTIONS.h @@ -0,0 +1,25 @@ +C CPP options file for mom_common package +C Use this file for selecting CPP options within the mom_common package + +#ifndef MOM_COMMON_OPTIONS_H +#define MOM_COMMON_OPTIONS_H +#include "PACKAGES_CONFIG.h" +#include "CPP_OPTIONS.h" + +#ifdef ALLOW_MOM_COMMON +C Package-specific options go here + +C allow LeithQG coefficient to be calculated +#undef ALLOW_LEITH_QG + +C allow isotropic 3-D Smagorinsky viscosity +#undef ALLOW_SMAG_3D + +C allow full 3D specification of horizontal Laplacian Viscosity +#define ALLOW_3D_VISCAH + +C allow full 3D specification of horizontal Biharmonic Viscosity +#define ALLOW_3D_VISCA4 + +#endif /* ALLOW_MOM_COMMON */ +#endif /* MOM_COMMON_OPTIONS_H */ diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SALT_PLUME_OPTIONS.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SALT_PLUME_OPTIONS.h new file mode 100644 index 0000000..7e19e2c --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SALT_PLUME_OPTIONS.h @@ -0,0 +1,27 @@ +C CPP options file for salt_plume package +C Use this file for selecting options within the salt_plume package + +#ifndef SALT_PLUME_OPTIONS_H +#define SALT_PLUME_OPTIONS_H +#include "PACKAGES_CONFIG.h" +#include "CPP_OPTIONS.h" + +#ifdef ALLOW_SALT_PLUME +C Place CPP define/undef flag here + +C SALT_PLUME_IN_LEADS +C Motivation: As ice concentration AREA -> 1, leads occur -> ice +C production is no longer uniform in grid box -> assumptions +C which motivate KPP no longer holds -> treat overturn more +C realistic with this flag. +C if defined: Activate pkg/salt_plume only when seaice AREA exceeds +C a certain value representative of lead opening AND only +C if seaice growth dh is from atmospheric cooling. +C if undefined: Activate pkg/salt_plume whenever seaice forms. +C This is the default of pkg/salt_plume. +#define SALT_PLUME_IN_LEADS +#undef SALT_PLUME_SPLIT_BASIN +#undef SALT_PLUME_VOLUME + +#endif /* ALLOW_SALT_PLUME */ +#endif /* SALT_PLUME_OPTIONS_H */ diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_LAYERS.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_LAYERS.h new file mode 100644 index 0000000..648c7b1 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_LAYERS.h @@ -0,0 +1,86 @@ +CBOP +C !ROUTINE: SEAICE_LAYERS.h + +C !DESCRIPTION: \bv +C *==========================================================* +C | SEAICE_LAYERS.h +C | o header file for sea ice multi-layer variables +C | for refined thermodynamics with vertical discretisation +C | of seaice and snow cover, accounting for heat content +C | and brine pockets contribution to seaice enthalpy +C *==========================================================* +C | Note: for now, only used when coupled to to GEOS AGCM +C *==========================================================* +C \ev +CEOP + +#ifdef HACK_FOR_GMAO_CPL +C SIqIce :: Seaice enthalpy for each ice layer and each category [J/m^2] +C SIqSnow :: Snow enthalpy for each snow layer and each category [J/m^2] +C SImeltPd :: Melt Pond volume for each category [m] +C SIiceAge :: Seaice Age for each category [s] +C SIskinS :: seaice skin salinity [psu] +C SIskinH :: seaice skin-layer depth [m] + _RL SIqIce (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nIceLayers, + & nITD,nSx,nSy) + _RL SIqSnow (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSnowLayers, + & nITD,nSx,nSy) + _RL SImeltPd(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nITD,nSx,nSy) + _RL SIiceAge(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nITD,nSx,nSy) + _RL SIskinS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL SIskinH (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + COMMON /SEAICE_LAYERS/ + & SIqIce, SIqSnow, + & SImeltPd, SIiceAge, + & SIskinS, SIskinH + +C SIwindTauX :: wind stress over seaice, X-component at U point +C SIwindTauY :: wind stress over seaice, Y-component at V point + _RL SIwindTauX(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL SIwindTauY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + COMMON /SEAICE_DYN_FORCING/ + & SIwindTauX, SIwindTauY + +C SIadv_Area :: advection increment of Seaice fraction [-] +C SIadv_Heff :: advection increment of Seaice thickness [m] +C SIadv_Hsnow :: advection increment of snow thickness [m] +C SIadv_tIces :: advection increment of ice surface temperature +C SIadv_qIce :: advection increment of Seaice enthalpy [J/m^2] +C SIadv_qSnow :: advection increment of Snow enthalpy [J/m^2] +C SIadv_meltPd :: advection increment of Melt Pond volume [m] +C SIadv_iceAge :: advection increment of Seaice Age [s] +C SIadv_skinS :: advection increment of seaice skin salinity [psu] +C SIadv_skinH :: advection increment of seaice skin-layer depth [m] + COMMON /SEAICE_ADV_INCREMENT/ + & SIadv_Area, SIadv_Heff, SIadv_Hsnow, + & SIadv_tIces, SIadv_qIce, SIadv_qSnow, + & SIadv_meltPd, SIadv_iceAge, SIadv_skinS, SIadv_skinH + _RL SIadv_Area (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nITD,nSx,nSy) + _RL SIadv_Heff (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nITD,nSx,nSy) + _RL SIadv_Hsnow (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nITD,nSx,nSy) + _RL SIadv_tIces (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nITD,nSx,nSy) + _RL SIadv_qIce (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nIceLayers, + & nITD,nSx,nSy) + _RL SIadv_qSnow (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSnowLayers, + & nITD,nSx,nSy) + _RL SIadv_meltPd(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nITD,nSx,nSy) + _RL SIadv_iceAge(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nITD,nSx,nSy) + _RL SIadv_skinS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL SIadv_skinH (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + +C oceWeight :: grid-cell ocean fraction from GEOS [0-1] + _RL oceWeight(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + COMMON /DIAGS_GMAO_CPL/ + & oceWeight + +C SI_FRZMLT :: available heat (W/m^2) to freeze (>0) or melt (<0) sea ice +C so that surface level ocean reaches freezing temperature + _RL SI_FRZMLT(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + COMMON /SEAICE_FRZMLT/ + & SI_FRZMLT + +#endif /* HACK_FOR_GMAO_CPL */ + +CEH3 ;;; Local Variables: *** +CEH3 ;;; mode:fortran *** +CEH3 ;;; End: *** diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_OPTIONS.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_OPTIONS.h new file mode 100644 index 0000000..71ae446 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_OPTIONS.h @@ -0,0 +1,264 @@ +#ifndef SEAICE_OPTIONS_H +#define SEAICE_OPTIONS_H +#include "PACKAGES_CONFIG.h" +#include "CPP_OPTIONS.h" + +C *==========================================================* +C | SEAICE_OPTIONS.h +C | o CPP options file for sea ice package. +C *==========================================================* +C | Use this file for selecting options within the sea ice +C | package. +C *==========================================================* + +#ifdef ALLOW_SEAICE +C--- Package-specific Options & Macros go here + +C-- Write "text-plots" of certain fields in STDOUT for debugging. +#undef SEAICE_DEBUG + +C-- By default, the sea-ice package uses its own integrated bulk +C formulae to compute fluxes (fu, fv, EmPmR, Qnet, and Qsw) over +C open-ocean. When this flag is set, these variables are computed +C in a separate external package, for example, pkg/exf, and then +C modified for sea-ice effects by pkg/seaice. +#define SEAICE_EXTERNAL_FLUXES + +C-- This CPP flag has been retired. The number of ice categories +C used to solve for seaice flux is now specified by run-time +C parameter SEAICE_multDim. +C Note: be aware of pickup_seaice.* compatibility issues when +C restarting a simulation with a different number of categories. +c#define SEAICE_MULTICATEGORY + +C-- run with sea Ice Thickness Distribution (ITD); +C set number of categories (nITD) in SEAICE_SIZE.h +#define SEAICE_ITD + +C-- Since the missing sublimation term is now included +C this flag is needed for backward compatibility +#undef SEAICE_DISABLE_SUBLIM + +C-- Suspected missing term in coupled ocn-ice heat budget (to be confirmed) +#undef SEAICE_DISABLE_HEATCONSFIX + +C-- Default is constant seaice salinity (SEAICE_salt0); Define the following +C flag to consider (space & time) variable salinity: advected and forming +C seaice with a fraction (=SEAICE_saltFrac) of freezing seawater salinity. +C- Note: SItracer also offers an alternative way to handle variable salinity. +#undef SEAICE_VARIABLE_SALINITY + +C-- Enable grease ice parameterization (requires to define ALLOW_SITRACER): +C The grease ice parameterization delays formation of solid sea ice from +C frazil ice by a time constant and provides a dynamic calculation of the +C initial solid sea ice thickness HO as a function of winds, currents and +C available grease ice volume. Grease ice does not significantly reduce heat +C loss from the ocean in winter and area covered by grease is thus handled +C like open water (For details see Smedsrud and Martin, 2014, Ann.Glac.). +C Set SItrName(1) = 'grease' in namelist SEAICE_PARM03 in data.seaice +C then output SItr01 is SItrNameLong(1) = 'grease ice volume fraction', +C with SItrUnit(1) = '[0-1]', which needs to be multiplied by SIheff to +C yield grease ice volume. Additionally, the actual grease ice layer +C thickness (diagnostic SIgrsLT) can be saved. +#undef SEAICE_GREASE + +C-- Tracers of ice and/or ice cover. +#ifdef SEAICE_GREASE +C SEAICE_GREASE code requires to define ALLOW_SITRACER +# define ALLOW_SITRACER +#else +# undef ALLOW_SITRACER +#endif +#ifdef ALLOW_SITRACER +C- To try avoid 'spontaneous generation' of tracer maxima by advdiff. +# define ALLOW_SITRACER_ADVCAP + +C- Include code to diagnose sea ice tracer budgets in +C seaice_advdiff.F and seaice_tracer_phys.F. Diagnostics are +C computed the "call diagnostics_fill" statement is commented out. +# undef ALLOW_SITRACER_DEBUG_DIAG +#endif /* ALLOW_SITRACER */ + +C-- Historically, the seaice model was discretized on a B-Grid. This +C discretization should still work but it is not longer actively tested +C and supported. The following flag should always be set in order to use +C the operational C-grid discretization. +#define SEAICE_CGRID + +#ifdef SEAICE_CGRID +C-- Options for the C-grid version only: + +C enable advection of sea ice momentum +# undef SEAICE_ALLOW_MOM_ADVECTION + +C enable JFNK code by defining the following flag +# undef SEAICE_ALLOW_JFNK +C enable Krylov code by defining the following flag +# undef SEAICE_ALLOW_KRYLOV + +C-- Use a different order when mapping 2D velocity arrays to 1D vector +C before passing it to FGMRES. +# undef SEAICE_JFNK_MAP_REORDER + +C to reproduce old verification results for JFNK +# undef SEAICE_PRECOND_EXTRA_EXCHANGE + +C enable LSR to use global (multi-tile) tri-diagonal solver +# undef SEAICE_GLOBAL_3DIAG_SOLVER + +C enable EVP code by defining the following flag +# define SEAICE_ALLOW_EVP +# ifdef SEAICE_ALLOW_EVP +C- When set use SEAICE_zetaMin and SEAICE_evpDampC to limit viscosities +C from below and above in seaice_evp: not necessary, and not recommended +# undef SEAICE_ALLOW_CLIPZETA + +C Include code to avoid underflows in EVP-code (copied from CICE). +C Many compilers can handle this more efficiently with the help of a flag. +# undef SEAICE_EVP_ELIMINATE_UNDERFLOWS + +C Include code to print residual of EVP iteration for debugging/diagnostics +# undef ALLOW_SEAICE_EVP_RESIDUAL +# endif /* SEAICE_ALLOW_EVP */ + +C smooth regularization (without max-function) of delta for +C better differentiability +# undef SEAICE_DELTA_SMOOTHREG + +C regularize zeta to zmax with a smooth tanh-function instead +C of a min(zeta,zmax). This improves convergence of iterative +C solvers (Lemieux and Tremblay 2009, JGR). No effect on EVP +# undef SEAICE_ZETA_SMOOTHREG + +C-- Different yield curves within the VP rheology framework +C allow the truncated ellipse rheology (runtime flag SEAICEuseTEM) +# undef SEAICE_ALLOW_TEM + +C allow the use of the Mohr Coulomb rheology (runtime flag SEAICEuseMCS) +C as defined in (Ip 1991) /!\ This is known to give unstable results, +C use with caution +# undef SEAICE_ALLOW_MCS + +C allow the use of Mohr Coulomb with elliptical plastic potential +C (runtime flag SEAICEuseMCE) +# undef SEAICE_ALLOW_MCE + +C allow the teardrop and parabolic lens rheology +C (runtime flag SEAICEuseTD and SEAICEusePL) +# undef SEAICE_ALLOW_TEARDROP + +C-- LSR solver settings +C Use LSR vector code; not useful on non-vector machines, because it +C slows down convergence considerably, but the extra iterations are +C more than made up by the much faster code on vector machines. For +C the only regularly test vector machine these flags a specified +C in the build options file SUPER-UX_SX-8_sxf90_awi, so that we comment +C them out here. +# undef SEAICE_VECTORIZE_LSR + +C Use zebra-method (alternate lines) for line-successive-relaxation +C This modification improves the convergence of the vector code +C dramatically, so that is may actually be useful in general, but +C that needs to be tested. Can be used without vectorization options. +# undef SEAICE_LSR_ZEBRA + +C Include code to print residual of nonlinear outer loop of LSR +# undef SEAICE_ALLOW_CHECK_LSR_CONVERGENCE + +C This flag is also required for an actual adjoint of seaice_lsr; +C increases memory requirements a lot. +# undef SEAICE_LSR_ADJOINT_ITER + +C Use parameterisation of grounding ice for a better representation +C of fastice in shallow seas +# undef SEAICE_ALLOW_BOTTOMDRAG + +#else /* not SEAICE_CGRID, but old B-grid */ +C-- Options for the B-grid version only: + +C- By default for B-grid dynamics solver wind stress under sea-ice is +C set to the same value as it would be if there was no sea-ice. +C Define following CPP flag for B-grid ice-ocean stress coupling. +# define SEAICE_BICE_STRESS + +C- By default for B-grid dynamics solver surface tilt is obtained +C indirectly via geostrophic velocities. Define following CPP +C in order to use ETAN instead. +# define EXPLICIT_SSH_SLOPE + +C- Defining this flag turns on FV-discretization of the B-grid LSOR solver. +C It is smoother and includes all metric terms, similar to C-grid solvers. +C It is here for completeness, but its usefulness is unclear. +# undef SEAICE_LSRBNEW + +#endif /* SEAICE_CGRID */ + +C-- Some regularisations +C- When set limit the Ice-Loading to mass of 1/5 of Surface ocean grid-box +#undef SEAICE_CAP_ICELOAD + +C- When set use SEAICE_clipVelocties = .true., to clip U/VICE at 40cm/s, +C not recommended +#undef SEAICE_ALLOW_CLIPVELS + +C- When set cap the sublimation latent heat flux in solve4temp according +C to the available amount of ice+snow. Otherwise this term is treated +C like all of the others -- residuals heat and fw stocks are passed to +C the ocean at the end of seaice_growth in a conservative manner. +C SEAICE_CAP_SUBLIM is not needed as of now, but kept just in case. +#undef SEAICE_CAP_SUBLIM + +C-- AD flags +C- TAF related flag, currently only used in seaice_ad_check_lev[1-4]_dir.h; +C it is unclear if this is ever needed. +#undef AUTODIFF_SOMETIMES_NEEDED + +C- Reset fields to zero to stabilise AD code of dynamics solver +C (resulting in wrong gradients) +#undef SEAICE_DYN_STABLE_ADJOINT + +C- Another flag to simplify dependencies for TAF-generated AD-code +C the thermodynamic part, mostly by resetting variables to zero +#undef SEAICE_MODIFY_GROWTH_ADJ + +C- Special seaice flag for AD testing +#undef SEAICE_EXCLUDE_FOR_EXACT_AD_TESTING + +C-- Use the adjointable sea-ice thermodynamic model +C in seaice_growth_adx.F instead of seaice_growth.F +#undef SEAICE_USE_GROWTH_ADX + +C-- These flags are not strictly AD-related but may help obtaining +C simpler AD-code: +C- Do not compile code that resets AREA (or AREAITD) to a mininum value +C of SEAICE_area_floor (=SIeps with default of 1e-5) if there is +C some finite sea ice thickness +#undef DISABLE_AREA_FLOOR + +C- Do not compile growth/thermodynamics code (avoiding this code can +C also be done by setting runtime parameter usePWthermodynamics=F) +#undef DISABLE_SEAICE_GROWTH + +C- Allow sea-ice dynamic code. This option is provided so that, +C if turned off (#undef), to compile (and process with TAF) only the +C the thermodynamics component of the code. Note that, if needed, +C sea-ice dynamics can be turned off at runtime (SEAICEuseDYNAMICS=F). +#define SEAICE_ALLOW_DYNAMICS + +C- Do not compile/use seaice-related obcs code when using obcs. +#undef DISABLE_SEAICE_OBCS + +C-- Enable free drift code +#undef SEAICE_ALLOW_FREEDRIFT + +C-- pkg/seaice cost functions compile flags +C- Sea-ice volume (requires pkg/cost) +#undef ALLOW_COST_ICE +#ifdef ALLOW_COST_ICE +C- Enable template for sea-ice volume export in seaice_cost_export.F +C (requires pkg/cost & ALLOW_COST_ICE defined) +# undef ALLOW_SEAICE_COST_EXPORT +#endif /* ALLOW_COST_ICE */ + +#endif /* ALLOW_SEAICE */ +#endif /* SEAICE_OPTIONS_H */ diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_SIZE.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_SIZE.h new file mode 100644 index 0000000..671ec1f --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SEAICE_SIZE.h @@ -0,0 +1,54 @@ +#ifdef ALLOW_SEAICE + +CBOP +C !ROUTINE: SEAICE_SIZE.h +C !INTERFACE: +C #include SEAICE_SIZE.h + +C !DESCRIPTION: +C Contains seaice array-size definition (number of tracers,categories). + +C SItrMaxNum :: number of passive tracers to allocate +C nITD :: number of seaice categories to allocate +CEOP + +C- Maximum Number of categories + INTEGER nITD +C-- +#ifdef SEAICE_ITD +C nITD defines number of ice thickness categories, +C i.e. size of additional dimension to AREA, HEFF, HSNOW, etc. +C Bitz et al. (2001, JGR) suggest a minimum of nITD = 5 + PARAMETER (nITD = 5) +#else + PARAMETER (nITD = 7) +#endif + +C- Maximum Number of tracers + INTEGER SItrMaxNum + PARAMETER(SItrMaxNum = 3 ) + +#ifdef HACK_FOR_GMAO_CPL +C nIceLayers :: number of Ice layers (in each category) +C nSnowLayers :: number of snow layers (in each category) + INTEGER nIceLayers, nSnowLayers + PARAMETER( nIceLayers = 4 , nSnowLayers = 1 ) +#endif /* HACK_FOR_GMAO_CPL */ + +#ifdef ALLOW_AUTODIFF + INTEGER iicekey + INTEGER nEVPstepMax + PARAMETER ( nEVPstepMax=180 ) + INTEGER NMAX_TICE + PARAMETER ( NMAX_TICE=10 ) + INTEGER SOLV_MAX_FIXED + PARAMETER ( SOLV_MAX_FIXED=500 ) + INTEGER MPSEUDOTIMESTEPS + PARAMETER (MPSEUDOTIMESTEPS=2) +#endif /* ALLOW_AUTODIFF */ + +#endif /* ALLOW_SEAICE */ + +CEH3 ;;; Local Variables: *** +CEH3 ;;; mode:fortran *** +CEH3 ;;; End: *** diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SHELFICE.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SHELFICE.h new file mode 100644 index 0000000..1c390bf --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SHELFICE.h @@ -0,0 +1,313 @@ +#ifdef ALLOW_SHELFICE + +CBOP +C !ROUTINE: SHELFICE.h + +C !DESCRIPTION: \bv +C *==========================================================* +C | SHELFICE.h +C | o Basic header thermodnynamic shelf ice package. +C | Contains all SHELFICE field declarations. +C *==========================================================* + +C----------------------------------------------------------------------- +C +C-- Constants that can be set in data.shelfice +C SHELFICEtopoFile :: File containing the topography of the +C shelfice draught (unit=m) +C SHELFICEmassFile :: name of shelfice Mass file +C SHELFICEloadAnomalyFile :: name of shelfice load anomaly file +C SHELFICEMassDynTendFile :: file name for other mass tendency +C (e.g. dynamics) +C useISOMIPTD :: use simple ISOMIP thermodynamics, def: F +C SHELFICEconserve :: use conservative form of H&O-thermodynamics +C following Jenkins et al. (2001, JPO), def: F +C SHELFICEMassStepping :: flag to step forward ice shelf mass/thickness +C accounts for melting/freezing & dynamics +C (from file or from coupling), def: F +C SHELFICEDynMassOnly :: step ice mass ONLY with Shelficemassdyntendency +C (not melting/freezing) def: F +C SHELFICEboundaryLayer :: turn on vertical merging of cells to for a +C boundary layer of drF thickness, def: F +C SHI_withBL_realFWflux :: with above BL, allow to use real-FW flux (and +C adjust advective flux at boundary accordingly) +C def: F +C SHI_withBL_uStarTopDz :: with SHELFICEboundaryLayer, compute uStar from +C uVel,vVel avergaged over top Dz thickness; +C def: F +C SHELFICEadvDiffHeatFlux :: use advective-diffusive heat flux into the +C shelf instead of default diffusive heat +C flux, see Holland and Jenkins (1999), +C eq.21,22,26,31; def: F +C SHELFICEsaltToHeatRatio :: constant ratio giving +C SHELFICEsaltTransCoeff/SHELFICEheatTransCoeff +C (def: 5.05e-3) +C SHELFICEheatTransCoeff :: constant heat transfer coefficient that +C determines heat flux into shelfice +C (def: 1e-4 m/s) +C SHELFICEsaltTransCoeff :: constant salinity transfer coefficient that +C determines salt flux into shelfice +C (def: SHELFICEsaltToHeatRatio * SHELFICEheatTransCoeff) +C ----------------------------------------------------------------------- +C SHELFICEuseGammaFrict :: use velocity dependent exchange coefficients, +C see Holland and Jenkins (1999), eq.11-18, +C with the following parameters (def: F): +C SHELFICE_oldCalcUStar :: use old uStar averaging expression +C shiCdrag :: quadratic drag coefficient to compute uStar +C (def: 0.0015) +C shiZetaN :: ??? (def: 0.052) +C shiRc :: ??? (not used, def: 0.2) +C shiPrandtl, shiSchmidt :: constant Prandtl (13.8) and Schmidt (2432.0) +C numbers used to compute gammaTurb +C shiKinVisc :: constant kinetic viscosity used to compute +C gammaTurb (def: 1.95e-5) +C SHELFICEremeshFrequency :: Frequency (in seconds) of call to +C SHELFICE_REMESHING (def: 0. --> no remeshing) +C SHELFICEsplitThreshold :: Thickness fraction remeshing threshold above +C which top-cell splits (no unit) +C SHELFICEmergeThreshold :: Thickness fraction remeshing threshold below +C which top-cell merges with below (no unit) +C ----------------------------------------------------------------------- +C SHELFICEDragLinear :: linear drag at bottom shelfice (1/s) +C SHELFICEDragQuadratic :: quadratic drag at bottom shelfice (default +C = shiCdrag or bottomDragQuadratic) +C no_slip_shelfice :: set slip conditions for shelfice separately, +C (by default the same as no_slip_bottom, but +C really should be false when there is linear +C or quadratic drag) +C SHELFICElatentHeat :: latent heat of fusion (def: 334000 J/kg) +C SHELFICEwriteState :: enable output +C SHELFICEHeatCapacity_Cp :: heat capacity of ice shelf (def: 2000 J/K/kg) +C rhoShelfIce :: density of ice shelf (def: 917.0 kg/m^3) +C +C SHELFICE_dump_mnc :: use netcdf for snapshot output +C SHELFICE_tave_mnc :: use netcdf for time-averaged output +C SHELFICE_dumpFreq :: analoguous to dumpFreq (= default) +C SHELFICE_taveFreq :: analoguous to taveFreq (= default) +C +C-- Fields +C kTopC :: index of the top "wet cell" beneath the ice shelf (2D) +C K_icefront :: index of the bottommost ice front cell (2D) +C R_shelfIce :: shelfice topography [m] +C shelficeMassInit :: ice-shelf mass (per unit area) (kg/m^2) +C shelficeMass :: ice-shelf mass (per unit area) (kg/m^2) +C shelfIceMassDynTendency :: other mass balance tendency (kg/m^2/s) +C :: (e.g., from dynamics) +C shelficeLoadAnomaly :: pressure load anomaly of shelfice (Pa) +C shelficeHeatFlux :: upward heat flux (W/m^2) +C shelficeFreshWaterFlux :: upward fresh water flux (virt. salt flux) +C (kg/m^2/s) +C shelficeForcingT :: analogue of surfaceForcingT +C units are r_unit.Kelvin/s (=Kelvin.m/s if r=z) +C shelficeForcingS :: analogue of surfaceForcingS +C units are r_unit.g/kg/s (=g/kg.m/s if r=z) +#ifdef ALLOW_DIAGNOSTICS +C shelficeDragU :: Ice-Shelf stress (for diagnostics), Zonal comp. +C Units are N/m^2 ; > 0 increase top uVel +C shelficeDragV :: Ice-Shelf stress (for diagnostics), Merid. comp. +C Units are N/m^2 ; > 0 increase top vVel +#endif /* ALLOW_DIAGNOSTICS */ +#ifdef ALLOW_CTRL +C maskSHI :: Mask=1 where ice shelf is present on surface +C layer, showing full 2D ice shelf extent. +C =maskC for rest of k values +C Used with ice shelf fwflx +C or shiTransCoeffT/S ctrl. +#endif +C----------------------------------------------------------------------- +C \ev +CEOP + + COMMON /SHELFICE_PARMS_I/ kTopC, + & SHELFICEselectDragQuadr, K_icefront + INTEGER kTopC (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + INTEGER SHELFICEselectDragQuadr + INTEGER K_icefront (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + + COMMON /SHELFICE_PARMS_R/ + & SHELFICE_dumpFreq, SHELFICE_taveFreq, + & SHELFICEsaltToHeatRatio, + & SHELFICEheatTransCoeff, SHELFICEsaltTransCoeff, + & rhoShelfice, SHELFICEkappa, + & SHELFICElatentHeat, + & SHELFICEheatCapacity_Cp, + & SHELFICEthetaSurface, + & SHELFICEsalinity, + & SHELFICEDragLinear, SHELFICEDragQuadratic, + & shiCdrag, shiZetaN, shiRc, + & shiPrandtl, shiSchmidt, shiKinVisc, + & iceFrontThetaHorizDiffusionLength, + & iceFrontThetaInterior, + & SHELFICEremeshFrequency, + & SHELFICEsplitThreshold, SHELFICEmergeThreshold + + _RL SHELFICE_dumpFreq, SHELFICE_taveFreq + _RL SHELFICEsaltToHeatRatio + _RL SHELFICEheatTransCoeff + _RL SHELFICEsaltTransCoeff + _RL SHELFICElatentHeat + _RL SHELFICEheatCapacity_Cp + _RL rhoShelfice + _RL SHELFICEkappa + _RL SHELFICEDragLinear + _RL SHELFICEDragQuadratic + _RL SHELFICEthetaSurface + _RL shiCdrag, shiZetaN, shiRc + _RL shiPrandtl, shiSchmidt, shiKinVisc + _RL SHELFICEremeshFrequency + _RL SHELFICEsplitThreshold + _RL SHELFICEmergeThreshold + _RL SHELFICEsalinity + _RL iceFrontThetaHorizDiffusionLength + _RL iceFrontThetaInterior + + COMMON /SHELFICE_FIELDS_RL/ + & shelficeMass, shelficeMassInit, + & shelficeLoadAnomaly, + & shelficeForcingT, shelficeForcingS, + & shiTransCoeffT, shiTransCoeffS, + & iceFrontForcingT, iceFrontForcingS, + & shiCDragFld, shiDragQuadFld + + _RL shelficeMass (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL shelficeMassInit (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL shelficeLoadAnomaly (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL shelficeForcingT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL shelficeForcingS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) +#ifndef ALLOW_shiTransCoeff_3d + _RL shiTransCoeffT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL shiTransCoeffS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) +#else + _RL shiTransCoeffT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) + _RL shiTransCoeffS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) +#endif + _RL iceFrontForcingT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) + _RL iceFrontForcingS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) + _RL shiCDragFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL shiDragQuadFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + + COMMON /SHELFICE_FIELDS_RS/ + & R_shelfIce, + & shelficeHeatFlux, + & shelfIceFreshWaterFlux, + & shelfIceMassDynTendency, + & iceFrontHeatFlux, iceFrontFreshWaterFlux, + & SHIICFHeatFlux, SHIICFFreshWaterFlux + + _RS R_shelfIce (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RS shelficeHeatFlux (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RS shelficeFreshWaterFlux(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RS + & shelfIceMassDynTendency(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL iceFrontHeatFlux + & (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr, nSx,nSy) + _RL iceFrontFreshWaterFlux + & (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr, nSx,nSy) + _RL SHIICFHeatFlux + & (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL SHIICFFreshWaterFlux + & (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + +#ifdef ALLOW_CTRL + COMMON /SHELFICE_MASKS_CTRL/ maskSHI + _RS maskSHI (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) +#endif /* ALLOW_CTRL */ + +C ow - 06/29/2018 +C ow - maskSHI above is not consistent with the spirit of gencost. +C ow - Use the following masks below instead. +C ow - mask2dSHIICF: 2d shelf-ice & ice-front mask: +C 1 for having shelf-ice and/or ice-front at one or more vertical levels +C and 0 otherwise. +C mask3dSHIICF: 3d shelf-ice & ice-front mask. +C mask2dSHI: 2d shelf-ice mask +C mask3dSHI: 3d shelf-ice mask +C mask2dICF: 2d ice-front mask: 1 for having ice-front at one or more vertical levels. +C mask3dICF: 3d ice-front mask + COMMON /SHELFICE_MASKS/ mask2dSHIICF, mask3dSHIICF, + & mask2dSHI, mask3dSHI, mask2dICF, mask3dICF + _RS mask2dSHIICF (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RS mask3dSHIICF (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) + _RS mask2dSHI (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RS mask3dSHI (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) + _RS mask2dICF (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RS mask3dICF (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) + +C ow - 07/23/2020 +C ow - CURI_ARR, CURJ_AA, +C CURI_ARR: i-index for neighboring ice-front points +C CURJ_ARR: j-index for neighboring ice-front points +C icefrontwidth_arr: ice-front width in meters + COMMON /SHELFICE_ICEFRONT_I/CURI_ARR, CURJ_ARR + INTEGER CURI_ARR(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,4) + INTEGER CURJ_ARR(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,4) + COMMON /SHELFICE_ICEFRONT_R/icefrontwidth_arr + _RL icefrontwidth_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,4) + +#ifdef ALLOW_DIAGNOSTICS + COMMON /SHELFICE_DIAG_DRAG/ shelficeDragU, shelficeDragV + _RS shelficeDragU(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RS shelficeDragV(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) +#endif /* ALLOW_DIAGNOSTICS */ + + LOGICAL SHELFICEisOn + LOGICAL useISOMIPTD + LOGICAL SHELFICEconserve + LOGICAL SHELFICEboundaryLayer + LOGICAL SHI_withBL_realFWflux + LOGICAL SHI_withBL_uStarTopDz + LOGICAL no_slip_shelfice + LOGICAL SHELFICEwriteState + LOGICAL SHELFICE_dump_mdsio + LOGICAL SHELFICE_tave_mdsio + LOGICAL SHELFICE_dump_mnc + LOGICAL SHELFICE_tave_mnc + LOGICAL SHELFICEadvDiffHeatFlux + LOGICAL SHELFICEuseGammaFrict + LOGICAL SHELFICE_oldCalcUStar + LOGICAL SHELFICEMassStepping + LOGICAL SHELFICEDynMassOnly + COMMON /SHELFICE_PARMS_L/ + & SHELFICEisOn, + & useISOMIPTD, + & SHELFICEconserve, + & SHELFICEboundaryLayer, + & SHI_withBL_realFWflux, + & SHI_withBL_uStarTopDz, + & no_slip_shelfice, + & SHELFICEwriteState, + & SHELFICE_dump_mdsio, + & SHELFICE_tave_mdsio, + & SHELFICE_dump_mnc, + & SHELFICE_tave_mnc, + & SHELFICEadvDiffHeatFlux, + & SHELFICEuseGammaFrict, + & SHELFICE_oldCalcUStar, + & SHELFICEMassStepping, + & SHELFICEDynMassOnly + + CHARACTER*(MAX_LEN_FNAM) SHELFICEloadAnomalyFile + CHARACTER*(MAX_LEN_FNAM) SHELFICEmassFile + CHARACTER*(MAX_LEN_FNAM) SHELFICEtopoFile + CHARACTER*(MAX_LEN_FNAM) SHELFICEMassDynTendFile + CHARACTER*(MAX_LEN_FNAM) SHELFICETransCoeffTFile + COMMON /SHELFICE_PARM_C/ + & SHELFICEloadAnomalyFile, + & SHELFICEmassFile, + & SHELFICEtopoFile, + & SHELFICEMassDynTendFile, + & SHELFICETransCoeffTFile + + COMMON /ICEFRONT_FIELDS_RS/ + & R_icefront, + & icefrontlength + _RS R_icefront (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RS icefrontlength (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + + CHARACTER*(MAX_LEN_FNAM) ICEFRONTlengthFile + CHARACTER*(MAX_LEN_FNAM) ICEFRONTdepthFile + COMMON /ICEFRONT_PARM_C/ + & ICEFRONTlengthFile, + & ICEFRONTdepthFile + +#endif /* ALLOW_SHELFICE */ diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SHELFICE_OPTIONS.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SHELFICE_OPTIONS.h new file mode 100644 index 0000000..5c44aab --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SHELFICE_OPTIONS.h @@ -0,0 +1,41 @@ +C *==========================================================* +C | SHELFICE_OPTIONS.h +C | o CPP options file for SHELFICE package. +C *==========================================================* +C | Use this file for selecting options within the SHELFICE +C | package. +C *==========================================================* + +#ifndef SHELFICE_OPTIONS_H +#define SHELFICE_OPTIONS_H +#include "PACKAGES_CONFIG.h" +#include "CPP_OPTIONS.h" + +#ifdef ALLOW_SHELFICE +C Package-specific Options & Macros go here + +C allow Ian Fenty's shelfice/icefront merged code +#define shelfice_new_thermo + +C allow code for simple ISOMIP thermodynamics +#define ALLOW_ISOMIP_TD + +C allow friction velocity-dependent transfer coefficient +C following Holland and Jenkins, JPO, 1999 +#define SHI_ALLOW_GAMMAFRICT + +C in uStar expression, use wet-point method to average velocity +C at grid-cell center +#undef SHI_USTAR_WETPOINT + +CC use 3d shiTransCoeffT and shiTransCoeffS +C#define ALLOW_shiTransCoeff_3d + +C allow (vertical) remeshing whenever ocean top thickness factor +C exceeds thresholds +#undef ALLOW_SHELFICE_REMESHING +C and allow to print message to STDOUT when this happens +#define SHELFICE_REMESH_PRINT + +#endif /* ALLOW_SHELFICE */ +#endif /* SHELFICE_OPTIONS_H */ diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SIZE.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SIZE.h new file mode 100644 index 0000000..9541af5 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/SIZE.h @@ -0,0 +1,70 @@ +C These lines are here to deliberately cause a compile-time error. +C If you see these lines in your .F files or the compiler shows them +C as an error then it means you have not placed your configuration +C files in the appropriate place. +C You need to place you own copy of SIZE.h in the include +C path for the model, and comment out these lines. + +CBOP +C !ROUTINE: SIZE.h +C !INTERFACE: +C include SIZE.h +C !DESCRIPTION: \bv +C *==========================================================* +C | SIZE.h Declare size of underlying computational grid. +C *==========================================================* +C | The design here supports a three-dimensional model grid +C | with indices I,J and K. The three-dimensional domain +C | is comprised of nPx*nSx blocks (or tiles) of size sNx +C | along the first (left-most index) axis, nPy*nSy blocks +C | of size sNy along the second axis and one block of size +C | Nr along the vertical (third) axis. +C | Blocks/tiles have overlap regions of size OLx and OLy +C | along the dimensions that are subdivided. +C *==========================================================* +C \ev +C +C Voodoo numbers controlling data layout: +C sNx :: Number of X points in tile. +C sNy :: Number of Y points in tile. +C OLx :: Tile overlap extent in X. +C OLy :: Tile overlap extent in Y. +C nSx :: Number of tiles per process in X. +C nSy :: Number of tiles per process in Y. +C nPx :: Number of processes to use in X. +C nPy :: Number of processes to use in Y. +C Nx :: Number of points in X for the full domain. +C Ny :: Number of points in Y for the full domain. +C Nr :: Number of points in vertical direction. +CEOP + INTEGER sNx + INTEGER sNy + INTEGER OLx + INTEGER OLy + INTEGER nSx + INTEGER nSy + INTEGER nPx + INTEGER nPy + INTEGER Nx + INTEGER Ny + INTEGER Nr + PARAMETER ( + & sNx = 15, + & sNy = 15, + & OLx = 4, + & OLy = 4, + & nSx = 1, + & nSy = 1, + & nPx = 384, + & nPy = 1, + & Nx = sNx*nSx*nPx, + & Ny = sNy*nSy*nPy, + & Nr = 50) + +C MAX_OLX :: Set to the maximum overlap region size of any array +C MAX_OLY that will be exchanged. Controls the sizing of exch +C routine buffers. + INTEGER MAX_OLX + INTEGER MAX_OLY + PARAMETER ( MAX_OLX = OLx, + & MAX_OLY = OLy ) diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ggl90_calc.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ggl90_calc.F new file mode 100644 index 0000000..738c592 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ggl90_calc.F @@ -0,0 +1,1216 @@ +#include "GGL90_OPTIONS.h" +#ifdef ALLOW_AUTODIFF +# include "AUTODIFF_OPTIONS.h" +#endif + +CBOP +C !ROUTINE: GGL90_CALC + +C !INTERFACE: ====================================================== + SUBROUTINE GGL90_CALC( + I bi, bj, sigmaR, myTime, myIter, myThid ) + +C !DESCRIPTION: \bv +C *==========================================================* +C | SUBROUTINE GGL90_CALC | +C | o Compute all GGL90 fields defined in GGL90.h | +C *==========================================================* +C | Equation numbers refer to | +C | Gaspar et al. (1990), JGR 95 (C9), pp 16,179 | +C | Some parts of the implementation follow Blanke and | +C | Delecuse (1993), JPO, and OPA code, in particular the | +C | computation of the | +C | mixing length = max(min(lk,depth),lkmin) | +C | Note: Only call this S/R if Nr > 1 (no use if Nr=1) | +C *==========================================================* + +C global parameters updated by ggl90_calc +C GGL90TKE :: sub-grid turbulent kinetic energy (m^2/s^2) +C GGL90viscAz :: GGL90 eddy viscosity coefficient (m^2/s) +C GGL90diffKzT :: GGL90 diffusion coefficient for temperature (m^2/s) +C \ev + +C !USES: ============================================================ + IMPLICIT NONE +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "DYNVARS.h" +#include "FFIELDS.h" +#include "GRID.h" +#include "GGL90.h" +#ifdef ALLOW_AUTODIFF_TAMC +# include "tamc.h" +#endif +#ifdef ALLOW_SHELFICE +#include "SHELFICE.h" +#endif + +C !INPUT PARAMETERS: =================================================== +C Routine arguments +C bi, bj :: Current tile indices +C sigmaR :: Vertical gradient of iso-neutral density +C myTime :: Current time in simulation +C myIter :: Current time-step number +C myThid :: My Thread Id number + INTEGER bi, bj + _RL sigmaR(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) + _RL myTime + INTEGER myIter + INTEGER myThid + +#ifdef ALLOW_GGL90 + +C !LOCAL VARIABLES: ==================================================== +C iMin,iMax,jMin,jMax :: index boundaries of computation domain +C i, j, k :: array computation indices +C kSrf :: vertical index of surface level +C kTop :: index of top interface (just below surf. level) +C kBot :: index of bottom interface (just above bottom lev.) +C delK :: from interface k to level just below: k-delK +C hFac/hFacI :: fractional thickness of W-cell +C explDissFac :: explicit Dissipation Factor (in [0-1]) +C implDissFac :: implicit Dissipation Factor (in [0-1]) +C +C In general, all 3D variables are defined at W-points (i.e., +C between k and k-1), all 2D variables are also defined at W-points +C or at the very surface level (like uStarSquare) +C +C totalDepth :: thickness of water column (inverse of recip_Rcol) +C uStarSquare :: square of friction velocity +C verticalShear :: (squared) vertical shear of horizontal velocity +C Nsquare :: squared buoyancy freqency +C RiNumber :: local Richardson number +C KappaM :: (local) viscosity parameter (eq.10) +C KappaH :: (local) diffusivity parameter for temperature (eq.11) +C KappaE :: (local) diffusivity parameter for TKE (eq.15) +C TKEdissipation :: dissipation of TKE +C GGL90mixingLength:: mixing length of scheme following Banke+Delecuse +C rMixingLength:: inverse of mixing length +C TKEPrandtlNumber :: here, an empirical function of the Richardson number + INTEGER iMin ,iMax ,jMin ,jMax + INTEGER i, j, k + INTEGER kp1, km1, kl + INTEGER kSrf, kTop, kBot, delK + INTEGER errCode +#ifdef ALLOW_SHELFICE + INTEGER ktmp, kSrftmp, kToptmp + _RL explDissFacSI, implDissFacSI +#endif + _RL deltaTloc + _RL explDissFac, implDissFac + _RL totalDepth (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL uStarSquare (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL verticalShear(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL KappaM (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL KappaH +c _RL Nsquare + _RL Nsquare(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) +c _RL SQRTTKE + _RL SQRTTKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) + _RL RiNumber +#ifdef ALLOW_GGL90_IDEMIX + _RL IDEMIX_RiNumber +#endif + _RL TKEdissipation + _RL tempU, tempUp, tempV, tempVp, prTemp + _RL MaxLength, tmpmlx, tmpVisc + _RL TKEPrandtlNumber (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) + _RL GGL90mixingLength(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) + _RL rMixingLength (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) + _RL mxLength_Dn (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) + _RL KappaE (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) + _RL GGL90visctmp (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) +#ifdef ALLOW_GGL90_IDEMIX + _RL hFacI (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) +C IDEMIX_gTKE :: TKE tendency due to internal waves +C (output of S/R GGL90_IDEMIX) + _RL IDEMIX_gTKE (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) +#endif /* ALLOW_GGL90_IDEMIX */ + _RL recip_hFacI (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) + _RL hFac +C- tri-diagonal matrix + _RL a3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) + _RL b3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) + _RL c3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) +C This mixed layer model is not invariant under coordinate +C transformation to pressure coordinates, so we need these +C factors to scale the vertical (pressure) coordinates + _RL coordFac, recip_coordFac +#ifdef ALLOW_GGL90_HORIZDIFF +C xA, yA :: area of lateral faces +C dfx, dfy :: diffusive flux across lateral faces +C gTKE :: right hand side of diffusion equation + _RL xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL yA (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL dfx (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL dfy (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL gTKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy) +#endif /* ALLOW_GGL90_HORIZDIFF */ +#ifdef ALLOW_GGL90_SMOOTH + _RL p4, p8, p16 +#endif +#ifdef ALLOW_DIAGNOSTICS + _RL surf_flx_tke(1-OLx:sNx+OLx,1-OLy:sNy+OLy) +#endif /* ALLOW_DIAGNOSTICS */ +#ifdef ALLOW_AUTODIFF_TAMC + INTEGER act1, act2, act3, act4 + INTEGER max1, max2, max3 + INTEGER ikeyLoc, kkeyLoc +#endif +CEOP + + PARAMETER( iMin = 2-OLx, iMax = sNx+OLx-1 ) + PARAMETER( jMin = 2-OLy, jMax = sNy+OLy-1 ) +#ifdef ALLOW_GGL90_SMOOTH + p4 = 0.25 _d 0 + p8 = 0.125 _d 0 + p16 = 0.0625 _d 0 +#endif + + IF ( usingPCoords ) THEN + kSrf = Nr + kTop = Nr + delK = 1 + ELSE + kSrf = 1 + kTop = 2 + delK = 0 + ENDIF + deltaTloc = dTtracerLev(kSrf) + + coordFac = 1. _d 0 + IF ( usingPCoords) coordFac = gravity * rhoConst + recip_coordFac = 1./coordFac + +#ifdef ALLOW_AUTODIFF_TAMC + act1 = bi - myBxLo(myThid) + max1 = myBxHi(myThid) - myBxLo(myThid) + 1 + act2 = bj - myByLo(myThid) + max2 = myByHi(myThid) - myByLo(myThid) + 1 + act3 = myThid - 1 + max3 = nTx*nTy + act4 = ikey_dynamics - 1 + ikeyLoc = (act1 + 1) + act2*max1 + & + act3*max1*max2 + & + act4*max1*max2*max3 +#endif /* ALLOW_AUTODIFF_TAMC */ + +C explicit/implicit timestepping weights for dissipation + explDissFac = 0. _d 0 + implDissFac = 1. _d 0 - explDissFac + +#ifdef ALLOW_SHELFICE + explDissFacSI = 0.5 _d 0 + implDissFacSI = 1. _d 0 - explDissFacSI +#endif + +C For nonlinear free surface and especially with r*-coordinates, the +C hFacs change every timestep, so we need to update them here in the +C case of using IDEMIX. + DO k=1,Nr + km1 = MAX(k-1,1) + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + hFac = + & MIN(.5 _d 0,_hFacC(i,j,km1,bi,bj) ) + + & MIN(.5 _d 0,_hFacC(i,j,k ,bi,bj) ) + recip_hFacI(i,j,k)=0. _d 0 + IF ( hFac .NE. 0. _d 0 ) + & recip_hFacI(i,j,k)=1. _d 0/hFac +#ifdef ALLOW_GGL90_IDEMIX + hFacI(i,j,k) = hFac +#endif /* ALLOW_GGL90_IDEMIX */ + ENDDO + ENDDO + ENDDO + +#ifdef ALLOW_GGL90_IDEMIX +C step forward IDEMIX_E(energy) and compute tendency for TKE, +C IDEMIX_gTKE = tau_d * IDEMIX_E**2, following Olbers and Eden (2013) + IF ( useIDEMIX) CALL GGL90_IDEMIX( + I bi, bj, hFacI, recip_hFacI, sigmaR, + O IDEMIX_gTKE, + I myTime, myIter, myThid ) +#endif /* ALLOW_GGL90_IDEMIX */ + +C Initialize local fields + DO k=1,Nr + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + rMixingLength(i,j,k) = 0. _d 0 + mxLength_Dn(i,j,k) = 0. _d 0 + GGL90visctmp(i,j,k) = 0. _d 0 + KappaE(i,j,k) = 0. _d 0 + TKEPrandtlNumber(i,j,k) = 1. _d 0 + GGL90mixingLength(i,j,k) = GGL90mixingLengthMin + GGL90visctmp(i,j,k) = 0. _d 0 +#ifndef SOLVE_DIAGONAL_LOWMEMORY + a3d(i,j,k) = 0. _d 0 + b3d(i,j,k) = 1. _d 0 + c3d(i,j,k) = 0. _d 0 +#endif + Nsquare(i,j,k) = 0. _d 0 + SQRTTKE(i,j,k) = 0. _d 0 + ENDDO + ENDDO + ENDDO +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE GGL90TKE(:,:,:,bi,bj)=comlev1_bibj, key=ikeyLoc, kind=isbyte +#endif + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + KappaM(i,j) = 0. _d 0 + uStarSquare(i,j) = 0. _d 0 + verticalShear(i,j) = 0. _d 0 + totalDepth(i,j) = Ro_surf(i,j,bi,bj) - R_low(i,j,bi,bj) +c rMixingLength(i,j,1) = 0. _d 0 + mxLength_Dn(i,j,1) = GGL90mixingLengthMin +#ifdef ALLOW_AUTODIFF + IF ( usingZCoords .AND. maskC(i,j,1,bi,bj).EQ.oneRS ) THEN +#endif + SQRTTKE(i,j,1) = SQRT( GGL90TKE(i,j,1,bi,bj) ) +#ifdef ALLOW_AUTODIFF + ELSE + SQRTTKE(i,j,1) = 0. _d 0 + ENDIF +#endif +#ifdef ALLOW_GGL90_HORIZDIFF + xA(i,j) = 0. _d 0 + yA(i,j) = 0. _d 0 + dfx(i,j) = 0. _d 0 + dfy(i,j) = 0. _d 0 + gTKE(i,j) = 0. _d 0 +#endif /* ALLOW_GGL90_HORIZDIFF */ + ENDDO + ENDDO + + DO k = 2, Nr + kl = k-delK + DO j=jMin,jMax + DO i=iMin,iMax +#ifdef ALLOW_AUTODIFF + IF ( maskC(i,j,kl,bi,bj).EQ.oneRS ) THEN +#endif + SQRTTKE(i,j,k)=SQRT( GGL90TKE(i,j,k,bi,bj) ) +#ifdef ALLOW_AUTODIFF + ELSE + SQRTTKE(i,j,k)=0. _d 0 + ENDIF +#endif + +C buoyancy frequency + Nsquare(i,j,k) = gravity*gravitySign*recip_rhoConst + & * sigmaR(i,j,k) * coordFac +C vertical shear term (dU/dz)^2+(dV/dz)^2 is computed later +C to save some memory +C mixing length + GGL90mixingLength(i,j,k) = SQRTTWO * + & SQRTTKE(i,j,k)/SQRT( MAX(Nsquare(i,j,k),GGL90eps) ) + & * maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj) + +#ifdef ALLOW_SHELFICE + if (k .LT. kTopC(i,j,bi,bj)) THEN + SQRTTKE(i,j,k) = 0.0 _d 0 + Nsquare(i,j,k) = 0.0 _d 0 + GGL90mixingLength(i,j,k) = 0.0 _d 0 + endif +#endif + ENDDO + ENDDO + ENDDO + +C- ensure mixing between first and second level + IF (mxlSurfFlag) THEN + DO j=jMin,jMax + DO i=iMin,iMax +#ifdef ALLOW_SHELFICE + ktmp = kTopC(i,j,bi,bj) + if (ktmp .EQ. 0) THEN + GGL90mixingLength(i,j,kTop)=drF(kSrf)*recip_coordFac + ELSE + GGL90mixingLength(i,j,ktmp+1)=drF(ktmp)*recip_coordFac + ENDIF +#else + GGL90mixingLength(i,j,kTop)=drF(kSrf)*recip_coordFac +#endif + ENDDO + ENDDO + ENDIF + +C-- Impose upper and lower bound for mixing length +#ifdef ALLOW_AUTODIFF +CADJ INCOMPLETE GGL90mixingLength +#endif + IF ( mxlMaxFlag .EQ. 0 ) THEN + + DO k=2,Nr + DO j=jMin,jMax + DO i=iMin,iMax + MaxLength=totalDepth(i,j)*recip_coordFac + GGL90mixingLength(i,j,k) = MIN(GGL90mixingLength(i,j,k), + & MaxLength) + ENDDO + ENDDO + ENDDO + + ELSEIF ( mxlMaxFlag .EQ. 1 ) THEN + + DO k=2,Nr + DO j=jMin,jMax + DO i=iMin,iMax + MaxLength=MIN(Ro_surf(i,j,bi,bj)-rF(k),rF(k)-R_low(i,j,bi,bj)) + & * recip_coordFac +c MaxLength=MAX(MaxLength,20. _d 0) + GGL90mixingLength(i,j,k) = MIN(GGL90mixingLength(i,j,k), + & MaxLength) + ENDDO + ENDDO + ENDDO + + ELSEIF ( mxlMaxFlag .EQ. 2 ) THEN + + IF ( usingPcoords ) THEN +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE GGL90mixingLength(:,:,Nr) +CADJ & = comlev1_bibj, key = ikeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ +C Downward sweep, extra treatment of k=Nr for p-coordinates +C because level Nr+1 is not available + DO j=jMin,jMax + DO i=iMin,iMax + GGL90mixingLength(i,j,Nr) = MIN(GGL90mixingLength(i,j,Nr), + & GGL90mixingLengthMin+drF(Nr)*recip_coordFac) + ENDDO + ENDDO + DO k=Nr-1,2,-1 +#ifdef ALLOW_AUTODIFF_TAMC + kkeyLoc = (ikeyLoc-1)*Nr + k +CADJ STORE GGL90mixingLength(:,:,k+1) +CADJ & = comlev1_bibj_k, key = kkeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ + DO j=jMin,jMax + DO i=iMin,iMax + GGL90mixingLength(i,j,k) = MIN(GGL90mixingLength(i,j,k), + & GGL90mixingLength(i,j,k+1)+drF(k)*recip_coordFac) + ENDDO + ENDDO + ENDDO +C Upward sweep + DO k=2,Nr +#ifdef ALLOW_AUTODIFF_TAMC + kkeyLoc = (ikeyLoc-1)*Nr + k +CADJ STORE GGL90mixingLength(:,:,k-1) +CADJ & = comlev1_bibj_k, key = kkeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ + DO j=jMin,jMax + DO i=iMin,iMax + GGL90mixingLength(i,j,k) = MIN(GGL90mixingLength(i,j,k), + & GGL90mixingLength(i,j,k-1)+drF(k-1)*recip_coordFac) + ENDDO + ENDDO + ENDDO + ELSE +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE GGL90mixingLength(:,:,Nr) +CADJ & = comlev1_bibj, key = ikeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ +C Downward sweep + DO k=2,Nr +#ifdef ALLOW_AUTODIFF_TAMC + kkeyLoc = (ikeyLoc-1)*Nr + k +CADJ STORE GGL90mixingLength(:,:,k-1) +CADJ & = comlev1_bibj_k, key = kkeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ + DO j=jMin,jMax + DO i=iMin,iMax + GGL90mixingLength(i,j,k) = MIN(GGL90mixingLength(i,j,k), + & GGL90mixingLength(i,j,k-1)+drF(k-1)*recip_coordFac) + ENDDO + ENDDO + ENDDO +C Upward sweep, extra treatment of k=Nr for z-coordinates +C because level Nr+1 is not available + DO j=jMin,jMax + DO i=iMin,iMax + GGL90mixingLength(i,j,Nr) = MIN(GGL90mixingLength(i,j,Nr), + & GGL90mixingLengthMin+drF(Nr)*recip_coordFac) + ENDDO + ENDDO + DO k=Nr-1, 2,-1 +#ifdef ALLOW_AUTODIFF_TAMC + kkeyLoc = (ikeyLoc-1)*Nr + k +CADJ STORE GGL90mixingLength(:,:,k+1) +CADJ & = comlev1_bibj_k, key = kkeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ + DO j=jMin,jMax + DO i=iMin,iMax + GGL90mixingLength(i,j,k) = MIN(GGL90mixingLength(i,j,k), + & GGL90mixingLength(i,j,k+1)+drF(k)*recip_coordFac) + ENDDO + ENDDO + ENDDO + ENDIF + + ELSEIF ( mxlMaxFlag .EQ. 3 ) THEN + + IF ( usingPcoords ) THEN +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE GGL90mixingLength(:,:,Nr) +CADJ & = comlev1_bibj, key = ikeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ +C Downward sweep, extra treatment of k=Nr for p-coordinates +C because level Nr+1 is not available + DO j=jMin,jMax + DO i=iMin,iMax + mxLength_Dn(i,j,Nr) = MIN(GGL90mixingLength(i,j,Nr), + & GGL90mixingLengthMin+drF(Nr)*recip_coordFac) + ENDDO + ENDDO + DO k=Nr-1,2,-1 +#ifdef ALLOW_AUTODIFF_TAMC + kkeyLoc = (ikeyLoc-1)*Nr + k +CADJ STORE mxLength_Dn(:,:,k+1) +CADJ & = comlev1_bibj_k, key = kkeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ + DO j=jMin,jMax + DO i=iMin,iMax + mxLength_Dn(i,j,k) = MIN(GGL90mixingLength(i,j,k), + & mxLength_Dn(i,j,k+1)+drF(k)*recip_coordFac) + ENDDO + ENDDO + ENDDO +C Upward sweep + DO k=2,Nr +#ifdef ALLOW_AUTODIFF_TAMC + kkeyLoc = (ikeyLoc-1)*Nr + k +CADJ STORE GGL90mixingLength(:,:,k-1) +CADJ & = comlev1_bibj_k, key = kkeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ + DO j=jMin,jMax + DO i=iMin,iMax + GGL90mixingLength(i,j,k) = MIN(GGL90mixingLength(i,j,k), + & GGL90mixingLength(i,j,k-1)+drF(k-1)*recip_coordFac) + ENDDO + ENDDO + ENDDO + ELSE +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE GGL90mixingLength(:,:,Nr) +CADJ & = comlev1_bibj, key = ikeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ +C Downward sweep + DO k=2,Nr +#ifdef ALLOW_AUTODIFF_TAMC + kkeyLoc = (ikeyLoc-1)*Nr + k +CADJ STORE mxLength_Dn(:,:,k-1) +CADJ & = comlev1_bibj_k, key = kkeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ + DO j=jMin,jMax + DO i=iMin,iMax + mxLength_Dn(i,j,k) = MIN(GGL90mixingLength(i,j,k), + & mxLength_Dn(i,j,k-1)+drF(k-1)*recip_coordFac) + ENDDO + ENDDO + ENDDO +C Upward sweep, extra treatment of k=Nr for z-coordinates +C because level Nr+1 is not available + DO j=jMin,jMax + DO i=iMin,iMax + GGL90mixingLength(i,j,Nr) = MIN(GGL90mixingLength(i,j,Nr), + & GGL90mixingLengthMin+drF(Nr)*recip_coordFac) + ENDDO + ENDDO + DO k=Nr-1,2,-1 +#ifdef ALLOW_AUTODIFF_TAMC + kkeyLoc = (ikeyLoc-1)*Nr + k +CADJ STORE GGL90mixingLength(:,:,k-1) +CADJ & = comlev1_bibj_k, key = kkeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ + DO j=jMin,jMax + DO i=iMin,iMax + GGL90mixingLength(i,j,k) = MIN(GGL90mixingLength(i,j,k), + & GGL90mixingLength(i,j,k+1)+drF(k)*recip_coordFac) + ENDDO + ENDDO + ENDDO + ENDIF + + ELSE + STOP 'GGL90_CALC: Wrong mxlMaxFlag (mixing length limit)' + ENDIF +C-- Impose minimum mixing length to avoid division by zero +C and compute inverse + IF ( mxlMaxFlag.EQ.3 ) THEN +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE GGL90mixingLength = comlev1_bibj, key = ikeyLoc, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ + DO k=2,Nr + DO j=jMin,jMax + DO i=iMin,iMax + GGL90mixingLength(i,j,k) = MIN(GGL90mixingLength(i,j,k), + & mxLength_Dn(i,j,k)) +#ifdef ALLOW_AUTODIFF + ENDDO + ENDDO + ENDDO + DO k=2,Nr + DO j=jMin,jMax + DO i=iMin,iMax +#endif + tmpmlx = SQRT( GGL90mixingLength(i,j,k)*mxLength_Dn(i,j,k) ) + tmpmlx = MAX( tmpmlx, GGL90mixingLengthMin) + rMixingLength(i,j,k) = 1. _d 0 / tmpmlx + ENDDO + ENDDO + ENDDO + ELSE +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE GGL90mixingLength = comlev1_bibj, key=ikeyLoc, kind=isbyte +#endif + DO k=2,Nr + DO j=jMin,jMax + DO i=iMin,iMax + GGL90mixingLength(i,j,k) = MAX(GGL90mixingLength(i,j,k), + & GGL90mixingLengthMin) +#ifdef ALLOW_AUTODIFF + ENDDO + ENDDO + ENDDO + DO k=2,Nr + DO j=jMin,jMax + DO i=iMin,iMax +#endif + rMixingLength(i,j,k) = 1. _d 0 / GGL90mixingLength(i,j,k) + ENDDO + ENDDO + ENDDO + ENDIF + +C start "proper" k-loop (the code above was moved out and up to +C implemement various mixing parameters efficiently) + DO k=2,Nr + km1 = k-1 + +#ifdef ALLOW_GGL90_HORIZDIFF + IF ( GGL90diffTKEh .GT. 0. _d 0 ) THEN +C horizontal diffusion of TKE (requires an exchange in +C do_fields_blocking_exchanges) +C common factors + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + xA(i,j) = _dyG(i,j,bi,bj)*drC(k)* + & (MIN(.5 _d 0,_hFacW(i,j,km1,bi,bj) ) + + & MIN(.5 _d 0,_hFacW(i,j,k ,bi,bj) ) ) + yA(i,j) = _dxG(i,j,bi,bj)*drC(k)* + & (MIN(.5 _d 0,_hFacS(i,j,km1,bi,bj) ) + + & MIN(.5 _d 0,_hFacS(i,j,k ,bi,bj) ) ) + ENDDO + ENDDO +C Compute diffusive fluxes +C ... across x-faces + DO j=1-OLy,sNy+OLy + dfx(1-OLx,j)=0. _d 0 + DO i=1-OLx+1,sNx+OLx + dfx(i,j) = -GGL90diffTKEh*xA(i,j) + & *_recip_dxC(i,j,bi,bj) + & *(GGL90TKE(i,j,k,bi,bj)-GGL90TKE(i-1,j,k,bi,bj)) +#ifdef ISOTROPIC_COS_SCALING + & *CosFacU(j,bi,bj) +#endif /* ISOTROPIC_COS_SCALING */ + ENDDO + ENDDO +C ... across y-faces + DO i=1-OLx,sNx+OLx + dfy(i,1-OLy)=0. _d 0 + ENDDO + DO j=1-OLy+1,sNy+OLy + DO i=1-OLx,sNx+OLx + dfy(i,j) = -GGL90diffTKEh*yA(i,j) + & *_recip_dyC(i,j,bi,bj) + & *(GGL90TKE(i,j,k,bi,bj)-GGL90TKE(i,j-1,k,bi,bj)) +#ifdef ISOTROPIC_COS_SCALING + & *CosFacV(j,bi,bj) +#endif /* ISOTROPIC_COS_SCALING */ + ENDDO + ENDDO +C Compute divergence of fluxes + DO j=1-OLy,sNy+OLy-1 + DO i=1-OLx,sNx+OLx-1 + gTKE(i,j) = -recip_drC(k)*recip_rA(i,j,bi,bj) + & *recip_hFacI(i,j,k) + & *((dfx(i+1,j)-dfx(i,j)) + & + (dfy(i,j+1)-dfy(i,j)) ) + ENDDO + ENDDO +C end if GGL90diffTKEh .eq. 0. + ENDIF +#endif /* ALLOW_GGL90_HORIZDIFF */ + +C viscosity and diffusivity + DO j=jMin,jMax + DO i=iMin,iMax + KappaM(i,j) = GGL90ck*GGL90mixingLength(i,j,k)*SQRTTKE(i,j,k) + GGL90visctmp(i,j,k) = MAX( KappaM(i,j),diffKrNrS(k) + & * recip_coordFac*recip_coordFac ) + & * maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj) +C note: storing GGL90visctmp like this, and using it later to compute +C GGL9rdiffKr etc. is robust in case of smoothing (e.g. see OPA) + KappaM(i,j) = MAX( KappaM(i,j),viscArNr(k) + & * recip_coordFac*recip_coordFac ) + & * maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj) + ENDDO + ENDDO + +C compute vertical shear (dU/dz)^2+(dV/dz)^2 + IF ( calcMeanVertShear ) THEN +C by averaging (@ grid-cell center) the 4 vertical shear compon @ U,V pos. + DO j=jMin,jMax + DO i=iMin,iMax + tempU = ( uVel( i ,j,km1,bi,bj) - uVel( i ,j,k,bi,bj) ) + tempUp = ( uVel(i+1,j,km1,bi,bj) - uVel(i+1,j,k,bi,bj) ) + tempV = ( vVel(i, j ,km1,bi,bj) - vVel(i, j ,k,bi,bj) ) + tempVp = ( vVel(i,j+1,km1,bi,bj) - vVel(i,j+1,k,bi,bj) ) + verticalShear(i,j) = ( + & ( tempU*tempU + tempUp*tempUp ) + & + ( tempV*tempV + tempVp*tempVp ) + & )*halfRL*recip_drC(k)*recip_drC(k) + & *coordFac*coordFac + ENDDO + ENDDO + ELSE +C from the averaged flow at grid-cell center (2 compon x 2 pos.) + DO j=jMin,jMax + DO i=iMin,iMax + tempU = ( ( uVel(i,j,km1,bi,bj) + uVel(i+1,j,km1,bi,bj) ) + & -( uVel(i,j,k ,bi,bj) + uVel(i+1,j,k ,bi,bj) ) + & )*halfRL*recip_drC(k) + & *coordFac + tempV = ( ( vVel(i,j,km1,bi,bj) + vVel(i,j+1,km1,bi,bj) ) + & -( vVel(i,j,k ,bi,bj) + vVel(i,j+1,k ,bi,bj) ) + & )*halfRL*recip_drC(k) + & *coordFac + verticalShear(i,j) = tempU*tempU + tempV*tempV + ENDDO + ENDDO + ENDIF + +#ifdef ALLOW_SHELFICE + DO j=jMin,jMax + DO i=iMin,iMax + IF (k .EQ. kTopC(i,j,bi,bj)) THEN + verticalShear(i,j) = 0.0 _d 0 + ENDIF + ENDDO + ENDDO +#endif + +C compute Prandtl number (always greater than 0) +#ifdef ALLOW_GGL90_IDEMIX + IF ( useIDEMIX ) THEN + DO j=jMin,jMax + DO i=iMin,iMax +C account for partical cell factor in vertical shear: + verticalShear(i,j) = verticalShear(i,j) + & * recip_hFacI(i,j,k)*recip_hFacI(i,j,k) + RiNumber = MAX(Nsquare(i,j,k),0. _d 0) + & /(verticalShear(i,j)+GGL90eps) +CML IDEMIX_RiNumber = 1./GGL90eps + IDEMIX_RiNumber = MAX( KappaM(i,j)*Nsquare(i,j,k), 0. _d 0)/ + & ( GGL90eps + IDEMIX_gTKE(i,j,k) ) + prTemp = MIN(5.*RiNumber, 6.6 _d 0*IDEMIX_RiNumber) + TKEPrandtlNumber(i,j,k) = MIN(10. _d 0,prTemp) + TKEPrandtlNumber(i,j,k) = MAX( oneRL,TKEPrandtlNumber(i,j,k) ) + ENDDO + ENDDO + ELSE +#endif /* ALLOW_GGL90_IDEMIX */ + DO j=jMin,jMax + DO i=iMin,iMax + RiNumber = MAX(Nsquare(i,j,k),0. _d 0) + & /(verticalShear(i,j)+GGL90eps) + prTemp = 1. _d 0 + IF ( RiNumber .GE. 0.2 _d 0 ) prTemp = 5. _d 0 * RiNumber + TKEPrandtlNumber(i,j,k) = MIN(10. _d 0,prTemp) + ENDDO + ENDDO +#ifdef ALLOW_GGL90_IDEMIX + ENDIF +#endif /* ALLOW_GGL90_IDEMIX */ + + DO j=jMin,jMax + DO i=iMin,iMax +C diffusivity + KappaH = KappaM(i,j)/TKEPrandtlNumber(i,j,k) + KappaE(i,j,k) = GGL90alpha * KappaM(i,j) + & * maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj) + +C dissipation term + TKEdissipation = explDissFac*GGL90ceps + & *SQRTTKE(i,j,k)*rMixingLength(i,j,k) + & *GGL90TKE(i,j,k,bi,bj) + +CIGF use explDissFacSI under shelfice +#ifdef ALLOW_SHELFICE + IF (kTopC(i,j,bi,bj) .GT. 0) THEN + TKEdissipation = explDissFacSI*GGL90ceps + & *SQRTTKE(i,j,k)*rMixingLength(i,j,k) + & *GGL90TKE(i,j,k,bi,bj) + ENDIF +#endif + +C partial update with sum of explicit contributions + GGL90TKE(i,j,k,bi,bj) = GGL90TKE(i,j,k,bi,bj) + & + deltaTloc*( + & + KappaM(i,j)*verticalShear(i,j) + & - KappaH*Nsquare(i,j,k) + & - TKEdissipation + & ) + + ENDDO + ENDDO + +#ifdef ALLOW_GGL90_IDEMIX + IF ( useIDEMIX ) THEN +C add IDEMIX contribution to the turbulent kinetic energy + DO j=jMin,jMax + DO i=iMin,iMax + GGL90TKE(i,j,k,bi,bj) = GGL90TKE(i,j,k,bi,bj) + & + deltaTloc*IDEMIX_gTKE(i,j,k) + ENDDO + ENDDO + ENDIF +#endif /* ALLOW_GGL90_IDEMIX */ + +#ifdef ALLOW_GGL90_HORIZDIFF + IF ( GGL90diffTKEh .GT. 0. _d 0 ) THEN +C-- Add horiz. diffusion tendency + DO j=jMin,jMax + DO i=iMin,iMax + GGL90TKE(i,j,k,bi,bj) = GGL90TKE(i,j,k,bi,bj) + & + gTKE(i,j)*deltaTloc + ENDDO + ENDDO + ENDIF +#endif /* ALLOW_GGL90_HORIZDIFF */ + +C-- end of k loop + ENDDO + IF ( usingPCoords ) THEN +C impose TKE(1) = 0. + DO j=jMin,jMax + DO i=iMin,iMax + GGL90TKE(i,j,1,bi,bj) = 0. _d 0 + ENDDO + ENDDO + ENDIF + +C ============================================== +C Implicit time step to update TKE for k=1,Nr; +C TKE(Nr+1)=0 by default; +C for pressure coordinates, this translates into +C TKE(1) = 0, TKE(Nr+1) is the surface value +C ============================================== +C set up matrix +C-- Lower diagonal + DO j=jMin,jMax + DO i=iMin,iMax + a3d(i,j,1) = 0. _d 0 + ENDDO + ENDDO + DO k=2,Nr + km1=MAX(2,k-1) + DO j=jMin,jMax + DO i=iMin,iMax + IF ( usingPCoords) km1=MIN(Nr,MAX(kSurfC(i,j,bi,bj)+1,k-1)) +C- We keep recip_hFacC in the diffusive flux calculation, +C- but no hFacC in TKE volume control +C- No need for maskC(k-1) with recip_hFacC(k-1) + a3d(i,j,k) = -deltaTloc + & *recip_drF(k-1)*recip_hFacC(i,j,k-1,bi,bj) + & *.5 _d 0*(KappaE(i,j, k )+KappaE(i,j,km1)) + & *recip_drC(k)*maskC(i,j,k,bi,bj) + & *coordFac*coordFac + ENDDO + ENDDO + ENDDO +C-- Upper diagonal + DO j=jMin,jMax + DO i=iMin,iMax + c3d(i,j,1) = 0. _d 0 + ENDDO + ENDDO + DO k=2,Nr + kp1=MIN(k+1,Nr) + DO j=jMin,jMax + DO i=iMin,iMax + IF ( usingZCoords ) kp1=MAX(1,MIN(klowC(i,j,bi,bj),k+1)) +C- We keep recip_hFacC in the diffusive flux calculation, +C- but no hFacC in TKE volume control +C- No need for maskC(k) with recip_hFacC(k) + c3d(i,j,k) = -deltaTloc + & *recip_drF( k ) * recip_hFacC(i,j,k,bi,bj) + & *.5 _d 0*(KappaE(i,j,k)+KappaE(i,j,kp1)) + & *recip_drC(k)*maskC(i,j,k-1,bi,bj) + & *coordFac*coordFac + ENDDO + ENDDO + ENDDO + +#ifdef ALLOW_GGL90_IDEMIX + IF ( useIDEMIX ) THEN + DO k=2,Nr + DO j=jMin,jMax + DO i=iMin,iMax + a3d(i,j,k) = a3d(i,j,k)*recip_hFacI(i,j,k) + c3d(i,j,k) = c3d(i,j,k)*recip_hFacI(i,j,k) + ENDDO + ENDDO + ENDDO + ENDIF +#endif /* ALLOW_GGL90_IDEMIX */ + + IF (.NOT.GGL90_dirichlet) THEN +C Neumann bottom boundary condition for TKE: no flux from bottom + IF ( usingPCoords ) THEN + DO j=jMin,jMax + DO i=iMin,iMax + kBot = MIN(kSurfC(i,j,bi,bj)+1,Nr) + a3d(i,j,kBot) = 0. _d 0 + ENDDO + ENDDO + ELSE + DO j=jMin,jMax + DO i=iMin,iMax + kBot = MAX(kLowC(i,j,bi,bj),1) + c3d(i,j,kBot) = 0. _d 0 + ENDDO + ENDDO + ENDIF + ENDIF + +C-- Center diagonal + DO k=1,Nr + km1 = MAX(k-1,1) + DO j=jMin,jMax + DO i=iMin,iMax + b3d(i,j,k) = 1. _d 0 - c3d(i,j,k) - a3d(i,j,k) + & + implDissFac*deltaTloc*GGL90ceps*SQRTTKE(i,j,k) + & * rMixingLength(i,j,k) + & * maskC(i,j,k,bi,bj)*maskC(i,j,km1,bi,bj) +CIGF use implDissFacSI under shelf ice +#ifdef ALLOW_SHELFICE + IF (kTopC(i,j,bi,bj) .GT. 0) THEN + b3d(i,j,k) = 1. _d 0 - c3d(i,j,k) - a3d(i,j,k) + & + implDissFacSI*deltaTloc*GGL90ceps*SQRTTKE(i,j,k) + & * rMixingLength(i,j,k) + & * maskC(i,j,k,bi,bj)*maskC(i,j,km1,bi,bj) + ENDIF +#endif + + ENDDO + ENDDO + ENDDO + IF ( usingPCoords ) THEN +C impose TKE(1) = 0. + DO j=jMin,jMax + DO i=iMin,iMax + b3d(i,j,1) = 1. _d 0 + ENDDO + ENDDO + ENDIF +C end set up matrix + +C Apply boundary condition + IF ( calcMeanVertShear ) THEN +C by averaging (@ grid-cell center) the 4 components @ U,V pos. + DO j=jMin,jMax + DO i=iMin,iMax + tempU = surfaceForcingU( i ,j,bi,bj) + tempUp = surfaceForcingU(i+1,j,bi,bj) + tempV = surfaceForcingV(i, j ,bi,bj) + tempVp = surfaceForcingV(i,j+1,bi,bj) + uStarSquare(i,j) = SQRT( + & ( tempU*tempU + tempUp*tempUp + & + tempV*tempV + tempVp*tempVp + & )*halfRL )*recip_coordFac +C Note: adding parenthesis in 4 terms sum (-> 2 group of 2) as below: +c uStarSquare(i,j) = SQRT( +c & ( ( tempU*tempU + tempUp*tempUp ) +c & + ( tempV*tempV + tempVp*tempVp ) +c & )*halfRL )*recip_coordFac +C seems to break restart ! + ENDDO + ENDDO + ELSE + DO j=jMin,jMax + DO i=iMin,iMax +C estimate friction velocity uStar from surface forcing + uStarSquare(i,j) = SQRT( + & ( .5 _d 0*( surfaceForcingU(i, j, bi,bj) + & + surfaceForcingU(i+1,j, bi,bj) ) )**2 + & + ( .5 _d 0*( surfaceForcingV(i, j, bi,bj) + & + surfaceForcingV(i, j+1,bi,bj) ) )**2 + & )*recip_coordFac +CIGF SET KSURF TO KTOPC WHERE KTOPC IS NONZERO +CIGF and also set uStarSquare to zero (no influence of surface forcing) +#ifdef ALLOW_SHELFICE + IF (kTopC(i,j,bi,bj) .GT. 0) THEN + uStarSquare(i,j) = 0.0 _d 0 + ENDIF +#endif + ENDDO + ENDDO + ENDIF +C Dirichlet surface boundary condition for TKE + IF ( usingPCoords ) THEN + DO j=jMin,jMax + DO i=iMin,iMax + GGL90TKE(i,j,kSrf,bi,bj) = GGL90TKE(i,j,kSrf,bi,bj) + & - c3d(i,j,kSrf) * maskC(i,j,kSrf,bi,bj) + & *MAX(GGL90TKEsurfMin,GGL90m2*uStarSquare(i,j)) + c3d(i,j,kSrf) = 0. _d 0 + ENDDO + ENDDO + ELSE + DO j=jMin,jMax + DO i=iMin,iMax +CIGF SET KSURF TO KTOPC WHERE KTOPC IS NONZERO +#ifdef ALLOW_SHELFICE + IF (kTopC(i,j,bi,bj) .GT. 0) THEN + kSrftmp = kTopC(i,j,bi,bj) + ELSE + kSrftmp = 1 + ENDIF + kToptmp = MIN(Nr,kSrftmp+1) + GGL90TKE(i,j,kSrftmp,bi,bj) = maskC(i,j,kSrftmp,bi,bj) + & *MAX(GGL90TKEsurfMin,GGL90m2*uStarSquare(i,j)) + GGL90TKE(i,j,kToptmp,bi,bj) = GGL90TKE(i,j,kToptmp,bi,bj) + & - a3d(i,j,kToptmp)*GGL90TKE(i,j,kSrftmp,bi,bj) + a3d(i,j,kToptmp) = 0. _d 0 +#else + GGL90TKE(i,j,kSrf,bi,bj) = maskC(i,j,kSrf,bi,bj) + & *MAX(GGL90TKEsurfMin,GGL90m2*uStarSquare(i,j)) + GGL90TKE(i,j,kTop,bi,bj) = GGL90TKE(i,j,kTop,bi,bj) + & - a3d(i,j,kTop)*GGL90TKE(i,j,kSrf,bi,bj) + a3d(i,j,kTop) = 0. _d 0 +#endif + ENDDO + ENDDO + ENDIF + + IF (GGL90_dirichlet) THEN +C Dirichlet bottom boundary condition for TKE = GGL90TKEbottom + IF ( usingPCoords ) THEN + DO j=jMin,jMax + DO i=iMin,iMax + kBot = MIN(kSurfC(i,j,bi,bj)+1,Nr) + GGL90TKE(i,j,kBot,bi,bj) = GGL90TKE(i,j,kBot,bi,bj) + & - GGL90TKEbottom*a3d(i,j,kBot) + a3d(i,j,kBot) = 0. _d 0 + ENDDO + ENDDO + ELSE + DO j=jMin,jMax + DO i=iMin,iMax + kBot = MAX(kLowC(i,j,bi,bj),1) + GGL90TKE(i,j,kBot,bi,bj) = GGL90TKE(i,j,kBot,bi,bj) + & - GGL90TKEbottom*c3d(i,j,kBot) + c3d(i,j,kBot) = 0. _d 0 + ENDDO + ENDDO + ENDIF + ENDIF + +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE GGL90TKE(:,:,:,bi,bj)=comlev1_bibj, key=ikeyLoc, kind=isbyte +#endif +C solve tri-diagonal system + errCode = -1 + CALL SOLVE_TRIDIAGONAL( iMin,iMax, jMin,jMax, + I a3d, b3d, c3d, + U GGL90TKE(1-OLx,1-OLy,1,bi,bj), + O errCode, + I bi, bj, myThid ) + +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE GGL90TKE(:,:,:,bi,bj)=comlev1_bibj, key=ikeyLoc, kind=isbyte +#endif + DO k=2,Nr + DO j=jMin,jMax + DO i=iMin,iMax +C impose minimum TKE to avoid numerical undershoots below zero; +C level k=1 is either prescribed surface boundary condition (z-coords) or +C bottom boundary conditions, which by definition is zero + GGL90TKE(i,j,k,bi,bj) = maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj) + & *MAX( GGL90TKE(i,j,k,bi,bj), GGL90TKEmin ) + ENDDO + ENDDO + ENDDO + +C end of time step +C =============================== + + DO k=2,Nr + kl = k-delK + DO j=1,sNy + DO i=1,sNx +#ifdef ALLOW_GGL90_SMOOTH + tmpVisc = ( + & p4 * GGL90visctmp(i ,j ,k)*mskCor(i ,j ,bi,bj) + & +p8 *( ( GGL90visctmp(i-1,j ,k)*mskCor(i-1,j ,bi,bj) + & + GGL90visctmp(i+1,j ,k)*mskCor(i+1,j ,bi,bj) ) + & + ( GGL90visctmp(i ,j-1,k)*mskCor(i ,j-1,bi,bj) + & + GGL90visctmp(i ,j+1,k)*mskCor(i ,j+1,bi,bj) ) ) + & +p16*( ( GGL90visctmp(i+1,j+1,k)*mskCor(i+1,j+1,bi,bj) + & + GGL90visctmp(i-1,j-1,k)*mskCor(i-1,j-1,bi,bj) ) + & + ( GGL90visctmp(i+1,j-1,k)*mskCor(i+1,j-1,bi,bj) + & + GGL90visctmp(i-1,j+1,k)*mskCor(i-1,j+1,bi,bj) ) ) + & )/( + & p4 + & +p8 *(( maskC(i-1,j ,kl,bi,bj)*mskCor(i-1,j ,bi,bj) + & + maskC(i+1,j ,kl,bi,bj)*mskCor(i+1,j ,bi,bj) ) + & +( maskC(i ,j-1,kl,bi,bj)*mskCor(i ,j-1,bi,bj) + & + maskC(i ,j+1,kl,bi,bj)*mskCor(i ,j+1,bi,bj) ) ) + & +p16*(( maskC(i+1,j+1,kl,bi,bj)* mskCor(i+1,j+1,bi,bj) + & + maskC(i-1,j-1,kl,bi,bj)*mskCor(i-1,j-1,bi,bj) ) + & +( maskC(i+1,j-1,kl,bi,bj)*mskCor(i+1,j-1,bi,bj) + & + maskC(i-1,j+1,kl,bi,bj)*mskCor(i-1,j+1,bi,bj) ) ) + & )*maskC(i,j,kl,bi,bj)*mskCor(i,j,bi,bj) +#else + tmpVisc = GGL90visctmp(i,j,k) +#endif + tmpVisc = MIN(tmpVisc/TKEPrandtlNumber(i,j,k),GGL90diffMax) + & * coordFac*coordFac + GGL90diffKr(i,j,k,bi,bj)= MAX( tmpVisc , diffKrNrS(k) ) + ENDDO + ENDDO + ENDDO + + DO k=2,Nr + kl = k-delK + DO j=1,sNy + DO i=1,sNx+1 +#ifdef ALLOW_GGL90_SMOOTH + tmpVisc = ( + & p4 *( GGL90visctmp(i-1,j ,k)*mskCor(i-1,j ,bi,bj) + & + GGL90visctmp(i ,j ,k)*mskCor(i ,j ,bi,bj) ) + & +p8 *( ( GGL90visctmp(i-1,j-1,k)*mskCor(i-1,j-1,bi,bj) + & + GGL90visctmp(i ,j-1,k)*mskCor(i ,j-1,bi,bj) ) + & + ( GGL90visctmp(i-1,j+1,k)*mskCor(i-1,j+1,bi,bj) + & + GGL90visctmp(i ,j+1,k)*mskCor(i ,j+1,bi,bj) ) ) + & )/( + & p4 * 2. _d 0 + & +p8 *(( maskC(i-1,j-1,kl,bi,bj)*mskCor(i-1,j-1,bi,bj) + & + maskC(i ,j-1,kl,bi,bj)*mskCor(i ,j-1,bi,bj) ) + & +( maskC(i-1,j+1,kl,bi,bj)*mskCor(i-1,j+1,bi,bj) + & + maskC(i ,j+1,kl,bi,bj)*mskCor(i ,j+1,bi,bj) ) ) + & )*maskC(i-1,j,kl,bi,bj)*mskCor(i-1,j,bi,bj) + & *maskC(i ,j,kl,bi,bj)*mskCor(i ,j,bi,bj) +#else + tmpVisc = _maskW(i,j,kl,bi,bj) * halfRL + & *( GGL90visctmp(i-1,j,k) + & + GGL90visctmp(i, j,k) ) +#endif + tmpVisc = MIN( tmpVisc , GGL90viscMax ) + & * coordFac*coordFac + GGL90viscArU(i,j,k,bi,bj) = MAX( tmpVisc, viscArNr(k) ) + ENDDO + ENDDO + ENDDO + + DO k=2,Nr + kl = k-delK + DO j=1,sNy+1 + DO i=1,sNx +#ifdef ALLOW_GGL90_SMOOTH + tmpVisc = ( + & p4 *( GGL90visctmp(i ,j-1,k)*mskCor(i ,j-1,bi,bj) + & + GGL90visctmp(i ,j ,k)*mskCor(i ,j ,bi,bj) ) + & +p8 *( ( GGL90visctmp(i-1,j-1,k)*mskCor(i-1,j-1,bi,bj) + & + GGL90visctmp(i-1,j ,k)*mskCor(i-1,j ,bi,bj) ) + & + ( GGL90visctmp(i+1,j-1,k)*mskCor(i+1,j-1,bi,bj) + & + GGL90visctmp(i+1,j ,k)*mskCor(i+1,j ,bi,bj) ) ) + & )/( + & p4 * 2. _d 0 + & +p8 *(( maskC(i-1,j-1,kl,bi,bj)*mskCor(i-1,j-1,bi,bj) + & + maskC(i-1,j ,kl,bi,bj)*mskCor(i-1,j ,bi,bj) ) + & +( maskC(i+1,j-1,kl,bi,bj)*mskCor(i+1,j-1,bi,bj) + & + maskC(i+1,j ,kl,bi,bj)*mskCor(i+1,j ,bi,bj) ) ) + & )*maskC(i,j-1,kl,bi,bj)*mskCor(i,j-1,bi,bj) + & *maskC(i,j ,kl,bi,bj)*mskCor(i,j ,bi,bj) +#else + tmpVisc = _maskS(i,j,kl,bi,bj) * halfRL + & *( GGL90visctmp(i,j-1,k) + & + GGL90visctmp(i,j, k) ) +#endif + tmpVisc = MIN( tmpVisc , GGL90viscMax ) + & * coordFac*coordFac + GGL90viscArV(i,j,k,bi,bj) = MAX( tmpVisc, viscArNr(k) ) + ENDDO + ENDDO + ENDDO + +#ifdef ALLOW_DIAGNOSTICS + IF ( useDiagnostics ) THEN + CALL DIAGNOSTICS_FILL( GGL90TKE ,'GGL90TKE', + & 0,Nr, 1, bi, bj, myThid ) + CALL DIAGNOSTICS_FILL( GGL90viscArU,'GGL90ArU', + & 0,Nr, 1, bi, bj, myThid ) + CALL DIAGNOSTICS_FILL( GGL90viscArV,'GGL90ArV', + & 0,Nr, 1, bi, bj, myThid ) + CALL DIAGNOSTICS_FILL( GGL90diffKr,'GGL90Kr ', + & 0,Nr, 1, bi, bj, myThid ) + CALL DIAGNOSTICS_FILL( TKEPrandtlNumber ,'GGL90Prl', + & 0,Nr, 2, bi, bj, myThid ) + CALL DIAGNOSTICS_FILL( GGL90mixingLength,'GGL90Lmx', + & 0,Nr, 2, bi, bj, myThid ) + +C diagnose surface flux of TKE + IF ( usingPCoords ) THEN +C diagnose surface flux of TKE + DO j=jMin,jMax + DO i=iMin,iMax + surf_flx_tke(i,j) = + & (MAX(GGL90TKEsurfMin,GGL90m2*uStarSquare(i,j)) + & - GGL90TKE(i,j,kSrf,bi,bj) ) + & *recip_drF(kSrf)*recip_hFacC(i,j,kSrf,bi,bj) + & *KappaE(i,j,kSrf) + & *coordFac + ENDDO + ENDDO + ELSE + DO j=jMin,jMax + DO i=iMin,iMax + surf_flx_tke(i,j) =(GGL90TKE(i,j,kSrf,bi,bj)- + & GGL90TKE(i,j,kTop,bi,bj)) + & *recip_drF(kSrf)*recip_hFacC(i,j,kSrf,bi,bj) + & *KappaE(i,j,kTop) + ENDDO + ENDDO + ENDIF + CALL DIAGNOSTICS_FILL( surf_flx_tke,'GGL90flx', + & 0, 1, 2, bi, bj, myThid ) + + k=kSrf + DO j=jMin,jMax + DO i=iMin,iMax +C diagnose work done by the wind + surf_flx_tke(i,j) = + & halfRL*( surfaceForcingU(i, j,bi,bj)*uVel(i ,j,k,bi,bj) + & +surfaceForcingU(i+1,j,bi,bj)*uVel(i+1,j,k,bi,bj)) + & + halfRL*( surfaceForcingV(i,j, bi,bj)*vVel(i,j ,k,bi,bj) + & +surfaceForcingV(i,j+1,bi,bj)*vVel(i,j+1,k,bi,bj)) + surf_flx_tke(i,j) = surf_flx_tke(i,j) *recip_coordFac + ENDDO + ENDDO + CALL DIAGNOSTICS_FILL( surf_flx_tke,'GGL90tau', + & 0, 1, 2, bi, bj, myThid ) + + ENDIF +#endif /* ALLOW_DIAGNOSTICS */ + +#endif /* ALLOW_GGL90 */ + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ini_masks_etc.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ini_masks_etc.F new file mode 100644 index 0000000..c59afe1 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ini_masks_etc.F @@ -0,0 +1,532 @@ +#include "PACKAGES_CONFIG.h" +#include "CPP_OPTIONS.h" + +CBOP +C !ROUTINE: INI_MASKS_ETC +C !INTERFACE: + SUBROUTINE INI_MASKS_ETC( myThid ) +C !DESCRIPTION: \bv +C *==========================================================* +C | SUBROUTINE INI_MASKS_ETC +C | o Initialise masks and topography factors +C *==========================================================* +C | These arrays are used throughout the code and describe +C | the topography of the domain through masks (0s and 1s) +C | and fractional height factors (0 kSurf = Nr+1 + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + tmpVar(i,j) = 0. _d 0 + kSurfC(i,j,bi,bj) = Nr+1 + kLowC (i,j,bi,bj) = 0 + ENDDO + ENDDO + DO k=1,Nr + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + tmpVar(i,j) = tmpVar(i,j) + drF(k)*hFacC(i,j,k,bi,bj) + IF ( hFacC(i,j,k,bi,bj).NE.zeroRS ) kLowC(i,j,bi,bj) = k + ENDDO + ENDDO + ENDDO + DO k=Nr,1,-1 + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + IF ( hFacC(i,j,k,bi,bj).NE.zeroRS ) kSurfC(i,j,bi,bj) = k + ENDDO + ENDDO + ENDDO + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + Ro_surf(i,j,bi,bj) = R_low(i,j,bi,bj) + tmpVar(i,j) + maskInC(i,j,bi,bj) = 0. + IF ( kSurfC(i,j,bi,bj).LE.Nr ) maskInC(i,j,bi,bj) = 1. +c k = MAX( 0, kLowC (i,j,bi,bj) - kSurfC(i,j,bi,bj) + 1 ) +c tmpFld(i,j,bi,bj) = k + ENDDO + ENDDO + +C- end bi,bj loops. + ENDDO + ENDDO + + IF ( plotLevel.GE.debLevB ) THEN +c CALL PLOT_FIELD_XYRS( tmpFld, +c & 'Model Depths K Index' , -1, myThid ) + CALL PLOT_FIELD_XYRS(R_low, + & 'Model R_low (ini_masks_etc)', -1, myThid ) + CALL PLOT_FIELD_XYRS(Ro_surf, + & 'Model Ro_surf (ini_masks_etc)', -1, myThid ) + ENDIF + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + +C-- Calculate quantities derived from XY depth map + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx +C Total fluid column thickness (r_unit) : + tmpVar(i,j) = Ro_surf(i,j,bi,bj) - R_low(i,j,bi,bj) +c tmpFld(i,j,bi,bj) = tmpVar(i,j) +C Inverse of fluid column thickness (1/r_unit) + IF ( tmpVar(i,j) .LE. zeroRL ) THEN + recip_Rcol(i,j,bi,bj) = zeroRS + ELSE + recip_Rcol(i,j,bi,bj) = 1. _d 0 / tmpVar(i,j) + ENDIF + ENDDO + ENDDO + +C- Method-1 (useMin4hFacEdges = T): +C compute hFacW,hFacS as minimum of adjacent hFacC factor +C- Method-2 (useMin4hFacEdges = F): +C compute hFacW,hFacS from rSurfW,S and rLowW,S by applying +C same rules as for hFacC +C Note: Currently, no difference between methods except when useShelfIce=T and +C if, in adjacent columns, ice-draft and bathy are within the same level k + + IF ( useMin4hFacEdges ) THEN +C-- hFacW and hFacS (at U and V points): +C- Method-1: use simply minimum of adjacent hFacC factor + + DO k=1, Nr + DO j=1-OLy,sNy+OLy + hFacW(1-OLx,j,k,bi,bj) = zeroRS + DO i=2-OLx,sNx+OLx + hFacW(i,j,k,bi,bj) = + & MIN( hFacC(i,j,k,bi,bj), hFacC(i-1,j,k,bi,bj) ) + ENDDO + ENDDO + DO i=1-OLx,sNx+OLx + hFacS(i,1-OLy,k,bi,bj) = zeroRS + ENDDO + DO j=2-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + hFacS(i,j,k,bi,bj) = + & MIN( hFacC(i,j,k,bi,bj), hFacC(i,j-1,k,bi,bj) ) + ENDDO + ENDDO + ENDDO + + ELSE +C-- hFacW and hFacS (at U and V points): +C- Method-2: compute new hFacW,S from rSurfW,S and rLowW,S +C by applying same rules as for hFacC + + DO k=1, Nr + hFacMnSz = MAX( hFacMin, MIN(hFacMinDr*recip_drF(k),oneRL) ) + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx +C o Non-dimensional distance between grid bound. and domain lower_R bound. + hFac1tmp = ( rF(k) - rLowW(i,j,bi,bj) )*recip_drF(k) + hFac_loc = MIN( hFac1tmp, oneRL ) +c hFac_loc = MAX( hFac_loc, zeroRL ) +C o Impose minimum fraction and/or size (dimensional) + IF ( hFac_loc.LT.hFacMnSz*halfRL ) THEN + hFac1tmp = 0. _d 0 + ELSE + hFac1tmp = MAX( hFac_loc, hFacMnSz ) + ENDIF +C o Reduce the previous fraction : substract the outside fraction +C (i.e., beyond reference (=at rest) surface position rSurfW) + hFac2tmp = ( rF(k) -rSurfW(i,j,bi,bj) )*recip_drF(k) + hFac_loc = hFac1tmp - MAX( hFac2tmp, zeroRL ) +C o Impose minimum fraction and/or size (dimensional) + IF ( hFac_loc.LT.hFacMnSz*halfRL ) THEN + hFacW(i,j,k,bi,bj) = zeroRS + ELSE + hFacW(i,j,k,bi,bj) = MAX( hFac_loc, hFacMnSz ) + ENDIF + ENDDO + ENDDO + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx +C o Non-dimensional distance between grid bound. and domain lower_R bound. + hFac1tmp = ( rF(k) - rLowS(i,j,bi,bj) )*recip_drF(k) + hFac_loc = MIN( hFac1tmp, oneRL ) +c hFac_loc = MAX( hFac_loc, zeroRL ) +C o Impose minimum fraction and/or size (dimensional) + IF ( hFac_loc.LT.hFacMnSz*halfRL ) THEN + hFac1tmp = 0. _d 0 + ELSE + hFac1tmp = MAX( hFac_loc, hFacMnSz ) + ENDIF +C o Reduce the previous fraction : substract the outside fraction +C (i.e., beyond reference (=at rest) surface position rSurfS) + hFac2tmp = ( rF(k) -rSurfS(i,j,bi,bj) )*recip_drF(k) + hFac_loc = hFac1tmp - MAX( hFac2tmp, zeroRL ) +C o Impose minimum fraction and/or size (dimensional) + IF ( hFac_loc.LT.hFacMnSz*halfRL ) THEN + hFacS(i,j,k,bi,bj) = zeroRS + ELSE + hFacS(i,j,k,bi,bj) = MAX( hFac_loc, hFacMnSz ) + ENDIF + ENDDO + ENDDO + ENDDO + ENDIF + +C-- Update rLow & reference rSurf at Western & Southern edges (U & V pts): +C account for adjusted R_low & Ro_surf due to hFacMin constrain on hFacC. +C Might need further adjustment (e.g., if useShelfIce=T) to match +C integrated level thickness ( =Sum_k(drF*hFac) ) + DO j=1-OLy,sNy+OLy + DO i=2-OLx,sNx+OLx + rLowW(i,j,bi,bj) = + & MAX( R_low(i-1,j,bi,bj), R_low(i,j,bi,bj) ) + rSurfW(i,j,bi,bj) = + & MIN( Ro_surf(i-1,j,bi,bj), Ro_surf(i,j,bi,bj) ) + rSurfW(i,j,bi,bj) = + & MAX( rSurfW(i,j,bi,bj), rLowW(i,j,bi,bj) ) + ENDDO + ENDDO + DO j=2-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + rLowS(i,j,bi,bj) = + & MAX( R_low(i,j-1,bi,bj), R_low(i,j,bi,bj) ) + rSurfS(i,j,bi,bj) = + & MIN( Ro_surf(i,j-1,bi,bj), Ro_surf(i,j,bi,bj) ) + rSurfS(i,j,bi,bj) = + & MAX( rSurfS(i,j,bi,bj), rLowS(i,j,bi,bj) ) + ENDDO + ENDDO + +c IF ( useShelfIce ) THEN +C-- Adjust reference rSurf at Western & Southern edges (U & V pts) +C to get consistent column thickness from Sum_k(hFac*drF) and rSurf-rLow + +C- Total column thickness at Western edge + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + tmpVar(i,j) = 0. _d 0 + ENDDO + ENDDO + DO k=1,Nr + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + tmpVar(i,j) = tmpVar(i,j) + drF(k)*hFacW(i,j,k,bi,bj) + ENDDO + ENDDO + ENDDO + +C- Adjust both rLow and rSurf at W & S edges (split correction by half) +C adjust rSurfW and rLowW: + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + tmpVar(i,j) = rLowW(i,j,bi,bj) + tmpVar(i,j) + tmpVar(i,j) = ( tmpVar(i,j) -rSurfW(i,j,bi,bj) )*halfRL + ENDDO + ENDDO + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + rSurfW(i,j,bi,bj) = rSurfW(i,j,bi,bj) + tmpVar(i,j) + rLowW (i,j,bi,bj) = rLowW (i,j,bi,bj) - tmpVar(i,j) + ENDDO + ENDDO + +C- Total column thickness at Southern edges + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + tmpVar(i,j) = 0. _d 0 + ENDDO + ENDDO + DO k=1,Nr + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + tmpVar(i,j) = tmpVar(i,j) + drF(k)*hFacS(i,j,k,bi,bj) + ENDDO + ENDDO + ENDDO + +C- Adjust both rLow and rSurf at S edge (split correction by half) +C Adjust rSurfS and rLowS: + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + tmpVar(i,j) = rLowS(i,j,bi,bj) + tmpVar(i,j) + tmpVar(i,j) = ( tmpVar(i,j) -rSurfS(i,j,bi,bj) )*halfRL + ENDDO + ENDDO + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + rSurfS(i,j,bi,bj) = rSurfS(i,j,bi,bj) + tmpVar(i,j) + rLowS (i,j,bi,bj) = rLowS (i,j,bi,bj) - tmpVar(i,j) + ENDDO + ENDDO + +C- end if useShelfIce +c ENDIF + +C- end bi,bj loops. + ENDDO + ENDDO + + CALL EXCH_UV_XYZ_RS( hFacW, hFacS, .FALSE., myThid ) + CALL EXCH_UV_XY_RS( rSurfW, rSurfS, .FALSE., myThid ) + CALL EXCH_UV_XY_RS( rLowW, rLowS, .FALSE., myThid ) + +C-- Calculate surface k index for interface W & S (U & V points) + DO bj=myByLo(myThid), myByHi(myThid) + DO bi=myBxLo(myThid), myBxHi(myThid) + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + kSurfW(i,j,bi,bj) = Nr+1 + kSurfS(i,j,bi,bj) = Nr+1 + DO k=Nr,1,-1 + IF (hFacW(i,j,k,bi,bj).NE.zeroRS) kSurfW(i,j,bi,bj) = k + IF (hFacS(i,j,k,bi,bj).NE.zeroRS) kSurfS(i,j,bi,bj) = k + ENDDO + maskInW(i,j,bi,bj)= zeroRS + IF ( kSurfW(i,j,bi,bj).LE.Nr ) maskInW(i,j,bi,bj)= oneRS + maskInS(i,j,bi,bj)= zeroRS + IF ( kSurfS(i,j,bi,bj).LE.Nr ) maskInS(i,j,bi,bj)= oneRS + ENDDO + ENDDO + ENDDO + ENDDO + +C-- Additional closing of Western and Southern grid-cell edges: for example, +C a) might add some "thin walls" in specific location +C b) close non-periodic N & S boundaries of lat-lon grid at the N/S poles. +C new: location now reccorded as kSurfW/S = Nr+2 + CALL ADD_WALLS2MASKS( rEmpty, myThid ) + + ELSE +#ifndef DISABLE_SIGMA_CODE +C--- Sigma and Hybrid-Sigma set-up: + CALL INI_SIGMA_HFAC( myThid ) +#endif /* DISABLE_SIGMA_CODE */ + ENDIF + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + +C-- Write to disk: Total Column Thickness & hFac(C,W,S): +C This I/O is now done in write_grid.F +c CALL WRITE_FLD_XY_RS( 'Depth',' ',tmpFld,0,myThid) +c CALL WRITE_FLD_XYZ_RS( 'hFacC',' ',hFacC,0,myThid) +c CALL WRITE_FLD_XYZ_RS( 'hFacW',' ',hFacW,0,myThid) +c CALL WRITE_FLD_XYZ_RS( 'hFacS',' ',hFacS,0,myThid) + + IF ( plotLevel.GE.debLevB ) THEN + CALL PLOT_FIELD_XYZRS( hFacC, 'hFacC' , Nr, 0, myThid ) + CALL PLOT_FIELD_XYZRS( hFacW, 'hFacW' , Nr, 0, myThid ) + CALL PLOT_FIELD_XYZRS( hFacS, 'hFacS' , Nr, 0, myThid ) + ENDIF + +C-- Masks and reciprocals of hFac[CWS] + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO k=1,Nr + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + IF ( hFacC(i,j,k,bi,bj).NE.zeroRS ) THEN + recip_hFacC(i,j,k,bi,bj) = 1. _d 0 / hFacC(i,j,k,bi,bj) + maskC(i,j,k,bi,bj) = oneRS + ELSE + recip_hFacC(i,j,k,bi,bj) = zeroRS + maskC(i,j,k,bi,bj) = zeroRS + ENDIF + IF ( hFacW(i,j,k,bi,bj).NE.zeroRS ) THEN + recip_hFacW(i,j,k,bi,bj) = 1. _d 0 / hFacW(i,j,k,bi,bj) + maskW(i,j,k,bi,bj) = oneRS + ELSE + recip_hFacW(i,j,k,bi,bj) = zeroRS + maskW(i,j,k,bi,bj) = zeroRS + ENDIF + IF ( hFacS(i,j,k,bi,bj).NE.zeroRS ) THEN + recip_hFacS(i,j,k,bi,bj) = 1. _d 0 / hFacS(i,j,k,bi,bj) + maskS(i,j,k,bi,bj) = oneRS + ELSE + recip_hFacS(i,j,k,bi,bj) = zeroRS + maskS(i,j,k,bi,bj) = zeroRS + ENDIF + ENDDO + ENDDO + ENDDO +#ifdef NONLIN_FRSURF +C-- Save initial geometrical hFac factor into h0Fac (fixed in time): +C Note: In case 1 pkg modifies hFac (from packages_init_fixed, called +C later in sequence of calls) this pkg would need also to update h0Fac. + DO k=1,Nr + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + h0FacC(i,j,k,bi,bj) = _hFacC(i,j,k,bi,bj) + h0FacW(i,j,k,bi,bj) = _hFacW(i,j,k,bi,bj) + h0FacS(i,j,k,bi,bj) = _hFacS(i,j,k,bi,bj) + ENDDO + ENDDO + ENDDO +#endif /* NONLIN_FRSURF */ +C- end bi,bj loops. + ENDDO + ENDDO + +c #ifdef ALLOW_NONHYDROSTATIC +C-- Calculate "recip_hFacU" = reciprocal hfac distance/volume for W cells +C NOTE: not used ; computed locally in CALC_GW +c #endif + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ini_parms.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ini_parms.F new file mode 100644 index 0000000..1ad0c9e --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/ini_parms.F @@ -0,0 +1,1601 @@ +#include "PACKAGES_CONFIG.h" +#include "CPP_OPTIONS.h" +#ifdef ALLOW_EXCH2 +# include "W2_OPTIONS.h" +#endif /* ALLOW_EXCH2 */ + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +CBOP +C !ROUTINE: INI_PARMS +C !INTERFACE: + SUBROUTINE INI_PARMS( myThid ) + +C !DESCRIPTION: +C Routine to load model "parameters" from parameter file "data" + +C !USES: + IMPLICIT NONE +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#ifdef ALLOW_EXCH2 +# include "W2_EXCH2_SIZE.h" +# include "W2_EXCH2_TOPOLOGY.h" +#endif /* ALLOW_EXCH2 */ +#include "EOS.h" +C- need GRID.h to save, in rF(1), half retired param Ro_SeaLevel value: +#include "GRID.h" +#include "SET_GRID.h" +#ifdef ALLOW_SHELFICE +#include "SHELFICE_OPTIONS.h" +#endif + +C !INPUT/OUTPUT PARAMETERS: +C myThid :: Number of this instance of INI_PARMS + INTEGER myThid + +C !LOCAL VARIABLES: +C dxSpacing, dySpacing :: Default spacing in X and Y. +C :: Units are that of coordinate system +C :: i.e. cartesian => metres +C :: s. polar => degrees +C deltaTtracer :: Timestep for tracer equations ( s ) +C forcing_In_AB :: flag to put all forcings (Temp,Salt,Tracers,Momentum) +C :: contribution in (or out of) Adams-Bashforth time stepping. +C goptCount :: Used to count the nuber of grid options (only one is allowed!) +C msgBuf :: Informational/error message buffer +C errIO :: IO error flag +C errCount :: error counter (inconsitent params and other errors) +C iUnit :: Work variable for IO unit number +C k, i, j :: Loop counters +C xxxDefault :: Default value for variable xxx + _RL dxSpacing + _RL dySpacing + _RL deltaTtracer + CHARACTER*(MAX_LEN_MBUF) msgBuf + LOGICAL forcing_In_AB + INTEGER goptCount + INTEGER gridNx, gridNy + INTEGER k, i, j, iUnit + INTEGER errIO, errCount +C Default values for variables which have vertical coordinate system +C dependency. + _RL viscArDefault + _RL diffKrTDefault + _RL diffKrSDefault + _RL hFacMinDrDefault + _RL delRDefault(Nr) +C zCoordInputData :: Variables used to select between different coordinate systems. +C pCoordInputData :: The vertical coordinate system in the rest of the model is +C rCoordInputData :: written in terms of r. In the model "data" file input data +C coordsSet :: can be interms of z, p or r. +C :: e.g. delZ or delP or delR for the vertical grid spacing. +C :: The following rules apply: +C :: All parameters must use the same vertical coordinate system. +C :: e.g. delZ and viscAz is legal but +C :: delZ and viscAr is an error. +C :: Similarly specifying delZ and delP is an error. +C :: zCoord..., pCoord..., rCoord... are used to flag when +C :: z, p or r are used. +C :: coordsSet counts how many vertical coordinate systems have +C :: been used to specify variables. coordsSet > 1 is an error. +C vertSetCount :: to count number of vertical array elements which are set. +C specifiedDiffKrT :: internal flag, true when any diffK[r,z,p,Nr]T is specified +C specifiedDiffKrS :: internal flag, true when any diffK[r,z,p,Nr]S is specified + + LOGICAL zCoordInputData + LOGICAL pCoordInputData + LOGICAL rCoordInputData + INTEGER coordsSet + INTEGER vertSetCount + LOGICAL specifiedDiffKrT, specifiedDiffKrS + +C Variables which have vertical coordinate system dependency. +C delZ :: Vertical grid spacing ( m ). +C delP :: Vertical grid spacing ( Pa ). +C viscAz :: Eddy viscosity coeff. for mixing of momentum vertically ( m^2/s ) +C viscAp :: Eddy viscosity coeff. for mixing of momentum vertically ( Pa^2/s ) +C diffKzT :: Laplacian diffusion coeff. for mixing of heat vertically ( m^2/s ) +C diffKpT :: Laplacian diffusion coeff. for mixing of heat vertically ( Pa^2/s ) +C diffKzS :: Laplacian diffusion coeff. for mixing of salt vertically ( m^2/s ) +C diffKpS :: Laplacian diffusion coeff. for mixing of salt vertically ( Pa^2/s ) + _RL delZ(Nr) + _RL delP(Nr) + _RL viscAz + _RL viscAp + _RL viscAr + _RL diffKzT + _RL diffKpT + _RL diffKrT + _RL diffKzS + _RL diffKpS + _RL diffKrS + +C Retired main data file parameters. Kept here to trap use of old data files. +C nRetired :: Counter used to trap gracefully namelists containing "retired" +C :: parameters. These are parameters that are either no-longer used +C or that have moved to a different input file and/or namelist. +C Namelist PARM01: +C useConstantF :: Coriolis coeff set to f0 (replaced by selectCoriMap=0) +C useBetaPlaneF :: Coriolis coeff = f0 + beta.y (replaced by selectCoriMap=1) +C useSphereF :: Coriolis = 2.omega.sin(phi) (replaced by selectCoriMap=2) +C useJamartWetPoints :: for backward compat. (replaced by selectCoriScheme=1) +C :: Use wet-point method for Coriolis (Jamart & Ozer 1986) +C SadournyCoriolis :: for backward compat. (replaced by selectVortScheme=2) +C tracerAdvScheme :: tracer advection scheme (old passive tracer code) +C trac_EvPrRn :: tracer conc. in Rain & Evap (old passive tracer code) +C saltDiffusion :: diffusion of salinity on/off (flag not used) +C tempDiffusion :: diffusion of temperature on/off (flag not used) +C zonal_filt_lat :: Moved to package "zonal_filt" +C gravitySign :: direction of gravity relative to R direction +C :: (removed from namelist and set according to z/p coordinate) +C viscAstrain :: replaced by standard viscosity coeff & useStrainTensionVisc +C viscAtension :: replaced by standard viscosity coeff & useStrainTensionVisc +C useAnisotropicViscAgridMax :: Changed to be default behavior. Can +C use old method by setting useAreaViscLength=.true. +C usePickupBeforeC35 :: to restart from old-pickup files (generated with code +C from before checkpoint-35, Feb 08, 2001): disabled (Jan 2007) +C debugMode :: to print debug msg. now read from parameter file eedata +C allowInteriorFreezing :: Allow water at depth to freeze and rise to the surface +C (replaced by pkg/frazil) +C useOldFreezing :: use the old version (before checkpoint52a_pre, 2003-11-12) +C balanceEmPmR :: for backward compat. (replaced by selectBalanceEmPmR=1), +C :: substract global mean of EmPmR at every time step +C Namelist PARM02: +C cg2dChkResFreq :: Frequency with which to check 2-D con. grad solver +C residual (was never coded) +C cg3dChkResFreq :: Frequency with which to check 3-D con. grad solver +C residual (was never coded) +C Namelist PARM03: +C tauThetaClimRelax3Dim :: replaced by pkg/rbcs (3.D Relaxation B.Cs) +C tauSaltClimRelax3Dim :: replaced by pkg/rbcs (3.D Relaxation B.Cs) +C calendarDumps :: moved to package "cal" (calendar) +C Namelist PARM04: +C Ro_SeaLevel :: origin of the vertical R-coords axis ; +C :: replaced by top_Pres or seaLev_Z setting +C groundAtK1 :: put the surface(k=1) at the ground (replaced by usingPCoords) +C rkFac :: removed from namelist ; replaced by -rkSign +C thetaMin :: unfortunate variable name ; replaced by xgOrigin +C phiMin :: unfortunate variable name ; replaced by ygOrigin +C Namelist PARM05: +C shelfIceFile :: File containing the topography of the shelfice draught +C (replaced by SHELFICEtopoFile in SHELFICE.h) +C dQdTfile :: File containing thermal relaxation coefficient + + INTEGER nRetired + LOGICAL useConstantF, useBetaPlaneF, useSphereF + LOGICAL useJamartWetPoints + LOGICAL useEnergyConservingCoriolis + LOGICAL SadournyCoriolis + LOGICAL tempDiffusion, saltDiffusion + INTEGER tracerAdvScheme + _RL trac_EvPrRn + _RL zonal_filt_lat +c _RL gravitySign + _RL viscAstrain, viscAtension + LOGICAL useAnisotropicViscAgridMax + LOGICAL usePickupBeforeC35 + LOGICAL saveDebugMode + LOGICAL allowInteriorFreezing, useOldFreezing + LOGICAL balanceEmPmR +C- + INTEGER cg2dChkResFreq, cg3dChkResFreq +C- + _RL tauThetaClimRelax3Dim, tauSaltClimRelax3Dim + LOGICAL calendarDumps +C- + LOGICAL groundAtK1 + _RL Ro_SeaLevel + _RL rkFac + _RL thetaMin, phiMin + CHARACTER*(MAX_LEN_FNAM) shelfIceFile + CHARACTER*(MAX_LEN_FNAM) dQdTfile + +C-- Continuous equation parameters + NAMELIST /PARM01/ + & gravitySign, nh_Am2, + & gravity, gBaro, gravityFile, rhonil, tAlpha, sBeta, + & selectCoriMap, f0, beta, fPrime, omega, rotationPeriod, + & viscAh, viscAhW, viscAhMax, + & viscAhGrid, viscAhGridMax, viscAhGridMin, + & viscC2leith, viscC4leith, smag3D_coeff, useSmag3D, + & useFullLeith, useAnisotropicViscAgridMax, useStrainTensionVisc, + & useAreaViscLength, viscC2leithD, viscC4leithD, viscC2LeithQG, + & viscC2smag, viscC4smag, viscAhD, viscAhZ, viscA4D, viscA4Z, + & viscA4, viscA4W, + & viscA4Max, viscA4Grid, viscA4GridMax, viscA4GridMin, + & viscA4ReMax, viscAhReMax, + & cosPower, viscAstrain, viscAtension, + & diffKhT, diffK4T, diffKhS, diffK4S, smag3D_diffCoeff, + & surf_pRef, tRef, sRef, tRefFile, sRefFile, rhoRefFile, + & eosType, selectP_inEOS_Zc, integr_GeoPot, selectFindRoSurf, + & HeatCapacity_Cp, celsius2K, atm_Cp, atm_Rd, atm_Rq, atm_Po, + & no_slip_sides, sideDragFactor, no_slip_bottom, bottomVisc_pCell, + & bottomDragLinear, bottomDragQuadratic, selectBotDragQuadr, + & momViscosity, momAdvection, momForcing, momTidalForcing, + & useCoriolis, useConstantF, useBetaPlaneF, useSphereF, + & use3dCoriolis, momPressureForcing, + & metricTerms, vectorInvariantMomentum, addFrictionHeating, + & tempDiffusion, tempAdvection, tempForcing, temp_stayPositive, + & saltDiffusion, saltAdvection, saltForcing, salt_stayPositive, + & implicSurfPress, implicDiv2DFlow, implicitNHPress, + & implicitFreeSurface, rigidLid, freeSurfFac, + & hFacMin, hFacMinDz, hFacMinDp, hFacMinDr, + & exactConserv, linFSConserveTr, uniformLin_PhiSurf, + & nonlinFreeSurf, hFacInf, hFacSup, select_rStar, + & nonHydrostatic, selectNHfreeSurf, quasiHydrostatic, + & implicitIntGravWave, staggerTimeStep, doResetHFactors, + & tempStepping, saltStepping, momStepping, + & implicitDiffusion, implicitViscosity, selectImplicitDrag, + & tempImplVertAdv, saltImplVertAdv, momImplVertAdv, + & viscAz, diffKzT, diffKzS, viscAp, diffKpT, diffKpS, + & viscAr, diffKrT, diffKrS, viscArNr, diffKrNrT, diffKrNrS, + & diffKr4T, diffKr4S, BL79LatVary, + & diffKrBL79surf, diffKrBL79deep, diffKrBL79scl, diffKrBL79Ho, + & diffKrBLEQsurf, diffKrBLEQdeep, diffKrBLEQscl, diffKrBLEQHo, + & rhoConst, thetaConst, rhoConstFresh, buoyancyRelation, + & readBinaryPrec, writeBinaryPrec, writeStatePrec, globalFiles, + & useSingleCpuIO, useSingleCpuInput, usePickupBeforeC54, + & usePickupBeforeC35, debugMode, debugLevel, plotLevel, + & allowFreezing, allowInteriorFreezing, useOldFreezing, ivdc_kappa, + & hMixCriteria, dRhoSmall, hMixSmooth, + & tempAdvScheme, tempVertAdvScheme, + & saltAdvScheme, saltVertAdvScheme, tracerAdvScheme, + & multiDimAdvection, useNHMTerms, useCDscheme, + & useAbsVorticity, selectCoriScheme, useJamartWetPoints, + & useEnergyConservingCoriolis, selectVortScheme, SadournyCoriolis, + & useJamartMomAdv, upwindVorticity, highOrderVorticity, + & upwindShear, selectKEscheme, + & selectAddFluid, useRealFreshWaterFlux, convertFW2Salt, + & temp_EvPrRn, salt_EvPrRn, trac_EvPrRn, + & temp_addMass, salt_addMass, zonal_filt_lat, + & smoothAbsFuncRange, sIceLoadFac, + & selectBalanceEmPmR, balanceEmPmR, balanceQnet, balancePrintMean, + & balanceThetaClimRelax, balanceSaltClimRelax + +C-- Elliptic solver parameters + NAMELIST /PARM02/ + & cg2dMaxIters, cg2dMinItersNSA, cg2dChkResFreq, cg2dUseMinResSol, + & cg2dTargetResidual, cg2dTargetResWunit, + & cg2dpcOffDFac, cg2dPreCondFreq, + & cg3dMaxIters, cg3dChkResFreq, cg3dTargetResidual, + & useNSACGSolver, useSRCGSolver, printResidualFreq + +C-- Time stepping parammeters + NAMELIST /PARM03/ + & nIter0, nTimeSteps, nTimeSteps_l2, nEndIter, + & baseTime, startTime, endTime, + & deltaT, deltaTClock, deltaTMom, + & deltaTtracer, dTtracerLev, deltaTFreeSurf, + & forcing_In_AB, momForcingOutAB, tracForcingOutAB, + & momDissip_In_AB, doAB_onGtGs, + & abEps, alph_AB, beta_AB, startFromPickupAB2, applyExchUV_early, + & tauCD, rCD, epsAB_CD, cAdjFreq, + & chkPtFreq, pChkPtFreq, pickupSuff, pickupStrictlyMatch, + & writePickupAtEnd, + & dumpFreq, dumpInitAndLast, adjDumpFreq, taveFreq, tave_lastIter, + & diagFreq, monitorFreq, adjMonitorFreq, monitorSelect, + & outputTypesInclusive, rwSuffixType, + & tauThetaClimRelax, tauSaltClimRelax, latBandClimRelax, + & tauThetaClimRelax3Dim, tauSaltClimRelax3Dim, + & periodicExternalForcing, externForcingPeriod, externForcingCycle, + & calendarDumps + +C-- Gridding parameters + NAMELIST /PARM04/ + & usingCartesianGrid, usingCylindricalGrid, + & usingSphericalPolarGrid, usingCurvilinearGrid, + & xgOrigin, ygOrigin, dxSpacing, dySpacing, + & delX, delY, delXFile, delYFile, horizGridFile, + & phiEuler, thetaEuler, psiEuler, + & rSphere, radius_fromHorizGrid, deepAtmosphere, seaLev_Z, + & top_Pres, delZ, delP, delR, delRc, delRFile, delRcFile, + & useMin4hFacEdges, interViscAr_pCell, interDiffKr_pCell, + & pCellMix_select, pCellMix_maxFac, pCellMix_delR, + & pCellMix_viscAr, pCellMix_diffKr, + & selectSigmaCoord, rSigmaBnd, hybSigmFile, + & Ro_SeaLevel, rkFac, groundAtK1, thetaMin, phiMin + +C-- Input files + NAMELIST /PARM05/ + & bathyFile, topoFile, addWwallFile, addSwallFile, shelfIceFile, + & diffKrFile, viscAhDfile, viscAhZfile, viscA4Dfile, viscA4Zfile, + & hydrogThetaFile, hydrogSaltFile, + & maskIniTemp, maskIniSalt, checkIniTemp, checkIniSalt, + & zonalWindFile, meridWindFile, + & thetaClimFile, saltClimFile, + & surfQfile, surfQnetFile, surfQswFile, EmPmRfile, saltFluxFile, + & uVelInitFile, vVelInitFile, pSurfInitFile, + & dQdTFile, ploadFile, geoPotAnomFile, addMassFile, + & tCylIn, tCylOut, + & eddyPsiXFile, eddyPsiYFile, geothermalFile, + & lambdaThetaFile, lambdaSaltFile, wghtBalanceFile, + & mdsioLocalDir, adTapeDir, + & the_run_name +CEOP + +#ifdef ALLOW_EXCH2 + gridNx = exch2_mydNx(1) + gridNy = exch2_mydNy(1) +#else /* ALLOW_EXCH2 */ + gridNx = Nx + gridNy = Ny +#endif /* ALLOW_EXCH2 */ + + _BEGIN_MASTER(myThid) + +C Defaults values for input parameters + CALL SET_DEFAULTS( + O viscArDefault, diffKrTDefault, diffKrSDefault, + O hFacMinDrDefault, delRDefault, + I myThid ) + + useJamartWetPoints = .FALSE. + useEnergyConservingCoriolis = .FALSE. + SadournyCoriolis = .FALSE. + balanceEmPmR = .FALSE. + +C-- Initialise "which vertical coordinate system used" flags. + zCoordInputData = .FALSE. + pCoordInputData = .FALSE. + rCoordInputData = .FALSE. + coordsSet = 0 + +C-- Initialise retired parameters to unlikely value + nRetired = 0 + useConstantF = .FALSE. + useBetaPlaneF = .FALSE. + useSphereF = .TRUE. + tempDiffusion = .TRUE. + saltDiffusion = .TRUE. + tracerAdvScheme = UNSET_I + trac_EvPrRn = UNSET_RL + zonal_filt_lat = UNSET_RL + gravitySign = UNSET_RL + viscAstrain = UNSET_RL + viscAtension = UNSET_RL + useAnisotropicViscAgridMax=.TRUE. + usePickupBeforeC35 = .FALSE. + saveDebugMode = debugMode + allowInteriorFreezing = .FALSE. + useOldFreezing = .FALSE. + cg2dChkResFreq = UNSET_I + cg3dChkResFreq = UNSET_I + tauThetaClimRelax3Dim = UNSET_RL + tauSaltClimRelax3Dim = UNSET_RL + calendarDumps = .FALSE. + Ro_SeaLevel = UNSET_RL + rkFac = UNSET_RL + groundAtK1 = .FALSE. + thetaMin = UNSET_RL + phiMin = UNSET_RL + shelfIceFile = ' ' + dQdTFile = ' ' + +C-- Open the parameter file + WRITE(msgBuf,'(A)') + & ' INI_PARMS: opening model parameter file "data"' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + + CALL OPEN_COPY_DATA_FILE( 'data', 'INI_PARMS', + O iUnit, myThid ) + +C-- Read settings from iUnit (= a copy of model parameter file "data"). + errIO = 0 + errCount = 0 + +C-- Set default "physical" parameters + viscAhW = UNSET_RL + viscA4W = UNSET_RL + viscAhD = UNSET_RL + viscAhZ = UNSET_RL + viscA4D = UNSET_RL + viscA4Z = UNSET_RL + viscAz = UNSET_RL + viscAp = UNSET_RL + viscAr = UNSET_RL + diffKzT = UNSET_RL + diffKpT = UNSET_RL + diffKrT = UNSET_RL + diffKzS = UNSET_RL + diffKpS = UNSET_RL + diffKrS = UNSET_RL + hFacMinDr = UNSET_RL + hFacMinDz = UNSET_RL + hFacMinDp = UNSET_RL + tAlpha = UNSET_RL + sBeta = UNSET_RL + implicitNHPress = UNSET_RL + tempVertAdvScheme = 0 + saltVertAdvScheme = 0 + plotLevel = UNSET_I +C-- z,p,r coord input switching. + WRITE(msgBuf,'(A)') ' INI_PARMS ; starts to read PARM01' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + READ(UNIT=iUnit,NML=PARM01) !,IOSTAT=errIO) + IF ( errIO .LT. 0 ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Error reading model parameter file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A)') 'S/R INI_PARMS: Problem in namelist PARM01' + CALL PRINT_ERROR( msgBuf, myThid ) + STOP 'ABNORMAL END: S/R INI_PARMS' + ELSE + WRITE(msgBuf,'(A)') ' INI_PARMS ; read PARM01 : OK' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + ENDIF + +C- set the type of vertical coordinate and type of fluid +C according to buoyancyRelation + usingPCoords = .FALSE. + usingZCoords = .FALSE. + fluidIsAir = .FALSE. + fluidIsWater = .FALSE. + IF ( buoyancyRelation.EQ.'ATMOSPHERIC' ) THEN + usingPCoords = .TRUE. + fluidIsAir = .TRUE. + ELSEIF ( buoyancyRelation.EQ.'OCEANICP') THEN + usingPCoords = .TRUE. + fluidIsWater = .TRUE. + ELSEIF ( buoyancyRelation.EQ.'OCEANIC' ) THEN + usingZCoords = .TRUE. + fluidIsWater = .TRUE. + ELSE + WRITE(msgBuf,'(2A)') 'S/R INI_PARMS:', + & ' Bad value of buoyancyRelation ' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + + IF ( .NOT.rigidLid .AND. + & .NOT.implicitFreeSurface ) THEN +C- No barotropic solver selected => use implicitFreeSurface as default + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: No request for barotropic solver' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: => Use implicitFreeSurface as default' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + implicitFreeSurface = .TRUE. + ENDIF + IF ( implicitFreeSurface ) freeSurfFac = 1. _d 0 + IF ( rigidLid ) freeSurfFac = 0. _d 0 + IF ( gBaro .EQ. UNSET_RL ) gBaro=gravity + IF ( rhoConst .EQ. UNSET_RL ) rhoConst=rhoNil + IF ( rhoConstFresh .EQ. UNSET_RL ) rhoConstFresh=rhoConst + IF ( implicitNHPress.EQ.UNSET_RL ) + & implicitNHPress = implicSurfPress + IF ( omega .EQ. UNSET_RL ) THEN + omega = 0. _d 0 + IF ( rotationPeriod .NE. 0. _d 0 ) + & omega = 2. _d 0 * PI / rotationPeriod + ELSEIF ( omega .EQ. 0. _d 0 ) THEN + rotationPeriod = 0. _d 0 + ELSE + rotationPeriod = 2. _d 0 * PI / omega + ENDIF + IF ( atm_Rd .EQ. UNSET_RL ) THEN + atm_Rd = atm_Cp * atm_kappa + ELSE + atm_kappa = atm_Rd / atm_Cp + ENDIF +C-- Non-hydrostatic/quasi-hydrostatic + IF (nonHydrostatic.AND.quasiHydrostatic) THEN + WRITE(msgBuf,'(A)') + & 'Illegal: both nonHydrostatic = quasiHydrostatic = TRUE' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF +C-- Advection and Forcing for Temp and salt + IF (tempVertAdvScheme.EQ.0) tempVertAdvScheme = tempAdvScheme + IF (saltVertAdvScheme.EQ.0) saltVertAdvScheme = saltAdvScheme +C-- horizontal viscosity (acting on Divergence or Vorticity) + IF ( viscAhD .EQ. UNSET_RL ) viscAhD = viscAh + IF ( viscAhZ .EQ. UNSET_RL ) viscAhZ = viscAh + IF ( viscA4D .EQ. UNSET_RL ) viscA4D = viscA4 + IF ( viscA4Z .EQ. UNSET_RL ) viscA4Z = viscA4 +C-- horizontal viscosity for vertical momentum + IF ( viscAhW .EQ. UNSET_RL ) viscAhW = viscAhD + IF ( viscA4W .EQ. UNSET_RL ) viscA4W = viscA4D +C-- z,p,r coord input switching. + IF ( viscAz .NE. UNSET_RL ) zCoordInputData = .TRUE. + IF ( viscAp .NE. UNSET_RL ) pCoordInputData = .TRUE. + IF ( viscAr .NE. UNSET_RL ) rCoordInputData = .TRUE. + IF ( viscAr .EQ. UNSET_RL ) viscAr = viscAz + IF ( viscAr .EQ. UNSET_RL ) viscAr = viscAp + vertSetCount = 0 + DO k=1,Nr + IF ( viscArNr(k).NE.UNSET_RL ) vertSetCount = vertSetCount + 1 + ENDDO + IF ( vertSetCount.GT.0 .AND. vertSetCount.LT.Nr ) THEN + WRITE(msgBuf,'(A,2(I5,A))') 'S/R INI_PARMS: Partial setting (', + & vertSetCount, ' /', Nr, ') of viscArNr is not allowed' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( viscAr .EQ. UNSET_RL ) THEN + viscAr = viscArDefault + ELSEIF ( vertSetCount.GT.0 ) THEN + WRITE(msgBuf,'(2A)') 'S/R INI_PARMS: Cannot set both ', + & 'viscArNr and viscAr (or Ap,Az) in param file data' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( vertSetCount.EQ.0 ) THEN + DO k=1,Nr + viscArNr(k) = viscAr + ENDDO + ENDIF +#ifdef ALLOW_MOM_COMMON +C- set default scheme for quadratic bottom-drag + IF ( selectBotDragQuadr.EQ.-1 .AND. bottomDragQuadratic.NE.0. ) + & selectBotDragQuadr = 0 +#endif /* ALLOW_MOM_COMMON */ + + IF ( smag3D_diffCoeff.NE.zeroRL .AND. .NOT.useSmag3D ) THEN + WRITE(msgBuf,'(2A)') '** WARNING ** INI_PARMS: ', + & 'will not use "smag3D_diffCoeff" without useSmag3D' + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + & SQUEEZE_RIGHT, myThid ) + WRITE(msgBuf,'(2A)') '** WARNING ** INI_PARMS: ', + & '==> reset "smag3D_diffCoeff" to zero' + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + & SQUEEZE_RIGHT, myThid ) + smag3D_diffCoeff = zeroRL + ENDIF + IF ( diffKzT .NE. UNSET_RL ) zCoordInputData = .TRUE. + IF ( diffKpT .NE. UNSET_RL ) pCoordInputData = .TRUE. + IF ( diffKrT .NE. UNSET_RL ) rCoordInputData = .TRUE. + IF ( diffKrT .EQ. UNSET_RL ) diffKrT = diffKzT + IF ( diffKrT .EQ. UNSET_RL ) diffKrT = diffKpT + vertSetCount = 0 + DO k=1,Nr + IF ( diffKrNrT(k).NE.UNSET_RL ) vertSetCount = vertSetCount + 1 + ENDDO + IF ( vertSetCount.GT.0 .AND. vertSetCount.LT.Nr ) THEN + WRITE(msgBuf,'(A,2(I5,A))') 'S/R INI_PARMS: Partial setting (', + & vertSetCount, ' /', Nr, ') of diffKrNrT is not allowed' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + specifiedDiffKrT = vertSetCount.EQ.Nr + IF ( diffKrT .EQ. UNSET_RL ) THEN + diffKrT = diffKrTDefault + ELSEIF ( vertSetCount.GT.0 ) THEN + WRITE(msgBuf,'(2A)') 'S/R INI_PARMS: Cannot set both ', + & 'diffKrNrT and diffKrT (or Kp,Kz) in param file data' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ELSE + specifiedDiffKrT = .TRUE. + ENDIF + IF ( vertSetCount.EQ.0 ) THEN + DO k=1,Nr + diffKrNrT(k) = diffKrT + ENDDO + ENDIF + + IF ( diffKzS .NE. UNSET_RL ) zCoordInputData = .TRUE. + IF ( diffKpS .NE. UNSET_RL ) pCoordInputData = .TRUE. + IF ( diffKrS .NE. UNSET_RL ) rCoordInputData = .TRUE. + IF ( diffKrS .EQ. UNSET_RL ) diffKrS = diffKzS + IF ( diffKrS .EQ. UNSET_RL ) diffKrS = diffKpS + vertSetCount = 0 + DO k=1,Nr + IF ( diffKrNrS(k).NE.UNSET_RL ) vertSetCount = vertSetCount + 1 + ENDDO + IF ( vertSetCount.GT.0 .AND. vertSetCount.LT.Nr ) THEN + WRITE(msgBuf,'(A,2(I5,A))') 'S/R INI_PARMS: Partial setting (', + & vertSetCount, ' /', Nr, ') of diffKrNrS is not allowed' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( vertSetCount.EQ.Nr ) THEN + specifiedDiffKrS = .TRUE. + IF ( diffKrS.NE.UNSET_RL ) THEN + WRITE(msgBuf,'(2A)') 'S/R INI_PARMS: Cannot set both ', + & 'diffKrNrS and diffKrS (or Kp,Kz) in param file data' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + ELSEIF ( diffKrS.NE.UNSET_RL ) THEN + specifiedDiffKrS = .TRUE. + DO k=1,Nr + diffKrNrS(k) = diffKrS + ENDDO + ELSE + specifiedDiffKrS = .FALSE. + diffKrS = diffKrSDefault +C- use temp diffusivity as default salt diffusivity: + DO k=1,Nr + diffKrNrS(k) = diffKrNrT(k) + ENDDO + ENDIF + + IF (diffKrBLEQsurf .EQ. UNSET_RL) diffKrBLEQsurf = diffKrBL79surf + IF (diffKrBLEQdeep .EQ. UNSET_RL) diffKrBLEQdeep = diffKrBL79deep + IF (diffKrBLEQscl .EQ. UNSET_RL) diffKrBLEQscl = diffKrBL79scl + IF (diffKrBLEQHo .EQ. UNSET_RL) diffKrBLEQHo = diffKrBL79Ho + + IF ( hFacMinDz .NE. UNSET_RL ) zCoordInputData = .TRUE. + IF ( hFacMinDp .NE. UNSET_RL ) pCoordInputData = .TRUE. + IF ( hFacMinDr .NE. UNSET_RL ) rCoordInputData = .TRUE. + IF ( hFacMinDr .EQ. UNSET_RL ) hFacMinDr = hFacMinDz + IF ( hFacMinDr .EQ. UNSET_RL ) hFacMinDr = hFacMinDp + IF ( hFacMinDr .EQ. UNSET_RL ) hFacMinDr = hFacMinDrDefault + + IF (convertFW2Salt.EQ.UNSET_RL) THEN + convertFW2Salt = 35. + IF (useRealFreshWaterFlux) convertFW2Salt=-1 + IF ( selectAddFluid.GE.1 ) convertFW2Salt=-1 + ENDIF + +C-- for backward compatibility : + IF ( selectCoriScheme.EQ.UNSET_I ) THEN + selectCoriScheme = 0 + IF ( useJamartWetPoints ) selectCoriScheme = 1 + IF ( useEnergyConservingCoriolis .AND. + & .NOT.vectorInvariantMomentum ) + & selectCoriScheme = selectCoriScheme + 2 + ENDIF + IF ( vectorInvariantMomentum ) THEN + IF ( useJamartWetPoints .AND. selectCoriScheme.NE.1 ) THEN + WRITE(msgBuf,'(A,I5,A)') + & 'S/R INI_PARMS: selectCoriScheme=', selectCoriScheme, + & ' conflicts with "useJamartWetPoints"' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + ELSE + IF ( useEnergyConservingCoriolis + & .AND. selectCoriScheme.LT.2 ) THEN + WRITE(msgBuf,'(A,I5,A)') + & 'S/R INI_PARMS: selectCoriScheme=', selectCoriScheme, + & ' conflicts with "useEnergyConservingCoriolis"' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( useJamartWetPoints .AND. selectCoriScheme.NE.1 + & .AND. selectCoriScheme.NE.3 ) THEN + WRITE(msgBuf,'(A,I5,A)') + & 'S/R INI_PARMS: selectCoriScheme=', selectCoriScheme, + & ' conflicts with "useJamartWetPoints"' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + ENDIF + IF ( SadournyCoriolis ) THEN +C-- for backward compatibility : + IF ( selectVortScheme.EQ.UNSET_I ) selectVortScheme = 2 + IF ( selectVortScheme.NE.2 ) THEN + WRITE(msgBuf,'(A,I5,A)') + & 'S/R INI_PARMS: selectVortScheme=', selectVortScheme, + & ' conflicts with "SadournyCoriolis"' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + ENDIF + IF ( selectBalanceEmPmR.EQ.UNSET_I ) THEN + selectBalanceEmPmR = 0 + IF ( balanceEmPmR ) selectBalanceEmPmR = 1 + ELSEIF ( selectBalanceEmPmR.NE.1 .AND. balanceEmPmR ) THEN + WRITE(msgBuf,'(A,I5,A)') + & 'S/R INI_PARMS: selectBalanceEmPmR=', selectBalanceEmPmR, + & ' conflicts with "balanceEmPmR"' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + + IF ( ivdc_kappa.NE.zeroRL .AND. .NOT.implicitDiffusion ) THEN + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: To use ivdc_kappa you must enable implicit', + & ' vertical diffusion.' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + + coordsSet = 0 + IF ( zCoordInputData ) coordsSet = coordsSet + 1 + IF ( pCoordInputData ) coordsSet = coordsSet + 1 + IF ( rCoordInputData ) coordsSet = coordsSet + 1 + IF ( coordsSet .GT. 1 ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Cannot mix z, p and r in the input data.' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( rhoConst .LE. 0. ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: rhoConst must be greater than 0.' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + recip_rhoConst = 1. _d 0 + ELSE + recip_rhoConst = 1. _d 0 / rhoConst + ENDIF + IF ( eosType.EQ.'LINEAR' .AND. rhoNil.LE.0. ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: rhoNil must be greater than 0.' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( HeatCapacity_Cp .LE. 0. ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: HeatCapacity_Cp must be greater than 0.' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( gravity .LE. 0. ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: gravity must be greater than 0.' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + recip_gravity = 1. _d 0 + ELSE + recip_gravity = 1. _d 0 / gravity + ENDIF + +C- set default printResidualFreq according to debugLevel + printResidualFreq = 0 + IF ( debugLevel.GE.debLevE ) printResidualFreq = 1 + IF ( plotLevel.EQ.UNSET_I ) plotLevel = debugLevel + +C- set useSingleCpuInput=.TRUE. if useSingleCpuIO==.TRUE. + IF ( useSingleCpuIO ) useSingleCpuInput=.TRUE. + +C Check for retired parameters still being used + nRetired = 0 + IF ( useConstantF ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: "useConstantF" ', + & 'is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: set "selectCoriMap"', + & ' [0,1,2,3] to impose a setting over grid default' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( useBetaPlaneF ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: "useBetaPlaneF" ', + & 'is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: set "selectCoriMap"', + & ' [0,1,2,3] to impose a setting over grid default' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( .NOT. useSphereF ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: "useSphereF" ', + & 'is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: set "selectCoriMap"', + & ' [0,1,2,3] to impose a setting over grid default' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( zonal_filt_lat .NE. UNSET_RL ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: Paramater "zonal_filt_lat" is', + & ' no longer allowed in file "data".' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: Paramater "zonal_filt_lat" is', + & ' now read from file "data.zonfilt".' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( gravitySign .NE. UNSET_RL ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "gravitySign" is set according to vertical ', + & ' coordinate and is no longer allowed in file "data".' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( tracerAdvScheme .NE. UNSET_I ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: "tracerAdvScheme" ', + & '(old passive tracer code) is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( trac_EvPrRn .NE. UNSET_RL ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: "trac_EvPrRn" ', + & '(old passive tracer code) is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( .NOT. tempDiffusion ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: "tempDiffusion" ', + & 'is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: to turn off diffusion', + & ' => set diffusivity to zero' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( .NOT. saltDiffusion ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: "saltDiffusion" ', + & 'is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: to turn off diffusion', + & ' => set diffusivity to zero' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( viscAstrain .NE. UNSET_RL ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "viscAstrain" ', + & 'is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: to use Strain & Tension', + & ' formulation => set useStrainTensionVisc to TRUE' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( viscAtension .NE. UNSET_RL ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "viscAtension" ', + & 'is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: to use Strain & Tension', + & ' formulation => set useStrainTensionVisc to TRUE' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( .NOT.useAnisotropicViscAgridMax ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "useAnisotropicViscAgridMax" ', + & 'is not allowed in "data" substitute useAreaViscLength=true' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( usePickupBeforeC35 ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "usePickupBeforeC35" ', + & 'is no longer supported & not longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( debugMode.NEQV.saveDebugMode ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "debugMode" has been moved to "eedata"', + & ' and is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( allowInteriorFreezing ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "allowInteriorFreezing" has been replaced', + & ' by pkg/frazil and is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( useOldFreezing ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: "useOldFreezing" ', + & 'is no longer supported & not longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + +C-- Elliptic solver parameters + WRITE(msgBuf,'(A)') ' INI_PARMS ; starts to read PARM02' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + READ(UNIT=iUnit,NML=PARM02) !,IOSTAT=errIO) + IF ( errIO .LT. 0 ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Error reading model parameter file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A)') 'S/R INI_PARMS: Problem in namelist PARM02' + CALL PRINT_ERROR( msgBuf, myThid ) + STOP 'ABNORMAL END: S/R INI_PARMS' + ELSE + WRITE(msgBuf,'(A)') ' INI_PARMS ; read PARM02 : OK' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + ENDIF +C Check for retired parameters still being used + IF ( cg2dChkResFreq .NE. UNSET_I ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: unused "cg2dChkResFreq"', + & ' is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( cg3dChkResFreq .NE. UNSET_I ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: unused "cg3dChkResFreq"', + & ' is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + +C-- Time stepping parameters + rCD = -1. _d 0 + epsAB_CD = UNSET_RL + latBandClimRelax = UNSET_RL + deltaTtracer = 0. _d 0 + forcing_In_AB = .TRUE. + WRITE(msgBuf,'(A)') ' INI_PARMS ; starts to read PARM03' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + READ(UNIT=iUnit,NML=PARM03) !,IOSTAT=errIO) + IF ( errIO .LT. 0 ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Error reading model parameter file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A)') 'S/R INI_PARMS: Problem in namelist PARM03' + CALL PRINT_ERROR( msgBuf, myThid ) + STOP 'ABNORMAL END: S/R INI_PARMS' + ELSE + WRITE(msgBuf,'(A)') ' INI_PARMS ; read PARM03 : OK' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + ENDIF +C Check for retired parameters still being used + IF ( tauThetaClimRelax3Dim .NE. UNSET_RL ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: "tauThetaClimRelax3Dim" ', + & 'is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: 3-dim. relaxation code', + & ' has moved to separate pkg/rbcs.' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( tauSaltClimRelax3Dim .NE. UNSET_RL ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: "tauSaltClimRelax3Dim" ', + & 'is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: 3-dim. relaxation code', + & ' has moved to separate pkg/rbcs.' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( calendarDumps ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: "calendarDumps" ', + & 'is no longer allowed in file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A,A)') 'S/R INI_PARMS: calendarDumps', + & ' has moved to "data.cal"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + +C Process "timestepping" params +C o Time step size + IF ( deltaTtracer .NE. dTtracerLev(1) .AND. + & deltaTtracer .NE. 0. .AND. dTtracerLev(1) .NE. 0. ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: deltaTtracer & dTtracerLev(1) not equal' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ELSEIF ( dTtracerLev(1) .NE. 0. ) THEN + deltaTtracer = dTtracerLev(1) + ENDIF + IF ( deltaT .EQ. 0. ) deltaT = deltaTClock + IF ( deltaT .EQ. 0. ) deltaT = deltaTtracer + IF ( deltaT .EQ. 0. ) deltaT = deltaTMom + IF ( deltaT .EQ. 0. ) deltaT = deltaTFreeSurf + IF ( deltaT .EQ. 0. ) THEN + WRITE(msgBuf,'(2A)') 'S/R INI_PARMS: ', + & 'need to specify in file "data", namelist "PARM03"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(2A)') 'S/R INI_PARMS: ', + & ' a model timestep (in s) deltaT or deltaTClock= ?' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + deltaT = 1. + ENDIF + IF ( deltaTMom .EQ. 0. ) deltaTMom = deltaT + IF ( deltaTtracer .EQ. 0. ) deltaTtracer = deltaT + IF ( deltaTClock .EQ. 0. ) deltaTClock = deltaT + DO k=1,Nr + IF (dTtracerLev(k).EQ.0.) dTtracerLev(k)= deltaTtracer + ENDDO +C Note that this line should set deltaFreesurf=deltaTtracer +C but this would change a lot of existing set-ups so we are +C obliged to set the default inappropriately. +C Be advised that when using asynchronous time stepping +C it is better to set deltaTreesurf=deltaTtracer + IF ( deltaTFreeSurf .EQ. 0. ) deltaTFreeSurf = deltaTMom + IF ( periodicExternalForcing ) THEN + IF ( externForcingCycle*externForcingPeriod .EQ. 0. ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: externForcingCycle,externForcingPeriod =0' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ELSEIF ( INT(externForcingCycle/externForcingPeriod) .NE. + & externForcingCycle/externForcingPeriod ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: externForcingCycle <> N*externForcingPeriod' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ELSEIF ( externForcingCycle.LT.externForcingPeriod ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: externForcingCycle < externForcingPeriod' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( externForcingPeriod.LT.deltaTClock ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: externForcingPeriod < deltaTClock' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + ENDIF +C o Adams-Bashforth time stepping: + IF ( momForcingOutAB .EQ. UNSET_I ) THEN + momForcingOutAB = 1 + IF ( forcing_In_AB ) momForcingOutAB = 0 + ENDIF + IF ( tracForcingOutAB .EQ. UNSET_I ) THEN + tracForcingOutAB = 1 + IF ( forcing_In_AB ) tracForcingOutAB = 0 + ENDIF +C o Convection frequency + IF ( cAdjFreq .LT. 0. ) THEN + cAdjFreq = deltaTClock + ENDIF + IF ( ivdc_kappa .NE. 0. .AND. cAdjFreq .NE. 0. ) THEN + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: You have enabled both ivdc_kappa and', + & ' convective adjustment.' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF (useCDscheme) THEN +C o CD coupling (CD scheme): + IF ( tauCD .EQ. 0. _d 0 ) tauCD = deltaTMom + IF ( rCD .LT. 0. ) rCD = 1. _d 0 - deltaTMom/tauCD + IF ( epsAB_CD .EQ. UNSET_RL ) epsAB_CD = abEps + ENDIF + + IF ( startTime.EQ.UNSET_RL .AND. nIter0.EQ.-1 ) THEN +C o set default value for start time & nIter0 + startTime = baseTime + nIter0 = 0 + ELSEIF ( startTime.EQ.UNSET_RL ) THEN +C o set start time from nIter0 + startTime = baseTime + deltaTClock*DFLOAT(nIter0) + ELSEIF ( nIter0.EQ.-1 ) THEN +C o set nIter0 from start time + nIter0 = NINT( (startTime-baseTime)/deltaTClock ) + ELSEIF ( baseTime.EQ.0. ) THEN +C o set base time from the 2 others + baseTime = startTime - deltaTClock*DFLOAT(nIter0) + ENDIF + + nTimeSteps_l2 = 4 +C o nTimeSteps 1 + IF ( nTimeSteps .EQ. 0 .AND. nEndIter .NE. 0 ) + & nTimeSteps = nEndIter-nIter0 +C o nTimeSteps 2 + IF ( nTimeSteps .EQ. 0 .AND. endTime .NE. 0. ) + & nTimeSteps = NINT((endTime-startTime)/deltaTClock) +C o nEndIter 1 + IF ( nEndIter .EQ. 0 .AND. nTimeSteps .NE. 0 ) + & nEndIter = nIter0+nTimeSteps +C o nEndIter 2 + IF ( nEndIter .EQ. 0 .AND. endTime .NE. 0. ) + & nEndIter = NINT((endTime-baseTime)/deltaTClock) +C o End Time 1 + IF ( endTime .EQ. 0. .AND. nTimeSteps .NE. 0 ) + & endTime = startTime + deltaTClock*DFLOAT(nTimeSteps) +C o End Time 2 + IF ( endTime .EQ. 0. .AND. nEndIter .NE. 0 ) + & endTime = baseTime + deltaTClock*DFLOAT(nEndIter) + +C o Consistent? + IF ( startTime .NE. baseTime+deltaTClock*DFLOAT(nIter0) ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: startTime, baseTime and nIter0 are inconsistent' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Perhaps more than two were set at once' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( nEndIter .NE. nIter0+nTimeSteps ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: nIter0, nTimeSteps and nEndIter are inconsistent' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Perhaps more than two were set at once' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( nTimeSteps .NE. NINT((endTime-startTime)/deltaTClock) + & ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: both endTime and nTimeSteps have been set' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: but are inconsistent' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + +C o Monitor (should also add CPP flag for monitor?) + IF (monitorFreq.LT.0.) THEN + monitorFreq=0. + IF (dumpFreq.NE.0.) monitorFreq=dumpFreq + IF (diagFreq.NE.0..AND.diagFreq.LT.monitorFreq) + & monitorFreq=diagFreq + IF (taveFreq.NE.0..AND.taveFreq.LT.monitorFreq) + & monitorFreq=taveFreq + IF (chkPtFreq.NE.0..AND.chkPtFreq.LT.monitorFreq) + & monitorFreq=chkPtFreq + IF (pChkPtFreq.NE.0..AND.pChkPtFreq.LT.monitorFreq) + & monitorFreq=pChkPtFreq + IF (monitorFreq.EQ.0.) monitorFreq=deltaTClock + ENDIF + IF ( monitorSelect.EQ.UNSET_I ) THEN + monitorSelect = 2 + IF ( fluidIsWater ) monitorSelect = 3 + ENDIF + +C-- Grid parameters +C In cartesian coords distances are in metres + DO k =1,Nr + delZ(k) = UNSET_RL + delP(k) = UNSET_RL + delR(k) = UNSET_RL + ENDDO +C In spherical polar distances are in degrees + dxSpacing = UNSET_RL + dySpacing = UNSET_RL +C- pCell-Mix parameters: + interViscAr_pCell = .FALSE. + interDiffKr_pCell = .FALSE. + pCellMix_select = 0 + pCellMix_maxFac = 1. _d 4 + pCellMix_delR = 0. + DO k=1,Nr + pCellMix_viscAr(k) = viscArNr(k) + pCellMix_diffKr(k) = diffKrNrT(k) + ENDDO + + WRITE(msgBuf,'(A)') ' INI_PARMS ; starts to read PARM04' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + READ(UNIT=iUnit,NML=PARM04) !,IOSTAT=errIO) + IF ( errIO .LT. 0 ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Error reading model parameter file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A)') 'S/R INI_PARMS: Problem in namelist PARM04' + CALL PRINT_ERROR( msgBuf, myThid ) + STOP 'ABNORMAL END: S/R INI_PARMS' + ELSE + WRITE(msgBuf,'(A)') ' INI_PARMS ; read PARM04 : OK' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + ENDIF + +C Check for retired parameters still being used + IF ( Ro_SeaLevel .NE. UNSET_RL ) THEN +c nRetired = nRetired+1 + IF ( usingPCoords ) THEN + WRITE(msgBuf,'(2A)') '** WARNING ** INI_PARMS: ', + & '"Ro_SeaLevel" (P @ bottom) depreciated (backward compat' + ELSEIF ( usingZCoords ) THEN + WRITE(msgBuf,'(2A)') '** WARNING ** INI_PARMS: ', + & '"Ro_SeaLevel" (Z @ top) depreciated (backward compat' + ENDIF + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + & SQUEEZE_RIGHT, myThid ) + IF ( usingPCoords ) THEN + WRITE(msgBuf,'(2A)') '** WARNING ** INI_PARMS: ', + & ' only). To set vert. axis, use instead "top_Pres".' + ELSEIF ( usingZCoords ) THEN + WRITE(msgBuf,'(2A)') '** WARNING ** INI_PARMS: ', + & ' only). To set vert. axis, use instead "seaLev_Z".' + ENDIF + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + & SQUEEZE_RIGHT, myThid ) + ENDIF + IF ( rkFac .NE. UNSET_RL ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "rkFac" has been replaced by -rkSign ', + & ' and is no longer allowed in file "data".' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( groundAtK1 ) THEN +c nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "groundAtK1" is set according to vertical ', + & ' coordinate and is no longer allowed in file "data".' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( thetaMin .NE. UNSET_RL ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "thetaMin" no longer allowed,', + & ' has been replaced by "xgOrigin"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( phiMin .NE. UNSET_RL ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "phiMin" no longer allowed,', + & ' has been replaced by "ygOrigin"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + +C X coordinate : Check for multiple definitions + goptCount = 0 + IF ( delX(1) .NE. UNSET_RL ) goptCount = goptCount + 1 + IF ( dxSpacing .NE. UNSET_RL ) goptCount = goptCount + 1 + IF ( delXFile .NE. ' ' ) goptCount = goptCount + 1 + IF ( goptCount.GT.1 ) THEN + WRITE(msgBuf,'(A,A)') 'Too many specifications for delX:', + & 'Specify only one of delX, dxSpacing or delXfile' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( dxSpacing .NE. UNSET_RL ) THEN + DO i=1,gridNx + delX(i) = dxSpacing + ENDDO + ENDIF +C Y coordinate : Check for multiple definitions + goptCount = 0 + IF ( delY(1) .NE. UNSET_RL ) goptCount = goptCount + 1 + IF ( dySpacing .NE. UNSET_RL ) goptCount = goptCount + 1 + IF ( delYFile .NE. ' ' ) goptCount = goptCount + 1 + IF ( goptCount.GT.1 ) THEN + WRITE(msgBuf,'(A,A)') 'Too many specifications for delY:', + & 'Specify only one of delY, dySpacing or delYfile' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( dySpacing .NE. UNSET_RL ) THEN + DO j=1,gridNy + delY(j) = dySpacing + ENDDO + ENDIF + +C-- Check for conflicting grid definitions. + goptCount = 0 + IF ( usingCartesianGrid ) goptCount = goptCount+1 + IF ( usingSphericalPolarGrid ) goptCount = goptCount+1 + IF ( usingCurvilinearGrid ) goptCount = goptCount+1 + IF ( usingCylindricalGrid ) goptCount = goptCount+1 + IF ( goptCount .GT. 1 ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: More than one coordinate system requested' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( goptCount .LT. 1 ) THEN +C- No horizontal grid is specified => use Cartesian grid as default: + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: No horizontal grid requested' + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + & SQUEEZE_RIGHT, myThid ) + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: => Use Cartesian Grid as default' + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + & SQUEEZE_RIGHT, myThid ) + usingCartesianGrid = .TRUE. + ENDIF +C- Radius of the Planet: + IF ( rSphere.EQ.UNSET_RL ) THEN + IF ( usingCurvilinearGrid .AND. + & radius_fromHorizGrid.NE.UNSET_RL ) THEN + rSphere = radius_fromHorizGrid + ELSE + rSphere = 6370. _d 3 + ENDIF + ENDIF + IF ( radius_fromHorizGrid.EQ.UNSET_RL ) THEN + radius_fromHorizGrid = rSphere + ENDIF + IF ( rSphere .NE. 0. ) THEN + recip_rSphere = 1. _d 0/rSphere + ELSE + recip_rSphere = 0. + ENDIF +C-- Default vertical axis origin + IF ( Ro_SeaLevel .NE. UNSET_RL ) THEN + IF ( usingPCoords .AND. top_Pres.NE.UNSET_RL ) THEN + WRITE(msgBuf,'(2A)') 'S/R INI_PARMS: ', + & 'Cannot set both "Ro_SeaLevel" and "top_Pres"' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( usingZCoords .AND. seaLev_Z.NE.UNSET_RL ) THEN + WRITE(msgBuf,'(2A)') 'S/R INI_PARMS: ', + & 'Cannot set both "Ro_SeaLevel" and "seaLev_Z"' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + rF(1) = Ro_SeaLevel + ELSE + rF(1) = UNSET_RS + ENDIF + IF ( top_Pres.EQ.UNSET_RL ) top_Pres = 0. + IF ( seaLev_Z.EQ.UNSET_RL ) seaLev_Z = 0. +C-- Default origin for X & Y axis (longitude & latitude origin): + IF ( xgOrigin .EQ. UNSET_RL ) xgOrigin = 0. + IF ( ygOrigin .EQ. UNSET_RL ) THEN + IF ( usingSphericalPolarGrid ) THEN + ygOrigin = 0. + ELSEIF ( usingCartesianGrid ) THEN + ygOrigin = 0. + ELSEIF ( usingCylindricalGrid ) THEN + ygOrigin = 0. + ELSEIF ( usingCurvilinearGrid ) THEN + ygOrigin = 0. + ELSE + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: found no coordinate system to set ygOrigin' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + ENDIF +C-- Make metric term & Coriolis settings consistent with underlying grid. + IF ( usingCartesianGrid ) THEN + metricTerms = .FALSE. + useNHMTerms = .FALSE. + ENDIF + IF ( usingCylindricalGrid ) THEN + useNHMTerms = .FALSE. + WRITE(msgBuf,'(A)') 'S/R INI_PARMS ; Cylinder OK' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + ENDIF + IF ( usingCurvilinearGrid ) THEN + metricTerms = .FALSE. + ENDIF + IF ( selectCoriMap.EQ.-1 ) THEN + IF ( usingCartesianGrid.OR.usingCylindricalGrid ) THEN +C default is to use Beta-Plane Coriolis + selectCoriMap = 1 + ELSE +C default for other grids is to use Spherical Coriolis + selectCoriMap = 2 + ENDIF + ENDIF + IF ( .NOT.(nonHydrostatic.OR.quasiHydrostatic) ) + & use3dCoriolis = .FALSE. + IF ( (selectCoriMap.EQ.0 .OR.selectCoriMap.EQ.1) + & .AND. fPrime.EQ.0. ) use3dCoriolis = .FALSE. + +C-- Grid rotation + IF ( phiEuler .NE. 0. _d 0 .OR. thetaEuler .NE. 0. _d 0 + & .OR. psiEuler .NE. 0. _d 0 ) rotateGrid = .TRUE. + +C-- Set default for latitude-band where relaxation to climatology applies +C note: done later (once domain size is known) if using CartesianGrid + IF ( latBandClimRelax .EQ. UNSET_RL) THEN + IF ( usingSphericalPolarGrid ) latBandClimRelax= 180. _d 0 + IF ( usingCurvilinearGrid ) latBandClimRelax= 180. _d 0 + ENDIF + +C-- set cell Center depth and put Interface at the middle between 2 C + setCenterDr = .FALSE. + DO k=1,Nr+1 + IF ( delRc(k).EQ.UNSET_RL ) THEN + IF ( setCenterDr ) THEN + WRITE(msgBuf,'(A,I4)') + & 'S/R INI_PARMS: No value for delRc at k =', k + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + ELSE + IF ( k.EQ.1 ) setCenterDr = .TRUE. + IF ( .NOT.setCenterDr ) THEN + WRITE(msgBuf,'(A,I4)') + & 'S/R INI_PARMS: No value for delRc at k <', k + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + ENDIF + ENDDO + IF ( setCenterDr ) rCoordInputData = .TRUE. +C-- p, z, r coord parameters + setInterFDr = .FALSE. + DO k = 1, Nr + IF ( delZ(k) .NE. UNSET_RL ) zCoordInputData = .TRUE. + IF ( delP(k) .NE. UNSET_RL ) pCoordInputData = .TRUE. + IF ( delR(k) .NE. UNSET_RL ) rCoordInputData = .TRUE. + IF ( delR(k) .EQ. UNSET_RL ) delR(k) = delZ(k) + IF ( delR(k) .EQ. UNSET_RL ) delR(k) = delP(k) + IF ( delR(k) .EQ. UNSET_RL ) THEN + IF ( setInterFDr ) THEN + WRITE(msgBuf,'(A,I4)') + & 'S/R INI_PARMS: No value for delZ/delP/delR at k =', k + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + ELSE + IF ( k.EQ.1 ) setInterFDr = .TRUE. + IF ( .NOT.setInterFDr ) THEN + WRITE(msgBuf,'(A,I4)') + & 'S/R INI_PARMS: No value for delZ/delP/delR at k <', k + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + ENDIF + ENDDO +C Check for multiple coordinate systems + coordsSet = 0 + IF ( zCoordInputData ) coordsSet = coordsSet + 1 + IF ( pCoordInputData ) coordsSet = coordsSet + 1 + IF ( rCoordInputData ) coordsSet = coordsSet + 1 + IF ( coordsSet .GT. 1 ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Cannot mix z, p and r in the input data.' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF +C- Check for double definition (file & namelist) + IF ( delRcFile.NE.' ' ) THEN + IF ( setCenterDr ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Cannot set both delRc and delRcFile' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + setCenterDr = .TRUE. + ENDIF + IF ( delRFile.NE.' ' ) THEN + IF ( setInterFDr ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Cannot set both delR and delRFile' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + setInterFDr = .TRUE. + ENDIF + +C-- Input files + WRITE(msgBuf,'(A)') ' INI_PARMS ; starts to read PARM05' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + READ(UNIT=iUnit,NML=PARM05) !,IOSTAT=errIO) + IF ( errIO .LT. 0 ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Error reading model parameter file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A)') 'S/R INI_PARMS: Problem in namelist PARM05' + CALL PRINT_ERROR( msgBuf, myThid ) + STOP 'ABNORMAL END: S/R INI_PARMS' + ELSE + WRITE(msgBuf,'(A)') ' INI_PARMS ; read PARM05 : OK' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + ENDIF +C Check for retired parameters still being used + IF ( shelfIceFile .NE. ' ' ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "shelfIceFile" is not allowed in "data", ', + & 'substitute "SHELFICEtopoFile" in data.shelfice' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF + IF ( dQdTFile .NE. ' ' ) THEN + nRetired = nRetired+1 + WRITE(msgBuf,'(A,A)') + & 'S/R INI_PARMS: "dQdTFile" has been retired from file "data"' + CALL PRINT_ERROR( msgBuf, myThid ) + ENDIF +C Check if two conflicting I/O directories have been specified + IF (mdsioLocalDir .NE. ' ' .AND. adTapeDir .NE. ' ') THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: mdsioLocalDir and adTapeDir cannot be' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: specified at the same time' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + +C Check for relaxation term: + IF ( (tauThetaClimRelax.GT.0.).AND. + & (thetaClimFile.EQ.' ') ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: tauThetaClimRelax > 0 but' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: thetaClimFile is undefined' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF + IF ( (tauSaltClimRelax.GT.0.).AND. + & (saltClimFile.EQ.' ') ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: tauSaltClimRelax > 0 but' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: saltClimFile is undefined' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF +C Check vertical diffusivity setting: +#ifdef ALLOW_3D_DIFFKR + IF ( specifiedDiffKrT ) THEN + WRITE(msgBuf,'(2A)') '** WARNING ** INI_PARMS: Ignores diffKr', + & 'T (or Kp,Kz) setting in file "data" with ALLOW_3D_DIFFKR' + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + & SQUEEZE_RIGHT, myThid ) + ENDIF + IF ( specifiedDiffKrS .AND. diffKrFile.NE.' ' ) THEN + WRITE(msgBuf,'(2A)') '** WARNING ** INI_PARMS: Ignores diffKr', + & 'S (or Kp,Kz) setting in file "data" and uses diffKrFile' + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + & SQUEEZE_RIGHT, myThid ) + ENDIF +#endif + +C-- Set Units conversion factor required to incorporate +C surface forcing into z-p isomorphic equations: +C mass2rUnit: from mass per unit area [kg/m2] to r-coordinate (z:=1/rho;p:=g) +C rUnit2mass: from r-coordinate to mass per unit area [kg/m2] (z:=rho;p:=1/g) + IF ( usingPCoords ) THEN + mass2rUnit = gravity + rUnit2mass = recip_gravity + ELSE + mass2rUnit = recip_rhoConst + rUnit2mass = rhoConst + ENDIF + +#ifndef shelfice_new_thermo +C-- For backward compatibility, set temp_addMass and salt_addMass +C to temp_EvPrRn and salt_EvPrRn if not set in parameter file "data" + IF (temp_addMass .EQ. UNSET_RL) temp_addMass = temp_EvPrRn + IF (salt_addMass .EQ. UNSET_RL) salt_addMass = salt_EvPrRn +#else + temp_addMass = UNSET_RL + salt_addMass = UNSET_RL +#endif + +C-- Make a choice (if unset) regarding using CG2D solver min.-residual sol. +C for simple set-up (cartesian grid + flat bottom), default is to +C use the solver minimum residual solution (cg2dUseMinResSol=1). + IF ( cg2dUseMinResSol.EQ.UNSET_I ) THEN + cg2dUseMinResSol = 0 + IF ( topoFile.EQ.' ' .AND. bathyFile.EQ.' ' + & .AND. usingCartesianGrid ) cg2dUseMinResSol = 1 + ENDIF + +C-- Close the open data file +#ifdef SINGLE_DISK_IO + CLOSE(iUnit) +#else + CLOSE(iUnit,STATUS='DELETE') +#endif /* SINGLE_DISK_IO */ + + WRITE(msgBuf,'(A)') ' INI_PARMS: finished reading file "data"' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT , myThid ) + +C-- Check whether any retired parameters were found. + IF ( nRetired .GT. 0 ) THEN + WRITE(msgBuf,'(A)') + & 'S/R INI_PARMS: Error reading parameter file "data":' + CALL PRINT_ERROR( msgBuf, myThid ) + WRITE(msgBuf,'(I4,A)') nRetired, + & ' out of date parameters were found in the namelist' + CALL PRINT_ERROR( msgBuf, myThid ) + errCount = errCount + 1 + ENDIF +C-- Stop if any error was found (including retired params): + IF ( errCount .GE. 1 ) THEN + WRITE(msgBuf,'(A,I3,A)') + & 'S/R INI_PARMS: detected', errCount,' fatal error(s)' + CALL PRINT_ERROR( msgBuf, myThid ) + CALL ALL_PROC_DIE( 0 ) + STOP 'ABNORMAL END: S/R INI_PARMS' + ENDIF + + _END_MASTER(myThid) + +C-- Everyone else must wait for the parameters to be loaded + _BARRIER + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/initialise_varia.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/initialise_varia.F new file mode 100644 index 0000000..2c7c1b4 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/initialise_varia.F @@ -0,0 +1,378 @@ +#include "PACKAGES_CONFIG.h" +#include "CPP_OPTIONS.h" +#ifdef ALLOW_AUTODIFF +# include "AUTODIFF_OPTIONS.h" +#endif +#ifdef ALLOW_CTRL +# include "CTRL_OPTIONS.h" +#endif +#ifdef ALLOW_SHELFICE +# include "SHELFICE_OPTIONS.h" +#endif + +CBOP +C !ROUTINE: INITIALISE_VARIA +C !INTERFACE: + SUBROUTINE INITIALISE_VARIA( myThid ) +C !DESCRIPTION: \bv +C *==========================================================* +C | SUBROUTINE INITIALISE_VARIA +C | o Set the initial conditions for dynamics variables +C | and time dependent arrays +C *==========================================================* +C | This routine reads/writes data from an input file and +C | from various binary files. +C | Each thread invokes an instance of this routine as does +C | each process in a multi-process parallel environment like +C | MPI. +C *==========================================================* +C \ev + +C !CALLING SEQUENCE: +C INITIALISE_VARIA +C | +C #ifdef ALLOW_AUTODIFF +C |-- INI_DEPTHS \ +C |-- CTRL_DEPTH_INI \ +C |-- UPDATE_MASKS_ETC } ALLOW_DEPTH_CONTROL case +C |-- UPDATE_CG2D / +C #endif +C |-- INI_NLFS_VARS +C |-- INI_DYNVARS +C |-- INI_NH_VARS +C |-- INI_FFIELDS +C | +C |-- INI_FIELDS +C | +C |-- INI_MIXING +C | +C |-- TAUEDDY_INIT_VARIA +C | +C |-- INI_FORCING +C | +C |-- AUTODIFF_INIT_VARIA +C | +C |-- PACKAGES_INIT_VARIABLES +C | +C |-- COST_INIT_VARIA +C | +C |-- CONVECTIVE_ADJUSTMENT_INI +C | +C |-- CALC_R_STAR +C |-- UPDATE_R_STAR +C |-- UPDATE_SIGMA +C |-- CALC_SURF_DR +C |-- UPDATE_SURF_DR +C | +C |-- UPDATE_CG2D +C | +C |-- INTEGR_CONTINUITY +C | +C |-- CALC_R_STAR +C |-- CALC_SURF_DR +C | +C |-- STATE_SUMMARY +C | +C |-- MONITOR +C | +C |-- DO_STATEVARS_TAVE +C | +C |-- DO_THE_MODEL_IO + +C !USES: + IMPLICIT NONE +C == Global variables == +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "DYNVARS.h" +#include "SURFACE.h" +#ifdef ALLOW_AUTODIFF +# include "GRID.h" +# include "FFIELDS.h" +# include "CTRL_FIELDS.h" +# if (defined ALLOW_SHELFICE) && (defined ALLOW_GENARR2D_CONTROL) +# include "SHELFICE.h" +# endif +#endif + +C !INPUT/OUTPUT PARAMETERS: +C == Routine arguments == + INTEGER myThid + +C !LOCAL VARIABLES: +C == Local variables == + INTEGER bi,bj +#ifdef CALC_PHI_RLOW_INI + INTEGER iMin, iMax, jMin, jMax + _RL PhiHydF (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL PhiHydC (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL dPhiHydX(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL dPhiHydY(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + INTEGER k +#endif +CEOP + +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_ENTER('INITIALISE_VARIA',myThid) +#endif + +#ifdef CALC_PHI_RLOW_INI + iMin = 1-OLx + iMax = sNx+OLx + jMin = 1-OLy + jMax = sNy+OLy +#endif + +#ifdef ALLOW_AUTODIFF + nIter0 = NINT( (startTime-baseTime)/deltaTClock ) +#endif /* ALLOW_AUTODIFF */ + +#ifdef ALLOW_DEPTH_CONTROL +C-- Intialize the depth for TAF/TAMC + CALL INI_DEPTHS( myThid ) +C-- Get control parameter depth + CALL CTRL_DEPTH_INI( myThid ) +C-- Re-calculate hFacS/W and some other parameters from hFacC + CALL UPDATE_MASKS_ETC( myThid ) +C-- Update laplace operators for use in 2D conjugate gradient solver. + CALL UPDATE_CG2D( startTime, nIter0, myThid ) +#endif /* ALLOW_DEPTH_CONTROL */ + +C-- Initialise Non-Lin FreeSurf variables: + CALL INI_NLFS_VARS( myThid ) + +C-- Initialize DYNVARS arrays (state fields + G terms: Gu,Gv,...) to zero [always] +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('INI_DYNVARS',myThid) +#endif + CALL INI_DYNVARS( myThid ) + +C-- Initialize NH_VARS arrays to zero [always] +#ifdef ALLOW_NONHYDROSTATIC + CALL INI_NH_VARS( myThid ) +#endif + +C-- Initialize FFIELDS arrays to zero [always] + CALL INI_FFIELDS( myThid ) + +C-- Initialise model fields. +C Starting values of U, V, W, temp., salt. and tendency terms +C are set here. Fields are either set to default or read from +C stored files. +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('INI_FIELDS',myThid) +#endif +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE phi0surf = tapelev_init, key = 1 +#endif + CALL INI_FIELDS( myThid ) + +C-- Initialise 3-dim. diffusivities +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('INI_MIXING',myThid) +#endif + CALL INI_MIXING( myThid ) + +#ifdef ALLOW_EDDYPSI +C-- Initialise eddy diffusivities + CALL TAUEDDY_INIT_VARIA( myThid ) +#endif + +C-- Initialise model forcing fields. +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('INI_FORCING',myThid) +#endif + CALL INI_FORCING( myThid ) + +#ifdef ALLOW_AUTODIFF +C-- Initialise active fields to help TAMC + if (useAUTODIFF) CALL AUTODIFF_INIT_VARIA( myThid ) +#endif + +#ifdef CALC_PHI_RLOW_INI +Cow +C-- Integrate hydrostatic balance for phiHyd with BC of phiHyd(z=0)=0 +C-- phiHydLow is calcluated here using the initial TS and will +C-- be used in ecco_phys.F (called in ECCO_INIT_VARIA.F/PACKAGES_INIT_VARIABLES.F). +C-- to correct m_bp. Otherwise, a zero phiHydLow will be used, which +C-- is incorrect. +C-- + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO k = 1, Nr + CALL CALC_PHI_HYD( + I bi,bj,iMin,iMax,jMin,jMax,k, + U phiHydF, + O phiHydC, dPhiHydX, dPhiHydY, + I startTime, -1, myThid ) + ENDDO + ENDDO + ENDDO +#endif + +C-- Initialize variable data for packages +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('PACKAGES_INIT_VARIABLES',myThid) +#endif +#ifdef ALLOW_AUTODIFF_TAMC +# ifdef NONLIN_FRSURF +CADJ STORE recip_hFacC = tapelev_init, key = 1 +# endif +# if (defined ALLOW_SHELFICE) && (defined ALLOW_GENARR2D_CONTROL) +CADJ STORE shelficeFreshwaterFlux = tapelev_init, key = 1 +CADJ STORE shelficeHeatFlux = tapelev_init, key = 1 +# ifndef SHI_ALLOW_GAMMAFRICT +CADJ STORE shiTransCoeffT = tapelev_init, key = 1 +CADJ STORE shiTransCoeffS = tapelev_init, key = 1 +# else +CADJ STORE shiCDragFld = tapelev_init, key = 1 +# endif +# endif +#endif + CALL PACKAGES_INIT_VARIABLES( myThid ) + +#ifdef ALLOW_COST +C-- Initialise the cost function (moved out of packages_init_variables to +C here to prevent resetting cost-funct in adinitialise_varia recomput.) + CALL COST_INIT_VARIA( myThid ) +#endif /* ALLOW_COST */ + +c#ifndef ALLOW_AUTODIFF +c IF ( usePickupBeforeC35 .AND. startTime .NE. baseTime ) THEN +C-- IMPORTANT : Need to activate the following call to restart from a pickup +C file written by MITgcmUV_checkpoint34 (Feb-08, 2001) or earlier. +C- Disable this option on Jan-09, 2007. +c CALL THE_CORRECTION_STEP(startTime, nIter0, myThid) +c ENDIF +c#endif + +#ifndef ALLOW_AUTODIFF_WHTAPEIO +C-- Initial conditions are convectively adjusted (for historical reasons) + IF ( startTime .EQ. baseTime .AND. cAdjFreq .NE. 0. ) THEN +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('CONVECTIVE_ADJUSTMENT_INI',myThid) +#endif +CADJ loop = parallel + DO bj = myByLo(myThid), myByHi(myThid) +CADJ loop = parallel + DO bi = myBxLo(myThid), myBxHi(myThid) + CALL CONVECTIVE_ADJUSTMENT_INI( + I bi, bj, startTime, nIter0, myThid ) + ENDDO + ENDDO + ENDIF +#endif /* ALLOW_AUTODIFF_WHTAPEIO */ + +#ifdef NONLIN_FRSURF +C-- Compute the surface level thickness <-- function of etaH(n) +C and modify hFac(C,W,S) accordingly : +# ifndef DISABLE_RSTAR_CODE + IF ( select_rStar.NE.0 ) + & CALL CALC_R_STAR(etaH, startTime, -1 , myThid ) +# endif /* DISABLE_RSTAR_CODE */ + IF ( nonlinFreeSurf.GT.0 ) THEN + IF ( select_rStar.GT.0 ) THEN +# ifndef DISABLE_RSTAR_CODE + CALL UPDATE_R_STAR( .TRUE., startTime, nIter0, myThid ) +# endif /* DISABLE_RSTAR_CODE */ + ELSEIF ( selectSigmaCoord.NE.0 ) THEN +# ifndef DISABLE_SIGMA_CODE + CALL UPDATE_SIGMA( etaH, startTime, nIter0, myThid ) +# endif /* DISABLE_SIGMA_CODE */ + ELSE + CALL CALC_SURF_DR(etaH, startTime, -1 , myThid ) +#ifdef ALLOW_AUTODIFF_TAMC +C These fields are only updated in the surface layer and TAF gets +C confused about it so that their contribution is not always added +C to the hfac*_ad lateron. This directive fixes that. +CADJ INCOMPLETE recip_hFacC, recip_hFacW, recip_hFacS +#endif /* ALLOW_AUTODIFF_TAMC */ + CALL UPDATE_SURF_DR( .TRUE., startTime, nIter0, myThid ) + ENDIF + ENDIF +C- update also CG2D matrix (and preconditioner) + IF ( nonlinFreeSurf.GT.2 ) THEN + CALL UPDATE_CG2D( startTime, nIter0, myThid ) + ENDIF +#endif /* NONLIN_FRSURF */ + +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('INTEGR_CONTINUITY',myThid) +#endif +C-- Integrate continuity vertically for vertical velocity + CALL INTEGR_CONTINUITY( uVel, vVel, + I startTime, nIter0, myThid ) + +#ifdef NONLIN_FRSURF + IF ( select_rStar.NE.0 ) THEN +#ifndef DISABLE_RSTAR_CODE +C-- r* : compute the future level thickness according to etaH(n+1) + CALL CALC_R_STAR(etaH, startTime, nIter0, myThid ) +#endif + ELSEIF ( nonlinFreeSurf.GT.0 .AND. selectSigmaCoord.EQ.0 ) THEN +C-- compute the future surface level thickness according to etaH(n+1) + CALL CALC_SURF_DR(etaH, startTime, nIter0, myThid ) + ENDIF +#endif /* NONLIN_FRSURF */ + +c IF ( nIter0.EQ.0 .AND. staggerTimeStep ) THEN +C-- Filter initial T & S fields if staggerTimeStep +C (only for backward compatibility ; to be removed later) +#ifdef ALLOW_SHAP_FILT +c IF ( useSHAP_FILT .AND. shap_filt_TrStagg ) THEN +c CALL SHAP_FILT_APPLY_TS(theta,salt,startTime,nIter0,myThid) +c ENDIF +#endif +#ifdef ALLOW_ZONAL_FILT +c IF ( useZONAL_FILT .AND. zonal_filt_TrStagg ) THEN +c CALL ZONAL_FILT_APPLY_TS( theta, salt, myThid ) +c ENDIF +#endif +c ENDIF + +#ifdef ALLOW_GRIDALT + IF (useGRIDALT) THEN + CALL TIMER_START('GRIDALT_UPDATE [INITIALISE_VARIA]',myThid) + CALL GRIDALT_UPDATE(myThid) + CALL TIMER_STOP ('GRIDALT_UPDATE [INITIALISE_VARIA]',myThid) + ENDIF +#endif + +C-- Finally summarise the model state +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('STATE_SUMMARY',myThid) +#endif + CALL STATE_SUMMARY( myThid ) + +#ifdef ALLOW_MONITOR +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('MONITOR',myThid) +#endif +C-- Check status of initial state (statistics, cfl, etc...) + CALL MONITOR( startTime, nIter0, myThid ) +#endif /* ALLOW_MONITOR */ + +#ifdef ALLOW_TIMEAVE +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('DO_STATEVARS_TAVE',myThid) +#endif +C-- Initialise time-average arrays with initial state values + CALL DO_STATEVARS_TAVE( startTime, nIter0, myThid ) +#endif + +C-- Dump initial state to files +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('DO_THE_MODEL_IO',myThid) +#endif + CALL DO_THE_MODEL_IO( .FALSE., startTime, nIter0, myThid ) + +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_LEAVE('INITIALISE_VARIA',myThid) +#endif + +C-- Check barrier synchronization: + CALL BAR_CHECK( 4, myThid ) + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/mom_calc_visc.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/mom_calc_visc.F new file mode 100644 index 0000000..b5c8a47 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/mom_calc_visc.F @@ -0,0 +1,805 @@ +#include "MOM_COMMON_OPTIONS.h" +#ifdef ALLOW_AUTODIFF +# include "AUTODIFF_OPTIONS.h" +#endif + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +CBOP +C !ROUTINE: MOM_CALC_VISC + +C !INTERFACE: + SUBROUTINE MOM_CALC_VISC( + I bi,bj,k, + O viscAh_Z,viscAh_D,viscA4_Z,viscA4_D, + I hDiv,vort3,tension,strain,stretching,KE,hFacZ, + I myThid) + +C !DESCRIPTION: +C Calculate horizontal viscosities (L is typical grid width) +C harmonic viscosity= +C viscAh (or viscAhD on div pts and viscAhZ on zeta pts) +C +0.25*L**2*viscAhGrid/deltaT +C +sqrt((viscC2leith/pi)**6*grad(Vort3)**2 +C +(viscC2leithD/pi)**6*grad(hDiv)**2)*L**3 +C +(viscC2smag/pi)**2*L**2*sqrt(Tension**2+Strain**2) +C +C biharmonic viscosity= +C viscA4 (or viscA4D on div pts and viscA4Z on zeta pts) +C +0.25*0.125*L**4*viscA4Grid/deltaT (approx) +C +0.125*L**5*sqrt((viscC4leith/pi)**6*grad(Vort3)**2 +C +(viscC4leithD/pi)**6*grad(hDiv)**2) +C +0.125*L**4*(viscC4smag/pi)**2*sqrt(Tension**2+Strain**2) +C +C Note that often 0.125*L**2 is the scale between harmonic and +C biharmonic (see Griffies and Hallberg (2000)) +C This allows the same value of the coefficient to be used +C for roughly similar results with biharmonic and harmonic +C +C LIMITERS -- limit min and max values of viscosities +C viscAhReMax is min value for grid point harmonic Reynolds num +C harmonic viscosity>sqrt(2*KE)*L/viscAhReMax +C +C viscA4ReMax is min value for grid point biharmonic Reynolds num +C biharmonic viscosity>sqrt(2*KE)*L**3/8/viscA4ReMax +C +C viscAhgridmax is CFL stability limiter for harmonic viscosity +C harmonic viscosity<0.25*viscAhgridmax*L**2/deltaT +C +C viscA4gridmax is CFL stability limiter for biharmonic viscosity +C biharmonic viscosity0.25*viscAhgridmin*L**2/deltaT +C biharmonic viscosity>viscA4gridmin*L**4/32/deltaT (approx) + +C RECOMMENDED VALUES +C viscC2Leith=1-3 +C viscC2LeithD=1-3 +C viscC2LeithQG=1 +C viscC4Leith=1-3 +C viscC4LeithD=1.5-3 +C viscC2smag=2.2-4 (Griffies and Hallberg,2000) +C 0.2-0.9 (Smagorinsky,1993) +C viscC4smag=2.2-4 (Griffies and Hallberg,2000) +C viscAhReMax>=1, (<2 suppresses a computational mode) +C viscA4ReMax>=1, (<2 suppresses a computational mode) +C viscAhgridmax=1 +C viscA4gridmax=1 +C viscAhgrid<1 +C viscA4grid<1 +C viscAhgridmin<<1 +C viscA4gridmin<<1 + +C !USES: + IMPLICIT NONE + +C == Global variables == +#include "SIZE.h" +#include "GRID.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "MOM_VISC.h" +#ifdef ALLOW_AUTODIFF_TAMC +#include "tamc.h" +#endif /* ALLOW_AUTODIFF_TAMC */ + +C !INPUT/OUTPUT PARAMETERS: +C myThid :: my thread Id number + INTEGER bi,bj,k + _RL viscAh_Z(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscAh_D(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_Z(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_D(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL hDiv(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL vort3(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL tension(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL strain(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL stretching(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL KE(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + INTEGER myThid +CEOP + +C !LOCAL VARIABLES: + INTEGER i,j +#ifdef ALLOW_NONHYDROSTATIC + _RL shiftAh, shiftA4 +#endif +#ifdef ALLOW_AUTODIFF_TAMC + INTEGER act1, act2, act3, act4 + INTEGER max1, max2, max3 + INTEGER ikey, lockey_1, lockey_2 +#endif + _RL smag2fac, smag4fac + _RL leith2fac, leith4fac + _RL leithD2fac, leithD4fac + _RL leithQG2fac + _RL viscAhRe_max, viscA4Re_max + _RL Alin, grdVrt, grdDiv, keZpt + _RL deepFac3, deepFac4 + _RL L2, L3, L5, L2rdt, L4rdt, recip_dt + _RL Uscl,U4scl + _RL divDx(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL divDy(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL vrtDx(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL vrtDy(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscAh_ZMax(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscAh_DMax(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_ZMax(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_DMax(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscAh_ZMin(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscAh_DMin(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_ZMin(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_DMin(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscAh_ZLth(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscAh_DLth(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_ZLth(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_DLth(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscAh_ZLthD(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscAh_DLthD(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_ZLthD(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_DLthD(1-OLx:sNx+OLx,1-OLy:sNy+OLy) +#ifdef ALLOW_LEITH_QG + _RL viscAh_ZLthQG(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscAh_DLthQG(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL sqargQG +#endif + _RL viscAh_ZSmg(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscAh_DSmg(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_ZSmg(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL viscA4_DSmg(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL sqargAh, sqargA4, sqargAhD, sqargA4D, sqargSmag + LOGICAL calcLeith, calcSmag, calcLeithQG + +#ifdef ALLOW_AUTODIFF_TAMC + act1 = bi - myBxLo(myThid) + max1 = myBxHi(myThid) - myBxLo(myThid) + 1 + act2 = bj - myByLo(myThid) + max2 = myByHi(myThid) - myByLo(myThid) + 1 + act3 = myThid - 1 + max3 = nTx*nTy + act4 = ikey_dynamics - 1 + ikey = (act1 + 1) + act2*max1 + & + act3*max1*max2 + & + act4*max1*max2*max3 + lockey_1 = (ikey-1)*Nr + k +#endif /* ALLOW_AUTODIFF_TAMC */ + +C-- Set flags which are used in this S/R and elsewhere : +C useVariableVisc, useHarmonicVisc and useBiharmonicVisc +C are now set early on (in S/R SET_PARAMS) + +c IF ( useVariableVisc ) THEN +C---- variable viscosity : + + recip_dt = 1. _d 0 + IF ( deltaTMom.NE.0. ) recip_dt = 1. _d 0/deltaTMom + deepFac3 = deepFac2C(k)*deepFacC(k) + deepFac4 = deepFac2C(k)*deepFac2C(k) + + IF ( useHarmonicVisc .AND. viscAhReMax.NE.0. ) THEN + viscAhRe_max=SQRT(2. _d 0)/viscAhReMax + ELSE + viscAhRe_max=0. _d 0 + ENDIF + + IF ( useBiharmonicVisc .AND. viscA4ReMax.NE.0. ) THEN + viscA4Re_max=0.125 _d 0*SQRT(2. _d 0)/viscA4ReMax + ELSE + viscA4Re_max=0. _d 0 + ENDIF + + calcLeithQG = (viscC2LeithQG.NE.zeroRL) + calcLeith= + & (viscC2leith.NE.0.) + & .OR.(viscC2leithD.NE.0.) + & .OR.(viscC4leith.NE.0.) + & .OR.(viscC4leithD.NE.0.) + & .OR. calcLeithQG + + calcSmag= + & (viscC2smag.NE.0.) + & .OR.(viscC4smag.NE.0.) + + IF (calcSmag) THEN + smag2fac=(viscC2smag/pi)**2 + smag4fac=0.125 _d 0*(viscC4smag/pi)**2 + ELSE + smag2fac=0. _d 0 + smag4fac=0. _d 0 + ENDIF + + IF (calcLeith) THEN + IF (useFullLeith) THEN +C Uses correct calculation for gradients, but might not work on cube sphere + leith2fac =(viscC2leith /pi)**6 + leithD2fac=(viscC2leithD/pi)**6 + leithQG2fac = (viscC2LeithQG/pi)**6 + leith4fac =0.015625 _d 0*(viscC4leith /pi)**6 + leithD4fac=0.015625 _d 0*(viscC4leithD/pi)**6 + ELSE +C Uses approximate gradients, but works on cube sphere. No reason to use this +C unless `useFullLeith` fails for your setup. + leith2fac =(viscC2leith /pi)**3 + leithD2fac=(viscC2leithD/pi)**3 + leithQG2fac = (viscC2LeithQG/pi)**3 + leith4fac =0.125 _d 0*(viscC4leith /pi)**3 + leithD4fac=0.125 _d 0*(viscC4leithD/pi)**3 + ENDIF + ELSE + leith2fac=0. _d 0 + leith4fac=0. _d 0 + leithQG2fac=0. _d 0 + leithD2fac=0. _d 0 + leithD4fac=0. _d 0 + ENDIF + + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx +C- viscosity arrays have been initialised everywhere before calling this S/R +c viscAh_D(i,j) = viscAhD +c viscAh_Z(i,j) = viscAhZ +c viscA4_D(i,j) = viscA4D +c viscA4_Z(i,j) = viscA4Z + + viscAh_DLth(i,j) = 0. _d 0 + viscAh_ZLth(i,j) = 0. _d 0 + viscA4_DLth(i,j) = 0. _d 0 + viscA4_ZLth(i,j) = 0. _d 0 + viscAh_DLthD(i,j)= 0. _d 0 + viscAh_ZLthD(i,j)= 0. _d 0 + viscA4_DLthD(i,j)= 0. _d 0 + viscA4_ZLthD(i,j)= 0. _d 0 +#ifdef ALLOW_LEITH_QG + viscAh_DLthQG(i,j) = 0. _d 0 + viscAh_ZLthQG(i,j) = 0. _d 0 +#endif + + viscAh_DSmg(i,j) = 0. _d 0 + viscAh_ZSmg(i,j) = 0. _d 0 + viscA4_DSmg(i,j) = 0. _d 0 + viscA4_ZSmg(i,j) = 0. _d 0 + ENDDO + ENDDO + +C- Initialise to zero gradient of vorticity and divergence: + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + divDx(i,j) = 0. + divDy(i,j) = 0. + vrtDx(i,j) = 0. + vrtDy(i,j) = 0. + ENDDO + ENDDO + + IF ( calcLeith ) THEN +C-- horizontal gradient of horizontal divergence: +C- gradient in x direction: + IF (useCubedSphereExchange) THEN +C to compute d/dx(hDiv), fill corners with appropriate values: + CALL FILL_CS_CORNER_TR_RL( 1, .FALSE., + & hDiv, bi,bj, myThid ) + ENDIF + DO j=2-OLy,sNy+OLy-1 + DO i=2-OLx,sNx+OLx-1 + divDx(i,j) = (hDiv(i,j)-hDiv(i-1,j)) + & *recip_dxC(i,j,bi,bj)*recip_deepFacC(k) + ENDDO + ENDDO + +C- gradient in y direction: + IF (useCubedSphereExchange) THEN +C to compute d/dy(hDiv), fill corners with appropriate values: + CALL FILL_CS_CORNER_TR_RL( 2, .FALSE., + & hDiv, bi,bj, myThid ) + ENDIF + DO j=2-OLy,sNy+OLy-1 + DO i=2-OLx,sNx+OLx-1 + divDy(i,j) = (hDiv(i,j)-hDiv(i,j-1)) + & *recip_dyC(i,j,bi,bj)*recip_deepFacC(k) + ENDDO + ENDDO + +C-- horizontal gradient of vertical vorticity: +C- gradient in x direction: + DO j=2-OLy,sNy+OLy + DO i=2-OLx,sNx+OLx-1 + vrtDx(i,j) = (vort3(i+1,j)-vort3(i,j)) + & *recip_dxG(i,j,bi,bj)*recip_deepFacC(k) + & *maskS(i,j,k,bi,bj) +#ifdef ALLOW_OBCS + & *maskInS(i,j,bi,bj) +#endif + ENDDO + ENDDO +C- gradient in y direction: + DO j=2-OLy,sNy+OLy-1 + DO i=2-OLx,sNx+OLx + vrtDy(i,j) = (vort3(i,j+1)-vort3(i,j)) + & *recip_dyG(i,j,bi,bj)*recip_deepFacC(k) + & *maskW(i,j,k,bi,bj) +#ifdef ALLOW_OBCS + & *maskInW(i,j,bi,bj) +#endif + ENDDO + ENDDO + +#ifdef ALLOW_LEITH_QG + IF ( calcLeithQG ) THEN +C horizontal gradient of vorticity and vortex stretching: +C In the case of using QG Leith, we want to add a term +C before calculating vector magnitude, so add to the +C values just calculated. +C gradient in x direction: + DO j=2-OLy,sNy+OLy + DO i=2-OLx,sNx+OLx-1 +C Average d/dx of stretching onto V-points to match vrtDX + vrtDx(i,j) = vrtDx(i,j) + & + halfRL*halfRL* + & ( (stretching(i+1,j)-stretching(i,j)) + & *recip_dxC(i+1,j,bi,bj)*recip_deepFacC(k) + & + (stretching(i,j)-stretching(i-1,j)) + & *recip_dxC(i,j,bi,bj)*recip_deepFacC(k) + & + (stretching(i+1,j-1)-stretching(i,j-1)) + & *recip_dxC(i,j-1,bi,bj)*recip_deepFacC(k) + & + (stretching(i,j-1)-stretching(i-1,j-1)) + & *recip_dxC(i-1,j-1,bi,bj)*recip_deepFacC(k) + & )*maskS(i,j,k,bi,bj) +#ifdef ALLOW_OBCS + & *maskInS(i,j,bi,bj) +#endif + ENDDO + ENDDO +C- gradient in y direction: + DO j=2-OLy,sNy+OLy-1 + DO i=2-OLx,sNx+OLx +C Average d/dy of stretching onto U-points to match vrtDy + vrtDy(i,j) = vrtDy(i,j) + & + halfRL*halfRL* + & ( (stretching(i,j+1)-stretching(i,j)) + & *recip_dyC(i,j+1,bi,bj)*recip_deepFacC(k) + & + (stretching(i,j)-stretching(i,j-1)) + & *recip_dyC(i,j,bi,bj)*recip_deepFacC(k) + & + (stretching(i-1,j+1)-stretching(i-1,j)) + & *recip_dyC(i-1,j+1,bi,bj)*recip_deepFacC(k) + & + (stretching(i-1,j)-stretching(i-1,j-1)) + & *recip_dyC(i-1,j,bi,bj)*recip_deepFacC(k) + & )*maskW(i,j,k,bi,bj) +#ifdef ALLOW_OBCS + & *maskInW(i,j,bi,bj) +#endif + ENDDO + ENDDO +C end if calcLeithQG + ENDIF +#endif /* ALLOW_LEITH_QG */ + +C-- end if calcLeith + ENDIF + + DO j=2-OLy,sNy+OLy-1 + DO i=2-OLx,sNx+OLx-1 +CCCCCCCCCCCCCCC Divergence Point CalculationsCCCCCCCCCCCCCCCCCCCC + +#ifdef ALLOW_AUTODIFF_TAMC +# ifndef AUTODIFF_DISABLE_LEITH + lockey_2 = i+OLx + (sNx+2*OLx)*(j+OLy-1) + & + (sNx+2*OLx)*(sNy+2*OLy)*(lockey_1-1) +CADJ STORE viscA4_ZSmg(i,j) +CADJ & = comlev1_mom_ijk_loop , key=lockey_2, byte=isbyte +CADJ STORE viscAh_ZSmg(i,j) +CADJ & = comlev1_mom_ijk_loop , key=lockey_2, byte=isbyte +# endif +#endif /* ALLOW_AUTODIFF_TAMC */ + +C These are (powers of) length scales + L2 = L2_D(i,j,bi,bj)*deepFac2C(k) + L2rdt = 0.25 _d 0*recip_dt*L2 + L3 = L3_D(i,j,bi,bj)*deepFac3 + L4rdt = L4rdt_D(i,j,bi,bj)*deepFac4 + L5 = (L2*L3) + +#ifndef AUTODIFF_DISABLE_REYNOLDS_SCALE +C Velocity Reynolds Scale + IF ( viscAhRe_max.GT.0. .AND. KE(i,j).GT.0. ) THEN + Uscl=SQRT(KE(i,j)*L2)*viscAhRe_max + ELSE + Uscl=0. + ENDIF + IF ( viscA4Re_max.GT.0. .AND. KE(i,j).GT.0. ) THEN + U4scl=SQRT(KE(i,j))*L3*viscA4Re_max + ELSE + U4scl=0. + ENDIF +#endif /* ndef AUTODIFF_DISABLE_REYNOLDS_SCALE */ + +#ifndef AUTODIFF_DISABLE_LEITH + IF (useFullLeith.AND.calcLeith) THEN +C This is the vector magnitude of the vorticity gradient squared + grdVrt=0.25 _d 0*( (vrtDx(i,j+1)*vrtDx(i,j+1) + & + vrtDx(i,j)*vrtDx(i,j) ) + & + (vrtDy(i+1,j)*vrtDy(i+1,j) + & + vrtDy(i,j)*vrtDy(i,j) ) ) + +C This is the vector magnitude of grad (div.v) squared +C Using it in Leith serves to damp instabilities in w. + grdDiv=0.25 _d 0*( (divDx(i+1,j)*divDx(i+1,j) + & + divDx(i,j)*divDx(i,j) ) + & + (divDy(i,j+1)*divDy(i,j+1) + & + divDy(i,j)*divDy(i,j) ) ) + + sqargAh = leith2fac*grdVrt+leithD2fac*grdDiv + sqargA4 = leith4fac*grdVrt+leithD4fac*grdDiv + sqargAhD = leithD2fac*grdDiv + sqargA4D = leithD4fac*grdDiv +#ifdef ALLOW_LEITH_QG + sqargQG = leithQG2fac*(grdVrt+grdDiv) +#endif + +#ifdef ALLOW_AUTODIFF +C Avoid derivative of SQRT(0) + IF (sqargAh .GT.0. _d 0) sqargAh = SQRT(sqargAh) + IF (sqargA4 .GT.0. _d 0) sqargA4 = SQRT(sqargA4) + IF (sqargAhD .GT.0. _d 0) sqargAhD = SQRT(sqargAhD) + IF (sqargA4D .GT.0. _d 0) sqargA4D = SQRT(sqargA4D) +# ifdef ALLOW_LEITH_QG + IF (sqargQG .GT.0. _d 0) sqargQG = SQRT(sqargQG) +# endif +#else /* ALLOW_AUTODIFF */ + sqargAh = SQRT(sqargAh) + sqargA4 = SQRT(sqargA4) + sqargAhD = SQRT(sqargAhD) + sqargA4D = SQRT(sqargA4D) +# ifdef ALLOW_LEITH_QG + sqargQG = SQRT(sqargQG) +# endif +#endif /* ALLOW_AUTODIFF */ + viscAh_DLth(i,j) = sqargAh * L3 + viscA4_DLth(i,j) = sqargA4 * L5 + viscAh_DLthd(i,j)= sqargAhD * L3 + viscA4_DLthd(i,j)= sqargA4D * L5 +#ifdef ALLOW_LEITH_QG + viscAh_DLthQG(i,j)=sqargQG * L3 +#endif + + ELSEIF (calcLeith) THEN +C but this approximation will work on cube (and differs by as much as 4X) + grdVrt=MAX( ABS(vrtDx(i,j+1)), ABS(vrtDx(i,j)) ) + grdVrt=MAX( grdVrt, ABS(vrtDy(i+1,j)) ) + grdVrt=MAX( grdVrt, ABS(vrtDy(i,j)) ) + +C This approximation is good to the same order as above... + grdDiv=MAX( ABS(divDx(i+1,j)), ABS(divDx(i,j)) ) + grdDiv=MAX( grdDiv, ABS(divDy(i,j+1)) ) + grdDiv=MAX( grdDiv, ABS(divDy(i,j)) ) + + viscAh_DLth(i,j)=(leith2fac*grdVrt+(leithD2fac*grdDiv))*L3 + viscA4_DLth(i,j)=(leith4fac*grdVrt+(leithD4fac*grdDiv))*L5 + viscAh_DLthD(i,j)=((leithD2fac*grdDiv))*L3 + viscA4_DLthD(i,j)=((leithD4fac*grdDiv))*L5 +#ifdef ALLOW_LEITH_QG + viscAh_DLthQG(i,j)=leithQG2fac*(grdVrt + grdDiv)*L3 +#endif + + ELSE + viscAh_DLth(i,j)=0. _d 0 + viscA4_DLth(i,j)=0. _d 0 + viscAh_DLthD(i,j)=0. _d 0 + viscA4_DLthD(i,j)=0. _d 0 +#ifdef ALLOW_LEITH_QG + viscAh_DLthQG(i,j)=0. _d 0 +#endif + ENDIF + + IF (calcSmag) THEN + sqargSmag = tension(i,j)**2 + & +0.25 _d 0*(strain(i+1, j )**2+strain( i ,j+1)**2 + & +strain(i , j )**2+strain(i+1,j+1)**2) +#ifdef ALLOW_AUTODIFF +C Avoid derivative of SQRT(0) + IF (sqargSmag.GT.0. _d 0) sqargSmag = SQRT(sqargSmag) +#else + sqargSmag = SQRT(sqargSmag) +#endif + viscAh_DSmg(i,j)=L2*sqargSmag + viscA4_DSmg(i,j)=smag4fac*L2*viscAh_DSmg(i,j) + viscAh_DSmg(i,j)=smag2fac*viscAh_DSmg(i,j) + ELSE + viscAh_DSmg(i,j)=0. _d 0 + viscA4_DSmg(i,j)=0. _d 0 + ENDIF +#endif /* AUTODIFF_DISABLE_LEITH */ + +C Harmonic on Div.u points + Alin=viscAhD+viscAhGrid*L2rdt + & + viscAh_DLth(i,j)+viscAh_DSmg(i,j) +#ifdef ALLOW_LEITH_QG + & + viscAh_DLthQG(i,j) +#endif +#ifdef ALLOW_3D_VISCAH + & + viscAhDfld(i,j,k,bi,bj) +# ifdef AUTODIFF_ALLOW_VISCFACADJ + & *viscFacAdj +# endif /* AUTODIFF_ALLOW_VISCFACADJ */ +#endif /* ALLOW_3D_VISCAH */ + viscAh_DMin(i,j)=MAX(viscAhGridMin*L2rdt,Uscl) + viscAh_D(i,j)=MAX(viscAh_DMin(i,j),Alin) + viscAh_DMax(i,j)=MIN(viscAhGridMax*L2rdt,viscAhMax) + viscAh_D(i,j)=MIN(viscAh_DMax(i,j),viscAh_D(i,j)) + + if ( (yC(i,j,bi,bj).GE.33.) .AND. + & (yC(i,j,bi,bj).LE.39.) .AND. + & (xC(i,j,bi,bj).GE.-7.) .AND. + & (xC(i,j,bi,bj).LE.-2.) + & ) then + viscAh_D(i,j)=10. _d 0 * viscAh_D(i,j) + endif + +C BiHarmonic on Div.u points + Alin=viscA4D+viscA4Grid*L4rdt + & + viscA4_DLth(i,j)+viscA4_DSmg(i,j) +#ifdef ALLOW_3D_VISCA4 + & + viscA4Dfld(i,j,k,bi,bj) +# ifdef AUTODIFF_ALLOW_VISCFACADJ + & *viscFacAdj +# endif /* AUTODIFF_ALLOW_VISCFACADJ */ +#endif /* ALLOW_3D_VISCA4 */ + viscA4_DMin(i,j)=MAX(viscA4GridMin*L4rdt,U4scl) + viscA4_D(i,j)=MAX(viscA4_DMin(i,j),Alin) + viscA4_DMax(i,j)=MIN(viscA4GridMax*L4rdt,viscA4Max) + viscA4_D(i,j)=MIN(viscA4_DMax(i,j),viscA4_D(i,j)) + +CCCCCCCCCCCCC Vorticity Point CalculationsCCCCCCCCCCCCCCCCCC +C These are (powers of) length scales + L2 = L2_Z(i,j,bi,bj)*deepFac2C(k) + L2rdt = 0.25 _d 0*recip_dt*L2 + L3 = L3_Z(i,j,bi,bj)*deepFac3 + L4rdt = L4rdt_Z(i,j,bi,bj)*deepFac4 + L5 = (L2*L3) + +#ifndef AUTODIFF_DISABLE_REYNOLDS_SCALE +C Velocity Reynolds Scale (Pb here at CS-grid corners !) + IF ( viscAhRe_max.GT.0. .OR. viscA4Re_max.GT.0. ) THEN + keZpt=0.25 _d 0*( (KE(i,j)+KE(i-1,j-1)) + & +(KE(i-1,j)+KE(i,j-1)) ) + IF ( keZpt.GT.0. ) THEN + Uscl = SQRT(keZpt*L2)*viscAhRe_max + U4scl= SQRT(keZpt)*L3*viscA4Re_max + ELSE + Uscl =0. + U4scl=0. + ENDIF + ELSE + Uscl =0. + U4scl=0. + ENDIF +#endif /* ndef AUTODIFF_DISABLE_REYNOLDS_SCALE */ + +#ifndef AUTODIFF_DISABLE_LEITH +C This is the vector magnitude of the vorticity gradient squared + IF (useFullLeith.AND.calcLeith) THEN + grdVrt=0.25 _d 0*( (vrtDx(i-1,j)*vrtDx(i-1,j) + & + vrtDx(i,j)*vrtDx(i,j) ) + & + (vrtDy(i,j-1)*vrtDy(i,j-1) + & + vrtDy(i,j)*vrtDy(i,j) ) ) + +C This is the vector magnitude of grad(div.v) squared + grdDiv=0.25 _d 0*( (divDx(i,j-1)*divDx(i,j-1) + & + divDx(i,j)*divDx(i,j) ) + & + (divDy(i-1,j)*divDy(i-1,j) + & + divDy(i,j)*divDy(i,j) ) ) + + sqargAh = leith2fac*grdVrt+leithD2fac*grdDiv + sqargA4 = leith4fac*grdVrt+leithD4fac*grdDiv + sqargAhD = leithD2fac*grdDiv + sqargA4D = leithD4fac*grdDiv +#ifdef ALLOW_LEITH_QG + sqargQG = leithQG2fac*(grdVrt+grdDiv) +#endif +#ifdef ALLOW_AUTODIFF +C Avoid derivative of SQRT(0) + IF (sqargAh .GT.0. _d 0) sqargAh = SQRT(sqargAh) + IF (sqargA4 .GT.0. _d 0) sqargA4 = SQRT(sqargA4) + IF (sqargAhD .GT.0. _d 0) sqargAhD = SQRT(sqargAhD) + IF (sqargA4D .GT.0. _d 0) sqargA4D = SQRT(sqargA4D) +# ifdef ALLOW_LEITH_QG + IF (sqargQG .GT.0. _d 0) sqargQG = SQRT(sqargQG) +# endif +#else /* ALLOW_AUTODIFF */ + sqargAh = SQRT(sqargAh) + sqargA4 = SQRT(sqargA4) + sqargAhD = SQRT(sqargAhD) + sqargA4D = SQRT(sqargA4D) +# ifdef ALLOW_LEITH_QG + sqargQG = SQRT(sqargQG) +# endif +#endif /* ALLOW_AUTODIFF */ + viscAh_ZLth(i,j) = sqargAh * L3 + viscA4_ZLth(i,j) = sqargA4 * L5 + viscAh_ZLthd(i,j)= sqargAhD * L3 + viscA4_ZLthd(i,j)= sqargA4D * L5 +#ifdef ALLOW_LEITH_QG + viscAh_ZLthQG(i,j)=sqargQG * L3 +#endif + + ELSEIF (calcLeith) THEN +C but this approximation will work on cube (and differs by 4X) + grdVrt=MAX( ABS(vrtDx(i-1,j)), ABS(vrtDx(i,j)) ) + grdVrt=MAX( grdVrt, ABS(vrtDy(i,j-1)) ) + grdVrt=MAX( grdVrt, ABS(vrtDy(i,j)) ) + + grdDiv=MAX( ABS(divDx(i,j)), ABS(divDx(i,j-1)) ) + grdDiv=MAX( grdDiv, ABS(divDy(i,j)) ) + grdDiv=MAX( grdDiv, ABS(divDy(i-1,j)) ) + + viscAh_ZLth(i,j)=(leith2fac*grdVrt+(leithD2fac*grdDiv))*L3 + viscA4_ZLth(i,j)=(leith4fac*grdVrt+(leithD4fac*grdDiv))*L5 + viscAh_ZLthD(i,j)=(leithD2fac*grdDiv)*L3 + viscA4_ZLthD(i,j)=(leithD4fac*grdDiv)*L5 +#ifdef ALLOW_LEITH_QG + viscAh_ZLthQG(i,j)=leithQG2fac*(grdVrt + grdDiv)*L3 +#endif + ELSE + viscAh_ZLth(i,j)=0. _d 0 + viscA4_ZLth(i,j)=0. _d 0 + viscAh_ZLthD(i,j)=0. _d 0 + viscA4_ZLthD(i,j)=0. _d 0 +#ifdef ALLOW_LEITH_QG + viscAh_ZLthQG(i,j)=0. _d 0 +#endif + ENDIF + + IF (calcSmag) THEN + sqargSmag = strain(i,j)**2 + & +0.25 _d 0*(tension( i , j )**2+tension( i ,j-1)**2 + & +tension(i-1, j )**2+tension(i-1,j-1)**2) +#ifdef ALLOW_AUTODIFF +C Avoid derivative of SQRT(0) + IF (sqargSmag.GT.0. _d 0) sqargSmag = SQRT(sqargSmag) +#else + sqargSmag = SQRT(sqargSmag) +#endif + viscAh_ZSmg(i,j)=L2*sqargSmag + viscA4_ZSmg(i,j)=smag4fac*L2*viscAh_ZSmg(i,j) + viscAh_ZSmg(i,j)=smag2fac*viscAh_ZSmg(i,j) + ENDIF +#endif /* AUTODIFF_DISABLE_LEITH */ + +C Harmonic on Zeta points + Alin=viscAhZ+viscAhGrid*L2rdt + & + viscAh_ZLth(i,j)+viscAh_ZSmg(i,j) +#ifdef ALLOW_LEITH_QG + & + viscAh_ZLthQG(i,j) +#endif +#ifdef ALLOW_3D_VISCAH + & + viscAhZfld(i,j,k,bi,bj) +# ifdef AUTODIFF_ALLOW_VISCFACADJ + & *viscFacAdj +# endif /* AUTODIFF_ALLOW_VISCFACADJ */ +#endif + viscAh_ZMin(i,j)=MAX(viscAhGridMin*L2rdt,Uscl) + viscAh_Z(i,j)=MAX(viscAh_ZMin(i,j),Alin) + viscAh_ZMax(i,j)=MIN(viscAhGridMax*L2rdt,viscAhMax) + viscAh_Z(i,j)=MIN(viscAh_ZMax(i,j),viscAh_Z(i,j)) + + if ( (yG(i,j,bi,bj).GE.33.) .AND. + & (yG(i,j,bi,bj).LE.39.) .AND. + & (xG(i,j,bi,bj).GE.-7.) .AND. + & (xG(i,j,bi,bj).LE.-2.) + & ) then + viscAh_Z(i,j)=10. _d 0 * viscAh_Z(i,j) + endif + +C BiHarmonic on Zeta points + Alin=viscA4Z+viscA4Grid*L4rdt + & + viscA4_ZLth(i,j)+viscA4_ZSmg(i,j) +#ifdef ALLOW_3D_VISCA4 + & + viscA4Zfld(i,j,k,bi,bj) +# ifdef AUTODIFF_ALLOW_VISCFACADJ + & *viscFacAdj +# endif /* AUTODIFF_ALLOW_VISCFACADJ */ +#endif + viscA4_ZMin(i,j)=MAX(viscA4GridMin*L4rdt,U4scl) + viscA4_Z(i,j)=MAX(viscA4_ZMin(i,j),Alin) + viscA4_ZMax(i,j)=MIN(viscA4GridMax*L4rdt,viscA4Max) + viscA4_Z(i,j)=MIN(viscA4_ZMax(i,j),viscA4_Z(i,j)) + ENDDO + ENDDO + +#ifdef ALLOW_NONHYDROSTATIC + IF ( nonHydrostatic ) THEN +C-- Pass Viscosities to calc_gw (if constant, not necessary) + + IF ( k.LT.Nr ) THEN +C Prepare for next level (next call) + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + viscAh_W(i,j,k+1,bi,bj) = halfRL*viscAh_D(i,j) + viscA4_W(i,j,k+1,bi,bj) = halfRL*viscA4_D(i,j) + ENDDO + ENDDO + ENDIF + + shiftAh = viscAhW - viscAhD + shiftA4 = viscA4W - viscA4D + IF ( k.EQ.1 ) THEN +C These values dont get used + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + viscAh_W(i,j,k,bi,bj) = shiftAh + viscAh_D(i,j) + viscA4_W(i,j,k,bi,bj) = shiftA4 + viscA4_D(i,j) + ENDDO + ENDDO + ELSE +C Note that previous call of this function has already added half. + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + viscAh_W(i,j,k,bi,bj) = shiftAh + viscAh_W(i,j,k,bi,bj) + & + halfRL*viscAh_D(i,j) + viscA4_W(i,j,k,bi,bj) = shiftA4 + viscA4_W(i,j,k,bi,bj) + & + halfRL*viscA4_D(i,j) + ENDDO + ENDDO + ENDIF + + ENDIF +#endif /* ALLOW_NONHYDROSTATIC */ + +c ELSE +C---- use constant viscosity (useVariableVisc=F): +c DO j=1-OLy,sNy+OLy +c DO i=1-OLx,sNx+OLx +c viscAh_D(i,j) = viscAhD +c viscAh_Z(i,j) = viscAhZ +c viscA4_D(i,j) = viscA4D +c viscA4_Z(i,j) = viscA4Z +c ENDDO +c ENDDO +C---- variable/constant viscosity : end if/else block +c ENDIF + +#ifdef ALLOW_DIAGNOSTICS + IF (useDiagnostics) THEN + CALL DIAGNOSTICS_FILL(viscAh_D,'VISCAHD ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_D,'VISCA4D ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscAh_Z,'VISCAHZ ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_Z,'VISCA4Z ',k,1,2,bi,bj,myThid) + + CALL DIAGNOSTICS_FILL(viscAh_DMax,'VAHDMAX ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_DMax,'VA4DMAX ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscAh_ZMax,'VAHZMAX ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_ZMax,'VA4ZMAX ',k,1,2,bi,bj,myThid) + + CALL DIAGNOSTICS_FILL(viscAh_DMin,'VAHDMIN ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_DMin,'VA4DMIN ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscAh_ZMin,'VAHZMIN ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_ZMin,'VA4ZMIN ',k,1,2,bi,bj,myThid) + + CALL DIAGNOSTICS_FILL(viscAh_DLth,'VAHDLTH ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_DLth,'VA4DLTH ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscAh_ZLth,'VAHZLTH ',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_ZLth,'VA4ZLTH ',k,1,2,bi,bj,myThid) + + CALL DIAGNOSTICS_FILL(viscAh_DLthD,'VAHDLTHD', + & k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_DLthD,'VA4DLTHD', + & k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscAh_ZLthD,'VAHZLTHD', + & k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_ZLthD,'VA4ZLTHD', + & k,1,2,bi,bj,myThid) +#ifdef ALLOW_LEITH_QG + CALL DIAGNOSTICS_FILL(viscAh_DLthQG,'VAHDLTHQ', + & k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscAh_ZLthQG,'VAHZLTHQ', + & k,1,2,bi,bj,myThid) +#endif + CALL DIAGNOSTICS_FILL(viscAh_DSmg,'VAHDSMAG',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_DSmg,'VA4DSMAG',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscAh_ZSmg,'VAHZSMAG',k,1,2,bi,bj,myThid) + CALL DIAGNOSTICS_FILL(viscA4_ZSmg,'VA4ZSMAG',k,1,2,bi,bj,myThid) + ENDIF +#endif /* ALLOW_DIAGNOSTICS */ + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/packages.conf b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/packages.conf new file mode 100644 index 0000000..84736b6 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/packages.conf @@ -0,0 +1,8 @@ +gfd +exch2 +diagnostics +ggl90 +gmredi +salt_plume +seaice +shelfice diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_advdiff.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_advdiff.F new file mode 100644 index 0000000..de41a95 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_advdiff.F @@ -0,0 +1,771 @@ +#include "SEAICE_OPTIONS.h" +#ifdef ALLOW_AUTODIFF +# include "AUTODIFF_OPTIONS.h" +#endif + +CBOP +C !ROUTINE: SEAICE_ADVDIFF + +C !INTERFACE: ========================================================== + SUBROUTINE SEAICE_ADVDIFF( + U uc, vc, + I myTime, myIter, myThid ) + +C !DESCRIPTION: \bv +C *===========================================================* +C | SUBROUTINE SEAICE_ADVDIFF +C | o driver for different advection routines +C | calls an adaption of gad_advection to call different +C | advection routines of pkg/generic_advdiff +C *===========================================================* +C \ev + +C !USES: =============================================================== + IMPLICIT NONE + +C === Global variables === +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "GRID.h" +#include "SEAICE_SIZE.h" +#include "SEAICE_PARAMS.h" +#include "SEAICE.h" +#include "SEAICE_TRACER.h" +#ifdef HACK_FOR_GMAO_CPL +# include "SEAICE_LAYERS.h" +#endif +#ifdef ALLOW_AUTODIFF_TAMC +# include "tamc.h" +#endif + +C !INPUT/OUTPUT PARAMETERS: =================================================== +C === Routine arguments === +C uc/vc :: current ice velocity on C-grid; +C :: C-Grid : Input only ; B-grid : Output only +C myTime :: current time in simulation +C myIter :: current iteration number in simulation +C myThid :: my Thread Id number + _RL uc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL vc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL myTime + INTEGER myIter + INTEGER myThid + +C !LOCAL VARIABLES: ==================================================== +C === Local variables === +C i,j,bi,bj :: Loop counters +C it :: Loop counter for ice thickness categories +C uTrans :: volume transport, x direction +C vTrans :: volume transport, y direction +C afx :: horizontal advective flux, x direction +C afy :: horizontal advective flux, y direction +C gFld :: tendency of seaice field +C xA,yA :: "areas" of X and Y face of tracer cells + INTEGER i, j, bi, bj +#ifdef SEAICE_ITD + INTEGER it +#endif /* SEAICE_ITD */ +#ifdef HACK_FOR_GMAO_CPL + INTEGER l, n +#endif /* HACK_FOR_GMAO_CPL */ +#ifdef ALLOW_AUTODIFF_TAMC + INTEGER itmpkey +#endif /* ALLOW_AUTODIFF_TAMC */ +#ifdef ALLOW_SITRACER + _RL hEffNm1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL areaNm1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + INTEGER iTr, SEAICEadvSchSItr + _RL SEAICEdiffKhSItr + _RL SItrExt (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL tmpscal1, tmpscal2 +# ifdef ALLOW_SITRACER_ADVCAP + _RL SItrPrev (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) +# endif +# ifdef ALLOW_SITRACER_DEBUG_DIAG + _RL DIAGarray (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) +# endif +#endif /* ALLOW_SITRACER */ + _RL fldNm1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL uTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL vTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL afx (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL afy (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL gFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RS xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RS yA (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL recip_heff(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + CHARACTER*(MAX_LEN_MBUF) msgBuf +CEOP +#ifdef HACK_FOR_GMAO_CPL + INTEGER SEAICEadvSchQice, SEAICEadvSchQsnow + INTEGER SEAICEadvSchMltPd + SEAICEadvSchQice = 0 + SEAICEadvSchQsnow = 0 + SEAICEadvSchMltPd = 0 + SEAICEadvSchQice = SEAICEadvSchHeff + SEAICEadvSchQsnow = SEAICEadvSchSnow +c SEAICEadvSchMltPd = SEAICEadvSchSnow +#endif /* HACK_FOR_GMAO_CPL */ + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + +C-- make a local copy of the velocities for compatibility with B-grid +C-- alternatively interpolate to C-points if necessary + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) +#ifndef SEAICE_CGRID /* not SEAICE_CGRID = BGRID */ +C-- hack to ensure backward compatibility: +C average B-grid seaice velocity to C-grid + DO j=1-OLy,sNy+OLy-1 + DO i=1-OLx,sNx+OLx-1 + uc(i,j,bi,bj)=.5 _d 0*(UICE(i,j,bi,bj)+UICE(i,j+1,bi,bj)) + vc(i,j,bi,bj)=.5 _d 0*(VICE(i,j,bi,bj)+VICE(i+1,j,bi,bj)) + ENDDO + ENDDO +#endif /* SEAICE_CGRID */ +C- compute cell areas used by all tracers + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + xA(i,j,bi,bj) = _dyG(i,j,bi,bj)*SIMaskU(i,j,bi,bj) + yA(i,j,bi,bj) = _dxG(i,j,bi,bj)*SIMaskV(i,j,bi,bj) + ENDDO + ENDDO + ENDDO + ENDDO + +#ifndef SEAICE_CGRID +C Do we need this? I am afraid so. + CALL EXCH_UV_XY_RL(uc,vc,.TRUE.,myThid) +#endif /* not SEAICE_CGRID */ + +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE uc = comlev1, key = ikey_dynamics, kind=isbyte +CADJ STORE vc = comlev1, key = ikey_dynamics, kind=isbyte +#endif /* ALLOW_AUTODIFF_TAMC */ + + IF ( SEAICEmultiDimAdvection ) THEN +#ifdef ALLOW_GENERIC_ADVDIFF + + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) +C--- loops on tile indices bi,bj + +#ifdef ALLOW_AUTODIFF_TAMC +C Initialise for TAF + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + gFld(i,j) = 0. _d 0 + ENDDO + ENDDO +C + act1 = bi - myBxLo(myThid) + max1 = myBxHi(myThid) - myBxLo(myThid) + 1 + act2 = bj - myByLo(myThid) + max2 = myByHi(myThid) - myByLo(myThid) + 1 + act3 = myThid - 1 + max3 = nTx*nTy + act4 = ikey_dynamics - 1 + itmpkey = (act1 + 1) + act2*max1 + & + act3*max1*max2 + & + act4*max1*max2*max3 +CADJ STORE area(:,:,bi,bj) = comlev1_bibj, key=itmpkey, kind=isbyte +CADJ STORE heff(:,:,bi,bj) = comlev1_bibj, key=itmpkey, kind=isbyte +CADJ STORE hsnow(:,:,bi,bj) = comlev1_bibj, key=itmpkey, kind=isbyte +# ifdef SEAICE_VARIABLE_SALINITY +CADJ STORE hsalt(:,:,bi,bj) = comlev1_bibj, key=itmpkey, kind=isbyte +# endif +#endif /* ALLOW_AUTODIFF_TAMC */ + + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx +#ifdef ALLOW_SITRACER + hEffNm1(i,j,bi,bj) = HEFF(i,j,bi,bj) + areaNm1(i,j,bi,bj) = AREA(i,j,bi,bj) +#endif + recip_heff(i,j) = 1. _d 0 + ENDDO + ENDDO + +C- Calculate "volume transports" through tracer cell faces. + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + uTrans(i,j) = uc(i,j,bi,bj)*xA(i,j,bi,bj) + vTrans(i,j) = vc(i,j,bi,bj)*yA(i,j,bi,bj) + ENDDO + ENDDO + +#ifdef SEAICE_ITD +C-- Effective Thickness (Volume) + IF ( SEAICEadvHeff ) THEN + DO it=1,SEAICE_multDim + CALL SEAICE_ADVECTION( + I GAD_HEFF, SEAICEadvSchHeff, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), + I uTrans, vTrans, HEFFITD(1-OLx,1-OLy,it,bi,bj), + I recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) +C- Add tendency due to diffusion + IF ( SEAICEdiffKhHeff .GT. 0. _d 0 ) + & CALL SEAICE_DIFFUSION( + I GAD_HEFF, SEAICEdiffKhHeff, ONE, + I HEFFITD(1-OLx,1-OLy,it,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) +C now do the "explicit" time step + DO j=1,sNy + DO i=1,sNx + HEFFITD(i,j,it,bi,bj) = HEFFM(i,j,bi,bj) * ( + & HEFFITD(i,j,it,bi,bj) + SEAICE_deltaTtherm * gFld(i,j) + & ) + ENDDO + ENDDO + ENDDO + ENDIF + +C-- Fractional area + IF ( SEAICEadvArea ) THEN + DO it=1,SEAICE_multDim + CALL SEAICE_ADVECTION( + I GAD_AREA, SEAICEadvSchArea, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), + I uTrans, vTrans, AREAITD(1-OLx,1-OLy,it,bi,bj), + I recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) +C- Add tendency due to diffusion + IF ( SEAICEdiffKhArea .GT. 0. _d 0 ) + & CALL SEAICE_DIFFUSION( + I GAD_AREA, SEAICEdiffKhArea, ONE, + I AREAITD(1-OLx,1-OLy,it,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) +C now do the "explicit" time step + DO j=1,sNy + DO i=1,sNx + AREAITD(i,j,it,bi,bj) = HEFFM(i,j,bi,bj) * ( + & AREAITD(i,j,it,bi,bj) + SEAICE_deltaTtherm * gFld(i,j) + & ) + ENDDO + ENDDO + ENDDO +C open water fraction needs to be advected for the ridging scheme + CALL SEAICE_ADVECTION( + I GAD_AREA, SEAICEadvSchArea, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), + I uTrans, vTrans, opnWtrFrac(1-OLx,1-OLy,bi,bj), recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) +C-- Add tendency due to diffusion + IF ( SEAICEdiffKhArea .GT. 0. _d 0 ) + & CALL SEAICE_DIFFUSION( + I GAD_AREA, SEAICEdiffKhArea, ONE, + I opnWtrFrac(1-OLx,1-OLy,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) +C now do the "explicit" time step + DO j=1,sNy + DO i=1,sNx + opnWtrFrac(i,j,bi,bj) = HEFFM(i,j,bi,bj) * ( + & opnWtrFrac(i,j,bi,bj) + SEAICE_deltaTtherm * gFld(i,j) + & ) + ENDDO + ENDDO + ENDIF + +C-- Effective Snow Thickness (Volume) + IF ( SEAICEadvSnow ) THEN + DO it=1,SEAICE_multDim + CALL SEAICE_ADVECTION( + I GAD_SNOW, SEAICEadvSchSnow, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), + I uTrans, vTrans, HSNOWITD(1-OLx,1-OLy,it,bi,bj), + I recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) +C-- Add tendency due to diffusion + IF ( SEAICEdiffKhSnow .GT. 0. _d 0 ) + & CALL SEAICE_DIFFUSION( + I GAD_SNOW, SEAICEdiffKhSnow, ONE, + I HSNOWITD(1-OLx,1-OLy,it,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) +C now do the "explicit" time step + DO j=1,sNy + DO i=1,sNx + HSNOWITD(i,j,it,bi,bj) = HEFFM(i,j,bi,bj) * ( + & HSNOWITD(i,j,it,bi,bj) + SEAICE_deltaTtherm*gFld(i,j) + & ) + ENDDO + ENDDO + ENDDO + ENDIF + +#ifdef HACK_FOR_GMAO_CPL + IF ( SEAICEadvSchQice.NE.0 ) THEN + DO n=1,SEAICE_multDim + DO l=1,nIceLayers + CALL SEAICE_ADVECTION( + I GAD_QICE1, SEAICEadvSchQice, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), uTrans, + I vTrans, SIqIce(1-OLx,1-OLy,l,n,bi,bj), recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) + IF ( SEAICEdiffKhHeff .GT. 0. _d 0 ) THEN +C- Add tendency due to diffusion + CALL SEAICE_DIFFUSION( + I GAD_QICE1, SEAICEdiffKhHeff, oneRL, + I SIqIce(1-OLx,1-OLy,l,n,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) + ENDIF +C now do the "explicit" time step + DO j=1,sNy + DO i=1,sNx + SIqIce(i,j,l,n,bi,bj) = ( SIqIce(i,j,l,n,bi,bj) + & + SEAICE_deltaTtherm * gFld(i,j) + & ) * HEFFM(i,j,bi,bj) + ENDDO + ENDDO + ENDDO + ENDDO + ENDIF +C-- + IF ( SEAICEadvSchQsnow.NE.0 ) THEN + DO n=1,SEAICE_multDim + DO l=1,nSnowLayers + CALL SEAICE_ADVECTION( + I GAD_QICE2, SEAICEadvSchQsnow, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), uTrans, + I vTrans, SIqSnow(1-OLx,1-OLy,l,n,bi,bj), recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) + IF ( SEAICEdiffKhSnow .GT. 0. _d 0 ) THEN +C- Add tendency due to diffusion + CALL SEAICE_DIFFUSION( + I GAD_QICE2, SEAICEdiffKhSnow, oneRL, + I SIqSnow(1-OLx,1-OLy,l,n,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) + ENDIF +C now do the "explicit" time step + DO j=1,sNy + DO i=1,sNx + SIqSnow(i,j,l,n,bi,bj) = ( SIqSnow(i,j,l,n,bi,bj) + & + SEAICE_deltaTtherm * gFld(i,j) + & ) * HEFFM(i,j,bi,bj) + ENDDO + ENDDO + ENDDO + ENDDO + ENDIF +C-- + IF ( SEAICEadvSchMltPd.NE.0 ) THEN + DO n=1,SEAICE_multDim + CALL SEAICE_ADVECTION( + I GAD_QICE2, SEAICEadvSchMltPd, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), uTrans, + I vTrans, SImeltPd(1-OLx,1-OLy,n,bi,bj), recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) + IF ( SEAICEdiffKhSnow .GT. 0. _d 0 ) THEN +C- Add tendency due to diffusion + CALL SEAICE_DIFFUSION( + I GAD_QICE2, SEAICEdiffKhSnow, oneRL, + I SImeltPd(1-OLx,1-OLy,n,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) + ENDIF +C now do the "explicit" time step + DO j=1,sNy + DO i=1,sNx + SImeltPd(i,j,n,bi,bj) = ( SImeltPd(i,j,n,bi,bj) + & + SEAICE_deltaTtherm * gFld(i,j) + & ) * HEFFM(i,j,bi,bj) + ENDDO + ENDDO + ENDDO + ENDIF +#endif /* HACK_FOR_GMAO_CPL */ + +C update mean ice thickness HEFF and total ice concentration AREA +C to match single category values +C (necessary here because updated HEFF is used below for SItracer) + CALL SEAICE_ITD_SUM(bi, bj, myTime, myIter, myThid) + +#else /* not SEAICE_ITD */ +C-- Effective Thickness (Volume) + IF ( SEAICEadvHeff ) THEN + CALL SEAICE_ADVECTION( + I GAD_HEFF, SEAICEadvSchHeff, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), + I uTrans, vTrans, HEFF(1-OLx,1-OLy,bi,bj), recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) + IF ( SEAICEdiffKhHeff .GT. 0. _d 0 ) THEN +C- Add tendency due to diffusion + CALL SEAICE_DIFFUSION( + I GAD_HEFF, SEAICEdiffKhHeff, ONE, + I HEFF(1-OLx,1-OLy,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) + ENDIF +C now do the "explicit" time step + DO j=1,sNy + DO i=1,sNx + HEFF(i,j,bi,bj) = HEFFM(i,j,bi,bj) * ( + & HEFF(i,j,bi,bj) + SEAICE_deltaTtherm * gFld(i,j) + & ) + ENDDO + ENDDO + ENDIF + +C-- Fractional area + IF ( SEAICEadvArea ) THEN + CALL SEAICE_ADVECTION( + I GAD_AREA, SEAICEadvSchArea, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), + I uTrans, vTrans, AREA(1-OLx,1-OLy,bi,bj), recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) + IF ( SEAICEdiffKhArea .GT. 0. _d 0 ) THEN +C- Add tendency due to diffusion + CALL SEAICE_DIFFUSION( + I GAD_AREA, SEAICEdiffKhArea, ONE, + I AREA(1-OLx,1-OLy,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) + ENDIF +C now do the "explicit" time step + DO j=1,sNy + DO i=1,sNx + AREA(i,j,bi,bj) = HEFFM(i,j,bi,bj) * ( + & AREA(i,j,bi,bj) + SEAICE_deltaTtherm * gFld(i,j) + & ) + ENDDO + ENDDO + ENDIF + +C-- Effective Snow Thickness (Volume) + IF ( SEAICEadvSnow ) THEN + CALL SEAICE_ADVECTION( + I GAD_SNOW, SEAICEadvSchSnow, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), + I uTrans, vTrans, HSNOW(1-OLx,1-OLy,bi,bj), recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) + IF ( SEAICEdiffKhSnow .GT. 0. _d 0 ) THEN +C-- Add tendency due to diffusion + CALL SEAICE_DIFFUSION( + I GAD_SNOW, SEAICEdiffKhSnow, ONE, + I HSNOW(1-OLx,1-OLy,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) + ENDIF +C now do the "explicit" time step + DO j=1,sNy + DO i=1,sNx + HSNOW(i,j,bi,bj) = HEFFM(i,j,bi,bj) * ( + & HSNOW(i,j,bi,bj) + SEAICE_deltaTtherm * gFld(i,j) + & ) + ENDDO + ENDDO + ENDIF +#endif /* SEAICE_ITD */ + +#ifdef SEAICE_VARIABLE_SALINITY +C-- Effective Sea Ice Salinity (Mass of salt) + IF ( SEAICEadvSalt ) THEN + CALL SEAICE_ADVECTION( + I GAD_SALT, SEAICEadvSchSalt, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), + I uTrans, vTrans, HSALT(1-OLx,1-OLy,bi,bj), recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) + IF ( SEAICEdiffKhSalt .GT. 0. _d 0 ) THEN +C-- Add tendency due to diffusion + CALL SEAICE_DIFFUSION( + I GAD_SALT, SEAICEdiffKhSalt, ONE, + I HSALT(1-OLx,1-OLy,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) + ENDIF +C now do the "explicit" time step + DO j=1,sNy + DO i=1,sNx + HSALT(i,j,bi,bj) = HEFFM(i,j,bi,bj) * ( + & HSALT(i,j,bi,bj) + SEAICE_deltaTtherm * gFld(i,j) + & ) + ENDDO + ENDDO + ENDIF +#endif /* SEAICE_VARIABLE_SALINITY */ + +#ifdef ALLOW_SITRACER +C-- Sea Ice Tracers + DO iTr = 1, SItrNumInUse + IF ( (SEAICEadvHEFF.AND.(SItrMate(iTr).EQ.'HEFF')).OR. + & (SEAICEadvAREA.AND.(SItrMate(iTr).EQ.'AREA')) ) THEN +C-- scale to effective value + IF (SItrMate(iTr).EQ.'HEFF') THEN + SEAICEadvSchSItr=SEAICEadvSchHEFF + SEAICEdiffKhSItr=SEAICEdiffKhHEFF + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SItrExt(i,j,bi,bj) = HEFFM(i,j,bi,bj) * + & SItracer(i,j,bi,bj,iTr) * hEffNm1(i,j,bi,bj) + ENDDO + ENDDO +c TAF? ELSEIF (SItrMate(iTr).EQ.'AREA') THEN + ELSE + SEAICEadvSchSItr=SEAICEadvSchAREA + SEAICEdiffKhSItr=SEAICEdiffKhAREA + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SItrExt(i,j,bi,bj) = HEFFM(i,j,bi,bj) * + & SItracer(i,j,bi,bj,iTr) * areaNm1(i,j,bi,bj) + ENDDO + ENDDO + ENDIF +C-- store a couple things + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx +#ifdef ALLOW_SITRACER_ADVCAP +C-- store previous value for spurious maxima treament + SItrPrev(i,j,bi,bj)=SItracer(i,j,bi,bj,iTr) +#endif +#ifdef ALLOW_SITRACER_DEBUG_DIAG + diagArray(I,J,2+(iTr-1)*5) = SItrExt(i,j,bi,bj) +#endif + ENDDO + ENDDO +C-- compute advective tendency + CALL SEAICE_ADVECTION( + I GAD_SITR+iTr-1, SEAICEadvSchSItr, + I uc(1-OLx,1-OLy,bi,bj), vc(1-OLx,1-OLy,bi,bj), + I uTrans, vTrans, SItrExt(1-OLx,1-OLy,bi,bj), + I recip_heff, + O gFld, afx, afy, + I bi, bj, myTime, myIter, myThid ) + IF ( SEAICEdiffKhHeff .GT. 0. _d 0 ) THEN +C-- add diffusive tendency + CALL SEAICE_DIFFUSION( + I GAD_SITR+iTr-1, SEAICEdiffKhSItr, ONE, + I SItrExt(1-OLx,1-OLy,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U gFld, + I bi, bj, myTime, myIter, myThid ) + ENDIF +C-- apply tendency + DO j=1,sNy + DO i=1,sNx + SItrExt(i,j,bi,bj) = HEFFM(i,j,bi,bj) * ( + & SItrExt(i,j,bi,bj) + SEAICE_deltaTtherm * gFld(i,j) ) + ENDDO + ENDDO +C-- scale back to actual value, or move effective value to ocean bucket + IF (SItrMate(iTr).EQ.'HEFF') THEN + DO j=1,sNy + DO i=1,sNx + if (HEFF(I,J,bi,bj).GE.siEps) then + SItracer(i,j,bi,bj,iTr)=SItrExt(i,j,bi,bj)/HEFF(I,J,bi,bj) + SItrBucket(i,j,bi,bj,iTr)=0. _d 0 + else + SItracer(i,j,bi,bj,iTr)=0. _d 0 + SItrBucket(i,j,bi,bj,iTr)=SItrExt(i,j,bi,bj) + endif +#ifdef ALLOW_SITRACER_ADVCAP +C hack to try avoid 'spontaneous generation' of maxima, which supposedly would +C occur less frequently if we advected SItr with uXheff instead SItrXheff with u + tmpscal1=max(SItrPrev(i,j,bi,bj), + & SItrPrev(i+1,j,bi,bj),SItrPrev(i-1,j,bi,bj), + & SItrPrev(i,j+1,bi,bj),SItrPrev(i,j-1,bi,bj)) + tmpscal2=MAX(ZERO,SItracer(i,j,bi,bj,iTr)-tmpscal1) + SItracer(i,j,bi,bj,iTr)=SItracer(i,j,bi,bj,iTr)-tmpscal2 + SItrBucket(i,j,bi,bj,iTr)=SItrBucket(i,j,bi,bj,iTr) + & +tmpscal2*HEFF(I,J,bi,bj) +#endif +C treat case of potential negative value + if (HEFF(I,J,bi,bj).GE.siEps) then + tmpscal1=MIN(0. _d 0,SItracer(i,j,bi,bj,iTr)) + SItracer(i,j,bi,bj,iTr)=SItracer(i,j,bi,bj,iTr)-tmpscal1 + SItrBucket(i,j,bi,bj,iTr)=SItrBucket(i,j,bi,bj,iTr) + & +HEFF(I,J,bi,bj)*tmpscal1 + endif +#ifdef ALLOW_SITRACER_DEBUG_DIAG + diagArray(I,J,1+(iTr-1)*5)= - SItrBucket(i,j,bi,bj,iTr) + & *HEFFM(I,J,bi,bj)/SEAICE_deltaTtherm*SEAICE_rhoIce + tmpscal1= ( HEFF(I,J,bi,bj)*SItracer(i,j,bi,bj,iTr) + & + SItrBucket(i,j,bi,bj,iTr) )*HEFFM(I,J,bi,bj) + diagArray(I,J,2+(iTr-1)*5)= tmpscal1-diagArray(I,J,2+(iTr-1)*5) + diagArray(I,J,3+(iTr-1)*5)=HEFFM(i,j,bi,bj) * + & SEAICE_deltaTtherm * gFld(i,j) +#endif + ENDDO + ENDDO +c TAF? ELSEIF (SItrMate(iTr).EQ.'AREA') THEN + ELSE + DO j=1,sNy + DO i=1,sNx + if (AREA(I,J,bi,bj).GE.SEAICE_area_floor) then + SItracer(i,j,bi,bj,iTr)=SItrExt(i,j,bi,bj)/AREA(I,J,bi,bj) + else + SItracer(i,j,bi,bj,iTr)=0. _d 0 + endif + SItrBucket(i,j,bi,bj,iTr)=0. _d 0 +#ifdef ALLOW_SITRACER_ADVCAP + tmpscal1=max(SItrPrev(i,j,bi,bj), + & SItrPrev(i+1,j,bi,bj),SItrPrev(i-1,j,bi,bj), + & SItrPrev(i,j+1,bi,bj),SItrPrev(i,j-1,bi,bj)) + tmpscal2=MAX(ZERO,SItracer(i,j,bi,bj,iTr)-tmpscal1) + SItracer(i,j,bi,bj,iTr)=SItracer(i,j,bi,bj,iTr)-tmpscal2 +#endif +C treat case of potential negative value + if (AREA(I,J,bi,bj).GE.SEAICE_area_floor) then + tmpscal1=MIN(0. _d 0,SItracer(i,j,bi,bj,iTr)) + SItracer(i,j,bi,bj,iTr)=SItracer(i,j,bi,bj,iTr)-tmpscal1 + endif +#ifdef ALLOW_SITRACER_DEBUG_DIAG + diagArray(I,J,1+(iTr-1)*5)= 0. _d 0 + diagArray(I,J,2+(iTr-1)*5)= - diagArray(I,J,2+(iTr-1)*5) + & + AREA(I,J,bi,bj)*SItracer(i,j,bi,bj,iTr)*HEFFM(I,J,bi,bj) + diagArray(I,J,3+(iTr-1)*5)=HEFFM(i,j,bi,bj) * + & SEAICE_deltaTtherm * gFld(i,j) +#endif + ENDDO + ENDDO + ENDIF +C-- + ENDIF + ENDDO +#ifdef ALLOW_SITRACER_DEBUG_DIAG +c CALL DIAGNOSTICS_FILL(DIAGarray,'UDIAG2 ',0,Nr,2,bi,bj,myThid) +#endif +#endif /* ALLOW_SITRACER */ + +C--- end bi,bj loops + ENDDO + ENDDO + +#else /* not ALLOW_GENERIC_ADVDIFF */ + WRITE(msgBuf,'(2A)') + & 'SEAICE_ADVDIFF: cannot use SEAICEmultiDimAdvection', + & ' without pkg/generic_advdiff' + CALL PRINT_ERROR( msgBuf , myThid ) + WRITE(msgBuf,'(2A)') 'SEAICE_ADVDIFF: ', + & 'Re-compile with pkg "generic_advdiff" in packages.conf' + CALL PRINT_ERROR( msgBuf , myThid ) + CALL ALL_PROC_DIE( myThid ) + STOP 'ABNORMAL END: S/R SEAICE_ADVDIFF' +#endif /* ALLOW_GENERIC_ADVDIFF */ + ELSE +C-- if not multiDimAdvection +#ifdef SEAICE_ITD +C just for safety + WRITE(msgBuf,'(2A)') 'SEAICE_ADVDIFF: ', + & 'ITD with SEAICEmultiDimAdvection=.False. is not allowed,' + CALL PRINT_ERROR( msgBuf , myThid ) + WRITE(msgBuf,'(2A)') 'SEAICE_ADVDIFF: ', + & 'use a multidimensional advection scheme (in data.seaice)' + CALL PRINT_ERROR( msgBuf , myThid ) + CALL ALL_PROC_DIE( myThid ) + STOP 'ABNORMAL END: S/R SEAICE_ADVDIFF' +#endif /* SEAICE_ITD */ + + IF ( SEAICEadvHEff ) THEN +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE heff = comlev1, key = ikey_dynamics, kind=isbyte +#endif + CALL ADVECT( uc, vc, hEff, fldNm1, HEFFM, myThid ) + IF ( SEAICEdiffKhHeff .GT. 0. _d 0 ) THEN +C- Add tendency due to diffusion + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) + CALL SEAICE_DIFFUSION( + I GAD_HEFF, SEAICEdiffKhHeff, SEAICE_deltaTtherm, + I fldNm1(1-OLx,1-OLy,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U HEFF(1-OLx,1-OLy,bi,bj), + I bi, bj, myTime, myIter, myThid ) + ENDDO + ENDDO + ENDIF + ENDIF + IF ( SEAICEadvArea ) THEN +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE area = comlev1, key = ikey_dynamics, kind=isbyte +#endif + CALL ADVECT( uc, vc, area, fldNm1, HEFFM, myThid ) + IF ( SEAICEdiffKhArea .GT. 0. _d 0 ) THEN +C- Add tendency due to diffusion + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) + CALL SEAICE_DIFFUSION( + I GAD_AREA, SEAICEdiffKhArea, SEAICE_deltaTtherm, + I fldNm1(1-OLx,1-OLy,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U Area(1-OLx,1-OLy,bi,bj), + I bi, bj, myTime, myIter, myThid ) + ENDDO + ENDDO + ENDIF + ENDIF + IF ( SEAICEadvSnow ) THEN +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE hsnow = comlev1, key = ikey_dynamics, kind=isbyte +#endif + CALL ADVECT( uc, vc, HSNOW, fldNm1, HEFFM, myThid ) + IF ( SEAICEdiffKhSnow .GT. 0. _d 0 ) THEN +C- Add tendency due to diffusion + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) + CALL SEAICE_DIFFUSION( + I GAD_SNOW, SEAICEdiffKhSnow, SEAICE_deltaTtherm, + I fldNm1(1-OLx,1-OLy,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U HSNOW(1-OLx,1-OLy,bi,bj), + I bi, bj, myTime, myIter, myThid ) + ENDDO + ENDDO + ENDIF + ENDIF + +#ifdef SEAICE_VARIABLE_SALINITY + IF ( SEAICEadvSalt ) THEN +#ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE hsalt = comlev1, key = ikey_dynamics, kind=isbyte +#endif + CALL ADVECT( uc, vc, HSALT, fldNm1, HEFFM, myThid ) + IF ( SEAICEdiffKhSalt .GT. 0. _d 0 ) THEN +C- Add tendency due to diffusion + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) + CALL SEAICE_DIFFUSION( + I GAD_SALT, SEAICEdiffKhSalt, SEAICE_deltaTtherm, + I fldNm1(1-OLx,1-OLy,bi,bj), HEFFM, + I xA(1-OLx,1-OLy,bi,bj), yA(1-OLx,1-OLy,bi,bj), + U HSALT(1-OLx,1-OLy,bi,bj), + I bi, bj, myTime, myIter, myThid ) + ENDDO + ENDDO + ENDIF + ENDIF +#endif /* SEAICE_VARIABLE_SALINITY */ + +C-- end if multiDimAdvection + ENDIF + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_diag_init_add.h b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_diag_init_add.h new file mode 100644 index 0000000..453b74d --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_diag_init_add.h @@ -0,0 +1,120 @@ + + diagName = 'CPLoWGHT' + diagTitle = 'grid-cell Ocean fraction from GEOS' + diagUnits = '1 ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + +#ifdef SEAICE_ITD + + diagName = 'SItIces ' + diagTitle = 'Surface Temperature over Seaice for each category' + diagUnits = 'K ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) + + diagName = 'SIqIce ' + diagTitle = 'SEAICE enthalpy for each layer and category' + diagUnits = 'J/m^2 ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + numArea = nIceLayers*nITD + CALL DIAGNOSTICS_SETKLEV( diagName, numArea, myThid ) + + diagName = 'SIqSnow ' + diagTitle = 'Snow enthalpy for each layer and category' + diagUnits = 'J/m^2 ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + numArea = nSnowLayers*nITD + CALL DIAGNOSTICS_SETKLEV( diagName, numArea, myThid ) + + diagName = 'SImeltPd' + diagTitle = 'Melt Pond volume for each category' + diagUnits = 'm ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) + + diagName = 'SIiceAge' + diagTitle = 'Seaice Age for each category' + diagUnits = 's ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) + +C- Advection Increment: + diagName = 'SI_dArea' + diagTitle = 'Seaice fraction Advection Increment per cat.' + diagUnits = '1 ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) + + diagName = 'SI_dHeff' + diagTitle = 'Seaice thickness Advection Increment per cat.' + diagUnits = 'm ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) + + diagName = 'SI_dHsnw' + diagTitle = 'Snow thickness Advection Increment per cat.' + diagUnits = 'm ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) + + diagName = 'SI_dTIce' + diagTitle = 'Seaice surf. temp. Advection Increment per cat.' + diagUnits = 'K ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) + + diagName = 'SI_dQIce' + diagTitle = 'Seaice enthalpy Advect. Increment per layer and cat.' + diagUnits = 'J/m^2 ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + numArea = nIceLayers*nITD + CALL DIAGNOSTICS_SETKLEV( diagName, numArea, myThid ) + + diagName = 'SI_dQSnw' + diagTitle = 'Snow enthalpy Advect. Increment per layer and cat.' + diagUnits = 'J/m^2 ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + numArea = nSnowLayers*nITD + CALL DIAGNOSTICS_SETKLEV( diagName, numArea, myThid ) + + diagName = 'SI_dMPnd' + diagTitle = 'Melt Pond volume Advection Increment per cat.' + diagUnits = 'm ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) + + diagName = 'SI_dIcAg' + diagTitle = 'Seaice Age Advection Increment per cat.' + diagUnits = 's ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) + +#endif /* SEAICE_ITD */ diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_diagnostics_init.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_diagnostics_init.F new file mode 100644 index 0000000..d95482b --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_diagnostics_init.F @@ -0,0 +1,838 @@ +#include "SEAICE_OPTIONS.h" + +C-- File seaice_diagnostics_init.F: Routines initialize SEAICE diagnostics +C-- Contents +C-- o SEAICE_DIAGNOSTICS_INIT +C-- o SEAICE_DIAG_SUFX + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +CBOP +C !ROUTINE: SEAICE_DIAGNOSTICS_INIT +C !INTERFACE: + SUBROUTINE SEAICE_DIAGNOSTICS_INIT( myThid ) + +C !DESCRIPTION: \bv +C *==========================================================* +C | SUBROUTINE SEAICE_DIAGNOSTICS_INIT +C | o Routine to initialize list of all available diagnostics +C | for SEAICE package +C *==========================================================* +C \ev +C !USES: + IMPLICIT NONE + +C === Global variables === +#include "EEPARAMS.h" +#include "SIZE.h" +#include "SEAICE_SIZE.h" +#include "SEAICE_PARAMS.h" +#include "SEAICE_TRACER.h" + +C !INPUT/OUTPUT PARAMETERS: +C === Routine arguments === +C myThid :: my Thread Id number + INTEGER myThid +CEOP + +#ifdef ALLOW_DIAGNOSTICS +C !LOCAL VARIABLES: +C === Local variables === +C diagNum :: diagnostics number in the (long) list of available diag. +C diagMate :: diag. mate number in the (long) list of available diag. +C diagName :: local short name (8c) of a diagnostics +C diagCode :: local parser field with characteristics of the diagnostics +C see head of S/R DIAGNOSTICS_INIT_EARLY or DIAGNOSTICS_MAIN_INIT +C for a list of options +C diagUnits :: local string (16c): physical units of a diagnostic field +C diagTitle :: local string (80c): description of field in diagnostic + INTEGER diagNum + INTEGER diagMate + CHARACTER*8 diagName + CHARACTER*16 diagCode + CHARACTER*16 diagUnits + CHARACTER*(80) diagTitle + +#ifdef ALLOW_SITRACER + INTEGER iTr, ilnb, numMateTr, numMateTrPreTh + CHARACTER*8 locUnitTr + CHARACTER*30 locNameTr +#endif + INTEGER numArea,numAreaPreTh,numHeff,numHeffPreTh + CHARACTER*9 flxUnits + CHARACTER*15 locName + CHARACTER*4 SEAICE_DIAG_SUFX, diagSufx + EXTERNAL SEAICE_DIAG_SUFX +C Functions :: + INTEGER ILNBLNK + EXTERNAL ILNBLNK + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + +C=============== state variables ============ + + diagName = 'SIarea ' + diagTitle = 'SEAICE fractional ice-covered area [0 to 1]' + diagUnits = 'm^2/m^2 ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + numArea = diagNum + + diagName = 'SIareaPR' + diagTitle = 'SIarea preceeding ridging process' + diagUnits = 'm^2/m^2 ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIareaPT' + diagTitle = 'SIarea preceeding thermodynamic growth/melt' + diagUnits = 'm^2/m^2 ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + numAreaPreTh = diagNum + + diagName = 'SIheff ' + diagTitle = 'SEAICE effective ice thickness' + diagUnits = 'm ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + numHeff = diagNum + + diagName = 'SIheffPT' + diagTitle = 'SIheff preceeeding thermodynamic growth/melt' + diagUnits = 'm ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + numHeffPreTh = diagNum + + diagName = 'SIhsnow ' + diagTitle = 'SEAICE effective snow thickness' + diagUnits = 'm ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIhsnoPT' + diagTitle = 'SIhsnow preceeeding thermodynamic growth/melt' + diagUnits = 'm ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIhsalt ' + diagTitle = 'SEAICE effective salinity' + diagUnits = 'g/m^2 ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + +#ifdef ALLOW_SITRACER + DO iTr = 1, SItrNumInUse + +C-- Set default name & tracer Units: + WRITE(locNameTr,'(A,I4.4,A)') 'sea ice tracer no. ',iTr + if (SItrMate(iTr).EQ.'HEFF') then + locUnitTr = '(kg/kg) ' + numMateTr = numHeff + numMateTrPreTh = numHeffPreTh + else + locUnitTr = '(kg/m^2)' + numMateTr = numArea + numMateTrPreTh = numAreaPreTh + endif +C- use name & units from data.seaice : + ilnb = ILNBLNK(SItrUnit(iTr)) + IF ( ilnb.GE.1 ) THEN + ilnb = LEN(locUnitTr) + locUnitTr = SItrUnit(iTr)(1:ilnb) + ENDIF + ilnb = ILNBLNK(SItrNameLong(iTr)) + IF ( ilnb.GE.1 ) THEN + ilnb = MIN(LEN(locNameTr),ilnb) + WRITE(locNameTr,'(A)') SItrNameLong(iTr)(1:ilnb) + ELSE + ilnb = ILNBLNK(SItrName(iTr)) + IF ( ilnb.GE.1 ) THEN + ilnb = MIN(LEN(locNameTr),ilnb) + WRITE(locNameTr,'(2A)') SItrName(iTr)(1:ilnb),' tracer' + ENDIF + ENDIF + ilnb = MAX(ILNBLNK(locNameTr),1) + + WRITE(diagName,'(A4,I2.2,A2)') 'SItr',iTr,' ' + WRITE(diagTitle,'(4A)') locNameTr(1:ilnb), + & ' (associated with ',SItrMate(iTr),')' + diagUnits = locUnitTr//' ' + diagCode = 'SM C M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, diagName, + I diagCode, diagUnits, diagTitle, numMateTr, myThid ) + + WRITE(diagName,'(A4,I2.2,A2)') 'SItr',iTr,'PT' + WRITE(diagTitle,'(A4,I2.2,2A)') 'SItr',iTr, + & ' preceeeding thermodynamic growth/melt' + diagUnits = locUnitTr//' ' + diagCode = 'SM C M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, diagName, + I diagCode, diagUnits, diagTitle, numMateTrPreTh, myThid ) + + ENDDO +#endif + + diagName = 'SItices ' + diagTitle = 'Surface Temperature over Sea-Ice (area weighted)' + diagUnits = 'K ' + diagCode = 'SM C M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, numArea, myThid ) + + diagName = 'SIuice ' + diagTitle = 'SEAICE zonal ice velocity, >0 from West to East' + diagUnits = 'm/s ' +#ifdef SEAICE_CGRID + diagCode = 'UU M1 ' +#else + diagCode = 'UZ M1 ' +#endif + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'SIvice ' + diagTitle = 'SEAICE merid. ice velocity, >0 from South to North' + diagUnits = 'm/s ' +#ifdef SEAICE_CGRID + diagCode = 'VV M1 ' +#else + diagCode = 'VZ M1 ' +#endif + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C=============== momentum, heat and fresh water forcing ============ + +C pkg/diagnostics SIfu and oceTAUX, dumpfreq FU, and tavefreq FUtave +C are identical but they differ from pkg/diagnostics EXFtaux, which +C is stress before impact of ice. Also when using exf bulk +C formulae, EXFtaux is defined on tracer rather than uvel points. +c diagName = 'SIfu ' +c diagTitle = 'SEAICE zonal surface wind stress, >0 increases uVel ' +c diagUnits = 'N/m^2 ' +c diagCode = 'UU U1 ' +c diagMate = diagNum + 2 +c CALL DIAGNOSTICS_ADDTOLIST( diagNum, +c I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C pkg/diagnostics SIfv and oceTAUY, dumpfreq FV, and tavefreq FVtave +C are identical but they differ from pkg/diagnostics EXFtauy, which +C is stress before impact of ice. Also when using exf bulk +C formulae, EXFtauy is defined on tracer rather than vvel points. +c diagName = 'SIfv ' +c diagTitle = 'SEAICE merid. surface wind stress, >0 increases vVel' +c diagUnits = 'N/m^2 ' +c diagCode = 'VV U1 ' +c diagMate = diagNum +c CALL DIAGNOSTICS_ADDTOLIST( diagNum, +c I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'SItaux ' + diagTitle = 'SEAICE zonal surface wind stress, >0 increases uIce' + diagUnits = 'N/m^2 ' + diagCode = 'UU U1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'SItauy ' + diagTitle = 'SEAICE merid surface wind stress, >0 increases vIce' + diagUnits = 'N/m^2 ' + diagCode = 'VV U1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'SIatmTx ' + diagTitle = 'Zonal surface wind stress over Ocean+SeaIce' + diagUnits = 'N/m^2 ' + diagCode = 'UU U1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'SIatmTy ' + diagTitle = 'Merid surface wind stress over Ocean+SeaIce' + diagUnits = 'N/m^2 ' + diagCode = 'VV U1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +c diagName = 'SIuwind ' +c diagTitle = 'SEAICE zonal 10-m wind speed, >0 increases uVel' +c diagUnits = 'm/s ' +c diagCode = 'UM U1 ' +c diagMate = diagNum + 2 +c CALL DIAGNOSTICS_ADDTOLIST( diagNum, +c I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +c diagName = 'SIvwind ' +c diagTitle = 'SEAICE meridional 10-m wind speed, >0 increases uVel' +c diagUnits = 'm/s ' +c diagCode = 'VM U1 ' +c diagMate = diagNum +c CALL DIAGNOSTICS_ADDTOLIST( diagNum, +c I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C SIqnet, Qnet, and QNETtave are identical. +C With #undef NONLIN_FRSURF SIqnet is identical to -(TFLUX-TRELAX). +C Except over land and under sea ice, SIqnet is also identical to +C EXFlwnet+EXFswnet-EXFhl-EXFhs. + diagName = 'SIqnet ' + diagTitle = 'Ocean surface heatflux, turb+rad, >0 decreases theta' + diagUnits = 'W/m^2 ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + +C SIqsw, Qsw, and QSWtave are identical. +C Except under sea ice, SIqsw is also identical to EXFswnet. + diagName = 'SIqsw ' + diagTitle = 'Ocean surface shortwave radiat., >0 decreases theta' + diagUnits = 'W/m^2 ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIatmQnt' + diagTitle = 'Net atmospheric heat flux, >0 decreases theta' + diagUnits = 'W/m^2 ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SItflux ' + diagTitle = 'Same as TFLUX but incl seaice (>0 incr T decr H)' + diagUnits = 'W/m^2 ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + +#ifndef SEAICE_DISABLE_HEATCONSFIX + diagName = 'SIaaflux' + diagTitle = 'conservative ocn<->seaice adv. heat flux adjust.' + diagUnits = 'W/m^2 ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) +#endif + + diagName = 'SIhl ' + diagTitle = 'Latent heat flux into ocean, >0 increases theta' + diagUnits = 'W/m^2 ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIqneto ' + diagTitle = 'Open Ocean Part of SIqnet, turb+rad, >0 decr theta' + diagUnits = 'W/m^2 ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIqneti ' + diagTitle = 'Ice Covered Part of SIqnet, turb+rad, >0 decr theta' + diagUnits = 'W/m^2 ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + +C pkg/diagnostics SIempmr, dumpfreq EmPmR, and tavefreq EmPmRtave +C are identical but they differ from pkg/diagnostics EXFempmr, which +C is EmPmR before impact of ice. + diagName = 'SIempmr ' + diagTitle = 'Ocean surface freshwater flux, > 0 increases salt' + diagUnits = 'kg/m^2/s ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIatmFW ' + diagTitle = 'Net freshwater flux from atmosphere & land (+=down)' + diagUnits = 'kg/m^2/s ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIsnPrcp' + diagTitle = 'Snow precip. (+=dw) over Sea-Ice (area weighted)' + diagUnits = 'kg/m^2/s ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIfwSubl' + diagTitle ='Potential sublimation freshwater flux, >0 decr. ice' + diagUnits = 'kg/m^2/s ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIacSubl' + diagTitle = 'Actual sublimation freshwater flux, >0 decr. ice' + diagUnits = 'kg/m^2/s ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIrsSubl' + diagTitle = 'Residual subl. freshwater flux, >0 taken from ocn' + diagUnits = 'kg/m^2/s ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIactLHF' + diagTitle = 'Actual latent heat flux over ice' + diagUnits = 'W/m^2 ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SImaxLHF' + diagTitle = 'Maximum latent heat flux over ice' + diagUnits = 'W/m^2 ' + diagCode = 'SM U1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + +#ifdef ALLOW_SITRACER + DO iTr = 1, SItrNumInUse + IF (SItrMate(iTr).EQ.'HEFF') then +C-- Set default name & tracer Units: + WRITE(diagUnits,'(A)') 'kg/m^2/s' +C-- use units from data.seaice : + ilnb = ILNBLNK(SItrUnit(iTr)) + IF ( ilnb.GE.1 ) THEN + WRITE(diagUnits,'(2A)') SItrUnit(iTr)(1:ilnb),'.kg/m^2/s' + ENDIF +C-- + WRITE(diagName,'(A4,I2.2,A2)') 'SItr',iTr,'Fx' + WRITE(diagTitle,'(A4,I2.2,A)') 'SItr',iTr, + I ' flux out of ice pack (that may enter ocean)' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, diagName, + I diagCode, diagUnits, diagTitle, 0, myThid ) + + ENDIF + ENDDO +#endif + +C============== ice growth/melt ============== + + diagName = 'SIaQbOCN' + diagTitle = 'Potential HEFF rate of change by ocean ice flux' + diagUnits = 'm/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIaQbATC' + diagTitle = 'Potential HEFF rate of change by atm flux over ice' + diagUnits = 'm/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIaQbATO' + diagTitle = 'Potential HEFF rate of change by open ocn atm flux' + diagUnits = 'm/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIdHbOCN' + diagTitle = 'HEFF rate of change by ocean ice flux' + diagUnits = 'm/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIdSbATC' + diagTitle = 'HSNOW rate of change by atm flux over sea ice' + diagUnits = 'm/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIdSbOCN' + diagTitle = 'HSNOW rate of change by ocean ice flux' + diagUnits = 'm/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIdHbATC' + diagTitle = 'HEFF rate of change by atm flux over sea ice' + diagUnits = 'm/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIdHbATO' + diagTitle = 'HEFF rate of change by open ocn atm flux' + diagUnits = 'm/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIdHbFLO' + diagTitle = 'HEFF rate of change by flooding snow' + diagUnits = 'm/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) +#ifdef SEAICE_GREASE + + diagName = 'SIgrsLT ' + diagTitle = 'actual grease ice layer thickness' + diagUnits = 'm ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) +#endif + +C=============== expansion/contraction ============ + + diagName = 'SIdAbATO' + diagTitle = 'Potential AREA rate of change by open ocn atm flux' + diagUnits = 'm^2/m^2/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIdAbATC' + diagTitle = 'Potential AREA rate of change by atm flux over ice' + diagUnits = 'm^2/m^2/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIdAbOCN' + diagTitle = 'Potential AREA rate of change by ocean ice flux' + diagUnits = 'm^2/m^2/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIdA' + diagTitle = 'AREA rate of change (net)' + diagUnits = 'm^2/m^2/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + +C============== advection/diffusion ============ + +C effective thickness + flxUnits = '.m^2/s ' + locName = 'eff ice thickn ' + WRITE(diagUnits,'(2A)') 'm',flxUnits + diagSufx = SEAICE_DIAG_SUFX( GAD_HEFF, myThid ) + +C-- advective flux + diagName = 'ADVx'//diagSufx + diagTitle = 'Zonal Advective Flux of '//locName + diagCode = 'UU M1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'ADVy'//diagSufx + diagTitle = 'Meridional Advective Flux of '//locName + diagCode = 'VV M1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C-- Diffusive flux: + diagName = 'DFxE'//diagSufx + diagTitle = 'Zonal Diffusive Flux of '//locName + diagCode = 'UU M1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'DFyE'//diagSufx + diagTitle = 'Meridional Diffusive Flux of '//locName + diagCode = 'VV M1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C fractional ice covered area (ice concentration) + locName = 'fract area ' + WRITE(diagUnits,'(2A)') 'm^2/m^2',flxUnits + diagSufx = SEAICE_DIAG_SUFX( GAD_AREA, myThid ) + +C-- advective flux + diagName = 'ADVx'//diagSufx + diagTitle = 'Zonal Advective Flux of '//locName + diagCode = 'UU M1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'ADVy'//diagSufx + diagTitle = 'Meridional Advective Flux of '//locName + diagCode = 'VV M1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C-- Diffusive flux: + diagName = 'DFxE'//diagSufx + diagTitle = 'Zonal Diffusive Flux of '//locName + diagCode = 'UU M1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'DFyE'//diagSufx + diagTitle = 'Meridional Diffusive Flux of '//locName + diagCode = 'VV M1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C effective snow thickness + locName = 'eff snow thickn' + WRITE(diagUnits,'(2A)') 'm',flxUnits + diagSufx = SEAICE_DIAG_SUFX( GAD_SNOW, myThid ) + +C-- advective flux + diagName = 'ADVx'//diagSufx + diagTitle = 'Zonal Advective Flux of '//locName + diagCode = 'UU M1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'ADVy'//diagSufx + diagTitle = 'Meridional Advective Flux of '//locName + diagCode = 'VV M1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C-- Diffusive flux: + diagName = 'DFxE'//diagSufx + diagTitle = 'Zonal Diffusive Flux of '//locName + diagCode = 'UU M1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'DFyE'//diagSufx + diagTitle = 'Meridional Diffusive Flux of '//locName + diagCode = 'VV M1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C sea ice salinity + locName = 'seaice salinity' + WRITE(diagUnits,'(2A)') 'psu',flxUnits + diagSufx = SEAICE_DIAG_SUFX( GAD_SALT, myThid ) + +C-- advective flux + diagName = 'ADVx'//diagSufx + diagTitle = 'Zonal Advective Flux of '//locName + diagCode = 'UU M1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'ADVy'//diagSufx + diagTitle = 'Meridional Advective Flux of '//locName + diagCode = 'VV M1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C-- Diffusive flux: + diagName = 'DFxE'//diagSufx + diagTitle = 'Zonal Diffusive Flux of '//locName + diagCode = 'UU M1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'DFyE'//diagSufx + diagTitle = 'Meridional Diffusive Flux of '//locName + diagCode = 'VV M1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C-- effective thickness transport (centered in space, 1 time-step lag) + diagName = 'SIuheff ' + diagTitle = 'Zonal Transport of eff ice thickn (centered)' + diagUnits = 'm^2/s ' + diagCode = 'UU M1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'SIvheff ' + diagTitle = 'Meridional Transport of eff ice thickn (centered)' + diagUnits = 'm^2/s ' + diagCode = 'VV M1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + +C=============== dynamics ============ + + diagName = 'SIpress ' + diagTitle = 'SEAICE strength (with upper and lower limit)' + diagUnits = 'N/m ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIzeta ' + diagTitle = 'SEAICE nonlinear bulk viscosity' + diagUnits = 'kg/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIeta ' + diagTitle = 'SEAICE nonlinear shear viscosity' + diagUnits = 'kg/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIsig1 ' + diagTitle = 'SEAICE normalized principle stress, component one' + diagUnits = 'no units ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIsig2 ' + diagTitle = 'SEAICE normalized principle stress, component two' + diagUnits = 'no units ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIshear ' + diagTitle = 'SEAICE shear deformation rate' + diagUnits = '1/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SIdelta ' + diagTitle = 'SEAICE Delta deformation rate' + diagUnits = '1/s ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SItensil' + diagTitle = 'SEAICE maximal tensile strength' + diagUnits = 'N/m ' + diagCode = 'SM M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + +#ifdef SEAICE_ITD +C=============== ice thickness categories ============ + + diagName = 'SIheffN ' + diagTitle = 'SEAICE effective ice thickness per category' + diagUnits = 'm ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) + + diagName = 'SIareaN ' + diagTitle = + I 'SEAICE fractional ice-covered area per category [0 to 1]' + diagUnits = 'm^2/m^2 ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) + + diagName = 'SIhsnowN' + diagTitle = 'SEAICE effective snow thickness per category' + diagUnits = 'm ' + diagCode = 'SM MX ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + CALL DIAGNOSTICS_SETKLEV( diagName, nITD, myThid ) +#endif + +#ifdef HACK_FOR_GMAO_CPL +# include "seaice_diag_init_add.h" +#endif + +#endif /* ALLOW_DIAGNOSTICS */ + + RETURN + END + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +CBOP 0 +C !ROUTINE: SEAICE_DIAG_SUFX + +C !INTERFACE: + CHARACTER*4 FUNCTION SEAICE_DIAG_SUFX( tracerId, myThid ) + +C !DESCRIPTION: +C *==========================================================* +C | FUNCTION SEAICE_DIAG_SUFX +C | o Return diagnostic suffix (4 character long) for the +C | "tracerId" tracer (used to build diagnostic names). +C *==========================================================* + +C !USES: + IMPLICIT NONE +#include "EEPARAMS.h" +#include "SEAICE_SIZE.h" +#include "SEAICE_PARAMS.h" + +C !INPUT PARAMETERS: +C tracerId :: tracer identifier +C myThid :: my thread Id number + INTEGER tracerId + INTEGER myThid +CEOP + +C !LOCAL VARIABLES: + +C-- Set diagnostic suffix (4 character long) for the "tracerId" tracer + IF ( tracerId.EQ.GAD_HEFF ) THEN + SEAICE_DIAG_SUFX = 'HEFF' + ELSEIF( tracerId.EQ.GAD_AREA ) THEN + SEAICE_DIAG_SUFX = 'AREA' + ELSEIF( tracerId.EQ.GAD_SNOW ) THEN + SEAICE_DIAG_SUFX = 'SNOW' + ELSEIF( tracerId.EQ.GAD_SALT ) THEN + SEAICE_DIAG_SUFX = 'SSLT' + ELSE + SEAICE_DIAG_SUFX = 'aaaa' + ENDIF + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_model.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_model.F new file mode 100644 index 0000000..e516f07 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_model.F @@ -0,0 +1,390 @@ +#include "SEAICE_OPTIONS.h" +#ifdef ALLOW_AUTODIFF +# include "AUTODIFF_OPTIONS.h" +#endif + +CBOP +C !ROUTINE: SEAICE_MODEL + +C !INTERFACE: ========================================================== + SUBROUTINE SEAICE_MODEL( myTime, myIter, myThid ) + +C !DESCRIPTION: \bv +C *===========================================================* +C | SUBROUTINE SEAICE_MODEL | +C | o Time stepping of a dynamic/thermodynamic sea ice model. | +C | Dynamics solver: Zhang/Hibler, JGR, 102, 8691-8702, 1997 | +C | Thermodynamics: Hibler, MWR, 108, 1943-1973, 1980 | +C | Rheology: Hibler, JPO, 9, 815- 846, 1979 | +C | Snow: Zhang et al. , JPO, 28, 191- 217, 1998 | +C | Parallel forward ice model written by Jinlun Zhang PSC/UW| +C | & coupled into MITgcm by Dimitris Menemenlis (JPL) 2/2001| +C | zhang@apl.washington.edu / menemenlis@jpl.nasa.gov | +C *===========================================================* +C *===========================================================* + IMPLICIT NONE +C \ev + +C !USES: =============================================================== +#include "SIZE.h" +#include "EEPARAMS.h" +#include "DYNVARS.h" +#include "PARAMS.h" +#include "GRID.h" +#include "FFIELDS.h" +#include "SEAICE_SIZE.h" +#include "SEAICE_PARAMS.h" +#include "SEAICE.h" +#include "SEAICE_TRACER.h" +#ifdef ALLOW_EXF +# include "EXF_OPTIONS.h" +# include "EXF_FIELDS.h" +#endif +#ifdef ALLOW_AUTODIFF_TAMC +# include "tamc.h" +#endif +#ifdef HACK_FOR_GMAO_CPL +# include "SEAICE_LAYERS.h" +#endif /* HACK_FOR_GMAO_CPL */ + +C !INPUT PARAMETERS: =================================================== +C myTime :: Current time in simulation +C myIter :: Current iteration number in simulation +C myThid :: my Thread Id number + _RL myTime + INTEGER myIter + INTEGER myThid + +C !LOCAL VARIABLES: ==================================================== +C i,j,bi,bj :: Loop counters + INTEGER i, j + INTEGER bi, bj +#ifdef ALLOW_EXF + INTEGER grpDiag +#endif +#ifdef ALLOW_SITRACER + INTEGER iTr +#endif +#ifndef SEAICE_CGRID + _RL uLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RL vLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) +#endif +CEOP + +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_ENTER( 'SEAICE_MODEL', myThid ) +#endif + +#ifdef ALLOW_THSICE + IF ( useThSice ) THEN +C-- Map thSice-variables to HEFF and AREA + CALL SEAICE_MAP_THSICE( myTime, myIter, myThid ) + ENDIF +#endif /* ALLOW_THSICE */ + +#ifdef ALLOW_EXF + IF ( useEXF ) THEN +C-- Winds are from pkg/exf, which does not update edges. + CALL EXCH_UV_AGRID_3D_RL( uwind, vwind, .TRUE., 1, myThid ) + IF ( useDiagnostics ) THEN +C- Fill-in EXF wind-stess diags, weighted by open-ocean fraction + grpDiag = -1 + IF ( SEAICEuseDYNAMICS ) grpDiag = 1 + CALL EXF_WEIGHT_SFX_DIAGS( + I AREA, grpDiag, myTime, myIter, myThid ) + ENDIF + ENDIF +#endif /* ALLOW_EXF */ + +#ifdef HACK_FOR_GMAO_CPL + CALL SEAICE_SAVE4GMAO( myTime, 1, myIter, myThid ) +#endif /* HACK_FOR_GMAO_CPL */ + +#ifdef ALLOW_AUTODIFF_TAMC + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + uIceNm1(i,j,bi,bj) = 0. _d 0 + vIceNm1(i,j,bi,bj) = 0. _d 0 +# ifdef ALLOW_SITRACER + DO iTr = 1, SItrMaxNum + SItrBucket(i,j,bi,bj,iTr) = 0. _d 0 + ENDDO +# endif + ENDDO + ENDDO + ENDDO + ENDDO +CADJ STORE uwind = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE vwind = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE heff = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE area = comlev1, key=ikey_dynamics, kind=isbyte +# ifdef SEAICE_ALLOW_DYNAMICS +# ifdef SEAICE_CGRID +CADJ STORE hsnow = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE seaicemasku = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE seaicemaskv = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE fu = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE fv = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE uice = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE vice = comlev1, key=ikey_dynamics, kind=isbyte +cphCADJ STORE eta = comlev1, key=ikey_dynamics, kind=isbyte +cphCADJ STORE zeta = comlev1, key=ikey_dynamics, kind=isbyte +cph( +CADJ STORE dwatn = comlev1, key=ikey_dynamics, kind=isbyte +#ifdef SEAICE_ALLOW_BOTTOMDRAG +CADJ STORE cbotc = comlev1, key=ikey_dynamics, kind=isbyte +#endif /* SEAICE_ALLOW_BOTTOMDRAG */ +cccCADJ STORE press0 = comlev1, key=ikey_dynamics, kind=isbyte +cccCADJ STORE zmax = comlev1, key=ikey_dynamics, kind=isbyte +cccCADJ STORE zmin = comlev1, key=ikey_dynamics, kind=isbyte +cph) +# ifdef SEAICE_ALLOW_EVP +CADJ STORE seaice_sigma1 = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE seaice_sigma2 = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE seaice_sigma12 = comlev1, key=ikey_dynamics, kind=isbyte +# endif +# endif +# endif +# ifdef ALLOW_SITRACER +CADJ STORE siceload = comlev1, key=ikey_dynamics, kind=isbyte +CADJ STORE sitracer = comlev1, key=ikey_dynamics, kind=isbyte +# endif +#endif /* ALLOW_AUTODIFF_TAMC */ + +C solve ice momentum equations and calculate ocean surface stress +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL( 'SEAICE_DYNSOLVER', myThid ) +#endif +#ifdef SEAICE_CGRID + CALL TIMER_START('SEAICE_DYNSOLVER [SEAICE_MODEL]',myThid) + CALL SEAICE_DYNSOLVER ( myTime, myIter, myThid ) + CALL TIMER_STOP ('SEAICE_DYNSOLVER [SEAICE_MODEL]',myThid) +#else + CALL TIMER_START('DYNSOLVER [SEAICE_MODEL]',myThid) + CALL DYNSOLVER ( myTime, myIter, myThid ) + CALL TIMER_STOP ('DYNSOLVER [SEAICE_MODEL]',myThid) +#endif /* SEAICE_CGRID */ + +C-- Apply ice velocity open boundary conditions +#ifdef ALLOW_OBCS +# ifndef DISABLE_SEAICE_OBCS + IF ( useOBCS ) CALL OBCS_ADJUST_UVICE( uice, vice, myThid ) +# endif /* DISABLE_SEAICE_OBCS */ +#endif /* ALLOW_OBCS */ + +#ifdef ALLOW_THSICE + IF ( useThSice ) THEN +#ifndef OLD_THSICE_CALL_SEQUENCE +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL( 'THSICE_DO_ADVECT', myThid ) +#endif + CALL THSICE_DO_ADVECT( 0, 0, myTime, myIter, myThid ) +#endif /* OLD_THSICE_CALL_SEQUENCE */ + ELSE +#endif /* ALLOW_THSICE */ +C-- Only call advection of heff, area, snow, and salt and +C-- growth for the generic 0-layer thermodynamics of seaice +C-- if useThSice=.false., otherwise the 3-layer Winton thermodynamics +C-- (called from DO_OCEANIC_PHYSICS) take care of this + +C NOW DO ADVECTION and DIFFUSION + IF ( SEAICEadvHeff .OR. SEAICEadvArea .OR. SEAICEadvSnow + & .OR. SEAICEadvSalt ) THEN +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL( 'SEAICE_ADVDIFF', myThid ) +#endif +#ifdef SEAICE_CGRID + CALL SEAICE_ADVDIFF( uIce, vIce, myTime, myIter, myThid ) +#else /* SEAICE_CGRID */ + CALL SEAICE_ADVDIFF( uLoc, vLoc, myTime, myIter, myThid ) +#endif /* SEAICE_CGRID */ + ENDIF + +C After advection, the sea ice variables may have unphysical values +C e.g., < 0, that are regularized here. Concentration as a special case +C may be > 1 in convergent motion and a ridging algorithm redistributes +C the ice to limit the concentration to 1. +#ifndef HACK_FOR_GMAO_CPL + CALL SEAICE_REG_RIDGE( myTime, myIter, myThid ) +#endif /* ndef HACK_FOR_GMAO_CPL */ + +#ifdef ALLOW_EXF + IF ( useEXF .AND. useDiagnostics ) THEN +C- Fill-in EXF surface flux diags, weighted by open-ocean fraction + grpDiag = -2 + IF ( usePW79thermodynamics ) grpDiag = 2 + CALL EXF_WEIGHT_SFX_DIAGS( + I AREA, grpDiag, myTime, myIter, myThid ) + ENDIF +#endif /* ALLOW_EXF */ + +#ifdef DISABLE_SEAICE_GROWTH + IF ( .TRUE. ) THEN +#else /* DISABLE_SEAICE_GROWTH */ +C thermodynamics growth +C must call growth after calling advection +C because of ugly time level business + IF ( usePW79thermodynamics ) THEN +#ifdef ALLOW_SEAICE_GROWTH_ADX +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL( 'SEAICE_GROWTH_ADX', myThid ) +#endif + CALL SEAICE_GROWTH_ADX( myTime, myIter, myThid ) +#else +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL( 'SEAICE_GROWTH', myThid ) +#endif + CALL SEAICE_GROWTH( myTime, myIter, myThid ) +#endif + ELSE +#endif /* DISABLE_SEAICE_GROWTH */ + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) + DO j=1,sNy + DO i=1,sNx + sIceLoad(i,j,bi,bj) = HEFF(i,j,bi,bj)*SEAICE_rhoIce + & + HSNOW(i,j,bi,bj)*SEAICE_rhoSnow + ENDDO + ENDDO +c#ifdef SEAICE_CAP_ICELOAD +c sIceTooHeavy = rhoConst*drF(1) / 5. _d 0 +c DO j=1,sNy +c DO i=1,sNx +c sIceLoad(i,j,bi,bj) = MIN( sIceLoad(i,j,bi,bj), +c & sIceTooHeavy ) +c ENDDO +c ENDDO +c#endif + ENDDO + ENDDO + ENDIF + +#ifdef ALLOW_SITRACER +# ifdef ALLOW_AUTODIFF_TAMC +CADJ STORE sitracer = comlev1, key=ikey_dynamics, kind=isbyte +# endif + CALL SEAICE_TRACER_PHYS ( myTime, myIter, myThid ) +#endif + +C-- Apply ice tracer open boundary conditions +#ifdef ALLOW_OBCS +# ifndef DISABLE_SEAICE_OBCS + IF ( useOBCS ) CALL OBCS_APPLY_SEAICE( myThid ) +# endif /* DISABLE_SEAICE_OBCS */ +#endif /* ALLOW_OBCS */ + +C-- Update overlap regions for a bunch of stuff + _EXCH_XY_RL( HEFF, myThid ) + _EXCH_XY_RL( AREA, myThid ) + _EXCH_XY_RL( HSNOW, myThid ) +#ifdef SEAICE_ITD + CALL EXCH_3D_RL( HEFFITD, nITD, myThid ) + CALL EXCH_3D_RL( AREAITD, nITD, myThid ) + CALL EXCH_3D_RL( HSNOWITD, nITD, myThid ) +#endif +#ifdef SEAICE_VARIABLE_SALINITY + _EXCH_XY_RL( HSALT, myThid ) +#endif +#ifdef ALLOW_SITRACER + DO iTr = 1, SItrNumInUse + _EXCH_XY_RL( SItracer(1-OLx,1-OLy,1,1,iTr),myThid ) + ENDDO +#endif + _EXCH_XY_RS(EmPmR, myThid ) + _EXCH_XY_RS(saltFlux, myThid ) + _EXCH_XY_RS(Qnet , myThid ) +#ifdef SHORTWAVE_HEATING + _EXCH_XY_RS(Qsw , myThid ) +#endif /* SHORTWAVE_HEATING */ +#ifdef ATMOSPHERIC_LOADING + IF ( useRealFreshWaterFlux ) + & _EXCH_XY_RS( sIceLoad, myThid ) +#endif + +#ifdef ALLOW_OBCS +C-- In case we use scheme with a large stencil that extends into overlap: +C no longer needed with the right masking in advection & diffusion S/R. +c IF ( useOBCS ) THEN +c DO bj=myByLo(myThid),myByHi(myThid) +c DO bi=myBxLo(myThid),myBxHi(myThid) +c CALL OBCS_COPY_TRACER( HEFF(1-OLx,1-OLy,bi,bj), +c I 1, bi, bj, myThid ) +c CALL OBCS_COPY_TRACER( AREA(1-OLx,1-OLy,bi,bj), +c I 1, bi, bj, myThid ) +c CALL OBCS_COPY_TRACER( HSNOW(1-OLx,1-OLy,bi,bj), +c I 1, bi, bj, myThid ) +#ifdef SEAICE_VARIABLE_SALINITY +c CALL OBCS_COPY_TRACER( HSALT(1-OLx,1-OLy,bi,bj), +c I 1, bi, bj, myThid ) +#endif +c ENDDO +c ENDDO +c ENDIF +#endif /* ALLOW_OBCS */ + +#ifdef ALLOW_DIAGNOSTICS + IF ( useDiagnostics ) THEN +C diagnostics for "non-state variables" that are modified by +C the seaice model +# ifdef ALLOW_EXF +c CALL DIAGNOSTICS_FILL(UWIND ,'SIuwind ',0,1 ,0,1,1,myThid) +c CALL DIAGNOSTICS_FILL(VWIND ,'SIvwind ',0,1 ,0,1,1,myThid) +# endif +c CALL DIAGNOSTICS_FILL_RS(FU ,'SIfu ',0,1 ,0,1,1,myThid) +c CALL DIAGNOSTICS_FILL_RS(FV ,'SIfv ',0,1 ,0,1,1,myThid) + CALL DIAGNOSTICS_FILL_RS(EmPmR,'SIempmr ',0,1 ,0,1,1,myThid) + CALL DIAGNOSTICS_FILL_RS(Qnet ,'SIqnet ',0,1 ,0,1,1,myThid) + CALL DIAGNOSTICS_FILL_RS(Qsw ,'SIqsw ',0,1 ,0,1,1,myThid) + ENDIF +#endif /* ALLOW_DIAGNOSTICS */ + +#ifdef ALLOW_THSICE +C endif .not.useThSice + ENDIF +#endif /* ALLOW_THSICE */ +CML This has already been done in seaice_ocean_stress/ostres, so why repeat? +CML CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid) + +#ifdef HACK_FOR_GMAO_CPL +C- Save advective increments: + CALL SEAICE_SAVE4GMAO( myTime, 2, myIter, myThid ) +C- for now, reset increments to zero +c CALL SEAICE_SAVE4GMAO( myTime, 0, myIter, myThid ) + +C- Compute SI_FRZMLT, the available heat (W/m^2) to freeze (>0) or melt (<0) +C sea ice so that surface level ocean reaches freezing temperature. +C FRZMLT = (-0.054*SW - TW) * (MAPL_RHO_SEAWATER*MAPL_CAPWTR*10.)/DT +C where -0.054*SW is the CICE freezing point of sea water in deg C. +C The freezing potential (>0) is subtracted from QNET. + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SI_FRZMLT(i,j,bi,bj) = maskC(i,j,1,bi,bj) * + & (-0.054*salt(i,j,1,bi,bj) - theta(i,j,1,bi,bj)) * + & rhoNil * HeatCapacity_Cp * drF(1) / deltaT + Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) - + & MAX( SI_FRZMLT(i,j,bi,bj) , zeroRL ) + ENDDO + ENDDO + ENDDO + ENDDO + +#endif /* HACK_FOR_GMAO_CPL */ + +#ifdef ALLOW_EXF +# ifdef ALLOW_AUTODIFF_TAMC +# if (defined (ALLOW_AUTODIFF_MONITOR)) + CALL EXF_ADJOINT_SNAPSHOTS( 3, myTime, myIter, myThid ) +# endif +# endif +#endif + +#ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_LEAVE( 'SEAICE_MODEL', myThid ) +#endif + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_save4gmao.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_save4gmao.F new file mode 100644 index 0000000..bd61105 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/seaice_save4gmao.F @@ -0,0 +1,261 @@ +#include "SEAICE_OPTIONS.h" + +CBOP +C !ROUTINE: SEAICE_SAVE4GMAO +C !INTERFACE: + SUBROUTINE SEAICE_SAVE4GMAO( + I myTime, seqFlag, myIter, myThid ) + +C !DESCRIPTION: \bv +C *==========================================================* +C | S/R SEAICE_SAVE4GMAO +C | o Save Seaice Advective Increment for GMAO Coupling +C *==========================================================* +C \ev + +C !USES: + IMPLICIT NONE + +C == Global variables === +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "GRID.h" +#ifdef ALLOW_SEAICE +# include "SEAICE_SIZE.h" +# include "SEAICE_PARAMS.h" +# include "SEAICE.h" +# ifdef HACK_FOR_GMAO_CPL +# include "SEAICE_LAYERS.h" +# endif +#endif /* ALLOW_SEAICE */ + +C !INPUT/OUTPUT PARAMETERS: +C myTime :: Current time of simulation ( s ) +C seqFlag :: flag that indicate where this S/R is called from: +C :: =0 reset inc. to zero (from initialise_varia) +C :: =1 called from the beginning of SEAICE_MODEL +C :: =2 called from the end of SEAICE_MODEL +C myIter :: Iteration number +C myThid :: my Thread Id number + _RL myTime + INTEGER seqFlag + INTEGER myIter + INTEGER myThid +CEOP + +#ifdef HACK_FOR_GMAO_CPL +# ifdef ALLOW_SEAICE +C !LOCAL VARIABLES: +C i,j,bi,bj :: Loop counters + INTEGER i, j, bi, bj + INTEGER l, n +c _RL tmpFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy) +c _RL fld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + + IF ( seqFlag.EQ.0 ) THEN +C-- Initialise to zero Advective Increments + + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) + + DO n=1,nITD +C- start loop on ice-category "n" + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SIadv_Area (i,j,n,bi,bj) = 0. _d 0 + SIadv_Heff (i,j,n,bi,bj) = 0. _d 0 + SIadv_Hsnow (i,j,n,bi,bj) = 0. _d 0 + SIadv_meltPd(i,j,n,bi,bj) = 0. _d 0 + SIadv_iceAge(i,j,n,bi,bj) = 0. _d 0 + SIadv_tIces (i,j,n,bi,bj) = 0. _d 0 + ENDDO + ENDDO + DO l=1,nIceLayers + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SIadv_qIce (i,j,l,n,bi,bj) = 0. _d 0 + ENDDO + ENDDO + ENDDO + DO l=1,nSnowLayers + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SIadv_qSnow (i,j,l,n,bi,bj) = 0. _d 0 + ENDDO + ENDDO + ENDDO +C- end loop on ice-category "n" + ENDDO + + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SIadv_skinS (i,j,bi,bj) = 0. _d 0 + SIadv_skinH (i,j,bi,bj) = 0. _d 0 + ENDDO + ENDDO + +C- end bi,bj loops + ENDDO + ENDDO + + ENDIF + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + + IF ( seqFlag.EQ.1 ) THEN +C-- Save seaice fields as entering seaice model + + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) + + DO n=1,nITD +C- start loop on ice-category "n" + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SIadv_Area (i,j,n,bi,bj) = AREAITD (i,j,n,bi,bj) + SIadv_Heff (i,j,n,bi,bj) = HEFFITD (i,j,n,bi,bj) + SIadv_Hsnow (i,j,n,bi,bj) = HSNOWITD(i,j,n,bi,bj) + SIadv_meltPd(i,j,n,bi,bj) = SImeltPd(i,j,n,bi,bj) + SIadv_iceAge(i,j,n,bi,bj) = SIiceAge(i,j,n,bi,bj) + SIadv_tIces (i,j,n,bi,bj) = TICES (i,j,n,bi,bj) + ENDDO + ENDDO + DO l=1,nIceLayers + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SIadv_qIce (i,j,l,n,bi,bj) = SIqIce (i,j,l,n,bi,bj) + ENDDO + ENDDO + ENDDO + DO l=1,nSnowLayers + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SIadv_qSnow(i,j,l,n,bi,bj) = SIqSnow(i,j,l,n,bi,bj) + ENDDO + ENDDO + ENDDO +C- end loop on ice-category "n" + ENDDO + +c DO j=1-OLy,sNy+OLy +c DO i=1-OLx,sNx+OLx +c SIadv_skinS (i,j,bi,bj) = SIskinS(i,j,bi,bj) +c SIadv_skinH (i,j,bi,bj) = SIskinH(i,j,bi,bj) +c ENDDO +c ENDDO + +C- end bi,bj loops + ENDDO + ENDDO + +#ifdef ALLOW_DIAGNOSTICS + IF ( useDiagnostics ) THEN + CALL DIAGNOSTICS_FILL( oceWeight,'CPLoWGHT',0,1,0,1,1,myThid ) + CALL DIAGNOSTICS_FILL( TICES, 'SItIces ', + I 0, nITD, 0,1,1, myThid ) + n = nIceLayers*nITD + CALL DIAGNOSTICS_FILL( SIqIce, 'SIqIce ', + I 0, n , 0,1,1, myThid ) + n = nSnowLayers*nITD + CALL DIAGNOSTICS_FILL( SIqSnow, 'SIqSnow ', + I 0, n , 0,1,1, myThid ) + CALL DIAGNOSTICS_FILL( SImeltPd, 'SImeltPd', + I 0, nITD, 0,1,1, myThid ) + CALL DIAGNOSTICS_FILL( SIiceAge, 'SIiceAge', + I 0, nITD, 0,1,1, myThid ) + ENDIF +#endif /* ALLOW_DIAGNOSTICS */ + + ENDIF + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + + IF ( seqFlag.EQ.2 ) THEN +C-- Calculate Advective Increments + + DO bj=myByLo(myThid),myByHi(myThid) + DO bi=myBxLo(myThid),myBxHi(myThid) + + DO n=1,nITD +C- start loop on ice-category "n" + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SIadv_Area (i,j,n,bi,bj) = AREAITD (i,j,n,bi,bj) + & - SIadv_Area (i,j,n,bi,bj) + SIadv_Heff (i,j,n,bi,bj) = HEFFITD (i,j,n,bi,bj) + & - SIadv_Heff (i,j,n,bi,bj) + SIadv_Hsnow (i,j,n,bi,bj) = HSNOWITD(i,j,n,bi,bj) + & - SIadv_Hsnow (i,j,n,bi,bj) + SIadv_meltPd(i,j,n,bi,bj) = SImeltPd(i,j,n,bi,bj) + & - SIadv_meltPd(i,j,n,bi,bj) + SIadv_iceAge(i,j,n,bi,bj) = SIiceAge(i,j,n,bi,bj) + & - SIadv_iceAge(i,j,n,bi,bj) + SIadv_tIces (i,j,n,bi,bj) = TICES (i,j,n,bi,bj) + & - SIadv_tIces (i,j,n,bi,bj) + ENDDO + ENDDO + DO l=1,nIceLayers + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SIadv_qIce (i,j,l,n,bi,bj) = SIqIce (i,j,l,n,bi,bj) + & - SIadv_qIce (i,j,l,n,bi,bj) + ENDDO + ENDDO + ENDDO + DO l=1,nSnowLayers + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + SIadv_qSnow(i,j,l,n,bi,bj) = SIqSnow(i,j,l,n,bi,bj) + & - SIadv_qSnow(i,j,l,n,bi,bj) + ENDDO + ENDDO + ENDDO +C- end loop on ice-category "n" + ENDDO + +c DO j=1-OLy,sNy+OLy +c DO i=1-OLx,sNx+OLx +c SIadv_skinS(i,j,bi,bj) = SIskinS(i,j,bi,bj) +c & - SIadv_skinS(i,j,bi,bj) +c SIadv_skinH(i,j,bi,bj) = SIskinH(i,j,bi,bj) +c & - SIadv_skinH(i,j,bi,bj) +c ENDDO +c ENDDO + +C- end bi,bj loops + ENDDO + ENDDO + +#ifdef ALLOW_DIAGNOSTICS + IF ( useDiagnostics ) THEN + CALL DIAGNOSTICS_FILL( SIadv_Area, 'SI_dArea', + I 0, nITD, 0,1,1, myThid ) + CALL DIAGNOSTICS_FILL( SIadv_Heff, 'SI_dHeff', + I 0, nITD, 0,1,1, myThid ) + CALL DIAGNOSTICS_FILL( SIadv_Hsnow, 'SI_dHsnw', + I 0, nITD, 0,1,1, myThid ) + CALL DIAGNOSTICS_FILL( SIadv_tIces, 'SI_dTIce', + I 0, nITD, 0,1,1, myThid ) + n = nIceLayers*nITD + CALL DIAGNOSTICS_FILL( SIadv_qIce, 'SI_dQIce', + I 0, n , 0,1,1, myThid ) + n = nSnowLayers*nITD + CALL DIAGNOSTICS_FILL( SIadv_qSnow, 'SI_dQSnw', + I 0, n , 0,1,1, myThid ) + CALL DIAGNOSTICS_FILL( SIadv_meltPd, 'SI_dMPnd', + I 0, nITD, 0,1,1, myThid ) + CALL DIAGNOSTICS_FILL( SIadv_iceAge, 'SI_dIcAg', + I 0, nITD, 0,1,1, myThid ) + ENDIF +#endif /* ALLOW_DIAGNOSTICS */ + + ENDIF + +# endif /* ALLOW_SEAICE */ +#endif /* HACK_FOR_GMAO_CPL */ + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_forcing.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_forcing.F new file mode 100755 index 0000000..cfe4cda --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_forcing.F @@ -0,0 +1,221 @@ +C $Header: /u/gcmpack/MITgcm/pkg/shelfice/shelfice_forcing.F,v 1.6 2015/04/22 13:12:19 dgoldberg Exp $ +C $Name: $ + +#include "SHELFICE_OPTIONS.h" + +C-- File shelfice_forcing.F: +C-- Contents +C-- o SHELFICE_FORCING_T +C-- o SHELFICE_FORCING_S + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +CBOP +C !ROUTINE: SHELFICE_FORCING_T +C !INTERFACE: + SUBROUTINE SHELFICE_FORCING_T( + U gT_arr, + I iMin,iMax,jMin,jMax, kLev, bi, bj, + I myTime, myIter, myThid ) + +C !DESCRIPTION: \bv +C *==========================================================* +C | S/R SHELFICE_FORCING_T +C | o Contains problem specific forcing for temperature. +C *==========================================================* +C | Adds terms to gT for forcing by shelfice sources +C | e.g. heat flux +C *==========================================================* +C \ev + +C !USES: + IMPLICIT NONE +C == Global data == +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "GRID.h" +c#include "DYNVARS.h" +c#include "FFIELDS.h" +#include "SHELFICE.h" + +C !INPUT/OUTPUT PARAMETERS: +C gT_arr :: the tendency array +C iMin,iMax :: Working range of x-index for applying forcing. +C jMin,jMax :: Working range of y-index for applying forcing. +C kLev :: Current vertical level index +C bi,bj :: Current tile indices +C myTime :: Current time in simulation +C myIter :: Current iteration number +C myThid :: my Thread Id number + _RL gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + INTEGER iMin, iMax, jMin, jMax + INTEGER kLev, bi, bj + _RL myTime + INTEGER myIter + INTEGER myThid + +#ifdef ALLOW_SHELFICE +C !LOCAL VARIABLES: +C == Local variables == +C i,j :: Loop counters +C kp1,km1 :: index of next/previous level +C gTloc :: local tendency in boundary layer +C drLoc :: fractional cell width of boundary layer in (k+/-1)th layer + INTEGER i, j + INTEGER Kp1, Km1 + _RS drLoc + _RL gTloc +CEOP + +C-- Forcing term + IF ( SHELFICEboundaryLayer ) THEN + DO j=1,sNy + DO i=1,sNx + IF ( kLev .LT. Nr .AND. kLev .EQ. kTopC(I,J,bi,bj) ) THEN + kp1 = MIN(kLev+1,Nr) + drLoc = drF(kLev)*( 1. _d 0 - _hFacC(I,J,kLev,bi,bj) ) + drLoc = MIN( drLoc, drF(Kp1) * _hFacC(I,J,Kp1,bi,bj) ) + drLoc = MAX( drLoc, 0. _d 0) + gTloc = shelficeForcingT(i,j,bi,bj) + & /( drF(kLev)*_hFacC(I,J,kLev,bi,bj)+drLoc ) + gT_arr(i,j) = gT_arr(i,j) + gTloc + ELSEIF ( kLev .GT. 1 .AND. kLev-1 .EQ. kTopC(I,J,bi,bj) ) THEN + km1 = MAX(kLev-1,1) + drLoc = drF(km1)*( 1. _d 0 - _hFacC(I,J,km1,bi,bj) ) + drLoc = MIN( drLoc, drF(kLev) * _hFacC(I,J,kLev,bi,bj) ) + drLoc = MAX( drLoc, 0. _d 0) + gTloc = shelficeForcingT(i,j,bi,bj) + & /( drF(km1)*_hFacC(I,J,km1,bi,bj)+drLoc ) +C The following is shorthand for the averaged tendency: +C gT(k+1) = gT(k+1) + { gTloc * [drF(k)*(1-hFacC(k))] +C + 0 * [drF(k+1) - drF(k)*(1-hFacC(k))] +C }/[drF(k+1)*hFacC(k+1)] + gT_arr(i,j) = gT_arr(i,j) + gTloc + & * drLoc*recip_drF(kLev)* _recip_hFacC(i,j,kLev,bi,bj) + ENDIF + ENDDO + ENDDO + ENDIF + +#ifdef shelfice_new_thermo + DO j=1,sNy + DO i=1,sNx +C-- TENDENCY FROM ICE FRONT + gT_arr(i,j) = gT_arr(i,j) + iceFrontForcingT(i,j,kLev,bi,bj) + +C-- TENDENCY FROM ICE SHELF + IF ( kLev .EQ. kTopC(I,J,bi,bj) ) THEN + gT_arr(i,j) = gT_arr(i,j) + shelficeForcingT(i,j,bi,bj) + ENDIF + ENDDO + ENDDO +#endif /* shelfice_new_thermo */ + +#endif /* ALLOW_SHELFICE */ + RETURN + END + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +CBOP +C !ROUTINE: SHELFICE_FORCING_S +C !INTERFACE: + SUBROUTINE SHELFICE_FORCING_S( + U gS_arr, + I iMin,iMax,jMin,jMax, kLev, bi, bj, + I myTime, myIter, myThid ) + +C !DESCRIPTION: \bv +C *==========================================================* +C | S/R SHELFICE_FORCING_S +C | o Contains problem specific forcing for merid velocity. +C *==========================================================* +C | Adds terms to gS for forcing by shelfice sources +C | e.g. fresh-water flux (virtual salt flux). +C *==========================================================* +C \ev + +C !USES: + IMPLICIT NONE +C == Global data == +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "GRID.h" +c#include "DYNVARS.h" +c#include "FFIELDS.h" +#include "SHELFICE.h" + +C !INPUT/OUTPUT PARAMETERS: +C gS_arr :: the tendency array +C iMin,iMax :: Working range of x-index for applying forcing. +C jMin,jMax :: Working range of y-index for applying forcing. +C kLev :: Current vertical level index +C bi,bj :: Current tile indices +C myTime :: Current time in simulation +C myIter :: Current iteration number +C myThid :: my Thread Id number + _RL gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy) + INTEGER iMin, iMax, jMin, jMax + INTEGER kLev, bi, bj + _RL myTime + INTEGER myIter + INTEGER myThid + +#ifdef ALLOW_SHELFICE +C !LOCAL VARIABLES: +C i,j :: Loop counters +C kp/m1 :: index of next/previous level +C gTloc :: local tendency in boundary layer +C drLoc :: fractional cell width of boundary layer + INTEGER i, j + INTEGER Kp1, Km1 + _RS drLoc + _RL gSloc +CEOP + +C-- Forcing term + IF ( SHELFICEboundaryLayer ) THEN + DO j=1,sNy + DO i=1,sNx + IF ( kLev .LT. Nr .AND. kLev .EQ. kTopC(I,J,bi,bj) ) THEN + kp1 = MIN(kLev+1,Nr) + drLoc = drF(kLev)*( 1. _d 0 - _hFacC(I,J,kLev,bi,bj) ) + drLoc = MIN( drLoc, drF(Kp1) * _hFacC(I,J,Kp1,bi,bj) ) + drLoc = MAX( drLoc, 0. _d 0) + gSloc = shelficeForcingS(i,j,bi,bj) + & /( drF(kLev)*_hFacC(I,J,kLev,bi,bj)+drLoc ) + gS_arr(i,j) = gS_arr(i,j) + gSloc + ELSEIF ( kLev .GT. 1 .AND. kLev-1 .EQ. kTopC(I,J,bi,bj) ) THEN + km1 = MAX(kLev-1,1) + drLoc = drF(km1)*( 1. _d 0 - _hFacC(I,J,km1,bi,bj) ) + drLoc = MIN( drLoc, drF(kLev) * _hFacC(I,J,kLev,bi,bj) ) + drLoc = MAX( drLoc, 0. _d 0) + gSloc = shelficeForcingS(i,j,bi,bj) + & /( drF(km1)*_hFacC(I,J,km1,bi,bj)+drLoc ) +C The following is shorthand for the averaged tendency: +C gS(k+1) = gS(k+1) + { gSloc * [drF(k)*(1-hFacC(k))] +C + 0 * [drF(k+1) - drF(k)*(1-hFacC(k))] +C }/[drF(k+1)*hFacC(k+1)] + gS_arr(i,j) = gS_arr(i,j) + gSloc + & * drLoc*recip_drF(kLev)* _recip_hFacC(i,j,kLev,bi,bj) + ENDIF + ENDDO + ENDDO + ENDIF + +#ifdef shelfice_new_thermo + DO j=1,sNy + DO i=1,sNx +C-- TENDENCY FROM ICE FRONT + gS_arr(i,j) = gS_arr(i,j) + iceFrontForcingS(i,j,kLev,bi,bj) +C-- TENDENCY FROM ICE SHELF + IF ( kLev .EQ. kTopC(I,J,bi,bj) ) THEN + gS_arr(i,j) = gS_arr(i,j) + shelficeForcingS(i,j,bi,bj) + ENDIF + ENDDO + ENDDO +#endif /* shelfice_new_thermo */ + +#endif /* ALLOW_SHELFICE */ + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_forcing_surf.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_forcing_surf.F new file mode 100644 index 0000000..d648ada --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_forcing_surf.F @@ -0,0 +1,155 @@ +#include "SHELFICE_OPTIONS.h" + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +CBOP +C !ROUTINE: SHELFICE_FORCING_SURF +C !INTERFACE: + SUBROUTINE SHELFICE_FORCING_SURF( + I bi, bj, iMin, iMax, jMin, jMax, + I myTime, myIter, myThid ) +C !DESCRIPTION: \bv +C *==========================================================* +C | S/R SHELFICE_FORCING_SURF +C | o Contains problem specific surface forcing +C *==========================================================* +C \ev + +C !USES: + IMPLICIT NONE +C == Global data == +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "GRID.h" +c#include "DYNVARS.h" +#include "SURFACE.h" +#include "FFIELDS.h" +#include "SHELFICE.h" + +C !INPUT/OUTPUT PARAMETERS: +C == Routine arguments == +C bi,bj :: Current tile indices +C iMin,iMax :: Working range of x-index for applying forcing. +C jMin,jMax :: Working range of y-index for applying forcing. +C myTime :: Current time in simulation +C myIter :: Current iteration number in simulation +C myThid :: Thread Id number + INTEGER bi, bj + INTEGER iMin, iMax, jMin, jMax + _RL myTime + INTEGER myIter + INTEGER myThid + +#ifdef ALLOW_SHELFICE +C !LOCAL VARIABLES: +C == Local variables == +C i,j :: Loop counters + INTEGER i, j + LOGICAL SHI_useRealFWflux +CEOP + + SHI_useRealFWflux = useRealFreshWaterFlux .AND. + & ( .NOT.SHELFICEboundaryLayer .OR. SHI_withBL_realFWflux ) + +c DO bj=myByLo(myThid),myByHi(myThid) +c DO bi=myBxLo(myThid),myBxHi(myThid) + +C-- Zero out surface forcing terms below ice-shelf + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + IF ( kTopC(i,j,bi,bj).NE.0 ) THEN + surfaceForcingT(i,j,bi,bj) = 0. + surfaceForcingS(i,j,bi,bj) = 0. + EmPmR(i,j,bi,bj) = 0. + Qsw (i,j,bi,bj) = 0. +C- just for consistent diagnostics, also reset Qnet: + Qnet (i,j,bi,bj) = 0. + ENDIF + ENDDO + ENDDO + DO j=1-OLy,sNy+OLy + DO i=2-OLx,sNx+OLx + IF ( MAX( kTopC(i-1,j,bi,bj), kTopC(i,j,bi,bj) ).NE.0 ) THEN + surfaceForcingU(i,j,bi,bj) = 0. + ENDIF + ENDDO + ENDDO + DO j=2-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + IF ( MAX( kTopC(i,j-1,bi,bj), kTopC(i,j,bi,bj) ).NE.0 ) THEN + surfaceForcingV(i,j,bi,bj) = 0. + ENDIF + ENDDO + ENDDO + +C-- Forcing term + +#ifndef shelfice_new_thermo + + IF ( .NOT.SHELFICEboundaryLayer ) THEN +C- for now, forcing using SHELFICEboundaryLayer is done separately +C (calling SHELFICE_FORCING_T & _S from APPLY_FORCING_T & _S) + DO j=1,sNy + DO i=1,sNx + IF ( kTopC(i,j,bi,bj).NE.0 ) THEN + surfaceForcingT(i,j,bi,bj) = shelficeForcingT(i,j,bi,bj) + surfaceForcingS(i,j,bi,bj) = shelficeForcingS(i,j,bi,bj) + ENDIF + ENDDO + ENDDO + ENDIF + + IF ( SHI_useRealFWflux ) THEN +C- Allows PmE to be used even if boundary layer is being used, +C as long as SHI_withBL_realFWflux is set to account for advective flux +#ifdef ALLOW_AUTODIFF + STOP 'RealFreshWaterFlux disabled in SHELFICE_FORCING_SURF' +#else /* ALLOW_AUTODIFF */ + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx +c IF ( kTopC(i,j,bi,bj).NE.0 ) THEN + EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj) + & + shelfIceFreshWaterFlux(i,j,bi,bj) +c ENDIF + ENDDO + ENDDO +#endif /* ALLOW_AUTODIFF */ + ENDIF +#endif /* shelfice_new_thermo */ + +#ifdef EXACT_CONSERV + IF ( staggerTimeStep ) THEN + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + PmEpR(i,j,bi,bj) = -EmPmR(i,j,bi,bj) + ENDDO + ENDDO + ENDIF +#endif /* EXACT_CONSERV */ + + IF ( usingZCoords ) THEN + DO j = jMin, jMax + DO i = iMin, iMax + phi0surf(i,j,bi,bj) = phi0surf(i,j,bi,bj) + & + shelficeLoadAnomaly(i,j,bi,bj)*recip_rhoConst + ENDDO + ENDDO + ENDIF + +#ifdef ALLOW_DIAGNOSTICS + IF ( useDiagnostics ) THEN + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + shelficeDragU(i,j,bi,bj) = 0. + shelficeDragV(i,j,bi,bj) = 0. + ENDDO + ENDDO + ENDIF +#endif /* ALLOW_DIAGNOSTICS */ + +c ENDDO +c ENDDO + +#endif /* ALLOW_SHELFICE */ + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_depths.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_depths.F new file mode 100644 index 0000000..6da9f6e --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_depths.F @@ -0,0 +1,125 @@ +#include "SHELFICE_OPTIONS.h" + +CBOP +C !ROUTINE: SHELFICE_INIT_DEPTHS +C !INTERFACE: + SUBROUTINE SHELFICE_INIT_DEPTHS( + U rLowC, rSurfC, + I myThid ) +C !DESCRIPTION: \bv +C *==========================================================* +C | SUBROUTINE SHELFICE_INIT_DEPTHS +C | o Modify ocean upper boundary position according to +C | ice-shelf topography +C *==========================================================* +C \ev + +C !USES: + IMPLICIT NONE +C === Global variables === +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#ifdef ALLOW_SHELFICE +# include "SHELFICE.h" +#endif /* ALLOW_SHELFICE */ + +C !INPUT/OUTPUT PARAMETERS: +C == Routine arguments == +C rLowC :: base of fluid column in r_unit at grid-cell center +C rSurfC :: surface reference position (r_unit) at grid-cell center +C myThid :: my Thread Id number + _RS rLowC (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + _RS rSurfC (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + INTEGER myThid + +#ifdef ALLOW_SHELFICE +C !LOCAL VARIABLES: +C == Local variables == +C bi, bj :: tile indices +C i, j :: Loop counters + INTEGER bi, bj + INTEGER i, j +CEOP + +C-- Initialize R_shelfIce + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + R_shelfIce(i,j,bi,bj) = 0. _d 0 + ENDDO + ENDDO + ENDDO + ENDDO + + IF ( SHELFICEtopoFile .NE. ' ' ) THEN + _BARRIER +C- Read the shelfIce draught using the mid-level I/O pacakage read_write_rec +C The 0 is the "iteration" argument. The 1 is the record number. + CALL READ_REC_XY_RS( SHELFICEtopoFile, R_shelfIce, + & 1, 0, myThid ) +C- Read the shelfIce draught using the mid-level I/O pacakage read_write_fld +C The 0 is the "iteration" argument. The ' ' is an empty suffix +C CALL READ_FLD_XY_RS( SHELFICEtopoFile, ' ', R_shelfIce, +C & 0, myThid ) +C- end setup R_shelfIce in the interior + ENDIF + +#ifdef ALLOW_SHELFICE_REMESHING + IF ( SHELFICEremeshFrequency.GT.zeroRL .AND. + & ( nIter0.NE.0 .OR. startTime.NE.baseTime + & .OR. pickupSuff.NE.' ') ) THEN + CALL SHELFICE_READ_PICKUP( 0, nIter0, myThid ) + ENDIF +#endif /* ALLOW_SHELFICE_REMESHING */ + +C- fill in the overlap (+ BARRIER): + _EXCH_XY_RS( R_shelfIce, myThid ) + +C-- Modify ocean upper boundary position according to ice-shelf topography + IF ( usingZCoords ) THEN + DO bj=myByLo(myThid), myByHi(myThid) + DO bi=myBxLo(myThid), myBxHi(myThid) + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + rSurfC(i,j,bi,bj) = + & MIN( rSurfC(i,j,bi,bj), R_shelfIce(i,j,bi,bj) ) + ENDDO + ENDDO + ENDDO + ENDDO + ELSE + STOP 'SHELFICE_INIT_DEPTHS: Missing code for P-coords' + ENDIF + +C---- ICEFRONT BEGIN + IF ( ICEFRONTlengthFile .NE. ' ' ) THEN + CALL READ_FLD_XY_RS( ICEFRONTlengthFile, ' ', + & icefrontlength, 0, myThid ) + _EXCH_XY_RS( icefrontlength, myThid ) + ENDIF + + IF ( ICEFRONTdepthFile .NE. ' ' ) THEN + CALL READ_FLD_XY_RS( ICEFRONTdepthFile, ' ', + & R_icefront, 0, myThid ) + _EXCH_XY_RS( R_icefront, myThid ) + ENDIF + +C Make sure that R_icefront is positive + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO J = 1-OLy, sNy+OLy + DO I = 1-OLx, sNx+OLx + R_icefront(I,J,bi,bj) = ABS(R_icefront(I,J,bi,bj)) + ENDDO + ENDDO + ENDDO + ENDDO + +C---- ICEFRONT END + +#endif /* ALLOW_SHELFICE */ + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_fixed.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_fixed.F new file mode 100644 index 0000000..f9279c7 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_fixed.F @@ -0,0 +1,677 @@ +#include "SHELFICE_OPTIONS.h" +#ifdef ALLOW_COST +# include "COST_OPTIONS.h" +#endif +#ifdef ALLOW_CTRL +# include "CTRL_OPTIONS.h" +#endif + + SUBROUTINE SHELFICE_INIT_FIXED( myThid ) +C *============================================================* +C | SUBROUTINE SHELFICE_INIT_FIXED +C | o Routine to initialize SHELFICE parameters and variables. +C *============================================================* +C | Initialize SHELFICE parameters and variables. +C *============================================================* + IMPLICIT NONE + +C === Global variables === +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "GRID.h" +#include "SHELFICE.h" +#ifdef ALLOW_COST +# include "cost.h" +# include "SHELFICE_COST.h" +#endif /* ALLOW_COST */ + +C === Routine arguments === +C myThid :: Number of this instance of SHELFICE_INIT_FIXED + INTEGER myThid + +#ifdef ALLOW_SHELFICE +C === Local variables === +C i, j, bi, bj :: Loop counters + INTEGER i, j, bi, bj +#ifdef ALLOW_DIAGNOSTICS + INTEGER diagNum + INTEGER diagMate + CHARACTER*8 diagName + CHARACTER*16 diagCode + CHARACTER*16 diagUnits + CHARACTER*(80) diagTitle +#endif /* ALLOW_DIAGNOSTICS */ +chzh[ +c#ifdef ALLOW_CTRL +chzh] + INTEGER k +# ifdef ALLOW_SHIFWFLX_COST_CONTRIBUTION + _RL dummy +# endif +chzh[ +c#endif +chzh] + +C local variabls used to determine shelf-ice and ice-front masks +C iceFrontCellThickness :: the ratio of the horizontal length +C of the ice front in each model grid cell +C divided by the grid cell area. The "thickness" +C of the colum perpendicular to the front +C iceFrontWidth :: the width of the ice front. + + INTEGER CURI, CURJ, FRONT_K + _RL ice_bottom_Z_C + _RL wet_top_Z_N, wet_bottom_Z_N + _RL iceFrontWetContact_Z_max + _RL iceFrontContact_H + _RL iceFrontVertContactFrac, iceFrontCellThickness + _RL iceFrontWidth, iceFrontFaceArea + _RS fK_icefront (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + + INTEGER SI + _RL epsilon_H + character*200 msgBuf + +#ifdef ALLOW_MNC +C Initialize MNC variable information for SHELFICE + IF ( useMNC .AND. (shelfice_tave_mnc.OR.shelfice_dump_mnc) + & ) THEN + CALL SHELFICE_MNC_INIT( myThid ) + ENDIF +#endif /* ALLOW_MNC */ + +C----------------------------------------------------------------------- +C-- Initialize SHELFICE variables kTopC +C-- kTopC is the same as kSurfC, except outside ice-shelf area: +C-- kTop = 0 where there is no ice-shelf (where kSurfC=1) +C-- and over land (completely dry column) where kSurfC = Nr+1 +C----------------------------------------------------------------------- + + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1-OLy, sNy+OLy + DO i = 1-OLx, sNx+OLx + IF ( kSurfC(i,j,bi,bj).LE.Nr .AND. + & Ro_surf(i,j,bi,bj).LT.rF(1) ) THEN + kTopC(i,j,bi,bj) = kSurfC(i,j,bi,bj) + ELSE + kTopC(i,j,bi,bj) = 0 + ENDIF + shelficeMassInit (i,j,bi,bj) = 0. _d 0 + shelficeLoadAnomaly(i,j,bi,bj) = 0. _d 0 + shelfIceMassDynTendency(i,j,bi,bj) = 0. _d 0 + icefrontlength(i,j,bi,bj) = 0. _d 0 + ENDDO + ENDDO + ENDDO + ENDDO + +#ifdef ALLOW_CTRL +C maskSHI is a hack to play along with the general ctrl-package +C infrastructure, where only the k=1 layer of a 3D mask is used +C for 2D fields. We cannot use maskInC instead, because routines +C like ctrl_get_gen and ctrl_set_unpack_xy require 3D masks. + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO k=1,Nr + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + maskSHI(i,j,k,bi,bj) = 0. _d 0 + ENDDO + ENDDO + ENDDO + DO k=1,Nr + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + IF ( Ro_surf(i,j,bi,bj).LT.rF(1) + & .AND. maskC(i,j,k,bi,bj).NE.zeroRS ) THEN + maskSHI(i,j,k,bi,bj) = 1. _d 0 + maskSHI(i,j,1,bi,bj) = 1. _d 0 + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO +#endif /* ALLOW_CTRL */ + +C 06/29/2018 +C ow - maskSHI above is not consistent with the spirit of gencost. Use mask2dSHI and mask3dSHI below +C ow - instead. +C ow - mask2dSHI and mask3dSHI are the 2d and 3d mask for shelfice. They are zero if there is no +C ow - shelfice and one if otherwise. For any i,j, if there is at least one non-zero mask3dSHI in +C ow - the vertical, then mask2dSHI at i,j is one. + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO k=1,Nr + DO j=1-OLy,sNy+OLy + DO i=1-OLx,sNx+OLx + mask3dSHIICF(i,j,k,bi,bj) = 0. _d 0 + mask3dSHI(i,j,k,bi,bj) = 0. _d 0 + mask3dICF(i,j,k,bi,bj) = 0. _d 0 + if(k.eq.1)then + mask2dSHIICF(i,j,bi,bj) = 0. _d 0 + mask2dSHI(i,j,bi,bj) = 0. _d 0 + mask2dICF(i,j,bi,bj) = 0. _d 0 + endif + ENDDO + ENDDO + ENDDO + + DO J = 1-OLy,sNy+OLy + DO I = 1-OLx,sNx+OLx + DO SI = 1,4 + CURI_ARR(I,J,bi,bj,SI) = -9999 + CURJ_ARR(I,J,bi,bj,SI) = -9999 + icefrontwidth_arr(I,J,bi,bj,SI) = 0. _d 0 + ENDDO /* SI */ + ENDDO /* I */ + ENDDO /* J */ + + ENDDO + ENDDO + + +#ifdef ALLOW_COST +#if (defined (ALLOW_SHIFWFLX_COST_CONTRIBUTION) && \ + defined (ALLOW_SHIFWFLX_CONTROL)) + IF ( shifwflx_errfile .NE. ' ' ) THEN + CALL READ_REC_XY_RL( shifwflx_errfile, wshifwflx, 1, 0, myThid ) + ENDIF + + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1-OLy, sNy+OLy + DO i = 1-OLx, sNx+OLx +c-- Test for missing values. + IF (wshifwflx(i,j,bi,bj) .LT. -9900.) THEN + wshifwflx(i,j,bi,bj) = 0. _d 0 + ENDIF +c-- use weight as mask + wshifwflx(i,j,bi,bj) = + & max(wshifwflx(i,j,bi,bj),wshifwflx0) + & *maskSHI(i,j,1,bi,bj) + IF (wshifwflx(i,j,bi,bj) .NE. 0.) THEN + wshifwflx(i,j,bi,bj) = + & 1./wshifwflx(i,j,bi,bj)/wshifwflx(i,j,bi,bj) + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CALL ACTIVE_WRITE_XY_LOC( 'wshifwflx', wshifwflx, + & 1, 0, myThid, dummy ) +#endif /* ALLOW_SHIFWFLX_COST_CONTRIBUTION and ALLOW_SHIFWFLX_CONTROL */ +#endif /* ALLOW_COST */ + + IF ( SHELFICEloadAnomalyFile .NE. ' ' ) THEN + CALL READ_FLD_XY_RL( SHELFICEloadAnomalyFile, ' ', + & shelficeLoadAnomaly, 0, myThid ) + ENDIF + IF ( SHELFICEmassFile.NE.' ' ) THEN + CALL READ_FLD_XY_RL( SHELFICEmassFile, ' ', + & shelficeMassInit, 0, myThid ) + ELSE + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1, sNy + DO i = 1, sNx + shelficeMassInit(i,j,bi,bj) = + & shelficeLoadAnomaly(i,j,bi,bj)*recip_gravity + & - rhoConst*Ro_surf(i,j,bi,bj) + ENDDO + ENDDO + ENDDO + ENDDO + ENDIF + _EXCH_XY_RL( shelficeMassInit, myThid ) + CALL WRITE_FLD_XY_RL ( 'shelficemassinit', ' ', + & shelficeMassInit, 0, myThid ) + +c IF ( SHELFICEloadAnomalyFile .EQ. ' ' ) THEN +C- In case we need shelficeLoadAnomaly in phi0surf for initial pressure +C calculation (if using selectP_inEOS_Zc=2 or 3) + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1-OLy, sNy+OLy + DO i = 1-OLx, sNx+OLx + shelficeLoadAnomaly(i,j,bi,bj) = gravity + & *(shelficeMassInit(i,j,bi,bj)+rhoConst*Ro_surf(i,j,bi,bj)) + ENDDO + ENDDO + ENDDO + ENDDO +c ELSE +c _EXCH_XY_RS( shelficeLoadAnomaly, myThid ) +c ENDIF + IF ( debugLevel.GE.debLevC ) THEN + CALL WRITE_FLD_XY_RL( 'SHICE_pLoadAnom', ' ', + I shelficeLoadAnomaly, -1, myThid ) + ENDIF + + IF ( SHELFICEMassStepping .AND. + & SHELFICEMassDynTendFile .NE. ' ' ) THEN + CALL READ_FLD_XY_RS( SHELFICEMassDynTendFile, ' ', + & shelfIceMassDynTendency, 0, myThid ) + ENDIF + +C-- ICEFRONT parameters (BEGIN) + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO J = 1-OLy, sNy+OLy + DO I = 1-OLx, sNx+OLx + K_icefront(i,j,bi,bj) = 0 + DO K = 1 , Nr + IF ( R_icefront(I,J,bi,bj) .GT. ABS(rF(K))) + & K_icefront(I,J,bi,bj) = K + ENDDO + fK_icefront(i,j,bi,bj) = 0.+K_icefront(i,j,bi,bj) + ENDDO + ENDDO + ENDDO + ENDDO +C-- ICEFRONT parameters (END) + +C create masks for shelf-ice and ice-front by modifyig code from shelfice_thermodynamics.F +C-- minimum fraction of a cell adjacent to an ice front that must be +C-- wet for exchange to happen + epsilon_H = 1. _d -03 + + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + +C-- First ice front then ice shelf. Loop through each i,j point +C-- process ice fronts in k, then process ice shelf. + DO J = 1-OLy+1,sNy+OLy-1 + DO I = 1-OLx+1,sNx+OLx-1 + +C-- The K index where the ice front ends (0 if no ice front) + FRONT_K = K_icefront(I,J,bi,bj) + +C-- If there is an ice front at this (I,J) continue + IF (FRONT_K .GT. 0) THEN + +C-- Loop through all depths where the ice front is fround + DO K = 1, FRONT_K +C-- Loop around the four laterally neighboring cells of the ice front. +C-- If any neighboring points has wet volume in contact with the ice +C-- front at (I,J) then calculate ice-ocean exchanges. +C-- The four laterally neighboring point are at (CURI,CURJ) + DO SI = 1,4 + IF (SI .EQ. 1) THEN +C-- Looking to right + CURI = I+1 + CURJ = J + + iceFrontWidth = dyG(I+1,J,bi,bj) + + ELSEIF (SI .EQ. 2) THEN +C-- Looking to LEFT + CURI = I-1 + CURJ = J + + iceFrontWidth = dyG(I,J,bi,bj) + ELSEIF (SI .EQ. 3) THEN +C-- Looking to NORTH + CURI = I + CURJ = J+1 + + iceFrontWidth = dxG(I,J+1,bi,bj) + ELSEIF (SI .EQ. 4) THEN +C-- Looking to south + CURI = I + CURJ = J-1 + + iceFrontWidth = dxG(I,J,bi,bj) + endif + + CURI_ARR(I,J,bi,bj,SI) = CURI + CURJ_ARR(I,J,bi,bj,SI) = CURJ + iceFrontWidth_arr(I,J,bi,bj,SI) = iceFrontWidth + +C-- cell depth describes the average distance +C-- perpendicular to the ice front fact + + if (iceFrontWidth < 1.0e-8) then + iceFrontCellThickness = 0 + iceFrontFaceArea = 0 + else + iceFrontCellThickness = RA(CURI,CURJ,bi,bj) + & /iceFrontWidth + iceFrontFaceArea = DRF(K)*iceFrontWidth + endif + +C-- First, make sure the adjacent point has at least some water in it. + IF (_hFacC(CURI,CURJ,K,bi,bj) .GT. zeroRL) THEN + +C-- we need to determine how much of the ice front is in contact with +C-- water in the neighboring grid cell at this depth level. + +C-- 1. Determine the top depth with water in the current cell +C-- 2. Determine the top depth with water in the neighbor cell +C-- 3. Determine the depth where water gap between (1) and (2). +C-- 4. If there is a gap then ice front is in contact with water in +C-- the neighboring cell + +C-- ice_bottom_Z_C: the depth (m) of the bottom of the ice in the +C-- current cell. Bounded between rF(K) and rF(K+1). +C-- * If the ice extends past the bottom of the cell then +C-- ice_bottom_Z_C = rF(K+1) +C-- [rF(k) >= ice_bottom_Z_C >= rF(K+1)] (rF is negative) + ice_bottom_Z_C = max(rF(K+1), + & min(Ro_surf(I,J, bi,bj), rF(K))) + +C-- wet_top_Z_N: the depth (m) of the bottom of the ice in the +C-- neighboring grid. If the neighboring cell has ice in +C-- (in the form of a shelf or front) then wet_top_Z_N is +C-- the depth of this neighboring ice. +C-- +C-- * If neighbor cell has no ice, then Ro_surf = 0 and +C-- wet_top_Z_N = rF(K) +C-- [rF(k) >= wet_top_Z_N >= rF(K+1)] (rF is negative) + + wet_top_Z_N = max(rF(K+1), + & min(Ro_surf(CURI,CURJ, bi,bj), rF(K))) + +C-- wet_bottom_Z_N: the depth (m) of the bottom of the wet part of the +C-- neighboring cell. If the seafloor reaches into +C-- the grid cell then the bottom of the wet part of the +C-- grid cell is at the seafloor. +C-- +C-- * If the seafloor is deeper than this grid cell then +C-- wet_bottom_Z = rF(K+1) +C-- * If the seafloor is shallower than this grid cell then +C-- wet_bottom_Z = rF(K) +C-- * If the seafloor reaches partly into this grid cell +C-- then wet_bottom_Z = R_low + +C-- [rF(k) >= wet_bottom_Z >= rF(K+1)] (rF is negative) + + wet_bottom_Z_N = min(rF(K), + & max(R_low(CURI,CURJ, bi,bj), rF(K+1))) + +C-- iceFrontWetContact_Z_max: The deepest point where the +C-- the ice front at (I,J) is in contact with water +C-- in the neighboring cell. The shallower of +C-- wet_bottom_Z_N (seafloor depth of neighboring point) and +C-- ice_bottom_Z_C (bottom of ice front in this center cell). + +C-- * wet_bottom_Z_N if the seafloor of the neighboring +C-- cell is shallower than the ice draft at (I,J). +C-- * ice_bottom_Z_C if the ice draft at (I,J) is shallower +C-- than the seafloor of the neighboring cell. + + IF (ice_bottom_Z_C .GT. wet_bottom_Z_N) THEN + iceFrontWetContact_Z_max = ice_bottom_Z_C + ELSE + iceFrontWetContact_Z_max = wet_bottom_Z_N + ENDIF + +C-- The shallowest depth where the ice front at (I,J) is in contact +C-- with water in the neighboring cell. If the neighboring cell has +C-- no ice draft then wet_top_Z_N = rF(k), the top of the cell. +C-- Otherwise, the shallowest depth where the ice front at (I,J) can +C-- be in in contact with water (not ice) in (CURI, CURJ) +C-- is wet_top_Z_N. + +C-- the fraction of the grid cell height that has ice draft in contact +C-- with water in the neighboring cell. + iceFrontVertContactFrac = + & (wet_top_Z_N - iceFrontWetContact_Z_max)/ DRF(K) +C-- Only proceed if iceFrontVertContactFrac is > 0, the +C-- ice draft at (I,J) +C-- is in contact with some water in the neighboring grid cell. + WRITE(msgBuf,'(A,3I4,L3,8e14.5)') + &'ZZZ, CURI, CURJ, K', CURI,CURJ,K, + & iceFrontVertContactFrac .GT. epsilon_H, + & wet_top_Z_N, iceFrontWetContact_Z_max, + & ice_bottom_Z_C, wet_bottom_Z_N, + & rF(K+1), Ro_surf(I,J, bi,bj), rF(K) + + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT , 1) + + IF (iceFrontVertContactFrac .GT. epsilon_H) THEN + mask3dSHIICF(CURI,CURJ,K,bi,bj) = 1. _d 0 + mask2dSHIICF(CURI,CURJ,bi,bj) = 1. _d 0 + mask3dICF(CURI,CURJ,K,bi,bj) = 1. _d 0 + mask2dICF(CURI,CURJ,bi,bj) = 1. _d 0 + ENDIF /* iceFrontVertContactFrac */ + ENDIF /* hFacC(CURI,CURJ,K,bi,bj) */ + ENDDO /* SI loop for adjacent cells */ + ENDDO /* K LOOP */ + ENDIF /* FRONT K */ + +C-- ice shelf + K = kTopC(I,J,bi,bj) + +C-- If there is an ice front at this (I,J) continue +C-- I am assuming K is only .GT. when there is at least some +C-- nonzero wet point below the shelf in the grid cell. + IF (K .GT. 0) THEN + mask3dSHIICF(I,J,K,bi,bj) = 1. _d 0 + mask2dSHIICF(I,J,bi,bj) = 1. _d 0 + mask3dSHI(I,J,K,bi,bj) = 1. _d 0 + mask2dSHI(I,J,bi,bj) = 1. _d 0 + ENDIF /* SHELF K > 0 */ + ENDDO /* i */ + ENDDO /* j */ + ENDDO /* bi */ + ENDDO /* bj */ + +c fill in the hilos + _EXCH_XY_RS (mask2dSHIICF , myThid ) + _EXCH_XY_RS (mask2dICF , myThid ) + _EXCH_XY_RS (mask2dSHI , myThid ) + _EXCH_XYZ_RS(mask3dSHIICF , myThid ) + _EXCH_XYZ_RS(mask3dICF , myThid ) + _EXCH_XYZ_RS(mask3dSHI , myThid ) + +C output the masks + CALL WRITE_FLD_XY_RS( 'mask2dSHIICF',' ',mask2dSHIICF,-1,myThid) + CALL WRITE_FLD_XYZ_RS( 'mask3dSHIICF',' ',mask3dSHIICF, 0,myThid) + CALL WRITE_FLD_XY_RS( 'mask2dSHI',' ',mask2dSHI,-1,myThid) + CALL WRITE_FLD_XYZ_RS( 'mask3dSHI',' ',mask3dSHI, 0,myThid) + CALL WRITE_FLD_XY_RS( 'mask2dICF',' ',mask2dICF,-1,myThid) + CALL WRITE_FLD_XYZ_RS( 'mask3dICF',' ',mask3dICF, 0,myThid) + CALL WRITE_FLD_XY_RS( 'R_icefront',' ',R_icefront,-1,myThid) + CALL WRITE_FLD_XY_RS( 'K_icefront',' ',fK_icefront,-1,myThid) + +#ifdef ALLOW_DIAGNOSTICS + IF ( useDiagnostics ) THEN + diagName = 'SHIfwFlx' + diagTitle = 'Ice shelf fresh water flux (positive upward)' + diagUnits = 'kg/m^2/s ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SHIhtFlx' + diagTitle = 'Ice shelf heat flux (positive upward)' + diagUnits = 'W/m^2 ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SHIICFfw' + diagTitle = 'total ice shelf and front FW flux (+ upward)' + diagUnits = 'kg/m^2/s ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SHIICFht' + diagTitle = 'total ice shelf and ice front heat flux (+ upward)' + diagUnits = 'W/m^2 ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'ICFfwFlx' + diagTitle = 'Ice front freshwater flux (+ve increases ocean salt)' + diagUnits = 'kg/m^2/s ' + diagCode = 'SM MR ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'ICFhtFlx' + diagTitle = 'Ice front heat flux (+ve cools ocean)' + diagUnits = 'W/m^2 ' + diagCode = 'SM MR ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SHI_TauX' + diagTitle = + & 'Ice shelf bottom stress, zonal comp., >0 increases uVel' + diagUnits = 'N/m^2 ' + diagCode = 'UU L1 ' + diagMate = diagNum + 2 + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'SHI_TauY' + diagTitle = + & 'Ice shelf bottom stress, merid. comp., >0 increases vVel' + diagUnits = 'N/m^2 ' + diagCode = 'VV L1 ' + diagMate = diagNum + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, diagMate, myThid ) + + diagName = 'SHIForcT' + diagTitle = 'Ice shelf forcing for theta, >0 increases theta' + diagUnits = 'W/m^2 ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SHIForcS' + diagTitle = 'Ice shelf forcing for salt, >0 increases salt' + diagUnits = 'g/m^2/s ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'ICFForcT' + diagTitle = 'Ice front forcing for theta, >0 increases theta' + diagUnits = 'W/m^2 ' + diagCode = 'SM MR ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'ICFForcS' + diagTitle = 'Ice front forcing for salt, >0 increases salt' + diagUnits = 'g/m^2/s ' + diagCode = 'SM MR ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SHIICFFT' + diagTitle = 'total SHI and ICF forcing for T, >0 increases theta' + diagUnits = 'W/m^2 ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SHIICFFS' + diagTitle = 'total SHI and ICF forcing for S, >0 increases salt' + diagUnits = 'g/m^2/s ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + +#ifndef ALLOW_shiTransCoeff_3d + diagName = 'SHIgammT' + diagTitle = 'Ice shelf exchange coefficient for theta' + diagUnits = 'm/s ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SHIgammS' + diagTitle = 'Ice shelf exchange coefficient for salt' + diagUnits = 'm/s ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) +#else + diagName = 'SHIgammT' + diagTitle = 'Ice shelf exchange coefficient for theta' + diagUnits = 'm/s ' + diagCode = 'SMR MR ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SHIgammS' + diagTitle = 'Ice shelf exchange coefficient for salt' + diagUnits = 'm/s ' + diagCode = 'SMR MR ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) +#endif + + diagName = 'SHI_mass' + diagTitle = 'dynamic ice shelf mass for surface load anomaly' + diagUnits = 'kg/m^2 ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + +#ifdef SHI_ALLOW_GAMMAFRICT + diagName = 'SHIuStar' + diagTitle = 'Friction velocity at bottom of ice shelf' + diagUnits = 'm/s ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'SHICDrag' + diagTitle = 'Shelfice drag coefficient for u* parameterization' + diagUnits = '1 ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) +#endif + +#ifdef ALLOW_SHELFICE_REMESHING + diagName = 'SHIRshel' + diagTitle = 'depth of shelfice' + diagUnits = 'm ' + diagCode = 'SM L1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) +#endif + +# ifdef ALLOW_AUTODIFF +# ifndef SHI_ALLOW_GAMMAFRICT + diagName = 'ADJshict' + diagTitle = 'dJ/dgammaT: Sens. to shelfice heat transfer coeff' + diagUnits = 'dJ/(m/s) ' + diagCode = 'SM A M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + + diagName = 'ADJshics' + diagTitle = 'dJ/dgammaS: Sens. to shelfice salt transfer coeff' + diagUnits = 'dJ/(m/s) ' + diagCode = 'SM A M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) + +# else + diagName = 'ADJshicd' + diagTitle = 'dJ/dcDrag: Sensitivity to shelfice u* drag coeff' + diagUnits = 'dJ/1 ' + diagCode = 'SM A M1 ' + CALL DIAGNOSTICS_ADDTOLIST( diagNum, + I diagName, diagCode, diagUnits, diagTitle, 0, myThid ) +# endif +# endif + ENDIF +#endif /* ALLOW_DIAGNOSTICS */ +#endif /* ALLOW_SHELFICE */ + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_varia.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_varia.F new file mode 100644 index 0000000..a347381 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_init_varia.F @@ -0,0 +1,184 @@ +#include "SHELFICE_OPTIONS.h" + +CBOP + SUBROUTINE SHELFICE_INIT_VARIA( myThid ) +C *============================================================* +C | SUBROUTINE SHELFICE_INIT_VARIA +C | o Routine to initialize SHELFICE variables. +C *============================================================* +C | Initialize SHELFICE parameters and variables. +C *============================================================* + IMPLICIT NONE + +C === Global variables === +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "GRID.h" +#include "SHELFICE.h" +#ifdef ALLOW_COST +# include "SHELFICE_COST.h" +#endif /* ALLOW_COST */ + +C === Routine arguments === +C myThid - Number of this instance of SHELFICE_INIT_VARIA + INTEGER myThid +CEndOfInterface + +#ifdef ALLOW_SHELFICE +C === Local variables === +C i,j,bi,bj - Loop counters + INTEGER i, j, k, bi, bj +CEOP + + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1-OLy, sNy+OLy + DO i = 1-OLx, sNx+OLx + shelficeForcingT (i,j,bi,bj) = 0. _d 0 + shelficeForcingS (i,j,bi,bj) = 0. _d 0 + shelficeHeatFlux (i,j,bi,bj) = 0. _d 0 + shelficeFreshWaterFlux(i,j,bi,bj) = 0. _d 0 +#ifndef ALLOW_shiTransCoeff_3d + shiTransCoeffT (i,j,bi,bj) = 0. _d 0 + shiTransCoeffS (i,j,bi,bj) = 0. _d 0 +#endif + shelficeMass (i,j,bi,bj) = 0. _d 0 + shiCDragFld (i,j,bi,bj) = 0. _d 0 + shiDragQuadFld (i,j,bi,bj) = 0. _d 0 + DO k = 1, NR +#ifdef ALLOW_shiTransCoeff_3d + shiTransCoeffT (i,j,k,bi,bj) = 0. _d 0 + shiTransCoeffS (i,j,k,bi,bj) = 0. _d 0 +#endif + iceFrontHeatFlux(i,j,k,bi,bj) = 0. _d 0 + iceFrontFreshWaterFlux(i,j,k,bi,bj) = 0. _d 0 + iceFrontForcingT(i,j,k,bi,bj) = 0. _d 0 + iceFrontForcingS(i,j,k,bi,bj) = 0. _d 0 + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + IF ( .NOT. SHELFICEuseGammaFrict ) THEN + IF ( SHELFICETransCoeffTFile .NE. ' ' ) THEN +#ifndef ALLOW_shiTransCoeff_3d + CALL READ_FLD_XY_RL( SHELFICETransCoeffTFile, ' ', + & shiTransCoeffT, 0, myThid ) + _EXCH_XY_RL( shiTransCoeffT, myThid ) +#else + CALL READ_FLD_XYZ_RL( SHELFICETransCoeffTFile, ' ', + & shiTransCoeffT, 0, myThid ) + _EXCH_XYZ_RL( shiTransCoeffT, myThid ) +#endif + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1-OLy, sNy+OLy + DO i = 1-OLx, sNx+OLx +#ifndef ALLOW_shiTransCoeff_3d + shiTransCoeffS(i,j,bi,bj) = SHELFICEsaltToHeatRatio * + & shiTransCoeffT(i,j,bi,bj) +#else + DO k = 1, Nr + shiTransCoeffS(i,j,k,bi,bj) = SHELFICEsaltToHeatRatio * + & shiTransCoeffT(i,j,k,bi,bj) + ENDDO +#endif + ENDDO + ENDDO + ENDDO + ENDDO + ELSE +C set coefficients to constant values + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1-OLy, sNy+OLy + DO i = 1-OLx, sNx+OLx +#ifndef ALLOW_shiTransCoeff_3d + shiTransCoeffT(i,j,bi,bj) = SHELFICEheatTransCoeff + shiTransCoeffS(i,j,bi,bj) = SHELFICEsaltTransCoeff +#else + DO k = 1, Nr + shiTransCoeffT(i,j,k,bi,bj) = SHELFICEheatTransCoeff + shiTransCoeffS(i,j,k,bi,bj) = SHELFICEsaltTransCoeff + ENDDO +#endif + ENDDO + ENDDO + ENDDO + ENDDO + ENDIF + ENDIF +C Update the spatially varying version of the drag coefficient +C shiCDragFld used in shelfice_thermodynamics +C shiCDragQuadFld used in shelfice_u/v_drag_coeff + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1-OLy, sNy+OLy + DO i = 1-OLx, sNx+OLx + shiCDragFld(i,j,bi,bj) = shiCDrag + shiDragQuadFld(i,j,bi,bj) = SHELFICEDragQuadratic + ENDDO + ENDDO + ENDDO + ENDDO + + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1-OLy, sNy+OLy + DO i = 1-OLx, sNx+OLx + shelficeMass(i,j,bi,bj) = shelficeMassInit(i,j,bi,bj) + ENDDO + ENDDO + ENDDO + ENDDO + + IF ( SHELFICEMassStepping .AND. + & ( nIter0.NE.0 .OR. startTime.NE.baseTime + & .OR. pickupSuff.NE.' ') ) THEN + CALL SHELFICE_READ_PICKUP( 1, nIter0, myThid ) +c ENDIF + +c IF ( SHELFICEMassStepping ) THEN +C set/update "kTopC" to agree with changing ice-shelf mass + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1-OLy, sNy+OLy + DO i = 1-OLx, sNx+OLx + IF ( kSurfC(i,j,bi,bj).LE.Nr .AND. + & shelficeMass(i,j,bi,bj).GT.zeroRL ) THEN + kTopC(i,j,bi,bj) = kSurfC(i,j,bi,bj) + ELSE + kTopC(i,j,bi,bj) = 0 + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + ENDIF + +#ifdef ALLOW_COST + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1-OLy, sNy+OLy + DO i = 1-OLx, sNx+OLx + cMeanSHIforT (i,j,bi,bj) = 0. _d 0 + cMeanSHIforS (i,j,bi,bj) = 0. _d 0 + ENDDO + ENDDO + ENDDO + ENDDO +c-- + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + objf_shelfice(bi,bj) = 0. _d 0 + objf_shifwflx(bi,bj) = 0. _d 0 + num_shifwflx(bi,bj) = 0. _d 0 + ENDDO + ENDDO +#endif /* ALLOW_COST */ + +#endif /* ALLOW_SHELFICE */ + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_readparms.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_readparms.F new file mode 100644 index 0000000..a63bd46 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_readparms.F @@ -0,0 +1,221 @@ +#include "SHELFICE_OPTIONS.h" + +CBOP +C !ROUTINE: SHELFICE_READPARMS + +C !INTERFACE: ========================================================== + SUBROUTINE SHELFICE_READPARMS( myThid ) + +C !DESCRIPTION: +C Initialize SHELFICE parameters, read in data.shelfice + +C !USES: =============================================================== + IMPLICIT NONE +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "SHELFICE.h" +#ifdef ALLOW_COST +# include "SHELFICE_COST.h" +#endif /* ALLOW_COST */ +#ifdef ALLOW_MNC +# include "MNC_PARAMS.h" +#endif + +C !INPUT PARAMETERS: =================================================== +C myThid :: thread number + INTEGER myThid + +C !OUTPUT PARAMETERS: ================================================== +C none + +#ifdef ALLOW_SHELFICE + +C !LOCAL VARIABLES: ==================================================== +C iUnit :: unit number for I/O +C msgBuf :: message buffer + INTEGER iUnit + CHARACTER*(MAX_LEN_MBUF) msgBuf +CEOP + + NAMELIST /SHELFICE_PARM01/ + & SHELFICEsaltToHeatRatio, + & SHELFICEheatTransCoeff, + & SHELFICEsaltTransCoeff, + & SHELFICEMassStepping, + & rhoShelfice, SHELFICEkappa, + & SHELFICElatentHeat, SHELFICEHeatCapacity_Cp, + & no_slip_shelfice, SHELFICEDragLinear, + & SHELFICEDragQuadratic, SHELFICEselectDragQuadr, + & SHELFICEthetaSurface, + & SHELFICEsalinity, + & useISOMIPTD, + & SHELFICEconserve, SHELFICEboundaryLayer, + & SHI_withBL_realFWflux, SHI_withBL_uStarTopDz, + & SHELFICEwriteState, + & SHELFICE_dumpFreq, + & SHELFICE_taveFreq, + & SHELFICE_tave_mnc, + & SHELFICE_dump_mnc, + & SHELFICEtopoFile, + & SHELFICEmassFile, SHELFICEloadAnomalyFile, + & SHELFICEMassDynTendFile, SHELFICETransCoeffTFile, + & ICEFRONTlengthFile, ICEFRONTdepthFile, + & SHELFICEDynMassOnly, + & SHELFICEadvDiffHeatFlux, + & SHELFICEuseGammaFrict, SHELFICE_oldCalcUStar, + & shiCdrag, shiZetaN, shiRc, + & shiPrandtl, shiSchmidt, shiKinVisc, +#ifdef ALLOW_COST + & mult_shelfice, + & mult_shifwflx, wshifwflx0, shifwflx_errfile, +#endif + & SHELFICEremeshFrequency, + & SHELFICEsplitThreshold, SHELFICEmergeThreshold + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + + IF ( .NOT.useShelfIce ) THEN +C- pkg SHELFICE is not used + _BEGIN_MASTER(myThid) +C- Track pkg activation status: + SHELFICEisOn = .FALSE. +C print a (weak) warning if data.shelfice is found + CALL PACKAGES_UNUSED_MSG( 'useShelfIce', ' ', ' ' ) + _END_MASTER(myThid) + RETURN + ENDIF + + _BEGIN_MASTER(myThid) + +C This routine has been called by the main model so we set our +C internal flag to indicate we are in business + SHELFICEisOn = .TRUE. + +C Set defaults values for parameters in SHELFICE.h + useISOMIPTD = .FALSE. + SHELFICEconserve = .FALSE. + SHELFICEboundaryLayer = .FALSE. + SHI_withBL_realFWflux = .FALSE. + SHI_withBL_uStarTopDz = .FALSE. + SHELFICEMassStepping = .FALSE. + SHELFICEDynMassOnly = .FALSE. + SHELFICEtopoFile = ' ' + SHELFICEmassFile = ' ' + SHELFICEloadAnomalyFile = ' ' + SHELFICEMassDynTendFile = ' ' + SHELFICETransCoeffTFile = ' ' + ICEFRONTlengthFile = ' ' + ICEFRONTdepthFile = ' ' + SHELFICElatentHeat = 334.0 _d 3 + SHELFICEHeatCapacity_Cp = 2000.0 _d 0 + rhoShelfIce = 917.0 _d 0 + SHELFICEsaltToHeatRatio = 5.05 _d -03 + SHELFICEheatTransCoeff = 1.0 _d -04 + SHELFICEsaltTransCoeff = UNSET_RL +C-- Molecular thermal conductivity ice shelf (m^2/s) + SHELFICEkappa = 1.54 _d -06 + SHELFICEthetaSurface = - 20.0 _d 0 + SHELFICEsalinity = 0.0 _d 0 + no_slip_shelfice = no_slip_bottom + SHELFICEDragLinear = bottomDragLinear + SHELFICEDragQuadratic = UNSET_RL + SHELFICEselectDragQuadr = -1 + SHELFICEwriteState = .FALSE. + SHELFICE_dumpFreq = dumpFreq + SHELFICE_taveFreq = taveFreq + SHELFICEadvDiffHeatFlux = .FALSE. + SHELFICEuseGammaFrict = .FALSE. + SHELFICE_oldCalcUStar = .FALSE. + SHELFICEremeshFrequency = 0. + SHELFICEsplitThreshold = hFacMin*1.1 _d 0 + 1. _d 0 + SHELFICEmergeThreshold = hFacMin*0.9 _d 0 +C these params. are default of Holland and Jenkins (1999) + shiCdrag = 0.0015 _d 0 + shiZetaN = 0.052 _d 0 + shiRc = 0.2 _d 0 + shiPrandtl = 13.8 _d 0 + shiSchmidt = 2432.0 _d 0 + shiKinVisc = 1.95 _d -6 +#ifdef ALLOW_COST + mult_shelfice = 0. _d 0 + mult_shifwflx = 0. _d 0 + wshifwflx0 = 0. _d 0 + shifwflx_errfile = ' ' +#endif +#ifdef ALLOW_MNC + SHELFICE_tave_mnc = timeave_mnc + SHELFICE_dump_mnc = snapshot_mnc +#else + SHELFICE_tave_mnc = .FALSE. + SHELFICE_dump_mnc = .FALSE. +#endif + +C Open and read the data.shelfice file + WRITE(msgBuf,'(A)') ' SHELFICE_READPARMS: opening data.shelfice' + CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + CALL OPEN_COPY_DATA_FILE( + I 'data.shelfice', 'SHELFICE_READPARMS', + O iUnit, + I myThid ) + READ(UNIT=iUnit,NML=SHELFICE_PARM01) + WRITE(msgBuf,'(A)') + & ' SHELFICE_READPARMS: finished reading data.shelfice' + CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + +C Close the open data file +#ifdef SINGLE_DISK_IO + CLOSE(iUnit) +#else + CLOSE(iUnit,STATUS='DELETE') +#endif /* SINGLE_DISK_IO */ + +C Now set-up any remaining parameters that result from the input parameters + IF ( SHELFICEsaltTransCoeff .EQ. UNSET_RL ) + & SHELFICEsaltTransCoeff = + & SHELFICEsaltToHeatRatio * SHELFICEheatTransCoeff + +C New calcUstar expression not available with SHELFICEboundaryLayer: + IF ( SHELFICEboundaryLayer ) SHELFICE_oldCalcUStar = .TRUE. +C specific options within SHELFICEboundaryLayer: + SHI_withBL_realFWflux = SHI_withBL_realFWflux .AND. + & SHELFICEboundaryLayer .AND. useRealFreshWaterFlux + SHI_withBL_uStarTopDz = SHI_withBL_uStarTopDz .AND. + & SHELFICEboundaryLayer .AND. SHELFICEuseGammaFrict + +C Set quadratic bottom drag depending on choices: + IF ( SHELFICEDragQuadratic .EQ. UNSET_RL) THEN + IF ( SHELFICEuseGammaFrict ) THEN + SHELFICEDragQuadratic = shiCdrag + ELSE + SHELFICEDragQuadratic = bottomDragQuadratic + ENDIF + ENDIF + IF ( SHELFICEDragQuadratic.EQ.0. _d 0 ) THEN + SHELFICEselectDragQuadr = -1 + ELSEIF ( SHELFICEselectDragQuadr.EQ.-1 ) THEN + SHELFICEselectDragQuadr = MAX( 0, selectBotDragQuadr ) + ENDIF + +C- Set Output type flags : + SHELFICE_tave_mdsio = .TRUE. + SHELFICE_dump_mdsio = .TRUE. +#ifdef ALLOW_MNC + IF (useMNC) THEN + IF ( .NOT.outputTypesInclusive + & .AND. SHELFICE_tave_mnc ) SHELFICE_tave_mdsio = .FALSE. + IF ( .NOT.outputTypesInclusive + & .AND. SHELFICE_dump_mnc ) SHELFICE_dump_mdsio = .FALSE. + ENDIF +#endif + + _END_MASTER(myThid) +C Everyone else must wait for the parameters to be loaded + _BARRIER + +#endif /* ALLOW_SHELFICE */ + + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_solve4fluxes.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_solve4fluxes.F new file mode 100644 index 0000000..c588d1c --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_solve4fluxes.F @@ -0,0 +1,287 @@ +#include "SHELFICE_OPTIONS.h" +#ifdef ALLOW_AUTODIFF +# include "AUTODIFF_OPTIONS.h" +#endif +#ifdef ALLOW_CTRL +# include "CTRL_OPTIONS.h" +#endif + +CBOP +C !ROUTINE: SHELFICE_SOLVE4FLUXES +C !INTERFACE: + SUBROUTINE SHELFICE_SOLVE4FLUXES( + I tLoc, sLoc, pLoc, + I gammaT, gammaS, + I iceConductionDistance, thetaIceConduction, + O heatFlux, fwFlux, + O forcingT, forcingS, + I bi, bj, myTime, myIter, myThid ) + +C !DESCRIPTION: \bv +C *==========================================================* +C | SUBROUTINE SOLVE4FLUXES +C | o Calculate +C *==========================================================* +C \ev + +C !USES: + IMPLICIT NONE + +C === Global variables === +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "GRID.h" +#include "DYNVARS.h" +#include "FFIELDS.h" +#include "SHELFICE.h" +#include "SHELFICE_COST.h" +#ifdef ALLOW_AUTODIFF +# include "CTRL_SIZE.h" +# include "ctrl.h" +# include "ctrl_dummy.h" +#endif /* ALLOW_AUTODIFF */ +#ifdef ALLOW_AUTODIFF_TAMC +# ifdef SHI_ALLOW_GAMMAFRICT +# include "tamc.h" +# endif /* SHI_ALLOW_GAMMAFRICT */ +#endif /* ALLOW_AUTODIFF_TAMC */ + +C !INPUT PARAMETERS: +C tLoc :: +C sLoc :: +C pLoc :: +C insitutLoc :: +C gammaT :: +C gammaS :: +C bi,bj :: tile indices +C myTime :: current time in simulation +C myIter :: iteration number in simulation +C myThid :: my Thread Id number + +C !OUTPUT PARAMETERS: +C heatFlux :: +C fwFlux :: +C forcingT :: +C forcingS :: +C---------- + + _RL tLoc, sLoc, pLoc, insitutLoc + _RL gammaT, gammaS + _RL iceConductionDistance, thetaIceConduction + _RL heatFlux, fwFlux, forcingS, forcingT + INTEGER i, j, bi, bj + _RL myTime + INTEGER myIter, myThid + character*200 msgBuf +CEOP + +#ifndef ALLOW_OPENAD + _RL SW_TEMP + EXTERNAL SW_TEMP +#endif + + +C !LOCAL VARIABLES: +C === Local variables === + _RL thetaFreeze, saltFreeze + _RL eps1, eps2, eps3, eps4, eps5, eps6, eps7, eps8 + _RL aqe, bqe, cqe, discrim, recip_aqe + _RL a0, a1, a2, b0, c0 + _RL w_B + +C === Useful Units === +C-- gammaT, m s^-1 +C-- gammaS, m s^-1 +C-- rUnit2mass (rhoConst), kg m^-3 +C-- mass2rUnit (recip_rhoConst), m^3 kg^-1 +C-- eps3, W K^-1 m^-2 +C-- fwFlux, kg m^-2 s^-1 +C-- heatFlux, kg m^-2 s^-1 +C-- forcing T, K m/s +C-- forcing S, psu m/s +C-- SHELFICEkappa, m^2/s +C-- w_B, m/s + +C-- eps1, W K^-1 m^-2 : kg/m^3 * J/kg/K * m/s +C-- eps2, W m^-2 : kg/m^3 * J/kg * m/s +C-- eps3, W K^-1 m^-2 : kg m^-3 * J kg^-1 K^-1 * m^2 s^-1 * m^-1 + +C-- fwFlux : fresh water flux due to melting (kg m^-2 s^-1) + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +C linear dependence of freezing point on salinity + a0 = -0.0575 _d 0 + c0 = 0.0901 _d 0 + b0 = -7.61 _d -4 + +C-- convert potential T into in-situ T relative to surface + insitutLoc = SW_TEMP(sLoc,tLoc,pLoc, zeroRL) + +C-- DEFINE SOME CONSTANTS + eps1 = rUnit2mass*HeatCapacity_Cp * gammaT + eps2 = rUnit2mass*SHELFICElatentHeat * gammaS + eps3 = rhoShelfIce*SHELFICEheatCapacity_Cp * SHELFICEkappa + & /iceConductionDistance; + eps4 = b0*pLoc + c0 + eps6 = eps4 - insitutLoc + eps7 = eps4 - thetaIceConduction + +C-- Default thermodynamics specify a linear T gradient +C-- through the ice (Holland and Jenkins, 1999, Section 2). + IF (SHELFICEadvDiffHeatFlux .EQV. .FALSE.) THEN + aqe = a0*(eps1 + eps3) + bqe = eps1*eps6 + eps3*eps7 - eps2 - SHELFICEsalinity*aqe + cqe = eps2 * sLoc - SHELFICEsalinity*(eps1*eps6 + eps3*eps7) + +C-- Alterantively, we can have a nonlinear T gradient +C-- through the ice (Holland and Jenkins, 1999, Section 3). +C-- This demands a different set of constants + ELSE + eps8 = rUnit2mass * gammaS * SHELFICEheatCapacity_Cp + aqe = a0 *(eps1 - eps8) + bqe = eps1*eps6 + sLoc*eps8*a0 - eps8*eps7 - eps2 - + & SHELFICEsalinity*eps1*a0 + cqe = sLoc*(eps8*eps7 + eps2) - SHELFICEsalinity*eps1 + ENDIF + +C solve quadratic equation for salinity at shelfice-ocean interface + recip_aqe = 0. _d 0 + IF ( aqe .NE. 0. _d 0 ) recip_aqe = 0.5 _d 0/aqe + +C-- Sb = \frac{-bqe \pm \sqrt(bqe^2 - 4 aqc cqe)}{2 aqe} + discrim = bqe*bqe - 4. _d 0*aqe*cqe + +C-- Try the negative root (- SQRT(discrim)) of the quadratic eq. + saltFreeze = (- bqe - SQRT(discrim))*recip_aqe + +C--- If the negative root yields a negative salinity, then use the +C-- positive root (+ SQRT(discrim)) + IF ( saltFreeze .LT. 0. _d 0 ) THEN + saltFreeze = (- bqe + SQRT(discrim))*recip_aqe + ENDIF + +C-- in situ seawater freezing point using linearization + thetaFreeze = a0*saltFreeze + eps4 + +C-- Calculate the upward heat and fresh water fluxes; +C-- MITgcm sign conventions: downward (negative) fresh water flux +C-- implies melting and due to upward (positive) heat flux + +C-- Default thermodynamics specify a linear T gradient +C-- through the ice (Holland and Jenkins, 1999, Section 2). + IF (SHELFICEadvDiffHeatFlux .EQV. .FALSE.) THEN +C-- This formulation of fwflux, derived from the heat balance equation +C-- instead of the salt balance equation, can handle the case when the +C-- salinity of the ocean, boundary layer, and ice are identical. + fwFlux = 1/SHELFICElatentHeat*( + & eps3*(thetaFreeze - thetaIceConduction) - + & eps1*(insitutLoc - thetaFreeze) ) +C-- Alterantively, we can have a nonlinear T gradient +C-- through the ice (Holland and Jenkins, 1999, Section 3). +C-- This is only for melting case (Eq. 31 of Holland and Jenkins, 1999) + ELSE + fwFlux = + & eps1 * ( thetaFreeze - insitutLoc ) / + & (SHELFICElatentHeat + SHELFICEheatCapacity_Cp* + & (thetaFreeze - thetaIceConduction)) + ENDIF + +C-- If a nonlinear local ice T gradient near the ice-ocean interface +C-- is allowed and fwflux is positive (ice growth) then +C-- we must solve the quadratic equation using a different set of +C-- coeffs (Holland Jenkins, 1999). +C-- Since we first need to know fwFlux, the solving of the +C-- quadratic equation for this case cannot be combined +C-- with the other two cases (linear T, nonlinear T and melting). + IF ((SHELFICEadvDiffHeatFlux .EQV. .TRUE.) .AND. + & (fwFlux .GT. zeroRL)) THEN + aqe = a0 *(eps1) + bqe = eps1*eps6 - eps2 - SHELFICEsalinity*eps1*a0 + cqe = sLoc*(eps2) - SHELFICEsalinity*eps1 + + recip_aqe = 0. _d 0 + IF ( aqe .NE. 0. _d 0 ) recip_aqe = 0.5 _d 0/aqe + + discrim = bqe*bqe - 4. _d 0*aqe*cqe + saltFreeze = (- bqe - SQRT(discrim))*recip_aqe + IF ( saltFreeze .LT. 0. _d 0 ) THEN + saltFreeze = (- bqe + SQRT(discrim))*recip_aqe + ENDIF + + thetaFreeze = a0*saltFreeze + eps4 + + fwFlux = + & eps1 * ( thetaFreeze - insitutLoc ) / + & SHELFICElatentHeat + ENDIF + +C velocity of meltwater flux at ice-ocean interface (m/s) +C * negative corresponds to downward flux of meltwater (melting) + w_B = fwFlux * mass2rUnit + +C-- Calculate the upward heat fluxes: +C-- melting requires upward (positive) heat flux from ocean to ice. + +C-- The heatFlux variable corresponds with the change of energy in the +C-- ocean grid cell volume. In the conservative case (J2001), +C-- advective heat fluxes change the energy of the volume whereas in +C-- the non-conservative case there are no advective heat fluxes +C-- melting or freezing have no associated advective heat fluxes. + IF (SHELFICEconserve) THEN + +C-- In the conservative case (J2001) there are two cases, fixed and +C-- non-fixed ocean volume. + + IF (useRealFreshWaterFlux ) THEN + +C-- If the ocean volume can change (realFWFlux=true) then advection of +C-- meltwater does not displace water at T=insitutLoc in the cell and the +C-- heat flux correpsonding to the total energy flux of the volume +C-- consists of only two terms: turbulent fluxes (positive out) +C-- and advective meltwater fluxes (negative in). + heatFlux = rUnit2mass*HeatCapacity_Cp * ( + & gammaT * (insitutLoc - thetaFreeze) + & + w_B * (thetaFreeze - insitutLoc + tLoc) ) + ELSE + +C-- If the volume is fixed (realFWFlux=false) then the advection of +C-- meltwater does displace ambient water at T=insitutLoc in the cell. +C-- Displacement reduction volume energy by w_B * insitutLoc (positive) + heatFlux = rUnit2mass*HeatCapacity_Cp * ( + & gammaT * (insitutLoc - thetaFreeze) + & + w_B * (thetaFreeze - insitutLoc) ) + ENDIF + + ELSE + +C-- In the non-conservative form, only fluxes are turbulent fluxes + heatFlux = rUnit2mass*HeatCapacity_Cp * + & gammaT * (insitutLoc - thetaFreeze) + ENDIF + +C-- Calculate the T and S tendency terms. T tendency term is +C-- not necessarily proportional to the heat flux term above because +C-- the heat flux term corresponds to total energy change in the grid +C-- cell and not the change of energy per unit volume. + + IF (SHELFICEconserve) THEN +C-- In the conservative case, meltwater advection contributes (J2001) +C-- to T and S tendencies +C-- * forcing T (K m/s) + forcingT = + & (gammaT - w_B)*(thetaFreeze - insitutLoc) + +C-- * forcing S (psu m/s) + forcingS = + & (gammaS - w_B)*(saltFreeze - sLoc) + ELSE +C-- Otherwise, the only fluxes out of the ocean that change T and S +C-- are the turbulent fluxes. + forcingT = gammaT * ( thetaFreeze - insitutLoc ) + forcingS = gammaS * ( saltFreeze - sLoc ) + ENDIF + + RETURN + END + diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_thermodynamics.F b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_thermodynamics.F new file mode 100755 index 0000000..abb47e5 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/code/shelfice_thermodynamics.F @@ -0,0 +1,566 @@ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/shelfice/shelfice_thermodynamics.F,v 1.47 2015/12/17 01:52:05 jmc Exp $ +C $Name: $ + +#include "SHELFICE_OPTIONS.h" +#ifdef ALLOW_AUTODIFF +# include "AUTODIFF_OPTIONS.h" +#endif +#ifdef ALLOW_CTRL +# include "CTRL_OPTIONS.h" +#endif + +CBOP +C !ROUTINE: SHELFICE_THERMODYNAMICS +C !INTERFACE: + SUBROUTINE SHELFICE_THERMODYNAMICS( + I myTime, myIter, myThid ) +C !DESCRIPTION: \bv +C *=============================================================* +C | S/R SHELFICE_THERMODYNAMICS +C | o shelf-ice main routine. +C | compute temperature and (virtual) salt flux at the +C | shelf-ice ocean interface +C | +C | stresses at the ice/water interface are computed in separate +C | routines that are called from mom_fluxform/mom_vecinv + +CIGF | ASSUMES +C--- | * SHELFICEconserve = true +C *=============================================================* +C \ev + +C !USES: + IMPLICIT NONE + +C === Global variables === +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" +#include "GRID.h" +#include "DYNVARS.h" +#include "FFIELDS.h" +#include "SHELFICE.h" +#include "SHELFICE_COST.h" +#ifdef ALLOW_AUTODIFF +# include "CTRL_SIZE.h" +# include "ctrl.h" +# include "ctrl_dummy.h" +#endif /* ALLOW_AUTODIFF */ +#ifdef ALLOW_AUTODIFF_TAMC +# ifdef SHI_ALLOW_GAMMAFRICT +# include "tamc.h" +# endif /* SHI_ALLOW_GAMMAFRICT */ +#endif /* ALLOW_AUTODIFF_TAMC */ + +C !INPUT/OUTPUT PARAMETERS: +C === Routine arguments === +C myIter :: iteration counter for this thread +C myTime :: time counter for this thread +C myThid :: thread number for this instance of the routine. + _RL myTime + INTEGER myIter + INTEGER myThid + +#ifdef ALLOW_SHELFICE +C !LOCAL VARIABLES : +C === Local variables === +C I,J,K,Kp1,bi,bj :: loop counters +C tLoc, sLoc, pLoc :: local potential temperature, salinity, pressure +C theta/saltFreeze :: temperature and salinity of water at the +C ice-ocean interface (at the freezing point) +C freshWaterFlux :: local variable for fresh water melt flux due +C to melting in kg/m^2/s +C (negative density x melt rate) +C iceFrontCellThickness :: the ratio of the grid cell area to +C the horizontal length of the ice front. +C unit meters. Approximately the length of the +C column perpendicular to the ice front extended +C to the far side of the tracer cell. +C iceFrontWidth :: the width of the ice front. unit meters. + + INTEGER I,J,K,Kp1 + INTEGER bi,bj + INTEGER CURI, CURJ, FRONT_K + + _RL tLoc + _RL sLoc + _RL pLoc + +#ifndef SHI_USTAR_WETPOINT + _RL uLoc(1-olx:snx+olx,1-oly:sny+oly) + _RL vLoc(1-olx:snx+olx,1-oly:sny+oly) +#endif + _RL velSq(1-olx:snx+olx,1-oly:sny+oly) + + _RL freshWaterFlux + + _RL ice_bottom_Z_C, seafloor_N + _RL wet_top_Z_N, wet_bottom_Z_N + _RL iceFrontWetContact_Z_max, iceFrontContact_Z_min + _RL iceFrontContact_H + _RL iceFrontVertContactFrac, iceFrontCellThickness + _RL iceFrontWidth, iceFrontFaceArea + _RL thermalConductionDistance, thermalConductionTemp + _RL tmpHeatFlux, tmpFWFLX + _RL tmpForcingT, tmpForcingS + _RL tmpFac, icfgridareaFrac + _RL tmpHeatFluxscaled, tmpFWFLXscaled + INTEGER SI + +#ifdef ALLOW_DIAGNOSTICS + _RL uStarDiag(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) + + _RL tmpdiagiceFrontForcingT(1-olx:snx+olx, + & 1-oly:sny+oly,nr,nsx,nsy) + _RL tmpdiagiceFrontForcingS(1-olx:snx+olx, + & 1-oly:sny+oly,nr,nsx,nsy) + _RL tmpdiagshelficeForcingT(1-olx:snx+olx, + & 1-oly:sny+oly,nsx,nsy) + _RL tmpdiagshelficeForcingS(1-olx:snx+olx, + & 1-oly:sny+oly,nsx,nsy) +#endif /* ALLOW_DIAGNOSTICS */ + + _RL epsilon_H + +#ifdef ALLOW_SHIFWFLX_CONTROL + _RL xx_shifwflx_loc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) +#endif + +#ifdef ALLOW_AUTODIFF_TAMC + INTEGER act1, act2, act3, act4 + INTEGER max1, max2, max3 + INTEGER ikey +#endif + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + +C-- minimum fraction of a cell adjacent to an ice front that must be +C-- wet for exchange to happen + epsilon_H = 1. _d -03 + +C-- hard coded for now. + thermalConductionDistance = 100.0 _d 0 + thermalConductionTemp = -20.0 _d 0 + icfgridareaFrac = 1.0 _d 0 + +C heat flux into the ice shelf, default is diffusive flux +C (Holland and Jenkins, 1999, eq.21) + + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) +#ifdef ALLOW_AUTODIFF_TAMC +# ifdef SHI_ALLOW_GAMMAFRICT + act1 = bi - myBxLo(myThid) + max1 = myBxHi(myThid) - myBxLo(myThid) + 1 + act2 = bj - myByLo(myThid) + max2 = myByHi(myThid) - myByLo(myThid) + 1 + act3 = myThid - 1 + max3 = nTx*nTy + act4 = ikey_dynamics - 1 + ikey = (act1 + 1) + act2*max1 + & + act3*max1*max2 + & + act4*max1*max2*max3 +# endif /* SHI_ALLOW_GAMMAFRICT */ +#endif /* ALLOW_AUTODIFF_TAMC */ + DO J = 1-OLy,sNy+OLy + DO I = 1-OLx,sNx+OLx + shelfIceHeatFlux (I,J,bi,bj) = 0. _d 0 + shelfIceFreshWaterFlux(I,J,bi,bj) = 0. _d 0 + SHIICFHeatFlux (I,J,bi,bj) = 0. _d 0 + SHIICFFreshWaterFlux(I,J,bi,bj) = 0. _d 0 + shelficeForcingT (I,J,bi,bj) = 0. _d 0 + shelficeForcingS (I,J,bi,bj) = 0. _d 0 +#ifndef ALLOW_shiTransCoeff_3d + shiTransCoeffS(I,J,bi,bj) = 5.05 _d -3 * + & shiTransCoeffT(I,J,bi,bj) +#endif + DO K = 1, NR +#ifdef ALLOW_shiTransCoeff_3d + shiTransCoeffS(I,J,K,bi,bj) = 5.05 _d -3 * + & shiTransCoeffT(I,J,K,bi,bj) +#endif + iceFrontHeatFlux(I,J,K,bi,bj) = 0. _d 0 + iceFrontFreshWaterFlux(I,J,K,bi,bj) = 0. _d 0 + iceFrontForcingT(I,J,K,bi,bj) = 0. _d 0 + iceFrontForcingS(I,J,K,bi,bj) = 0. _d 0 +#ifdef ALLOW_DIAGNOSTICS + IF ( useDiagnostics ) THEN + tmpdiagiceFrontForcingT(I,J,K,bi,bj) = 0. _d 0 + tmpdiagiceFrontForcingS(I,J,K,bi,bj) = 0. _d 0 + ENDIF +#endif /* ALLOW_DIAGNOSTICS */ + ENDDO /* K */ + + ENDDO /* I */ + ENDDO /* J */ + +C-- First ice front then ice shelf. Loop through each i,j point +C-- process ice fronts in k, then process ice shelf. + DO J = 1-OLy+1,sNy+OLy-1 + DO I = 1-OLx+1,sNx+OLx-1 + +C-- The K index where the ice front ends (0 if no ice front) + FRONT_K = K_icefront(I,J,bi,bj) + +C-- If there is an ice front at this (I,J) continue + IF (FRONT_K .GT. 0) THEN + +C-- Loop through all depths where the ice front is fround + DO K = 1, FRONT_K +C-- Loop around the four laterally neighboring cells of the ice front. +C-- If any neighboring points has wet volume in contact with the ice +C-- front at (I,J) then calculate ice-ocean exchanges. +C-- The four laterally neighboring point are at (CURI,CURJ) + + DO SI = 1,4 + CURI=CURI_ARR(I,J,bi,bj,SI) + CURJ=CURJ_ARR(I,J,bi,bj,SI) + iceFrontWidth=iceFrontWidth_arr(I,J,bi,bj,SI) + +C-- cell depth describes the average distance +C-- perpendicular to the ice front fact + + iceFrontCellThickness = 0. _d 0 + IF(iceFrontWidth.NE.0. _d 0) + & iceFrontCellThickness = RA(CURI,CURJ,bi,bj) + & /iceFrontWidth + iceFrontFaceArea = DRF(K)*iceFrontWidth + +C-- First, make sure the adjacent point has at least some water in it. + IF (_hFacC(CURI,CURJ,K,bi,bj) .GT. zeroRL) THEN + +C-- we need to determine how much of the ice front is in contact with +C-- water in the neighboring grid cell at this depth level. + +C-- 1. Determine the top depth with water in the current cell +C-- 2. Determine the top depth with water in the neighbor cell +C-- 3. Determine the depth where water gap between (1) and (2). +C-- 4. If there is a gap then ice front is in contact with water in +C-- the neighboring cell + +C-- ice_bottom_Z_C: the depth (m) of the bottom of the ice in the +C-- current cell. Bounded between rF(K) and rF(K+1). +C-- * If the ice extends past the bottom of the cell then +C-- ice_bottom_Z_C = rF(K+1) +C-- [rF(k) >= ice_bottom_Z_C >= rF(K+1)] (rF is negative) + ice_bottom_Z_C = max(rF(K+1), + & min(Ro_surf(I,J, bi,bj), rF(K))) + +C-- wet_top_Z_N: the depth (m) of the bottom of the ice in the +C-- neighboring grid. If the neighboring cell has ice in +C-- (in the form of a shelf or front) then wet_top_Z_N is +C-- the depth of this neighboring ice. +C-- +C-- * If neighbor cell has no ice, then Ro_surf = 0 and +C-- wet_top_Z_N = rF(K) +C-- [rF(k) >= wet_top_Z_N >= rF(K+1)] (rF is negative) + + wet_top_Z_N = max(rF(K+1), + & min(Ro_surf(CURI,CURJ, bi,bj), rF(K))) + +C-- wet_bottom_Z_N: the depth (m) of the bottom of the wet part of the +C-- neighboring cell. If the seafloor reaches into +C-- the grid cell then the bottom of the wet part of the +C-- grid cell is at the seafloor. +C-- +C-- * If the seafloor is deeper than this grid cell then +C-- wet_bottom_Z = rF(K+1) +C-- * If the seafloor is shallower than this grid cell then +C-- wet_bottom_Z = rF(K) +C-- * If the seafloor reaches partly into this grid cell +C-- then wet_bottom_Z = R_low + +C-- [rF(k) >= wet_bottom_Z >= rF(K+1)] (rF is negative) + + wet_bottom_Z_N = min(rF(K), + & max(R_low(CURI,CURJ, bi,bj), rF(K+1))) + +C-- iceFrontWetContact_Z_max: The deepest point where the +C-- the ice front at (I,J) is in contact with water +C-- in the neighboring cell. The shallower of +C-- wet_bottom_Z_N (seafloor depth of neighboring point) and +C-- ice_bottom_Z_C (bottom of ice front in this center cell). + +C-- * wet_bottom_Z_N if the seafloor of the neighboring +C-- cell is shallower than the ice draft at (I,J). +C-- * ice_bottom_Z_C if the ice draft at (I,J) is shallower +C-- than the seafloor of the neighboring cell. + + IF (ice_bottom_Z_C .GT. wet_bottom_Z_N) THEN + iceFrontWetContact_Z_max = ice_bottom_Z_C + ELSE + iceFrontWetContact_Z_max = wet_bottom_Z_N + ENDIF + +C-- The shallowest depth where the ice front at (I,J) is in contact +C-- with water in the neighboring cell. If the neighboring cell has +C-- no ice draft then wet_top_Z_N = rF(k), the top of the cell. +C-- Otherwise, the shallowest depth where the ice front at (I,J) can +C-- be in in contact with water (not ice) in (CURI, CURJ) +C-- is wet_top_Z_N. + +C-- the fraction of the grid cell height that has ice draft in contact +C-- with water in the neighboring cell. + iceFrontVertContactFrac = + & (wet_top_Z_N - iceFrontWetContact_Z_max)/ DRF(K) + + +C-- Only proceed if iceFrontVertContactFrac is > 0, the +C-- ice draft at (I,J) +C-- is in contact with some water in the neighboring grid cell. + IF (iceFrontVertContactFrac .GT. epsilon_H) THEN + tLoc = theta(CURI,CURJ,K,bi,bj) + sLoc = MAX(salt(CURI,CURJ,K,bi,bj), zeroRL) + +C-- use pressure at the halfway point between the top and bottom of +C-- points of the ice front where the ice front is in contact with +C-- open water. + pLoc = 0.5 _d 0 * ABS(wet_top_Z_N + + & iceFrontWetContact_Z_max) + + CALL SHELFICE_SOLVE4FLUXES( + I tLoc, sLoc, pLoc, +#ifndef ALLOW_shiTransCoeff_3d + I shiTransCoeffT(CURI,CURJ,bi,bj), + I shiTransCoeffS(CURI,CURJ,bi,bj), +#else + I shiTransCoeffT(CURI,CURJ,K,bi,bj), + I shiTransCoeffS(CURI,CURJ,K,bi,bj), +#endif + I thermalConductionDistance, + I thermalConductionTemp, + O tmpHeatFlux, tmpFWFLX, + O tmpForcingT, tmpForcingS, + I bi, bj, myTime, myIter, myThid ) + +C-- fluxes and forcing must be scaled by iceFrontVertContactFract and +C-- iceFrontContactFrac some fraction of the heigth and width of the +C-- grid cell face may not ice in contact with water. + +C tmpHeatFlux and tmpFWFLX come as W/m^2 and kg/m^2/s respectively +C-- but these rates only apply to the +C-- fraction of the grid cell that has ice in contact with seawater. +C-- we must scale by iceFrontVertContactFrac to get to the average +C-- fluxes in this grid cell. +C-- We also further scale by ratio of vertical to horizontal grid +C-- cell area so when comparing ice-front flux to ice-shelf flux we +C-- can just times them by the same area, i.e. horizontal grid cell area. + +C-- ratio of vertical area to horizontal grid cell area + icfgridareaFrac = + & iceFrontFaceArea/RA(CURI,CURJ,bi,bj) + +C-- In units W/m^2 + tmpHeatFluxscaled = + & tmpHeatFlux*iceFrontVertContactFrac + & *icfgridareaFrac + iceFrontHeatFlux(CURI,CURJ,K,bi,bj) = + & iceFrontHeatFlux(CURI,CURJ,K,bi,bj) + + & tmpHeatFluxscaled + +C In units of kg/s/m^2 + tmpFWFLXscaled = + & tmpFWFLX*iceFrontVertContactFrac + & *icfgridareaFrac + iceFrontFreshWaterFlux(CURI,CURJ,K,bi,bj) = + & iceFrontFreshWaterFlux(CURI,CURJ,K,bi,bj) + + & tmpFWFLXscaled + +C ow - 06/29/2018 +C ow - Verticallly sum up the 3D icefront heat and freshwater fluxes to +C ow - compute the total flux for the water column. The shelfice fluxes, +C ow - which are 2D, will be added later. NOTE that only +C ow - ice-front melts below shelf-ice are included to be consistent +C ow - with Rignot's data + if(k.GE.kTopC(I,J,bi,bj))then + if(RA(CURI,CURJ,bi,bj).NE.0. _d 0)then + SHIICFHeatFlux(CURI,CURJ,bi,bj) = + & SHIICFHeatFlux(CURI,CURJ,bi,bj) + + & tmpHeatFluxscaled + SHIICFFreshWaterFlux(CURI,CURJ,bi,bj) = + & SHIICFFreshWaterFlux(CURI,CURJ,bi,bj) + + & tmpFWFLXscaled + endif + endif +C iceFrontForcing[T,S] X m/s but these rates only apply to the +C-- fraction of the grid cell that has ice in contact with seawater. +C-- we must scale by iceFrontVertContactFrac to get to the average +C-- fluxes in this grid cell. We must also divide the by the length +C-- of the grid cell perpendicular to the face. + + IF (iceFrontCellThickness .NE. 0. _d 0) THEN +C In units of K / s + iceFrontForcingT(CURI,CURJ,K,bi,bj) = + & iceFrontForcingT(CURI,CURJ,K,bi,bj) + + & tmpForcingT/iceFrontCellThickness* + & iceFrontVertContactFrac* + & _recip_hFacC(CURI,CURJ,K,bi,bj) + tmpdiagiceFrontForcingT(CURI,CURJ,K,bi,bj) = + & tmpdiagiceFrontForcingT(CURI,CURJ,K,bi,bj) + + & tmpForcingT/iceFrontCellThickness* + & iceFrontVertContactFrac* + & DRF(k) + +C In units of psu /s + iceFrontForcingS(CURI,CURJ,K,bi,bj) = + & iceFrontForcingS(CURI,CURJ,K,bi,bj) + + & tmpForcingS/iceFrontCellThickness* + & iceFrontVertContactFrac* + & _recip_hFacC(CURI,CURJ,K,bi,bj) + tmpdiagiceFrontForcingS(CURI,CURJ,K,bi,bj) = + & tmpdiagiceFrontForcingS(CURI,CURJ,K,bi,bj) + + & tmpForcingS/iceFrontCellThickness* + & iceFrontVertContactFrac* + & DRF(k) + ENDIF /* iceFrontCellThickness */ +C In units of kg /s + addMass(CURI,CURJ,K,bi,bj) = + & addMass(CURI,CURJ,K,bi,bj) - + & tmpFWFLX*iceFrontFaceArea* + & iceFrontVertContactFrac + ENDIF /* iceFrontVertContactFrac */ + ENDIF /* hFacC(CURI,CURJ,K,bi,bj) */ + ENDDO /* SI loop for adjacent cells */ + ENDDO /* K LOOP */ + ENDIF /* FRONT K */ + +C-- ice shelf + K = kTopC(I,J,bi,bj) + +C-- If there is an ice front at this (I,J) continue +C-- I am assuming K is only .GT. when there is at least some +C-- nonzero wet point below the shelf in the grid cell. + IF (K .GT. 0) THEN +C-- Initialize these values to zero + pLoc = 0 _d 0 + tLoc = 0 _d 0 + sLoc = 0 _d 0 + +C-- make local copies of temperature, salinity and depth +C-- (pressure in deci-bar) underneath the ice +C-- for the ice shelf case we use hydrostatic pressure at the ice +C-- base of the ice shelf, top of the cavity. + + pLoc = ABS(R_shelfIce(I,J,bi,bj)) + tLoc = theta(I,J,K,bi,bj) + sLoc = MAX(salt(I,J,K,bi,bj), zeroRL) + + CALL SHELFICE_SOLVE4FLUXES( + I tLoc, sLoc, pLoc, +#ifndef ALLOW_shiTransCoeff_3d + I shiTransCoeffT(I,J,bi,bj), + I shiTransCoeffS(I,J,bi,bj), +#else + I shiTransCoeffT(I,J,K,bi,bj), + I shiTransCoeffS(I,J,K,bi,bj), +#endif + I pLoc, thermalConductionTemp, + O tmpHeatFlux, tmpFWFLX, + O tmpForcingT, tmpForcingS, + I bi, bj, myTime, myIter, myThid ) + +C In units of W/m^2 + shelficeHeatFlux(I,J,bi,bj) = tmpHeatFlux +C In units of kg/m^2/s + shelfIceFreshWaterFlux(I,J,bi,bj) = tmpFWFLX + +C ow - 06/29/2018 +C ow - Now add shelfice heat and freshwater fluxes + SHIICFHeatFlux(i,j,bi,bj) = + & SHIICFHeatFlux(i,j,bi,bj) + + & shelficeHeatFlux(i,j,bi,bj) + SHIICFFreshWaterFlux(i,j,bi,bj) = + & SHIICFFreshWaterFlux(i,j,bi,bj) + + & shelfIceFreshWaterFlux(i,j,bi,bj) +C In units of K/s -- division by drF required first + shelficeForcingT(I,J,bi,bj) = tmpForcingT* + & recip_drF(K)* _recip_hFacC(i,j,K,bi,bj) + tmpdiagshelficeForcingT(I,J,bi,bj) = tmpForcingT +C In units of psu/s -- division by drF required first + shelficeForcingS(I,J,bi,bj) = tmpForcingS* + & recip_drF(K)* _recip_hFacC(i,j,K,bi,bj) + tmpdiagshelficeForcingS(I,J,bi,bj) = tmpForcingS +C In units of kg/s -- multiplication of area required first + addMass(I,J,K, bi,bj) = addMass(I,J,K, bi,bj) - + & tmpFWFLX*RA(I,J,bi,bj) + ENDIF /* SHELF K > 0 */ + ENDDO /* i */ + ENDDO /* j */ + ENDDO /* bi */ + ENDDO /* bj */ + + +C-- Calculate new loading anomaly (in case the ice-shelf mass was updated) +#ifndef ALLOW_AUTODIFF +c IF ( SHELFICEloadAnomalyFile .EQ. ' ' ) THEN + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO j = 1-OLy, sNy+OLy + DO i = 1-OLx, sNx+OLx + shelficeLoadAnomaly(i,j,bi,bj) = gravity + & *( shelficeMass(i,j,bi,bj) + rhoConst*Ro_surf(i,j,bi,bj) ) + ENDDO + ENDDO + ENDDO + ENDDO +c ENDIF +#endif /* ndef ALLOW_AUTODIFF */ + +#ifdef ALLOW_DIAGNOSTICS + IF ( useDiagnostics ) THEN + CALL DIAGNOSTICS_FILL_RS(shelfIceFreshWaterFlux,'SHIfwFlx', + & 0,1,0,1,1,myThid) + CALL DIAGNOSTICS_FILL_RS(shelfIceHeatFlux, 'SHIhtFlx', + & 0,1,0,1,1,myThid) + + CALL DIAGNOSTICS_FILL_RS(SHIICFFreshWaterFlux,'SHIICFfw', + & 0,1,0,1,1,myThid) + CALL DIAGNOSTICS_FILL_RS(SHIICFHeatFlux, 'SHIICFht', + & 0,1,0,1,1,myThid) + + CALL DIAGNOSTICS_FILL(iceFrontFreshWaterFlux, 'ICFfwFlx', + & 0,Nr,0,1,1,myThid) + CALL DIAGNOSTICS_FILL(iceFrontHeatFlux, 'ICFhtFlx', + & 0,Nr,0,1,1,myThid) + +C SHIForcT (Ice shelf forcing for theta [W/m2], >0 increases theta) + tmpFac = HeatCapacity_Cp*rUnit2mass + CALL DIAGNOSTICS_SCALE_FILL(tmpdiagshelficeForcingT,tmpFac,1, + & 'SHIForcT',0,1,0,1,1,myThid) +C SHIForcS (Ice shelf forcing for salt [g/m2/s], >0 increases salt) + tmpFac = rUnit2mass + CALL DIAGNOSTICS_SCALE_FILL(tmpdiagshelficeForcingS,tmpFac,1, + & 'SHIForcS',0,1,0,1,1,myThid) + +C ICFForcT (Ice front forcing for theta [W/m2], >0 increases theta) + tmpFac = HeatCapacity_Cp*rUnit2mass + CALL DIAGNOSTICS_SCALE_FILL(tmpdiagiceFrontForcingT,tmpFac,1, + & 'ICFForcT',0,Nr,0,1,1,myThid) +C ICFForcS (Ice front forcing for salt [g/m2/s], >0 increases salt) + tmpFac = rUnit2mass + CALL DIAGNOSTICS_SCALE_FILL(tmpdiagiceFrontForcingS,tmpFac,1, + & 'ICFForcS',0,Nr,0,1,1,myThid) + +C Transfer coefficients +#ifndef ALLOW_shiTransCoeff_3d + CALL DIAGNOSTICS_FILL(shiTransCoeffT,'SHIgammT', + & 0,1,0,1,1,myThid) + CALL DIAGNOSTICS_FILL(shiTransCoeffS,'SHIgammS', + & 0,1,0,1,1,myThid) +#else + CALL DIAGNOSTICS_FILL(shiTransCoeffT,'SHIgammT', + & 0,Nr,0,1,1,myThid) + CALL DIAGNOSTICS_FILL(shiTransCoeffS,'SHIgammS', + & 0,Nr,0,1,1,myThid) +#endif +C Friction velocity +#ifdef SHI_ALLOW_GAMMAFRICT + IF ( SHELFICEuseGammaFrict ) + & CALL DIAGNOSTICS_FILL(uStarDiag,'SHIuStar',0,1,0,1,1,myThid) +#endif /* SHI_ALLOW_GAMMAFRICT */ + ENDIF +#endif + +#endif /* ALLOW_SHELFICE */ + RETURN + END diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data new file mode 100644 index 0000000..6719b92 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data @@ -0,0 +1,147 @@ +# ==================== +# | Model parameters | +# ==================== +# +# Continuous equation parameters + &PARM01 + tRef = 3*23.,3*22.,21.,2*20.,19.,2*18.,17.,2*16.,15.,14.,13., + 12.,11.,2*9.,8.,7.,2*6.,2*5.,3*4.,3*3.,4*2.,12*1., + sRef = 50*34.5, + no_slip_sides = .TRUE., + no_slip_bottom = .TRUE., +# + viscAr=0.5E-4, +# + viscAh=1.E0, + viscAhGrid=2.E-2, +# viscAh=2.0e4, +# + diffKhT=1.E1, + diffKrT=1.E-5, + diffKhS=1.E1, + diffKrS=1.E-5, +# +### diffKrBL79surf=0.1E-4, +### diffKrBL79deep=1.0E-4, + bottomDragQuadratic = 0.001, +#when using ggl90 + ivdc_kappa=10., + implicitDiffusion=.TRUE., + implicitViscosity=.TRUE., + useRealFreshWaterFlux=.TRUE., +# balanceThetaClimRelax=.TRUE., +# balanceSaltClimRelax=.TRUE., +# balanceEmPmR=.TRUE., +# balanceQnet=.TRUE., + allowFreezing=.FALSE., +### hFacInf=0.2, +### hFacSup=2.0, + hFacMin=.2, + hFacMinDr=5., + select_rStar=2, + nonlinFreeSurf=4, + gravity=9.81, + rhonil=1029., + rhoConst=1029., + rhoConstFresh=1000., + convertFW2Salt=-1., + eosType='JMD95Z', + implicitFreeSurface=.TRUE., + exactConserv=.TRUE., + useSingleCpuIO=.TRUE., + tempAdvScheme=30, + saltAdvScheme=30, + tempVertAdvScheme=3, + saltVertAdvScheme=3, + tempImplVertAdv=.TRUE., + saltImplVertAdv=.TRUE., + staggerTimeStep=.TRUE., + vectorInvariantMomentum=.TRUE., +#when using the cd scheme: +# useCDscheme=.TRUE., + useJamartWetPoints=.TRUE., + readBinaryPrec=32, + writeBinaryPrec=32, + selectAddFluid=1, + debugLevel=1, + / + +# Elliptic solver parameters + &PARM02 + cg2dMaxIters=300, +#cg2dTargetResWunit=1.E-12, + / + +# Time stepping parameters + &PARM03 + nIter0=0, +#2 lev2 for testing: +# nTimeSteps=120, +#3month +#nTimeSteps=2160, +#18month +#nTimeSteps=13110, +#2yr +#nTimeSteps=17520, +#4-yr from 2014 to 2017, inclusive +#nTimeSteps=35051, +#20y: +#nTimeSteps=175295, +#22y: +#nTimeSteps=192839, +#24y: +#nTimeSteps=210359, +#26yr +nTimeSteps=245422, +#60 years +#nTimeSteps=525985, +# + forcing_In_AB=.FALSE., + momDissip_In_AB=.FALSE., +#when using the cd scheme: +# epsAB_CD = 0.25, +# tauCD=172800.0, + deltaT = 450., +#when using ab2: + abEps = 0.1, +#when using ab3: +# doAB_onGtGs=.FALSE., +# alph_AB=0.5, +# beta_AB=0.281105, +# + pChkptFreq =31536000.0, + chkptFreq =31536000.0, +# taveFreq =31536000.0, +# dumpFreq =31536000.0, + monitorFreq=3600, + dumpInitAndLast = .TRUE., + pickupStrictlyMatch=.FALSE., + / + +# Gridding parameters + &PARM04 + usingCurvilinearGrid=.TRUE., + delR = + 10.00, 10.00, 10.00, 10.00, 10.00, 10.00, 10.00, 10.01, + 10.03, 10.11, 10.32, 10.80, 11.76, 13.42, 16.04, 19.82, 24.85, + 31.10, 38.42, 46.50, 55.00, 63.50, 71.58, 78.90, 85.15, 90.18, + 93.96, 96.58, 98.25, 99.25,100.01,101.33,104.56,111.33,122.83, + 139.09,158.94,180.83,203.55,226.50,249.50,272.50,295.50,318.50, + 341.50,364.50,387.50,410.50,433.50,456.50, + / + +# Input datasets + &PARM05 + diffKrFile='eccov4_r5_diffkr.data', +#adTapeDir='tapes', + bathyFile ='BATHY_ICE_SHELF_CAVITY_PLUS_ICE_FRONT_LLC_0090.bin', + hydrogSaltFile ='SALT_2050212_dailymean.bin', + hydrogThetaFile='THETA_2050212_dailymean.bin', + uVelInitFile ='UVEL_2050212_dailymean.bin', + vVelInitFile ='VVEL_2050212_dailymean.bin', + pSurfInitFile ='ETAN_2050212_dailymean.bin', + viscA4Dfile ='fenty_biharmonic_visc_v11.bin', + viscA4Zfile ='fenty_biharmonic_visc_v11.bin', + geothermalFile='geothermalFlux.bin', +# + / diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.cal b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.cal new file mode 100755 index 0000000..ece79b3 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.cal @@ -0,0 +1,10 @@ +# +# ******************* +# Calendar Parameters +# ******************* + &CAL_NML + TheCalendar='gregorian', + startDate_1=20120206, + startDate_2=210000, + calendarDumps = .TRUE., + & diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.diagnostics b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.diagnostics new file mode 100755 index 0000000..cbe4a74 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.diagnostics @@ -0,0 +1,127 @@ +# Diagnostic Package Choices +#-------------------- +# dumpAtLast (logical): always write output at the end of simulation (default=F) +# diag_mnc (logical): write to NetCDF files (default=useMNC) +#--for each output-stream: +# fileName(n) : prefix of the output file name (max 80c long) for outp.stream n +# frequency(n):< 0 : write snap-shot output every |frequency| seconds +# > 0 : write time-average output every frequency seconds +# timePhase(n) : write at time = timePhase + multiple of |frequency| +# averagingFreq : frequency (in s) for periodic averaging interval +# averagingPhase : phase (in s) for periodic averaging interval +# repeatCycle : number of averaging intervals in 1 cycle +# levels(:,n) : list of levels to write to file (Notes: declared as REAL) +# when this entry is missing, select all common levels of this list +# fields(:,n) : list of selected diagnostics fields (8.c) in outp.stream n +# (see "available_diagnostics.log" file for the full list of diags) +# missing_value(n) : missing value for real-type fields in output file "n" +# fileFlags(n) : specific code (8c string) for output file "n" +#-------------------- +# oceTAUX zonal surface wind stress, >0 increases uVel (N/m^2) +# oceTAUY meridional surf. wind stress, >0 increases vVel (N/m^2) +# oceFWflx net surface Fresh-Water flux into ocean, >0 decreases salinity (kg/m^2/s) +# oceSflux net surface Salt flux into the ocean, >0 increases salinity (g/m^2/s) +# oceQnet net surface heat flux into the ocean, >0 increases theta (W/m^2) +# oceQsw net Short-Wave radiation (+=down), >0 increases theta (W/m^2) +# SSS Sea Surface Salinity (g/kg) +# SST Sea Surface Temperature (degC) +# UVEL1 Zonal Surface Velocity (m/s) +# VVEL1 Meridional Surface Velocity (m/s) + + &DIAGNOSTICS_LIST + + frequency(1) = 86400., + fields(1:8,1) = 'oceTAUX ','oceTAUY ','oceFWflx','oceSflux','oceQnet ','oceQsw ','ETAN ','atmPload', + filename(1) = 'state_2d_set1', + timePhase(1) = 27000., + + frequency(2) = 86400., + fields(1:7,2) = 'SALT ','THETA ','UVELMASS','VVELMASS','WVELMASS','GM_PsiX ','GM_PsiY ', + filename(2) = 'state_3d_set1', + timePhase(2) = 27000., + + frequency(3) = -86400., + fields(1:2,3) = 'SALT ','THETA ', + filename(3) = 'snap_3d_set1', + timePhase(3) = 27000., + +# frequency(4) = -86400.0, +# fields(1,4) = 'ETAN ', +# filename(4) = 'snap_2d_set2', +# timePhase(4) = 27000., + + frequency(5) = 86400.0, + fields(1:8,5) = 'DFxE_TH ','DFyE_TH ','ADVx_TH ','ADVy_TH ', + 'DFxE_SLT','DFyE_SLT','ADVx_SLT','ADVy_SLT', + filename(5) = 'state_3d_set2', + timePhase(5) = 27000., + + frequency(6) = 86400.0, + fields(1:7,6) = 'ADVr_TH ','DFrE_TH ','DFrI_TH ', + 'ADVr_SLT','DFrE_SLT','DFrI_SLT', + filename(6) = 'state_3d_set4', + timePhase(6) = 27000., + + frequency(7) = 86400.0, + fields(1:14,7) = 'SIarea ','SIheff ','SIhsnow ','sIceLoad', + 'SIuice ','SIvice ','SItaux ','SItauy ', + 'ADVxHEFF','ADVyHEFF', + 'ADVxAREA','ADVyAREA', + 'ADVxSNOW','ADVySNOW', + fileName(7) = 'iceDiag', + missing_value(7) = -999., + timePhase(7) = 27000., + + frequency(8) = -86400., + fields(1:9,8) = 'SIarea ','SIheff ','SIhsnow ','sIceLoad', + 'SIuice ','SIvice ','SItaux ','SItauy ', + 'CPLoWGHT', + missing_value(8) = -999., +# fileName(8) = 'iceInst', + timePhase(8) = 27000., + + frequency(9) = 86400., + fields(1:11,9) = 'SIareaN ','SIheffN ','SIhsnowN','SIqSnow ', + 'SImeltPd','SItIces ','SIiceAge', + 'SI_dArea','SI_dHeff','SI_dHsnw','SI_dQSnw', +# 'SI_dMPnd', +# 'SI_dTIce','SI_dIcAg', + timePhase(9) = 0., + fileFlags(9) = 'D ', +# fileName(9) = 'iceNcat', + timePhase(9) = 27000., + + frequency(10) = 86400., + fields(1:2,10) = 'SIqIce ', + 'SI_dQIce', + timePhase(10) = 0., +# fileName(10) = 'iceEnerg', + timePhase(10) = 27000., + + frequency(11) = 86400., + fields(1:2,11) = 'SIqSnow ', + 'SI_dQSnw', + timePhase(11) = 0., +# fileName(11) = 'snowEnerg', + timePhase(11) = 27000., + + & + + &DIAG_STATIS_PARMS +# stat_fields(1:6,1) = 'ETAN ', 'THETA ','SALT ','oceQnet ','oceFWflx','oceSflux', +# stat_fName(1) = 'dynStDiag', +# stat_freq(1)= 86400.0, +# stat_phase(2) = 27000., + + stat_fields(1:21,2) = 'SIarea ','SIheff ','SIhsnow ','sIceLoad', + 'SIuice ','SIvice ','SItaux ','SItauy ', + 'SIareaN ','SIheffN ','SIhsnowN', + 'SIqSnow ','SIqIce ','SImeltPd', + 'SItIces ','SIiceAge', + 'SI_dArea','SI_dHeff','SI_dHsnw', + 'SI_dQSnw','SI_dQIce', +# 'SI_dMPnd','SI_dTIce','SI_dIcAg', + stat_fName(2) = 'iceStDiag', + stat_freq(2) = 86400., + stat_phase(2) = 27000., + & diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.exch2 b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.exch2 new file mode 100644 index 0000000..29c274b --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.exch2 @@ -0,0 +1,43 @@ +# EXCH2 Package: Wrapper-2 User Choice +#-------------------- +# preDefTopol :: pre-defined Topology selector: +# :: = 0 : topology defined from processing "data.exch2"; +# :: = 1 : simple, single facet topology; +# :: = 2 : customized topology (w2_set_myown_facets) +# :: = 3 : 6-facet Cube (3 face-dims: nRed, nGreen, nBlue). +# dimsFacets :: facet pair of dimensions (n1x,n1y, n2x,n2y ...) +# facetEdgeLink :: Face-Edge connectivity map: +# facetEdgeLink(i,j)=XX.1 : face(j)-edge(i) (i=1,2,3,4 <==> N,S,E,W) +# is connected to Northern edge of face "XX" ; similarly, +# = XX.2 : to Southern.E, XX.3 = Eastern.E, XX.4 = Western.E of face "XX" +# blankList :: List of "blank" tiles +# W2_mapIO :: global map IO selector (-1 = old type ; 0 = 1 long line in X +# :: 1 = compact, mostly in Y dir) +# W2_printMsg :: option for information messages printing +# :: <0 : write to log file ; =0 : minimum print ; +# :: =1 : no duplicated print ; =2 : all processes do print +#-------------------- + &W2_EXCH2_PARM01 + W2_printMsg= 0, + W2_mapIO = 1, +# + preDefTopol=0, +#-- 5 facets llc_120 topology (drop facet 6 and its connection): + dimsFacets(1:10) = 90, 270, 90, 270, 90, 90, 270, 90, 270, 90, + facetEdgeLink(1:4,1)= 3.4, 0. , 2.4, 5.1, + facetEdgeLink(1:4,2)= 3.2, 0. , 4.2, 1.3, + facetEdgeLink(1:4,3)= 5.4, 2.1, 4.4, 1.1, + facetEdgeLink(1:4,4)= 5.2, 2.3, 0. , 3.3, + facetEdgeLink(1:4,5)= 1.4, 4.1, 0. , 3.1, +#15x15 nprocs = 384 + blankList(1:84)= 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, + 11, 12, 14, 15, 16, 17, 18, 24, 65, 71, + 75, 76, 90, 95, 96, 101, 102, 109, 110, 111, + 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, + 122, 123, 124, 125, 126, 127, 129, 130, 131, 132, + 188, 189, 190, 193, 194, 195, 196, 199, 200, 201, + 202, 203, 205, 206, 207, 208, 209, 211, 212, 213, + 214, 215, 216, 242, 247, 253, 267, 268, 269, 270, + 288, 306, 324, 341, +# + / diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.ggl90 b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.ggl90 new file mode 100644 index 0000000..59b518c --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.ggl90 @@ -0,0 +1,15 @@ +# ===================================================================== +# | Parameters for Gaspar et al. (1990)'s TKE vertical mixing scheme | +# ===================================================================== + &GGL90_PARM01 +# GGL90taveFreq = 345600000., +# GGL90dumpFreq = 86400., +# GGL90writeState=.FALSE., +# GGL90diffTKEh=3.e3, + GGL90alpha=30., +# GGL90TKEFile = 'TKE_init.bin', + GGL90TKEmin = 1.e-7, + GGL90TKEbottom = 1.e-6, + mxlMaxFlag =2, + mxlSurfFlag=.TRUE., + / diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.gmredi b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.gmredi new file mode 100644 index 0000000..87d5689 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.gmredi @@ -0,0 +1,39 @@ +# GM+Redi package parameters: +# GM_Small_Number :: epsilon used in computing the slope +# GM_slopeSqCutoff :: slope^2 cut-off value + +#-from MOM : +# GM_background_K: G & Mc.W diffusion coefficient +# GM_maxSlope : max slope of isopycnals +# GM_Scrit : transition for scaling diffusion coefficient +# GM_Sd : half width scaling for diffusion coefficient +# GM_taper_scheme: slope clipping or one of the tapering schemes +# GM_Kmin_horiz : horizontal diffusion minimum value + +#-Option parameters (needs to "define" options in GMREDI_OPTIONS.h") +# GM_isopycK : isopycnal diffusion coefficient (default=GM_background_K) +# GM_AdvForm : turn on GM Advective form (default=Skew flux form) + + &GM_PARM01 + GM_Small_Number = 1.D-20, + GM_slopeSqCutoff = 1.D+08, + GM_AdvForm = .TRUE., + GM_isopycK = 1.D+3, + GM_background_K = 1.D+3, + GM_maxSlope = 4.D-3, + GM_taper_scheme = 'stableGmAdjTap', + GM_Kmin_horiz = 100., + GM_Scrit = 4.D-3, + GM_Sd = 1.D-3, + GM_K3dGMFile = 'eccov4_r5_kapgm.data', + GM_K3dRediFile = 'eccov4_r5_kapredi.data', + +# +### GM_Visbeck_alpha = 1.5D-2, +### GM_Visbeck_alpha = 0.D0, +### GM_Visbeck_length = 2.D+5, +### GM_Visbeck_depth = 1.D+3, +### GM_Visbeck_maxval_K= 2.5D+3, + / + + diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.mypackage b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.mypackage new file mode 100755 index 0000000..faa4794 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.mypackage @@ -0,0 +1,6 @@ +# + &MYPACKAGE_PARM01 + myPa_index1 = 1 + myPa_param1 = 0.0 + & + diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.pkg b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.pkg new file mode 100644 index 0000000..2808b20 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.pkg @@ -0,0 +1,9 @@ +# Packages + &PACKAGES + useGMRedi = .TRUE., + useGGL90 = .TRUE., + useSALT_PLUME = .TRUE., + useDiagnostics = .TRUE., + useSEAICE = .TRUE., + useShelfIce = .TRUE., + & diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.salt_plume b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.salt_plume new file mode 100644 index 0000000..8cb64c5 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.salt_plume @@ -0,0 +1,6 @@ + &SALT_PLUME_PARM01 +# SaltPlumeCriterion = 0.4D0, + SPsalFRAC= 0.5D0, +#SPsalFRAC= 0.25D0, +#SPsalFRAC= 0.0D0, + / diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.seaice b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.seaice new file mode 100755 index 0000000..7c8e416 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.seaice @@ -0,0 +1,50 @@ +# SEAICE parameters + &SEAICE_PARM01 + usePW79thermodynamics= .FALSE., + + SEAICEpresH0=2., + SEAICEpresPow0=1, + SEAICEpresPow1=1, + + SEAICE_strength = 2.25e4, + + SEAICE_no_slip = .TRUE., + + SEAICE_drag=0.001, + OCEAN_drag=0.001, + +##### + SEAICEuseTILT=.FALSE., + SEAICE_multDim=1, + SEAICErestoreUnderIce=.TRUE., + + LSR_ERROR = 2.e-4, + SEAICEuseDYNAMICS = .TRUE., + SEAICEadvScheme = 33, + SEAICEuseFluxForm = .TRUE., + SEAICEadvSnow = .TRUE., + SEAICEdiffKhHeff = 400., + SEAICEdiffKhArea = 400., + SEAICEdiffKhSnow = 400., + SEAICEuseFlooding = .TRUE., + SEAICE_mcPheePiston= 3.858024691358025E-05, + SEAICE_frazilFrac = 1., + SEAICE_mcPheeTaper = 0., + SEAICE_areaLossFormula=2, + SEAICEheatConsFix = .TRUE., + SEAICE_tempFrz0 = -1.96, + SEAICE_dTempFrz_dS = 0., + SEAICEuseMetricTerms = .TRUE., + +#changes needed due to pkg/seaice changes +#from checkpoint67c to checkpoint67d + SEAICEscaleSurfStress=.FALSE., + SEAICEaddSnowMass=.FALSE., + SEAICE_OLx=0, + SEAICE_OLy=0, + SEAICEetaZmethod=0, + SEAICE_waterDrag=5.34499514091350826D-3, + & + + &SEAICE_PARM03 + & diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.shelfice b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.shelfice new file mode 100644 index 0000000..f31d502 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/data.shelfice @@ -0,0 +1,18 @@ +# =================================== +# | Parameters for SHELFICE package | +# =================================== + &SHELFICE_PARM01 + SHELFICETransCoeffTFile = 'eccov4_r5_shiTransCoeffT.data', + SHELFICEadvDiffHeatFlux = .TRUE., + SHELFICEboundaryLayer = .FALSE., + SHELFICEtopoFile='ICE_DRAFT_ICE_SHELF_CAVITY_PLUS_ICE_FRONT_LLC_0090.bin', + SHELFICEloadAnomalyFile = 'ploadanom.bin', + SHELFICEuseGammaFrict = .FALSE., + SHELFICEconserve = .true., + SHELFICEheatTransCoeff=2.e-5, + ICEFRONTdepthFile = 'ICE_DRAFT_ICE_SHELF_CAVITY_PLUS_ICE_FRONT_LLC_0090.bin', + SHELFICEkappa = 0., + useISOMIPTD = .FALSE., + no_slip_shelfice = .false., + SHELFICEwriteState = .TRUE., + / diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/eedata b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/eedata new file mode 100755 index 0000000..0c1e412 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/input/eedata @@ -0,0 +1,13 @@ +# Example "eedata" file +# Lines beginning "#" are comments +# nTx - No. threads per process in X +# nTy - No. threads per process in Y + &EEPARMS + useCubedSphereExchange=.TRUE., + nTx=1, + nTy=1, +#debugMode=.TRUE., + / +# Note: Some systems use & as the +# namelist terminator. Other systems +# use a / character (as shown here). diff --git a/MIT_GEOS5PlugMod/configs/c90_llc90_03/readme b/MIT_GEOS5PlugMod/configs/c90_llc90_03/readme new file mode 100644 index 0000000..09fcdf9 --- /dev/null +++ b/MIT_GEOS5PlugMod/configs/c90_llc90_03/readme @@ -0,0 +1,7 @@ +adapted from +https://github.com/MITgcm-contrib/llc_hires/tree/master/llc_90/ecco_v4r5/code +https://github.com/MITgcm-contrib/llc_hires/tree/master/llc_90/ecco_v4r5/input +with 15x15 tiles on 363(=468-105) cpus. + +All binary files specified in input/data* can be linked from +pfe:/nobackup/hzhang1/pub/Release5/input_bin/