Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/AGRIF_DEMO/EXPREF/file_def_nemo-ice.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/AGRIF_DEMO/EXPREF/file_def_nemo-ice.xml (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/AGRIF_DEMO/EXPREF/file_def_nemo-ice.xml (revision 12150)
@@ -25,15 +25,8 @@
-
-
-
-
-
-
-
@@ -80,9 +73,5 @@
-
-
-
-
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/ORCA2_ICE_PISCES/EXPREF/file_def_nemo-ice.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/ORCA2_ICE_PISCES/EXPREF/file_def_nemo-ice.xml (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/ORCA2_ICE_PISCES/EXPREF/file_def_nemo-ice.xml (revision 12150)
@@ -25,16 +25,8 @@
-
-
-
-
-
-
-
-
@@ -81,11 +73,5 @@
-
-
-
-
-
-
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/ORCA2_SAS_ICE/EXPREF/file_def_nemo-ice.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/ORCA2_SAS_ICE/EXPREF/file_def_nemo-ice.xml (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/ORCA2_SAS_ICE/EXPREF/file_def_nemo-ice.xml (revision 12150)
@@ -25,15 +25,8 @@
-
-
-
-
-
-
-
@@ -80,9 +73,5 @@
-
-
-
-
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/SHARED/field_def_nemo-oce.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/SHARED/field_def_nemo-oce.xml (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/SHARED/field_def_nemo-oce.xml (revision 12150)
@@ -250,4 +250,5 @@
+
@@ -256,4 +257,5 @@
+
@@ -264,20 +266,33 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/SHARED/namelist_ref
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/SHARED/namelist_ref (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/SHARED/namelist_ref (revision 12150)
@@ -5,5 +5,5 @@
!! namelists 2 - Surface boundary (namsbc, namsbc_flx, namsbc_blk, namsbc_cpl,
!! namsbc_sas, namtra_qsr, namsbc_rnf,
-!! namsbc_isf, namsbc_iscpl, namsbc_apr,
+!! namisf, namsbc_apr,
!! namsbc_ssr, namsbc_wave, namberg)
!! 3 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide)
@@ -51,5 +51,4 @@
cn_ocerst_out = "restart" ! suffix of ocean restart name (output)
cn_ocerst_outdir = "." ! directory in which to write output ocean restarts
- ln_iscpl = .false. ! cavity evolution forcing or coupling to ice sheet model
nn_istate = 0 ! output the initial state (1) or not (0)
ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F)
@@ -72,5 +71,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- rn_isfhmin = 1.00 ! treshold [m] to discriminate grounding ice from floating ice
!
rn_rdt = 5400. ! time step for the dynamics and tracer
@@ -79,24 +77,35 @@
ln_crs = .false. ! Logical switch for coarsening module (T => fill namcrs)
!
- ln_meshmask = .false. ! =T create a mesh file
+ ln_meshmask = .true. ! =T create a mesh file
/
!-----------------------------------------------------------------------
&namcfg ! parameters of the configuration (default: use namusr_def in namelist_cfg)
!-----------------------------------------------------------------------
- ln_read_cfg = .false. ! (=T) read the domain configuration file
- ! ! (=F) user defined configuration (F => create/check namusr_def)
+ ln_read_cfg = .false. ! (=T) read the domain configuration file
+ ! ! (=F) user defined configuration (F => create/check namusr_def)
cn_domcfg = "domain_cfg" ! domain configuration filename
!
- ln_closea = .false. ! T => keep closed seas (defined by closea_mask field) in the
- ! ! domain and apply special treatment of freshwater fluxes.
- ! ! F => suppress closed seas (defined by closea_mask field)
- ! ! from the bathymetry at runtime.
- ! ! If closea_mask field doesn't exist in the domain_cfg file
- ! ! then this logical does nothing.
- ln_write_cfg = .false. ! (=T) create the domain configuration file
+ ln_closea = .false. ! (=T => fill namclo)
+ ! ! (=F) no control of net precip/evap over closed sea
+ !
+ ln_write_cfg = .false. ! (=T) create the domain configuration file
cn_domcfg_out = "domain_cfg_out" ! newly created domain configuration filename
!
- ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
- ! ! in netcdf input files, as the start j-row for reading
+ ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
+ ! ! in netcdf input files, as the start j-row for reading
+/
+!-----------------------------------------------------------------------
+&namclo ! parameters of the closed sea (cs) behavior (default: OFF)
+!-----------------------------------------------------------------------
+ ln_maskcs = .false. ! (=T) cs are masked ; So, in this case ln_mask_csundef and ln_clo_rnf have no effect.
+ ! ! (=F => set ln_mask_csundef and ln_clo_rnf)
+ ! ! cs masks are read and net evap/precip over closed sea spread out depending on domain_cfg.nc masks.
+ ! ! See ln_mask_csundef and ln_clo_rnf for specific option related to this case
+ !
+ ln_mask_csundef = .true. ! (=T) undefined closed seas are masked ;
+ ! ! (=F) undefined closed seas are kept and no specific treatment is done for these closed seas
+ !
+ ln_clo_rnf = .true. ! (=T) river mouth specified in domain_cfg.nc masks (rnf and emp case) are added to the runoff mask.
+ ! ! allow the treatment of closed sea outflow grid-points to be the same as river mouth grid-points
/
!-----------------------------------------------------------------------
@@ -184,6 +193,4 @@
!! namsbc_rnf river runoffs (ln_rnf =T)
!! namsbc_apr Atmospheric Pressure (ln_apr_dyn =T)
-!! namsbc_isf ice shelf melting/freezing (ln_isfcav =T : read (ln_read_cfg=T) or set or usr_def_zgr )
-!! namsbc_iscpl coupling option between land ice model and ocean (ln_isfcav =T)
!! namsbc_wave external fields from wave model (ln_wave =T)
!! namberg iceberg floats (ln_icebergs=T)
@@ -222,5 +229,4 @@
ln_rnf = .false. ! runoffs (T => fill namsbc_rnf)
ln_apr_dyn = .false. ! Patm gradient added in ocean & ice Eqs. (T => fill namsbc_apr )
- ln_isf = .false. ! ice shelf (T => fill namsbc_isf & namsbc_iscpl)
ln_wave = .false. ! Activate coupling with wave (T => fill namsbc_wave)
ln_cdgw = .false. ! Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave)
@@ -439,43 +445,68 @@
/
!-----------------------------------------------------------------------
-&namsbc_isf ! Top boundary layer (ISF) (ln_isfcav =T : read (ln_read_cfg=T)
-!----------------------------------------------------------------------- or set or usr_def_zgr )
- ! ! type of top boundary layer
- nn_isf = 1 ! ice shelf melting/freezing
- ! 1 = presence of ISF ; 2 = bg03 parametrisation
- ! 3 = rnf file for ISF ; 4 = ISF specified freshwater flux
- ! options 1 and 4 need ln_isfcav = .true. (domzgr)
- ! ! nn_isf = 1 or 2 cases:
- rn_gammat0 = 1.e-4 ! gammat coefficient used in blk formula
- rn_gammas0 = 1.e-4 ! gammas coefficient used in blk formula
- ! ! nn_isf = 1 or 4 cases:
- rn_hisf_tbl = 30. ! thickness of the top boundary layer (Losh et al. 2008)
- ! ! 0 => thickness of the tbl = thickness of the first wet cell
- ! ! nn_isf = 1 case
- nn_isfblk = 1 ! 1 ISOMIP like: 2 equations formulation (Hunter et al., 2006)
- ! ! 2 ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)
- nn_gammablk = 1 ! 0 = cst Gammat (= gammat/s)
- ! ! 1 = velocity dependend Gamma (u* * gammat/s) (Jenkins et al. 2010)
- ! ! 2 = velocity and stability dependent Gamma (Holland et al. 1999)
-
- !___________!_____________!___________________!___________!_____________!_________!___________!__________!__________!_______________!
- ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !
- ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !
-!* nn_isf = 4 case
- sn_fwfisf = 'rnfisf' , -12. ,'sowflisf' , .false. , .true. , 'yearly' , '' , '' , ''
-!* nn_isf = 3 case
- sn_rnfisf = 'rnfisf' , -12. ,'sofwfisf' , .false. , .true. , 'yearly' , '' , '' , ''
-!* nn_isf = 2 and 3 cases
- sn_depmax_isf ='rnfisf' , -12. ,'sozisfmax', .false. , .true. , 'yearly' , '' , '' , ''
- sn_depmin_isf ='rnfisf' , -12. ,'sozisfmin', .false. , .true. , 'yearly' , '' , '' , ''
-!* nn_isf = 2 case
- sn_Leff_isf = 'rnfisf' , -12. ,'Leff' , .false. , .true. , 'yearly' , '' , '' , ''
-/
-!-----------------------------------------------------------------------
-&namsbc_iscpl ! land ice / ocean coupling option (ln_isfcav =T : read (ln_read_cfg=T)
-!----------------------------------------------------------------------- or set or usr_def_zgr )
- nn_drown = 10 ! number of iteration of the extrapolation loop (fill the new wet cells)
- ln_hsb = .false. ! activate conservation module (conservation exact after a time of rn_fiscpl)
- nn_fiscpl = 43800 ! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency)
+&namisf ! Top boundary layer (ISF) (default: OFF)
+!-----------------------------------------------------------------------
+ !
+ ! ---------------- ice shelf load -------------------------------
+ !
+ cn_isfload = 'uniform' ! scheme to compute ice shelf load (ln_isfcav = .true. in domain_cfg.nc)
+ rn_isfload_T = -1.9
+ rn_isfload_S = 34.4
+ !
+ ! ---------------- ice shelf melt formulation -------------------------------
+ !
+ ln_isf = .false. ! activate ice shelf module
+ ln_isfdebug = .false. ! add debug print in ISF code (global min/max/sum of specific variable)
+ cn_isfdir = './' ! directory for all ice shelf input file
+ !
+ ! ---------------- cavities opened -------------------------------
+ !
+ ln_isfcav_mlt = .false. ! ice shelf melting into the cavity (need ln_isfcav = .true. in domain_cfg.nc)
+ cn_isfcav_mlt = '3eq' ! ice shelf melting formulation (spe/2eq/3eq/oasis)
+ ! ! spe = fwfisf is read from a forcing field
+ ! ! 2eq = ISOMIP like: 2 equations formulation (Hunter et al., 2006 for a short description)
+ ! ! 3eq = ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2016 for a short description)
+ ! ! oasis = fwfisf is given by oasis and pattern by file sn_isfcav_fwf
+ ! ! cn_isfcav_mlt = 2eq or 3eq cases:
+ cn_gammablk = 'vel' ! scheme to compute gammat/s (spe,ad15,hj99)
+ ! ! spe = constant transfert velocity (rn_gammat0, rn_gammas0)
+ ! ! vel = velocity dependent transfert velocity (u* * gammat/s) (Asay-Davis et al. 2016 for a short description)
+ ! ! vel_stab = velocity and stability dependent transfert coeficient (Holland et al. 1999 for a complete description)
+ rn_gammat0 = 1.4e-2 ! gammat coefficient used in spe, vel and vel_stab gamma computation method
+ rn_gammas0 = 4.0e-4 ! gammas coefficient used in spe, vel and vel_stab gamma computation method
+ !
+ rn_htbl = 30. ! thickness of the top boundary layer (Losh et al. 2008)
+ ! ! 0 => thickness of the tbl = thickness of the first wet cell
+ !
+ !* 'spe' and 'oasis' case
+ !___________!_____________!___________________!___________!_____________!_________!___________!__________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !
+ sn_isfcav_fwf = 'isfmlt_cav', -12. , 'fwflisf' , .false. , .true. , 'yearly' , '' , '' , ''
+ !
+ ! ---------------- cavities parametrised -------------------------------
+ !
+ ln_isfpar_mlt = .false. ! ice shelf melting parametrised
+ cn_isfpar_mlt = 'spe' ! ice shelf melting parametrisation (spe/bg03/oasis)
+ ! ! spe = fwfisf is read from a forcing field
+ ! ! bg03 = melt computed using Beckmann and Goosse parametrisation
+ ! ! oasis = fwfisf is given by oasis and pattern by file sn_isfpar_fwf
+ !
+ !* all cases
+ !___________!_____________!___________________!___________!_____________!_________!___________!__________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !
+ sn_isfpar_zmax = 'isfmlt_par', 0 ,'sozisfmax', .false. , .true. , 'yearly' , '' , '' , ''
+ sn_isfpar_zmin = 'isfmlt_par', 0 ,'sozisfmin', .false. , .true. , 'yearly' , '' , '' , ''
+ !* 'spe' and 'oasis' case
+ sn_isfpar_fwf = 'isfmlt_par' , -12. ,'sofwfisf' , .false. , .true. , 'yearly' , '' , '' , ''
+ !* 'bg03' case
+ sn_isfpar_Leff = 'isfmlt_par', 0. ,'Leff' , .false. , .true. , 'yearly' , '' , '' , ''
+ !
+ ! ---------------- ice sheet coupling -------------------------------
+ !
+ ln_isfcpl = .false.
+ nn_drown = 10 ! number of iteration of the extrapolation loop (fill the new wet cells)
+ ln_isfcpl_cons = .false.
/
!-----------------------------------------------------------------------
@@ -1200,5 +1231,5 @@
&nam_diatmb ! Top Middle Bottom Output (default: OFF)
!-----------------------------------------------------------------------
- ln_diatmb = .false. ! Choose Top Middle and Bottom output or not
+ ln_diatmb = .true. ! Choose Top Middle and Bottom output or not
/
!-----------------------------------------------------------------------
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/context_nemo.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/context_nemo.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/context_nemo.xml (revision 12150)
@@ -0,0 +1,47 @@
+
+
+
+
+
+ 1800
+ 1026.0
+ 3991.86795711963
+ 0.99530670233846
+ 917.0
+ 330.0
+ 1.e20
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/domain_def_nemo.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/domain_def_nemo.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/domain_def_nemo.xml (revision 12150)
@@ -0,0 +1,1 @@
+link ../../SHARED/domain_def_nemo.xml
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/field_def_nemo-ice.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/field_def_nemo-ice.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/field_def_nemo-ice.xml (revision 12150)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-ice.xml
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/field_def_nemo-oce.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/field_def_nemo-oce.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/field_def_nemo-oce.xml (revision 12150)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-oce.xml
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/file_def_nemo-ice.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/file_def_nemo-ice.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/file_def_nemo-ice.xml (revision 12150)
@@ -0,0 +1,124 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/file_def_nemo-oce.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/file_def_nemo-oce.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/file_def_nemo-oce.xml (revision 12150)
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+ @toce_e3t / @e3t
+ @soce_e3t / @e3t
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ @uoce_e3u / @e3u
+
+
+
+
+
+
+ @voce_e3v / @e3v
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/grid_def_nemo.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/grid_def_nemo.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/grid_def_nemo.xml (revision 12150)
@@ -0,0 +1,1 @@
+link ../../SHARED/grid_def_nemo.xml
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/iodef.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/iodef.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/iodef.xml (revision 12150)
@@ -0,0 +1,26 @@
+
+
+
+
+
+
+
+
+
+
+
+ 10
+ false
+ false
+ oceanx
+
+
+
+
+
+
+
+
+
+
+
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_cfg (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_cfg (revision 12150)
@@ -0,0 +1,685 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE : Reference namelist_ref !!
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE : 1 - Domain & run manager (namrun, namcfg, namdom, namtsd, namcrs, namc1d, namc1d_uvd)
+!! namelists 2 - Surface boundary (namsbc, namsbc_flx, namsbc_blk, namsbc_cpl,
+!! namsbc_sas, namtra_qsr, namsbc_rnf,
+!! namsbc_isf, namsbc_iscpl, namsbc_apr,
+!! namsbc_ssr, namsbc_wave, namberg)
+!! 3 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide)
+!! 4 - top/bot boundary (namdrg, namdrg_top, namdrg_bot, nambbc, nambbl)
+!! 5 - Tracer (nameos, namtra_adv, namtra_ldf, namtra_eiv, namtra_dmp)
+!! 6 - dynamics (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!! 7 - Vertical physics (namzdf, namzdf_ric, namzdf_tke, namzdf_gls, namzdf_iwm)
+!! 8 - diagnostics (namnc4, namtrd, namspr, namflo, namhsb)
+!! 9 - Obs & Assim (namobs, nam_asminc)
+!! 10 - miscellaneous (nammpp, namctl, namsto)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!! *** Domain & Run management namelists *** !!
+!! !!
+!! namrun parameters of the run
+!! namdom space and time domain
+!! namcfg parameters of the configuration (default: user defined GYRE)
+!! namwad Wetting and drying (default: OFF)
+!! namtsd data: temperature & salinity (default: OFF)
+!! namcrs coarsened grid (for outputs and/or TOP) (ln_crs =T)
+!! namc1d 1D configuration options ("key_c1d")
+!! namc1d_dyndmp 1D newtonian damping applied on currents ("key_c1d")
+!! namc1d_uvd 1D data (currents) ("key_c1d")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun ! parameters of the run
+!-----------------------------------------------------------------------
+ nn_no = 0 ! job number (no more used...)
+ cn_exp = 'WED025' ! experience name
+ nn_it000 = 1 ! first time step
+ nn_itend = 26280 ! last time step (std 5475)
+ nn_date0 = 19760301 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+ ln_rstart = .false. ! start from rest (F) or from a restart file (T)
+ nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T
+/
+!-----------------------------------------------------------------------
+&namdom ! time and space domain
+!-----------------------------------------------------------------------
+ rn_rdt = 1200. ! time step for the dynamics and tracer
+ ln_meshmask = .true. ! =T create a mesh file
+/
+!-----------------------------------------------------------------------
+&namcfg ! parameters of the configuration (default: use namusr_def in namelist_cfg)
+!-----------------------------------------------------------------------
+ ln_read_cfg = .true. ! (=T) read the domain configuration file
+ ! ! (=F) user defined configuration (F => create/check namusr_def)
+ cn_domcfg = "domain_cfg" ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namtsd ! Temperature & Salinity Data (init/dmp) (default: OFF)
+!-----------------------------------------------------------------------
+ ! ! =T read T-S fields for:
+ ln_tsd_init = .true. ! ocean initialisation
+ ln_tsd_dmp = .false. ! T-S restoring (see namtra_dmp)
+
+ cn_dir = './' ! root directory for the T-S data location
+ !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename !
+ sn_tem = 'dta_temp_WED025' , -12 , 'votemper', .true. , .true. , 'yearly' , '' , '' , ''
+ sn_sal = 'dta_sal_WED025' , -12 , 'vosaline', .true. , .true. , 'yearly' , '' , '' , ''
+/
+!-----------------------------------------------------------------------
+&namwad ! Wetting and Drying (WaD) (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs ! coarsened grid (for outputs and/or TOP) (ln_crs =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d ! 1D configuration options ("key_c1d" default: PAPA station)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d_dyndmp ! U & V newtonian damping ("key_c1d" default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d_uvd ! data: U & V currents ("key_c1d" default: OFF)
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! *** Surface Boundary Condition namelists *** !!
+!! !!
+!! namsbc surface boundary condition manager (default: NO selection)
+!! namsbc_flx flux formulation (ln_flx =T)
+!! namsbc_blk Bulk formulae formulation (ln_blk =T)
+!! namsbc_cpl CouPLed formulation ("key_oasis3" )
+!! namsbc_sas Stand-Alone Surface module (SAS_SRC only)
+!! namsbc_iif Ice-IF: use observed ice cover (nn_ice = 1 )
+!! namtra_qsr penetrative solar radiation (ln_traqsr =T)
+!! namsbc_ssr sea surface restoring term (for T and/or S) (ln_ssr =T)
+!! namsbc_rnf river runoffs (ln_rnf =T)
+!! namsbc_apr Atmospheric Pressure (ln_apr_dyn =T)
+!! namsbc_iscpl coupling option between land ice model and ocean (ln_isfcav =T)
+!! namsbc_wave external fields from wave model (ln_wave =T)
+!! namberg iceberg floats (ln_icebergs=T)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc ! Surface Boundary Condition manager (default: NO selection)
+!-----------------------------------------------------------------------
+ nn_fsbc = 1 ! frequency of surface boundary condition computation
+ ! ! (control sea-ice & iceberg model call)
+ ! Type of air-sea fluxes
+ ln_blk = .true. ! Bulk formulation (T => fill namsbc_blk )
+ ! Sea-ice :
+ nn_ice = 2 ! =0 no ice boundary condition
+ ! ! =1 use observed ice-cover ( => fill namsbc_iif )
+ ! ! =2 or 3 automatically for SI3 or CICE ("key_si3" or "key_cice")
+ ! ! except in AGRIF zoom where it has to be specified
+ ln_ice_embd = .false. ! =T embedded sea-ice (pressure + mass and salt exchanges)
+ ! ! =F levitating ice (no pressure, mass and salt exchanges)
+ ! Misc. options of sbc :
+ ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr)
+ ln_dm2dc = .true. ! daily mean to diurnal cycle on short wave
+ ln_ssr = .false. ! Sea Surface Restoring on T and/or S (T => fill namsbc_ssr)
+ nn_fwb = 0 ! FreshWater Budget: =0 unchecked
+ ! ! =1 global mean of e-p-r set to zero at each time step
+ ! ! =2 annual global mean of e-p-r set to zero
+ ln_rnf = .true. ! runoffs (T => fill namsbc_rnf)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx ! surface boundary condition : flux formulation (ln_flx =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_blk ! namsbc_blk generic Bulk formula (ln_blk =T)
+!-----------------------------------------------------------------------
+ ! ! bulk algorithm :
+ ln_NCAR = .true. ! "NCAR" algorithm (Large and Yeager 2008)
+ ln_COARE_3p0 = .false. ! "COARE 3.0" algorithm (Fairall et al. 2003)
+ ln_COARE_3p5 = .false. ! "COARE 3.5" algorithm (Edson et al. 2013)
+ ln_ECMWF = .false. ! "ECMWF" algorithm (IFS cycle 31)
+
+ cn_dir = './' ! root directory for the bulk data location
+ !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename !
+ sn_wndi = 'u10_core' , 6 , 'U_10_MOD', .true. , .false. , 'yearly' , 'weights_bicubic_core.nc' , 'Uwnd' , ''
+ sn_wndj = 'v10_core' , 6 , 'V_10_MOD', .true. , .false. , 'yearly' , 'weights_bicubic_core.nc' , 'Vwnd' , ''
+ sn_qsr = 'qsw_core' , 24 , 'SWDN_MOD', .false. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''
+ sn_qlw = 'qlw_core' , 24 , 'LWDN_MOD', .false. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''
+ sn_tair = 't10_core' , 6 , 'T_10_MOD', .true. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''
+ sn_humi = 'q10_core' , 6 , 'Q_10_MOD', .true. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''
+ sn_prec = 'precip_core' , -1 , 'TPRECIP', .true. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''
+ sn_snow = 'snow_core' , -1 , 'SNOW' , .true. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''
+ sn_slp = 'slp_core' , 6 , 'SLP' , .true. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_sas ! Stand-Alone Surface module: ocean data (SAS_SRC only)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_iif ! Ice-IF : use observed ice cover (nn_ice = 1)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr ! penetrative solar radiation (ln_traqsr =T)
+!-----------------------------------------------------------------------
+ ! ! type of penetration (default: NO selection)
+ ln_qsr_rgb = .true. ! RGB (Red-Green-Blue) light penetration
+ ! ! RGB & 2BD choices:
+ nn_chldta = 1 ! RGB : 2D Chl data (=1), 3D Chl data (=2) or cst value (=0)
+
+ cn_dir = './' ! root directory for the chlorophyl data location
+ !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename !
+ sn_chl ='chlorophyll_WED025' , -1 , 'CHLA' , .true. , .true. , 'yearly' , '' , '' , ''
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr ! surface boundary condition : sea surface restoring (ln_ssr =T)
+!-----------------------------------------------------------------------
+ nn_sssr = 2 ! add a damping term in the surface freshwater flux (=2)
+ ! ! or to SSS only (=1) or no damping term (=0)
+ rn_deds = -166.67 ! magnitude of the damping on salinity [mm/day]
+ ln_sssr_bnd = .true. ! flag to bound erp term (associated with nn_sssr=2)
+ rn_sssr_bnd = 4.e0 ! ABS(Max/Min) value of the damping erp term [mm/day]
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf ! runoffs (ln_rnf =T)
+!-----------------------------------------------------------------------
+
+ cn_dir = './' ! root directory for the runoff data location
+ !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename !
+ sn_rnf = 'runoff_WED025' , -1 , 'runoff' , .true. , .false., 'yearly' , '' , '' , ''
+/
+!-----------------------------------------------------------------------
+&namsbc_apr ! Atmospheric pressure used as ocean forcing (ln_apr_dyn =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namisf ! Top boundary layer (ISF) (default: OFF)
+!-----------------------------------------------------------------------
+ !
+ ! ---------------- ice shelf melt formulation -------------------------------
+ !
+ ln_isf = .true. ! activate ice shelf module
+ cn_isfdir = './' ! directory for all ice shelf input file
+ !
+ ! ---------------- cavities opened -------------------------------
+ !
+ ln_isfcav_mlt = .true. ! ice shelf melting into the cavity
+ cn_isfcav_mlt = '3eq' ! ice shelf melting formulation (spe/2eq/3eq/oasis)
+ ! ! spe = fwfisf is read from a forcing field
+ ! ! 2eq = ISOMIP like: 2 equations formulation (Hunter et al., 2006)
+ ! ! 3eq = ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)
+ ! ! oasis = fwfisf is given by oasis and pattern by file sn_isfcav_fwf
+ ! ! cn_isfcav_mlt = 2eq or 3eq cases:
+ cn_gammablk = 'vel' ! scheme to compute gammat/s (spe,ad15,hj99)
+ ! ! ad15 = velocity dependend Gamma (u* * gammat/s) (Jenkins et al. 2010)
+ ! ! hj99 = velocity and stability dependent Gamma (Holland et al. 1999)
+ rn_gammat0 = 1.4e-2 ! gammat coefficient used in blk formula
+ rn_gammas0 = 4.e-4 ! gammas coefficient used in blk formula
+ !
+ rn_htbl = 30. ! thickness of the top boundary layer (Losh et al. 2008)
+ ! ! 0 => thickness of the tbl = thickness of the first wet cell
+ !
+ !* 'spe' and 'oasis' case
+ !___________!_____________!___________________!___________!_____________!_________!___________!__________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !
+ sn_isfcav_fwf = 'isfmlt_cav', -12. , 'fwflisf' , .false. , .true. , 'yearly' , '' , '' , ''
+ !
+ ! ---------------- cavities parametrised -------------------------------
+ !
+ ln_isfpar_mlt = .true. ! ice shelf melting parametrised
+ cn_isfpar_mlt = 'spe' ! ice shelf melting parametrisation (spe/bg03/oasis)
+ ! ! spe = fwfisf is read from a forcing field
+ ! ! bg03 = melt computed using Beckmann and Goosse parametrisation
+ ! ! oasis = fwfisf is given by oasis and pattern by file sn_isfpar_fwf
+ !
+ !* all cases
+ !___________!_____________!___________________!___________!_____________!_________!___________!__________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !
+ sn_isfpar_zmax = 'isfmlt_par', -12. , 'sozisfmax' , .false. , .true. , 'yearly' , '' , '' , ''
+ sn_isfpar_zmin = 'isfmlt_par', -12. , 'sozisfmin' , .false. , .true. , 'yearly' , '' , '' , ''
+ !* 'spe' and 'oasis' case
+ sn_isfpar_fwf = 'isfmlt_par' , -12. , 'sofwfisf' , .false. , .true. , 'yearly' , '' , '' , ''
+ !* 'bg03' case
+ sn_isfpar_Leff = 'isfmlt_par', 0. , 'Leff' , .false. , .true. , 'yearly' , '' , '' , ''
+ !
+ ! ---------------- ice sheet coupling -------------------------------
+ !
+ ln_isfcpl = .false.
+ nn_drown = 10 ! number of iteration of the extrapolation loop (fill the new wet cells)
+ ln_isfcpl_cons = .false.
+/
+!-----------------------------------------------------------------------
+&namsbc_wave ! External fields from wave model (ln_wave=T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg ! iceberg parameters (default: OFF)
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! *** Lateral boundary condition *** !!
+!! !!
+!! namlbc lateral momentum boundary condition (default: NO selection)
+!! namagrif agrif nested grid (read by child model only) ("key_agrif")
+!! nam_tide Tidal forcing (default: OFF)
+!! nambdy Unstructured open boundaries (default: OFF)
+!! nambdy_dta Unstructured open boundaries - external data (see nambdy)
+!! nambdy_tide tidal forcing at open boundaries (default: OFF)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc ! lateral momentum boundary condition (default: NO selection)
+!-----------------------------------------------------------------------
+ ! ! free slip ! partial slip ! no slip ! strong slip
+ rn_shlat = 2. ! shlat = 0 ! 0 < shlat < 2 ! shlat = 2 ! 2 < shlat
+/
+!-----------------------------------------------------------------------
+&namagrif ! AGRIF zoom ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide ! tide parameters (default: OFF)
+!-----------------------------------------------------------------------
+ ln_tide = .true. ! Activate tides
+ ln_tide_pot = .false. ! use tidal potential forcing
+ clname(1) = 'M2' ! name of constituent - all tidal components must be set in namelist_cfg
+ clname(2) = 'S2'
+ clname(3) = 'K1'
+ clname(4) = 'O1'
+/
+!-----------------------------------------------------------------------
+&nambdy ! unstructured open boundaries (default: OFF)
+!-----------------------------------------------------------------------
+ ln_bdy = .true. ! Use unstructured open boundaries
+ nb_bdy = 1 ! number of open boundary sets
+ ln_coords_file = .true. ! =T : read bdy coordinates from file
+ cn_coords_file = 'coordinates_bdy_WED025.nc' ! bdy coordinates files
+ ln_mask_file = .false. ! =T : read mask from file
+ cn_mask_file = '' ! name of mask file (if ln_mask_file=.TRUE.)
+ cn_dyn2d = 'flather' !
+ nn_dyn2d_dta = 3 ! = 0, bdy data are equal to the initial state
+ ! ! = 1, bdy data are read in 'bdydata .nc' files
+ ! ! = 2, use tidal harmonic forcing data from files
+ ! ! = 3, use external data AND tidal harmonic forcing
+ cn_dyn3d = 'frs' !
+ nn_dyn3d_dta = 1 ! = 0, bdy data are equal to the initial state
+ ! ! = 1, bdy data are read in 'bdydata .nc' files
+ cn_tra = 'frs' !
+ nn_tra_dta = 1 ! = 0, bdy data are equal to the initial state
+ ! ! = 1, bdy data are read in 'bdydata .nc' files
+ cn_ice = 'frs' !
+ nn_ice_dta = 1 ! = 0, bdy data are equal to the initial state
+ ! ! = 1, bdy data are read in 'bdydata .nc' files
+ !
+ nn_rimwidth = 1 ! width of the relaxation zone
+/
+!-----------------------------------------------------------------------
+&nambdy_dta ! open boundaries - external data (see nam_bdy)
+!-----------------------------------------------------------------------
+ ln_full_vel = .false. ! ???
+
+ cn_dir = './' ! root directory for the BDY data location
+ !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename !
+ bn_ssh = 'bdyT_ssh_WED025' , -1 , 'sossheig' , .true. , .false., 'yearly' , '' , '' , ''
+ bn_u2d = 'bdyU_u2d_WED025' , -1 , 'vobtcrtx' , .true. , .false., 'yearly' , '' , '' , ''
+ bn_v2d = 'bdyV_u2d_WED025' , -1 , 'vobtcrty' , .true. , .false., 'yearly' , '' , '' , ''
+ bn_u3d = 'bdyU_u3d_WED025' , -1 , 'vozocrtx' , .true. , .false., 'yearly' , '' , '' , ''
+ bn_v3d = 'bdyV_u3d_WED025' , -1 , 'vomecrty' , .true. , .false., 'yearly' , '' , '' , ''
+ bn_tem = 'bdyT_tra_WED025' , -1 , 'votemper' , .true. , .false., 'yearly' , '' , '' , ''
+ bn_sal = 'bdyT_tra_WED025' , -1 , 'vosaline' , .true. , .false., 'yearly' , '' , '' , ''
+!* for si3
+ bn_a_i = 'bdyT_ice_WED025' , -1 , 'ileadfra' , .true. , .false., 'yearly' , '' , '' , ''
+ bn_h_i = 'bdyT_ice_WED025' , -1 , 'iicethic' , .true. , .false., 'yearly' , '' , '' , ''
+ bn_h_s = 'bdyT_ice_WED025' , -1 , 'isnowthi' , .true. , .false., 'yearly' , '' , '' , ''
+/
+!-----------------------------------------------------------------------
+&nambdy_tide ! tidal forcing at open boundaries (default: OFF)
+!-----------------------------------------------------------------------
+ filtide = 'bdytide_WED025_' ! file name root of tidal forcing files
+/
+
+!!======================================================================
+!! *** Top/Bottom boundary condition *** !!
+!! !!
+!! namdrg top/bottom drag coefficient (default: NO selection)
+!! namdrg_top top friction (ln_OFF=F & ln_isfcav=T)
+!! namdrg_bot bottom friction (ln_OFF=F)
+!! nambbc bottom temperature boundary condition (default: OFF)
+!! nambbl bottom boundary layer scheme (default: OFF)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdrg ! top/bottom drag coefficient (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_non_lin = .true. ! non-linear drag: Cd = Cd0 |U|
+/
+!-----------------------------------------------------------------------
+&namdrg_top ! TOP friction (ln_OFF =F & ln_isfcav=T)
+!-----------------------------------------------------------------------
+ rn_Cd0 = 2.5e-3 ! drag coefficient [-]
+/
+!-----------------------------------------------------------------------
+&namdrg_bot ! BOTTOM friction (ln_OFF =F)
+!-----------------------------------------------------------------------
+ rn_Cd0 = 2.5e-3 ! drag coefficient [-]
+/
+!-----------------------------------------------------------------------
+&nambbc ! bottom temperature boundary condition (default: OFF)
+!-----------------------------------------------------------------------
+ ln_trabbc = .false. ! Apply a geothermal heating at the ocean bottom
+/
+!-----------------------------------------------------------------------
+&nambbl ! bottom boundary layer scheme (default: OFF)
+!-----------------------------------------------------------------------
+ ln_trabbl = .true. ! Bottom Boundary Layer parameterisation flag
+/
+
+!!======================================================================
+!! Tracer (T-S) namelists !!
+!! !!
+!! nameos equation of state (default: NO selection)
+!! namtra_adv advection scheme (default: NO selection)
+!! namtra_ldf lateral diffusion scheme (default: NO selection)
+!! namtra_mle mixed layer eddy param. (Fox-Kemper param.) (default: OFF)
+!! namtra_eiv eddy induced velocity param. (default: OFF)
+!! namtra_dmp T & S newtonian damping (default: OFF)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos ! ocean Equation Of Seawater (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_teos10 = .true. ! = Use TEOS-10
+/
+!-----------------------------------------------------------------------
+&namtra_adv ! advection scheme for tracer (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_traadv_fct = .true. ! FCT scheme
+ nn_fct_h = 2 ! =2/4, horizontal 2nd / 4th order
+ nn_fct_v = 2 ! =2/4, vertical 2nd / COMPACT 4th order
+/
+!-----------------------------------------------------------------------
+&namtra_ldf ! lateral diffusion scheme for tracers (default: NO selection)
+!-----------------------------------------------------------------------
+ ! ! Operator type:
+ ln_traldf_lap = .true. ! laplacian operator
+ ! ! Direction of action:
+ ln_traldf_iso = .true. ! iso-neutral (standard operator)
+ !
+ ! ! Coefficients:
+ nn_aht_ijk_t = 20 ! space/time variation of eddy coefficient:
+ ! ! =-20 (=-30) read in eddy_diffusivity_2D.nc (..._3D.nc) file
+ ! ! = 0 constant
+ ! ! = 10 F(k) =ldf_c1d
+ ! ! = 20 F(i,j) =ldf_c2d
+ ! ! = 21 F(i,j,t) =Treguier et al. JPO 1997 formulation
+ ! ! = 30 F(i,j,k) =ldf_c2d * ldf_c1d
+ ! ! = 31 F(i,j,k,t)=F(local velocity and grid-spacing)
+ ! ! time invariant coefficients: aht0 = 1/2 Ud*Ld (lap case)
+ ! ! or = 1/12 Ud*Ld^3 (blp case)
+ rn_Ud = 0.011 ! lateral diffusive velocity [m/s] (nn_aht_ijk_t= 0, 10, 20, 30)
+/
+!-----------------------------------------------------------------------
+&namtra_mle ! mixed layer eddy parametrisation (Fox-Kemper) (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_eiv ! eddy induced velocity param. (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp ! tracer: T & S newtonian damping (default: OFF)
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! *** Dynamics namelists *** !!
+!! !!
+!! nam_vvl vertical coordinate options (default: z-star)
+!! namdyn_adv formulation of the momentum advection (default: NO selection)
+!! namdyn_vor advection scheme (default: NO selection)
+!! namdyn_hpg hydrostatic pressure gradient (default: NO selection)
+!! namdyn_spg surface pressure gradient (default: NO selection)
+!! namdyn_ldf lateral diffusion scheme (default: NO selection)
+!! namdta_dyn offline TOP: dynamics read in files (OFF_SRC only)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nam_vvl ! vertical coordinate options (default: z-star)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_adv ! formulation of the momentum advection (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_dynadv_vec = .true. ! vector form (T) or flux form (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_vor ! Vorticity / Coriolis scheme (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_dynvor_een = .true. ! energy & enstrophy scheme
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg ! Hydrostatic pressure gradient option (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_hpg_isf = .true. ! s-coordinate (sco ) adapted to isf
+/
+!-----------------------------------------------------------------------
+&namdyn_spg ! surface pressure gradient (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_dynspg_ts = .true. ! split-explicit free surface
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf ! lateral diffusion on momentum (default: NO selection)
+!-----------------------------------------------------------------------
+ ! ! Type of the operator :
+ ln_dynldf_blp = .true. ! bilaplacian operator
+ ! ! Direction of action :
+ ln_dynldf_hor = .true. ! horizontal (geopotential)
+ ! ! Coefficient
+ nn_ahm_ijk_t = 20 ! space/time variation of eddy coefficient :
+ ! ! =-30 read in eddy_viscosity_3D.nc file
+ ! ! =-20 read in eddy_viscosity_2D.nc file
+ ! ! = 0 constant
+ ! ! = 10 F(k)=c1d
+ ! ! = 20 F(i,j)=F(grid spacing)=c2d
+ ! ! = 30 F(i,j,k)=c2d*c1d
+ ! ! = 31 F(i,j,k)=F(grid spacing and local velocity)
+ ! ! = 32 F(i,j,k)=F(local gridscale and deformation rate)
+ ! ! time invariant coefficients : ahm = 1/2 Uv*Lv (lap case)
+ ! ! or = 1/12 Uv*Lv^3 (blp case)
+ rn_Uv = 0.0838 ! lateral viscous velocity [m/s] (nn_ahm_ijk_t= 0, 10, 20, 30)
+/
+!-----------------------------------------------------------------------
+&namdta_dyn ! offline ocean input files (OFF_SRC only)
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! vertical physics namelists !!
+!! !!
+!! namzdf vertical physics manager (default: NO selection)
+!! namzdf_ric richardson number vertical mixing (ln_zdfric=T)
+!! namzdf_tke TKE vertical mixing (ln_zdftke=T)
+!! namzdf_gls GLS vertical mixing (ln_zdfgls=T)
+!! namzdf_osm OSM vertical diffusion (ln_zdfosm=T)
+!! namzdf_iwm tidal mixing parameterization (ln_zdfiwm=T)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf ! vertical physics manager (default: NO selection)
+!-----------------------------------------------------------------------
+ !
+ ! ! type of vertical closure (required)
+ ln_zdftke = .true. ! Turbulent Kinetic Energy closure (T => fill namzdf_tke)
+ !
+ ! ! convection
+ ln_zdfevd = .true. ! enhanced vertical diffusion
+ nn_evdm = 0 ! apply on tracer (=0) or on tracer and momentum (=1)
+ rn_evd = 10.0 ! mixing coefficient [m2/s]
+ !
+ ! ! coefficients
+ rn_avm0 = 1.2e-4 ! vertical eddy viscosity [m2/s] (background Kz if ln_zdfcst=F)
+ rn_avt0 = 2e-06 ! vertical eddy diffusivity [m2/s] (background Kz if ln_zdfcst=F)
+ nn_avb = 0 ! profile for background avt & avm (=1) or not (=0)
+ nn_havtb = 1 ! horizontal shape for avtb (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric ! richardson number dependent vertical diffusion (ln_zdfric =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke ! turbulent eddy kinetic dependent vertical diffusion (ln_zdftke =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls ! GLS vertical diffusion (ln_zdfgls =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_osm ! OSM vertical diffusion (ln_zdfosm =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_iwm ! internal wave-driven mixing parameterization (ln_zdfiwm =T)
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! *** Diagnostics namelists *** !!
+!! !!
+!! namtrd dynamics and/or tracer trends (default: OFF)
+!! namptr Poleward Transport Diagnostics (default: OFF)
+!! namhsb Heat and salt budgets (default: OFF)
+!! namdiu Cool skin and warm layer models (default: OFF)
+!! namdiu Cool skin and warm layer models (default: OFF)
+!! namflo float parameters ("key_float")
+!! nam_diaharm Harmonic analysis of tidal constituents ("key_diaharm")
+!! namdct transports through some sections ("key_diadct")
+!! nam_diatmb Top Middle Bottom Output (default: OFF)
+!! nam_dia25h 25h Mean Output (default: OFF)
+!! namnc4 netcdf4 chunking and compression settings ("key_netcdf4")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namtrd ! trend diagnostics (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr ! Poleward Transport Diagnostic (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb ! Heat and salt budgets (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdiu ! Cool skin and warm layer models (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namflo ! float parameters ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_diaharm ! Harmonic analysis of tidal constituents ("key_diaharm")
+!-----------------------------------------------------------------------
+ nit000_han = 1 ! First time step used for harmonic analysis
+ nitend_han = 1 ! Last time step used for harmonic analysis
+ nstep_han = 540 ! Time step frequency for harmonic analysis
+ tname(1) = 'M2' ! Name of tidal constituents
+ tname(2) = 'S2'
+ tname(3) = 'N2'
+ tname(4) = 'K2'
+/
+!-----------------------------------------------------------------------
+&namdct ! transports through some sections ("key_diadct")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_diatmb ! Top Middle Bottom Output (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_dia25h ! 25h Mean Output (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! *** Observation & Assimilation *** !!
+!! !!
+!! namobs observation and model comparison (default: OFF)
+!! nam_asminc assimilation increments ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs ! observation usage switch (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc ! assimilation increments ('key_asminc')
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! *** Miscellaneous namelists *** !!
+!! !!
+!! nammpp Massively Parallel Processing ("key_mpp_mpi")
+!! namctl Control prints (default: OFF)
+!! namsto Stochastic parametrization of EOS (default: OFF)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nammpp ! Massively Parallel Processing ("key_mpp_mpi")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl ! Control prints (default: OFF)
+!-----------------------------------------------------------------------
+ ln_ctl = .FALSE. ! Toggle all report printing on/off (T/F); Ignored if sn_cfctl%l_config is T
+ sn_cfctl%l_config = .TRUE. ! IF .true. then control which reports are written with the following
+ sn_cfctl%l_runstat = .FALSE. ! switches and which areas produce reports with the proc integer settings.
+ sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure
+ sn_cfctl%l_oceout = .FALSE. ! that all areas report.
+ sn_cfctl%l_layout = .FALSE. !
+ sn_cfctl%l_mppout = .FALSE. !
+ sn_cfctl%l_mpptop = .FALSE. !
+ sn_cfctl%procmin = 0 ! Minimum area number for reporting [default:0]
+ sn_cfctl%procmax = 1000000 ! Maximum area number for reporting [default:1000000]
+ sn_cfctl%procincr = 1 ! Increment for optional subsetting of areas [default:1]
+ sn_cfctl%ptimincr = 1 ! Timestep increment for writing time step progress info
+ nn_print = 0 ! level of print (0 no extra print)
+ nn_ictls = 0 ! start i indice of control sum (use to compare mono versus
+ nn_ictle = 0 ! end i indice of control sum multi processor runs
+ nn_jctls = 0 ! start j indice of control over a subdomain)
+ nn_jctle = 0 ! end j indice of control
+ nn_isplt = 1 ! number of processors in i-direction
+ nn_jsplt = 1 ! number of processors in j-direction
+ ln_timing = .true. ! timing by routine write out in timing.output file
+ ln_diacfl = .false. ! CFL diagnostics write out in cfl_diagnostics.ascii
+/
+!-----------------------------------------------------------------------
+&namsto ! Stochastic parametrization of EOS (default: OFF)
+!-----------------------------------------------------------------------
+/
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_ice_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_ice_cfg (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_ice_cfg (revision 12150)
@@ -0,0 +1,84 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! SI3 namelist:
+!! 1 - Generic parameters (nampar)
+!! 2 - Ice thickness discretization (namitd)
+!! 3 - Ice dynamics (namdyn)
+!! 4 - Ice ridging/rafting (namdyn_rdgrft)
+!! 5 - Ice rheology (namdyn_rhg)
+!! 6 - Ice advection (namdyn_adv)
+!! 7 - Ice surface boundary conditions (namsbc)
+!! 8 - Ice thermodynamics (namthd)
+!! 9 - Ice heat diffusion (namthd_zdf)
+!! 10 - Ice lateral melting (namthd_da)
+!! 11 - Ice growth in open water (namthd_do)
+!! 12 - Ice salinity (namthd_sal)
+!! 13 - Ice melt ponds (namthd_pnd)
+!! 14 - Ice initialization (namini)
+!! 15 - Ice/snow albedos (namalb)
+!! 16 - Ice diagnostics (namdia)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!------------------------------------------------------------------------------
+&nampar ! Generic parameters
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namitd ! Ice discretization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namdyn ! Ice dynamics
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namdyn_rdgrft ! Ice ridging/rafting
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namdyn_rhg ! Ice rheology
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namdyn_adv ! Ice advection
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namsbc ! Ice surface boundary conditions
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd ! Ice thermodynamics
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_zdf ! Ice heat diffusion
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_da ! Ice lateral melting
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_do ! Ice growth in open water
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_sal ! Ice salinity
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namthd_pnd ! Melt ponds
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namini ! Ice initialization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namalb ! albedo parameters
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namdia ! Diagnostics
+!------------------------------------------------------------------------------
+/
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_ice_ref
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_ice_ref (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_ice_ref (revision 12150)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_ice_ref
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_ref
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_ref (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/EXPREF/namelist_ref (revision 12150)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_ref
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/cpp_WED025.fcm
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/cpp_WED025.fcm (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/WED025/cpp_WED025.fcm (revision 12150)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_mpp_mpi key_iomput key_si3 key_nosignedzero
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/ref_cfgs.txt
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/ref_cfgs.txt (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/cfgs/ref_cfgs.txt (revision 12150)
@@ -9,2 +9,3 @@
ORCA2_ICE_PISCES OCE TOP ICE NST
SPITZ12 OCE ICE
+WED025 OCE ICE
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/BDY/bdyvol.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/BDY/bdyvol.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/BDY/bdyvol.F90 (revision 12150)
@@ -14,7 +14,7 @@
USE bdy_oce ! ocean open boundary conditions
USE sbc_oce ! ocean surface boundary conditions
+ USE isf_oce, ONLY : fwfisf_cav, fwfisf_par ! ice shelf
USE dom_oce ! ocean space and time domain
USE phycst ! physical constants
- USE sbcisf ! ice shelf
!
USE in_out_manager ! I/O manager
@@ -77,5 +77,5 @@
! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
! -----------------------------------------------------------------------
- IF ( kc == 1 ) z_cflxemp = glob_sum( 'bdyvol', ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0
+ IF ( kc == 1 ) z_cflxemp = glob_sum( 'bdyvol', ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0
! Compute bdy surface each cycle if non linear free surface
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diahsb.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diahsb.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diahsb.F90 (revision 12150)
@@ -17,6 +17,6 @@
USE phycst ! physical constants
USE sbc_oce ! surface thermohaline fluxes
+ USE isf_oce ! ice shelf fluxes
USE sbcrnf ! river runoff
- USE sbcisf ! ice shelves
USE domvvl ! vertical scale factors
USE traqsr ! penetrative solar radiation
@@ -48,4 +48,5 @@
REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini !
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini !
+ REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_ini
!! * Substitutions
@@ -92,5 +93,5 @@
! 1 - Trends due to forcing !
! ------------------------- !
- z_frc_trd_v = r1_rau0 * glob_sum( 'diahsb', - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes
+ z_frc_trd_v = r1_rau0 * glob_sum( 'diahsb', - ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) ) * surf(:,:) ) ! volume fluxes
z_frc_trd_t = glob_sum( 'diahsb', sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes
z_frc_trd_s = glob_sum( 'diahsb', sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes
@@ -99,5 +100,6 @@
IF( ln_rnf_sal) z_frc_trd_s = z_frc_trd_s + glob_sum( 'diahsb', rnf_tsc(:,:,jp_sal) * surf(:,:) )
! ! Add ice shelf heat & salt input
- IF( ln_isf ) z_frc_trd_t = z_frc_trd_t + glob_sum( 'diahsb', risf_tsc(:,:,jp_tem) * surf(:,:) )
+ IF( ln_isf ) z_frc_trd_t = z_frc_trd_t &
+ & + glob_sum( 'diahsb', ( risf_cav_tsc(:,:,jp_tem) + risf_par_tsc(:,:,jp_tem) ) * surf(:,:) )
! ! Add penetrative solar radiation
IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( 'diahsb', qsr (:,:) * surf(:,:) )
@@ -156,13 +158,13 @@
!
DO jk = 1, jpkm1 ! volume variation (calculated with scale factors)
- zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm) - surf_ini(:,:)*e3t_ini(:,:,jk) ) * tmask(:,:,jk)
+ zwrk(:,:,jk) = surf(:,:)*e3t(:,:,jk,Kmm)*tmask(:,:,jk) - surf_ini(:,:)*e3t_ini(:,:,jk)*tmask_ini(:,:,jk)
END DO
- zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) )
+ zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) ) ! glob_sum_full needed as tmask and tmask_ini could be different
DO jk = 1, jpkm1 ! heat content variation
- zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm) - surf_ini(:,:)*hc_loc_ini(:,:,jk) ) * tmask(:,:,jk)
+ zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm) - surf_ini(:,:)*hc_loc_ini(:,:,jk) )
END DO
zdiff_hc = glob_sum_full( 'diahsb', zwrk(:,:,:) )
DO jk = 1, jpkm1 ! salt content variation
- zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm) - surf_ini(:,:)*sc_loc_ini(:,:,jk) ) * tmask(:,:,jk)
+ zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm) - surf_ini(:,:)*sc_loc_ini(:,:,jk) )
END DO
zdiff_sc = glob_sum_full( 'diahsb', zwrk(:,:,:) )
@@ -188,5 +190,5 @@
zwrk(:,:,jk) = surf(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
END DO
- zvol_tot = glob_sum_full( 'diahsb', zwrk(:,:,:) )
+ zvol_tot = glob_sum( 'diahsb', zwrk(:,:,:) )
!!gm to be added ?
@@ -272,4 +274,5 @@
CALL iom_get( numror, jpdom_autoglo, 'ssh_ini' , ssh_ini , ldxios = lrxios )
CALL iom_get( numror, jpdom_autoglo, 'e3t_ini' , e3t_ini , ldxios = lrxios )
+ CALL iom_get( numror, jpdom_autoglo, 'tmask_ini' , tmask_ini , ldxios = lrxios )
CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini, ldxios = lrxios )
CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini, ldxios = lrxios )
@@ -287,4 +290,5 @@
! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
e3t_ini (:,:,jk) = e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial vertical scale factors
+ tmask_ini (:,:,jk) = tmask(:,:,jk) ! initial mask
hc_loc_ini(:,:,jk) = ts(:,:,jk,jp_tem,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial heat content
sc_loc_ini(:,:,jk) = ts(:,:,jk,jp_sal,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial salt content
@@ -327,4 +331,5 @@
CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini' , ssh_ini , ldxios = lwxios )
CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini' , e3t_ini , ldxios = lwxios )
+ CALL iom_rstput( kt, nitrst, numrow, 'tmask_ini' , tmask_ini , ldxios = lwxios )
CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini, ldxios = lwxios )
CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini, ldxios = lwxios )
@@ -398,5 +403,5 @@
! ------------------- !
ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), &
- & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror )
+ & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), tmask_ini(jpi,jpj,jpk),STAT=ierror )
IF( ierror > 0 ) THEN
CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' ) ; RETURN
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diawri.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diawri.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diawri.F90 (revision 12150)
@@ -26,4 +26,6 @@
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and tracers
+ USE isf_oce
+ USE isfcpl
USE dom_oce ! ocean space and time domain
USE phycst ! physical constants
@@ -881,6 +883,7 @@
INTEGER , INTENT( in ) :: Kmm ! time level index
CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zisfdebug
!!
- INTEGER :: inum
+ INTEGER :: inum, jk
!!----------------------------------------------------------------------
!
@@ -906,4 +909,27 @@
CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww ) ! now k-velocity
ENDIF
+ CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'ht' , ht ) ! now water column height
+
+ IF ( ln_isf ) THEN
+ IF (ln_isfcav_mlt) THEN
+ CALL iom_rstput( 0, 0, inum, 'fwfisf_cav', fwfisf_cav ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,8) ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,8) ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,8), ktype = jp_i1 )
+ END IF
+ IF (ln_isfpar_mlt) THEN
+ CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,8) ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,8) ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,8) ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,8), ktype = jp_i1 )
+ END IF
+ END IF
+
IF( ALLOCATED(ahtu) ) THEN
CALL iom_rstput( 0, 0, inum, 'ahtu', ahtu ) ! aht at u-point
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/closea.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/closea.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/closea.F90 (revision 12150)
@@ -11,53 +11,43 @@
!! 4.0 ! 2016-06 (G. Madec) move to usrdef_closea, remove clo_ups
!! 4.0 ! 2017-12 (D. Storkey) new formulation based on masks read from file
+ !! 4.1 ! 2019-07 (P. Mathiot) update to the new domcfg.nc input file
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! dom_clo : read in masks which define closed seas and runoff areas
- !! sbc_clo : Special handling of freshwater fluxes over closed seas
!! clo_rnf : set close sea outflows as river mouths (see sbcrnf)
- !! clo_bat : set to zero a field over closed sea (see domzgr)
- !!----------------------------------------------------------------------
- USE oce ! dynamics and tracers
- USE dom_oce ! ocean space and time domain
- USE phycst ! physical constants
- USE sbc_oce ! ocean surface boundary conditions
- USE iom ! I/O routines
+ !! clo_msk : set to zero a field over closed sea (see domzgr)
+ !!----------------------------------------------------------------------
+ USE in_out_manager ! I/O manager
!
- USE in_out_manager ! I/O manager
- USE lib_fortran, ONLY: glob_sum
- USE lbclnk ! lateral boundary condition - MPP exchanges
- USE lib_mpp ! MPP library
- USE timing ! Timing
+ USE diu_bulk , ONLY: ln_diurnal_only ! used for sanity check
+ USE iom , ONLY: iom_open, iom_get, iom_close, jpdom_data ! I/O routines
+ USE lib_fortran , ONLY: glob_sum ! fortran library
+ USE lib_mpp , ONLY: mpp_max, ctl_nam, ctl_stop ! MPP library
IMPLICIT NONE
+
PRIVATE
PUBLIC dom_clo ! called by domain module
- PUBLIC sbc_clo ! called by sbcmod module
PUBLIC clo_rnf ! called by sbcrnf module
- PUBLIC clo_bat ! called in domzgr module
-
- LOGICAL, PUBLIC :: ln_closea !: T => keep closed seas (defined by closea_mask field) in the domain and apply
- !: special treatment of freshwater fluxes.
- !: F => suppress closed seas (defined by closea_mask field) from the bathymetry
- !: at runtime.
- !: If there is no closea_mask field in the domain_cfg file or we do not use
- !: a domain_cfg file then this logical does nothing.
- !:
- LOGICAL, PUBLIC :: l_sbc_clo !: T => Closed seas defined, apply special treatment of freshwater fluxes.
- !: F => No closed seas defined (closea_mask field not found).
- LOGICAL, PUBLIC :: l_clo_rnf !: T => Some closed seas output freshwater (RNF or EMPMR) to specified runoff points.
- INTEGER, PUBLIC :: jncs !: number of closed seas (inferred from closea_mask field)
- INTEGER, PUBLIC :: jncsr !: number of closed seas rnf mappings (inferred from closea_mask_rnf field)
- INTEGER, PUBLIC :: jncse !: number of closed seas empmr mappings (inferred from closea_mask_empmr field)
-
- INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: closea_mask !: mask of integers defining closed seas
- INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: closea_mask_rnf !: mask of integers defining closed seas rnf mappings
- INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: closea_mask_empmr !: mask of integers defining closed seas empmr mappings
- REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: surf !: closed sea surface areas
- !: (and residual global surface area)
- REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: surfr !: closed sea target rnf surface areas
- REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: surfe !: closed sea target empmr surface areas
+ PUBLIC clo_msk ! called in domzgr module
+
+ LOGICAL, PUBLIC :: ln_maskcs !: logical to mask all closed sea
+ LOGICAL, PUBLIC :: ln_mask_csundef !: logical to mask all undefined closed sea
+ LOGICAL, PUBLIC :: ln_clo_rnf !: closed sea treated as runoff (update rnf mask)
+
+ LOGICAL, PUBLIC :: l_sbc_clo !: T => net evap/precip over closed seas spread outover the globe/river mouth
+ LOGICAL, PUBLIC :: l_clo_rnf !: T => Some closed seas output freshwater (RNF) to specified runoff points.
+
+ INTEGER, PUBLIC :: ncsg !: number of closed seas global mappings (inferred from closea_mask_glo field)
+ INTEGER, PUBLIC :: ncsr !: number of closed seas rnf mappings (inferred from closea_mask_rnf field)
+ INTEGER, PUBLIC :: ncse !: number of closed seas empmr mappings (inferred from closea_mask_emp field)
+
+ INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_opnsea, mask_csundef !: mask defining the open sea and the undefined closed sea
+
+ INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csglo , mask_csgrpglo !: mask of integers defining closed seas
+ INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csrnf , mask_csgrprnf !: mask of integers defining closed seas rnf mappings
+ INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csemp , mask_csgrpemp !: mask of integers defining closed seas empmr mappings
!! * Substitutions
@@ -76,331 +66,103 @@
!! ** Purpose : Closed sea domain initialization
!!
- !! ** Method : if a closed sea is located only in a model grid point
- !! just the thermodynamic processes are applied.
- !!
- !! ** Action : Read closea_mask* fields (if they exist) from domain_cfg file and infer
- !! number of closed seas from closea_mask field.
- !! closea_mask : integer values defining closed seas (or groups of closed seas)
- !! closea_mask_rnf : integer values defining mappings from closed seas or groups of
- !! closed seas to a runoff area for downwards flux only.
- !! closea_mask_empmr : integer values defining mappings from closed seas or groups of
- !! closed seas to a runoff area for net fluxes.
- !!
- !! Python code to generate the closea_masks* fields from the old-style indices
- !! definitions is available at TOOLS/DOMAINcfg/make_closea_masks.py
- !!----------------------------------------------------------------------
- INTEGER :: inum ! input file identifier
- INTEGER :: ierr ! error code
- INTEGER :: id ! netcdf variable ID
-
- REAL(wp), DIMENSION(jpi,jpj) :: zdata_in ! temporary real array for input
- !!----------------------------------------------------------------------
- !
+ !! ** Action : Read mask_cs* fields (if needed) from domain_cfg file and infer
+ !! number of closed seas for each case (glo, rnf, emp) from mask_cs* field.
+ !!
+ !! ** Output : mask_csglo and mask_csgrpglo : integer values defining mappings from closed seas and associated groups to the open ocean for net fluxes.
+ !! mask_csrnf and mask_csgrprnf : integer values defining mappings from closed seas and associated groups to a runoff area for downwards flux only.
+ !! mask_csemp and mask_csgrpemp : integer values defining mappings from closed seas and associated groups to a runoff area for net fluxes.
+ !!----------------------------------------------------------------------
+ INTEGER :: ios ! io status
+ !!
+ NAMELIST/namclo/ ln_maskcs, ln_mask_csundef, ln_clo_rnf
+ !!---------------------------------------------------------------------
+ !!
+ READ ( numnam_ref, namclo, IOSTAT = ios, ERR = 901 )
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namclo in reference namelist' )
+ READ ( numnam_cfg, namclo, IOSTAT = ios, ERR = 902 )
+902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namclo in configuration namelist' )
+ IF(lwm) WRITE ( numond, namclo )
+ !!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*)'dom_clo : read in masks to define closed seas '
IF(lwp) WRITE(numout,*)'~~~~~~~'
+ IF(lwp) WRITE(numout,*)
+ !!
+ !! check option compatibility
+ IF( .NOT. ln_read_cfg ) THEN
+ CALL ctl_stop('Suppression of closed seas does not work with ln_read_cfg = .true. . Set ln_closea = .false. .')
+ ENDIF
+ !!
+ IF( (.NOT. ln_maskcs) .AND. ln_diurnal_only ) THEN
+ CALL ctl_stop('Special handling of freshwater fluxes over closed seas not compatible with ln_diurnal_only.')
+ END IF
!
! read the closed seas masks (if they exist) from domain_cfg file (if it exists)
! ------------------------------------------------------------------------------
!
- IF( ln_read_cfg) THEN
- !
- CALL iom_open( cn_domcfg, inum )
- !
- id = iom_varid(inum, 'closea_mask', ldstop = .false.)
- IF( id > 0 ) THEN
- l_sbc_clo = .true.
- ALLOCATE( closea_mask(jpi,jpj) , STAT=ierr )
- IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask array')
- zdata_in(:,:) = 0.0
- CALL iom_get ( inum, jpdom_data, 'closea_mask', zdata_in )
- closea_mask(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
- ! number of closed seas = global maximum value in closea_mask field
- jncs = maxval(closea_mask(:,:))
- CALL mpp_max('closea', jncs)
- IF( jncs > 0 ) THEN
- IF( lwp ) WRITE(numout,*) 'Number of closed seas : ',jncs
- ELSE
- CALL ctl_stop( 'Problem with closea_mask field in domain_cfg file. Has no values > 0 so no closed seas defined.')
- ENDIF
- ELSE
- IF( lwp ) WRITE(numout,*)
- IF( lwp ) WRITE(numout,*) ' ==>>> closea_mask field not found in domain_cfg file.'
- IF( lwp ) WRITE(numout,*) ' No closed seas defined.'
- IF( lwp ) WRITE(numout,*)
- l_sbc_clo = .false.
- jncs = 0
- ENDIF
-
- l_clo_rnf = .false.
-
- IF( l_sbc_clo ) THEN ! No point reading in closea_mask_rnf or closea_mask_empmr fields if no closed seas defined.
-
- id = iom_varid(inum, 'closea_mask_rnf', ldstop = .false.)
- IF( id > 0 ) THEN
- l_clo_rnf = .true.
- ALLOCATE( closea_mask_rnf(jpi,jpj) , STAT=ierr )
- IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask_rnf array')
- CALL iom_get ( inum, jpdom_data, 'closea_mask_rnf', zdata_in )
- closea_mask_rnf(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
- ! number of closed seas rnf mappings = global maximum in closea_mask_rnf field
- jncsr = maxval(closea_mask_rnf(:,:))
- CALL mpp_max('closea', jncsr)
- IF( jncsr > 0 ) THEN
- IF( lwp ) WRITE(numout,*) 'Number of closed seas rnf mappings : ',jncsr
- ELSE
- CALL ctl_stop( 'Problem with closea_mask_rnf field in domain_cfg file. Has no values > 0 so no closed seas rnf mappings defined.')
- ENDIF
- ELSE
- IF( lwp ) WRITE(numout,*) 'closea_mask_rnf field not found in domain_cfg file. No closed seas rnf mappings defined.'
- jncsr = 0
- ENDIF
-
- id = iom_varid(inum, 'closea_mask_empmr', ldstop = .false.)
- IF( id > 0 ) THEN
- l_clo_rnf = .true.
- ALLOCATE( closea_mask_empmr(jpi,jpj) , STAT=ierr )
- IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'dom_clo: failed to allocate closea_mask_empmr array')
- CALL iom_get ( inum, jpdom_data, 'closea_mask_empmr', zdata_in )
- closea_mask_empmr(:,:) = NINT(zdata_in(:,:)) * tmask(:,:,1)
- ! number of closed seas empmr mappings = global maximum value in closea_mask_empmr field
- jncse = maxval(closea_mask_empmr(:,:))
- CALL mpp_max('closea', jncse)
- IF( jncse > 0 ) THEN
- IF( lwp ) WRITE(numout,*) 'Number of closed seas empmr mappings : ',jncse
- ELSE
- CALL ctl_stop( 'Problem with closea_mask_empmr field in domain_cfg file. Has no values > 0 so no closed seas empmr mappings defined.')
- ENDIF
- ELSE
- IF( lwp ) WRITE(numout,*) 'closea_mask_empmr field not found in domain_cfg file. No closed seas empmr mappings defined.'
- jncse = 0
- ENDIF
-
- ENDIF ! l_sbc_clo
- !
- CALL iom_close( inum )
- !
- ELSE ! ln_read_cfg = .false. so no domain_cfg file
- IF( lwp ) WRITE(numout,*) 'No domain_cfg file so no closed seas defined.'
- l_sbc_clo = .false.
- l_clo_rnf = .false.
- ENDIF
- !
+ ! load mask of open sea
+ CALL alloc_csmask( mask_opnsea )
+ CALL read_csmask( cn_domcfg, 'mask_opensea' , mask_opnsea )
+ !
+ IF ( ln_maskcs ) THEN
+ ! closed sea are masked
+ IF(lwp) WRITE(numout,*)' ln_maskcs = T : all closed seas are masked'
+ IF(lwp) WRITE(numout,*)
+ ! no special treatment of closed sea
+ ! no redistribution of emp unbalance over closed sea into river mouth/open ocean
+ l_sbc_clo = .false. ; l_clo_rnf = .false.
+ ELSE
+ ! redistribution of emp unbalance over closed sea into river mouth/open ocean
+ IF(lwp) WRITE(numout,*)' ln_maskcs = F : net emp is corrected over defined closed seas'
+ !
+ l_sbc_clo = .true.
+ !
+ ! river mouth from lakes added to rnf mask for special treatment
+ IF ( ln_clo_rnf) l_clo_rnf = .true.
+ !
+ IF ( ln_mask_csundef) THEN
+ ! closed sea not defined (ie not in the domcfg namelist used to build the domcfg.nc file) are masked
+ IF(lwp) WRITE(numout,*)' ln_mask_csundef = T : all undefined closed seas are masked'
+ !
+ CALL alloc_csmask( mask_csundef )
+ CALL read_csmask( cn_domcfg, 'mask_csundef', mask_csundef )
+ ! revert the mask for masking of undefined closed seas in domzgr
+ ! (0 over the undefined closed sea and 1 elsewhere)
+ mask_csundef(:,:) = 1 - mask_csundef(:,:)
+ END IF
+ IF(lwp) WRITE(numout,*)
+ !
+ ! allocate source mask for each cases
+ CALL alloc_csmask( mask_csglo )
+ CALL alloc_csmask( mask_csrnf )
+ CALL alloc_csmask( mask_csemp )
+ !
+ ! load source mask of cs for each cases
+ CALL read_csmask( cn_domcfg, 'mask_csglo', mask_csglo )
+ CALL read_csmask( cn_domcfg, 'mask_csrnf', mask_csrnf )
+ CALL read_csmask( cn_domcfg, 'mask_csemp', mask_csemp )
+ !
+ ! compute number of cs for each cases
+ ncsg = MAXVAL( mask_csglo(:,:) ) ; CALL mpp_max( 'closea', ncsg )
+ ncsr = MAXVAL( mask_csrnf(:,:) ) ; CALL mpp_max( 'closea', ncsr )
+ ncse = MAXVAL( mask_csemp(:,:) ) ; CALL mpp_max( 'closea', ncse )
+ !
+ ! allocate closed sea group masks
+ !(used to defined the target area in case multiple lakes have the same river mouth (great lakes for example))
+ CALL alloc_csmask( mask_csgrpglo )
+ CALL alloc_csmask( mask_csgrprnf )
+ CALL alloc_csmask( mask_csgrpemp )
+
+ ! load mask of cs group for each cases
+ CALL read_csmask( cn_domcfg, 'mask_csgrpglo', mask_csgrpglo )
+ CALL read_csmask( cn_domcfg, 'mask_csgrprnf', mask_csgrprnf )
+ CALL read_csmask( cn_domcfg, 'mask_csgrpemp', mask_csgrpemp )
+ !
+ END IF
END SUBROUTINE dom_clo
-
- SUBROUTINE sbc_clo( kt )
- !!---------------------------------------------------------------------
- !! *** ROUTINE sbc_clo ***
- !!
- !! ** Purpose : Special handling of closed seas
- !!
- !! ** Method : Water flux is forced to zero over closed sea
- !! Excess is shared between remaining ocean, or
- !! put as run-off in open ocean.
- !!
- !! ** Action : emp updated surface freshwater fluxes and associated heat content at kt
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! ocean model time step
- !
- INTEGER :: ierr
- INTEGER :: jc, jcr, jce ! dummy loop indices
- REAL(wp), PARAMETER :: rsmall = 1.e-20_wp ! Closed sea correction epsilon
- REAL(wp) :: zfwf_total, zcoef, zcoef1 !
- REAL(wp), DIMENSION(jncs) :: zfwf !:
- REAL(wp), DIMENSION(jncsr+1) :: zfwfr !: freshwater fluxes over closed seas
- REAL(wp), DIMENSION(jncse+1) :: zfwfe !:
- REAL(wp), DIMENSION(jpi,jpj) :: ztmp2d ! 2D workspace
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('sbc_clo')
- !
- ! !------------------!
- IF( kt == nit000 ) THEN ! Initialisation !
- ! !------------------!
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '
- IF(lwp) WRITE(numout,*)'~~~~~~~'
-
- ALLOCATE( surf(jncs+1) , STAT=ierr )
- IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array')
- surf(:) = 0.e0_wp
- !
- ! jncsr can be zero so add 1 to avoid allocating zero-length array
- ALLOCATE( surfr(jncsr+1) , STAT=ierr )
- IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surfr array')
- surfr(:) = 0.e0_wp
- !
- ! jncse can be zero so add 1 to avoid allocating zero-length array
- ALLOCATE( surfe(jncse+1) , STAT=ierr )
- IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surfe array')
- surfe(:) = 0.e0_wp
- !
- surf(jncs+1) = glob_sum( 'closea', e1e2t(:,:) ) ! surface of the global ocean
- !
- ! ! surface areas of closed seas
- DO jc = 1, jncs
- ztmp2d(:,:) = 0.e0_wp
- WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
- surf(jc) = glob_sum( 'closea', ztmp2d(:,:) )
- END DO
- !
- ! jncs+1 : surface area of global ocean, closed seas excluded
- surf(jncs+1) = surf(jncs+1) - SUM(surf(1:jncs))
- !
- ! ! surface areas of rnf target areas
- IF( jncsr > 0 ) THEN
- DO jcr = 1, jncsr
- ztmp2d(:,:) = 0.e0_wp
- WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
- surfr(jcr) = glob_sum( 'closea', ztmp2d(:,:) )
- END DO
- ENDIF
- !
- ! ! surface areas of empmr target areas
- IF( jncse > 0 ) THEN
- DO jce = 1, jncse
- ztmp2d(:,:) = 0.e0_wp
- WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:)
- surfe(jce) = glob_sum( 'closea', ztmp2d(:,:) )
- END DO
- ENDIF
- !
- IF(lwp) WRITE(numout,*)' Closed sea surface areas (km2)'
- DO jc = 1, jncs
- IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jc, surf(jc) * 1.0e-6
- END DO
- IF(lwp) WRITE(numout,FMT='(A,ES12.2)') 'Global surface area excluding closed seas (km2): ', surf(jncs+1) * 1.0e-6
- !
- IF(jncsr > 0) THEN
- IF(lwp) WRITE(numout,*)' Closed sea target rnf surface areas (km2)'
- DO jcr = 1, jncsr
- IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jcr, surfr(jcr) * 1.0e-6
- END DO
- ENDIF
- !
- IF(jncse > 0) THEN
- IF(lwp) WRITE(numout,*)' Closed sea target empmr surface areas (km2)'
- DO jce = 1, jncse
- IF(lwp) WRITE(numout,FMT='(1I3,5X,ES12.2)') jce, surfe(jce) * 1.0e-6
- END DO
- ENDIF
- ENDIF
- !
- ! !--------------------!
- ! ! update emp !
- ! !--------------------!
-
- zfwf_total = 0._wp
-
- !
- ! 1. Work out total freshwater fluxes over closed seas from EMP - RNF.
- !
- zfwf(:) = 0.e0_wp
- DO jc = 1, jncs
- ztmp2d(:,:) = 0.e0_wp
- WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
- zfwf(jc) = glob_sum( 'closea', ztmp2d(:,:) )
- END DO
- zfwf_total = SUM(zfwf)
-
- zfwfr(:) = 0.e0_wp
- IF( jncsr > 0 ) THEN
- !
- ! 2. Work out total FW fluxes over rnf source areas and add to rnf target areas.
- ! Where zfwf is negative add flux at specified runoff points and subtract from fluxes for global redistribution.
- ! Where positive leave in global redistribution total.
- !
- DO jcr = 1, jncsr
- !
- ztmp2d(:,:) = 0.e0_wp
- WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
- zfwfr(jcr) = glob_sum( 'closea', ztmp2d(:,:) )
- !
- ! The following if avoids the redistribution of the round off
- IF ( ABS(zfwfr(jcr) / surf(jncs+1) ) > rsmall) THEN
- !
- ! Add residuals to target runoff points if negative and subtract from total to be added globally
- IF( zfwfr(jcr) < 0.0 ) THEN
- zfwf_total = zfwf_total - zfwfr(jcr)
- zcoef = zfwfr(jcr) / surfr(jcr)
- zcoef1 = rcp * zcoef
- WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0.0)
- emp(:,:) = emp(:,:) + zcoef
- qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
- ENDWHERE
- ENDIF
- !
- ENDIF
- END DO
- ENDIF ! jncsr > 0
- !
- zfwfe(:) = 0.e0_wp
- IF( jncse > 0 ) THEN
- !
- ! 3. Work out total fluxes over empmr source areas and add to empmr target areas.
- !
- DO jce = 1, jncse
- !
- ztmp2d(:,:) = 0.e0_wp
- WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:)
- zfwfe(jce) = glob_sum( 'closea', ztmp2d(:,:) )
- !
- ! The following if avoids the redistribution of the round off
- IF ( ABS( zfwfe(jce) / surf(jncs+1) ) > rsmall ) THEN
- !
- ! Add residuals to runoff points and subtract from total to be added globally
- zfwf_total = zfwf_total - zfwfe(jce)
- zcoef = zfwfe(jce) / surfe(jce)
- zcoef1 = rcp * zcoef
- WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0.0)
- emp(:,:) = emp(:,:) + zcoef
- qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
- ENDWHERE
- !
- ENDIF
- END DO
- ENDIF ! jncse > 0
-
- !
- ! 4. Spread residual flux over global ocean.
- !
- ! The following if avoids the redistribution of the round off
- IF ( ABS(zfwf_total / surf(jncs+1) ) > rsmall) THEN
- zcoef = zfwf_total / surf(jncs+1)
- zcoef1 = rcp * zcoef
- WHERE( closea_mask(:,:) == 0 )
- emp(:,:) = emp(:,:) + zcoef
- qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
- ENDWHERE
- ENDIF
-
- !
- ! 5. Subtract area means from emp (and qns) over closed seas to give zero mean FW flux over each sea.
- !
- DO jc = 1, jncs
- ! The following if avoids the redistribution of the round off
- IF ( ABS(zfwf(jc) / surf(jncs+1) ) > rsmall) THEN
- !
- ! Subtract residuals from fluxes over closed sea
- zcoef = zfwf(jc) / surf(jc)
- zcoef1 = rcp * zcoef
- WHERE( closea_mask(:,:) == jc )
- emp(:,:) = emp(:,:) - zcoef
- qns(:,:) = qns(:,:) + zcoef1 * sst_m(:,:)
- ENDWHERE
- !
- ENDIF
- END DO
- !
- emp (:,:) = emp (:,:) * tmask(:,:,1)
- !
- CALL lbc_lnk( 'closea', emp , 'T', 1._wp )
- !
- END SUBROUTINE sbc_clo
-
SUBROUTINE clo_rnf( p_rnfmsk )
!!---------------------------------------------------------------------
- !! *** ROUTINE sbc_rnf ***
+ !! *** ROUTINE clo_rnf ***
!!
!! ** Purpose : allow the treatment of closed sea outflow grid-points
@@ -412,30 +174,26 @@
!! ** Action : update (p_)mskrnf (set 1 at closed sea outflow)
!!----------------------------------------------------------------------
+ !! subroutine parameter
REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_rnfmsk ! river runoff mask (rnfmsk array)
- !!----------------------------------------------------------------------
- !
- IF( jncsr > 0 ) THEN
- WHERE( closea_mask_rnf(:,:) > 0 .and. closea_mask(:,:) == 0 )
- p_rnfmsk(:,:) = MAX( p_rnfmsk(:,:), 1.0_wp )
- ENDWHERE
- ENDIF
- !
- IF( jncse > 0 ) THEN
- WHERE( closea_mask_empmr(:,:) > 0 .and. closea_mask(:,:) == 0 )
- p_rnfmsk(:,:) = MAX( p_rnfmsk(:,:), 1.0_wp )
- ENDWHERE
- ENDIF
+ !!
+ !! local variables
+ REAL(wp), DIMENSION(jpi,jpj) :: zmsk
+ !!----------------------------------------------------------------------
+ !
+ ! zmsk > 0 where cs river mouth defined (case rnf and emp)
+ zmsk(:,:) = ( mask_csgrprnf (:,:) + mask_csgrpemp(:,:) ) * mask_opnsea(:,:)
+ WHERE( zmsk(:,:) > 0 )
+ p_rnfmsk(:,:) = 1.0_wp
+ END WHERE
!
END SUBROUTINE clo_rnf
-
- SUBROUTINE clo_bat( k_top, k_bot )
- !!---------------------------------------------------------------------
- !! *** ROUTINE clo_bat ***
+ SUBROUTINE clo_msk( k_top, k_bot, k_mask, cd_prt )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE clo_msk ***
!!
!! ** Purpose : Suppress closed sea from the domain
!!
- !! ** Method : Read in closea_mask field (if it exists) from domain_cfg file.
- !! Where closea_mask > 0 set first and last ocean level to 0
+ !! ** Method : Where closea_mask > 0 set first and last ocean level to 0
!! (As currently coded you can't define a closea_mask field in
!! usr_def_zgr).
@@ -443,46 +201,64 @@
!! ** Action : set k_top=0 and k_bot=0 over closed seas
!!----------------------------------------------------------------------
+ !! subroutine parameter
INTEGER, DIMENSION(:,:), INTENT(inout) :: k_top, k_bot ! ocean first and last level indices
- INTEGER :: inum, id
- INTEGER, DIMENSION(jpi,jpj) :: closea_mask ! closea_mask field
- REAL(wp), DIMENSION(jpi,jpj) :: zdata_in ! temporary real array for input
- !!----------------------------------------------------------------------
- !
- IF(lwp) THEN ! Control print
+ INTEGER, DIMENSION(:,:), INTENT(in ) :: k_mask ! mask used to mask ktop and k_bot
+ CHARACTER(LEN=*), INTENT(in ) :: cd_prt ! text for control print
+ !!
+ !! local variables
+ !!----------------------------------------------------------------------
+ !!
+ IF ( lwp ) THEN
WRITE(numout,*)
- WRITE(numout,*) 'clo_bat : suppression of closed seas'
+ WRITE(numout,*) 'clo_msk : Suppression closed seas based on ',TRIM(cd_prt),' field.'
WRITE(numout,*) '~~~~~~~'
+ WRITE(numout,*)
ENDIF
- !
- IF( ln_read_cfg ) THEN
- !
- CALL iom_open( cn_domcfg, inum )
- !
- id = iom_varid(inum, 'closea_mask', ldstop = .false.)
- IF( id > 0 ) THEN
- IF( lwp ) WRITE(numout,*) 'Suppressing closed seas in bathymetry based on closea_mask field,'
- CALL iom_get ( inum, jpdom_data, 'closea_mask', zdata_in )
- closea_mask(:,:) = NINT(zdata_in(:,:))
- WHERE( closea_mask(:,:) > 0 )
- k_top(:,:) = 0
- k_bot(:,:) = 0
- ENDWHERE
- ELSE
- IF( lwp ) WRITE(numout,*) 'No closea_mask field found in domain_cfg file. No suppression of closed seas.'
- ENDIF
- !
- CALL iom_close(inum)
- !
- ELSE
- IF( lwp ) WRITE(numout,*) 'No domain_cfg file => no suppression of closed seas.'
- ENDIF
- !
- ! Initialise l_sbc_clo and l_clo_rnf for this case (ln_closea=.false.)
- l_sbc_clo = .false.
- l_clo_rnf = .false.
- !
- END SUBROUTINE clo_bat
-
- !!======================================================================
+ !!
+ k_top(:,:) = k_top(:,:) * k_mask(:,:)
+ k_bot(:,:) = k_bot(:,:) * k_mask(:,:)
+ !!
+ END SUBROUTINE clo_msk
+
+ SUBROUTINE read_csmask(cd_file, cd_var, k_mskout)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE read_csmask ***
+ !!
+ !! ** Purpose : read mask in cd_filec file
+ !!----------------------------------------------------------------------
+ ! subroutine parameter
+ CHARACTER(LEN=256), INTENT(in ) :: cd_file ! netcdf file name
+ CHARACTER(LEN= * ), INTENT(in ) :: cd_var ! netcdf variable name
+ INTEGER, DIMENSION(:,:), INTENT( out) :: k_mskout ! output mask variable
+ !
+ ! local variables
+ INTEGER :: ics ! netcdf id
+ REAL(wp), DIMENSION(jpi,jpj) :: zdta ! netcdf data
+ !!----------------------------------------------------------------------
+ !
+ CALL iom_open ( cd_file, ics )
+ CALL iom_get ( ics, jpdom_data, TRIM(cd_var), zdta )
+ CALL iom_close( ics )
+ k_mskout(:,:) = NINT(zdta(:,:))
+ !
+ END SUBROUTINE read_csmask
+
+ SUBROUTINE alloc_csmask( kmask )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE alloc_csmask ***
+ !!
+ !! ** Purpose : allocated cs mask
+ !!----------------------------------------------------------------------
+ ! subroutine parameter
+ INTEGER, ALLOCATABLE, DIMENSION(:,:), INTENT(inout) :: kmask
+ !
+ ! local variables
+ INTEGER :: ierr
+ !!----------------------------------------------------------------------
+ !
+ ALLOCATE( kmask(jpi,jpj) , STAT=ierr )
+ IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'alloc_csmask: failed to allocate surf array')
+ !
+ END SUBROUTINE
+
END MODULE closea
-
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/dom_oce.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/dom_oce.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/dom_oce.F90 (revision 12150)
@@ -33,9 +33,7 @@
LOGICAL , PUBLIC :: ln_linssh !: =T linear free surface ==>> model level are fixed in time
LOGICAL , PUBLIC :: ln_meshmask !: =T create a mesh-mask file (mesh_mask.nc)
- REAL(wp), PUBLIC :: rn_isfhmin !: threshold to discriminate grounded ice to floating ice
REAL(wp), PUBLIC :: rn_rdt !: time step for the dynamics and tracer
REAL(wp), PUBLIC :: rn_atfp !: asselin time filter parameter
INTEGER , PUBLIC :: nn_euler !: =0 start with forward time step or not (=1)
- LOGICAL , PUBLIC :: ln_iscpl !: coupling with ice sheet
LOGICAL , PUBLIC :: ln_crs !: Apply grid coarsening to dynamical model output or online passive tracers
@@ -166,4 +164,5 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: e3t_1d , e3w_1d !: reference vertical scale factors at T- and W-pts (m)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfdep, bathy
!!----------------------------------------------------------------------
@@ -178,7 +177,5 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_h !: internal domain T-point mask (Figure 8.5 NEMO book)
- INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: misfdep !: top first ocean level (ISF)
- INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfdep !: Iceshelf draft (ISF)
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask !: surface mask at T-,U-, V- and F-pts
@@ -276,6 +273,7 @@
& STAT=ierr(6) )
!
- !
- ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(7) )
+ ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(7) )
+ !
+ ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(8) )
!
ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , &
@@ -283,6 +281,5 @@
& mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , STAT=ierr(9) )
!
- ALLOCATE( misfdep(jpi,jpj) , mikt(jpi,jpj) , miku(jpi,jpj) , &
- & risfdep(jpi,jpj) , mikv(jpi,jpj) , mikf(jpi,jpj) , STAT=ierr(10) )
+ ALLOCATE( mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj), mikf(jpi,jpj), STAT=ierr(10) )
!
ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) , &
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domain.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domain.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domain.F90 (revision 12150)
@@ -30,5 +30,4 @@
USE trc_oce ! shared ocean & passive tracers variab
USE phycst ! physical constants
- USE closea ! closed seas
USE domhgr ! domain: set the horizontal mesh
USE domzgr ! domain: set the vertical mesh
@@ -38,5 +37,6 @@
USE c1d ! 1D configuration
USE dyncor_c1d ! 1D configuration: Coriolis term (cor_c1d routine)
- USE wet_dry, ONLY : ll_wd
+ USE wet_dry, ONLY : ll_wd
+ USE closea , ONLY : dom_clo ! closed seas
!
USE in_out_manager ! I/O manager
@@ -136,16 +136,11 @@
ENDIF
!
- CALL dom_hgr ! Horizontal mesh
- CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry
- CALL dom_msk( ik_top, ik_bot ) ! Masks
- IF( ln_closea ) CALL dom_clo ! ln_closea=T : closed seas included in the simulation
- ! Read in masks to define closed seas and lakes
- !
- DO jj = 1, jpj ! depth of the iceshelves
- DO ji = 1, jpi
- ik = mikt(ji,jj)
- risfdep(ji,jj) = gdepw_0(ji,jj,ik)
- END DO
- END DO
+ CALL dom_hgr ! Horizontal mesh
+
+ IF( ln_closea ) CALL dom_clo ! Read in masks to define closed seas and lakes
+
+ CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry
+
+ CALL dom_msk( ik_top, ik_bot ) ! Masks
!
ht_0(:,:) = 0._wp ! Reference ocean thickness
@@ -194,9 +189,8 @@
IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point
!
- IF( ln_meshmask .AND. .NOT.ln_iscpl ) CALL dom_wri ! Create a domain file
- IF( ln_meshmask .AND. ln_iscpl .AND. .NOT.ln_rstart ) CALL dom_wri ! Create a domain file
- IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control
- !
- IF( ln_write_cfg ) CALL cfg_write ! create the configuration file
+ IF( ln_meshmask ) CALL dom_wri ! Create a domain file
+ IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control
+ !
+ IF( ln_write_cfg ) CALL cfg_write ! create the configuration file
!
IF(lwp) THEN
@@ -294,6 +288,6 @@
& nn_it000, nn_itend , nn_date0 , nn_time0 , nn_leapy , nn_istate , &
& nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, nn_euler , &
- & ln_cfmeta, ln_iscpl, ln_xios_read, nn_wxios
- NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask
+ & ln_cfmeta, ln_xios_read, nn_wxios
+ NAMELIST/namdom/ ln_linssh, rn_rdt, rn_atfp, ln_crs, ln_meshmask
#if defined key_netcdf4
NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
@@ -343,5 +337,4 @@
WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber
WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz
- WRITE(numout,*) ' IS coupling at the restart step ln_iscpl = ', ln_iscpl
IF( TRIM(Agrif_CFixed()) == '0' ) THEN
WRITE(numout,*) ' READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
@@ -415,5 +408,4 @@
WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh
WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask
- WRITE(numout,*) ' treshold to open the isf cavity rn_isfhmin = ', rn_isfhmin, ' [m]'
WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt
WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domvvl.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domvvl.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domvvl.F90 (revision 12150)
@@ -37,4 +37,5 @@
PUBLIC dom_vvl_init ! called by domain.F90
+ PUBLIC dom_vvl_zgr ! called by isfcpl.F90
PUBLIC dom_vvl_sf_nxt ! called by step.F90
PUBLIC dom_vvl_sf_update ! called by step.F90
@@ -118,21 +119,48 @@
INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
!
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+ !
+ CALL dom_vvl_ctl ! choose vertical coordinate (z_star, z_tilde or layer)
+ !
+ ! ! Allocate module arrays
+ IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
+ !
+ ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
+ CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' )
+ e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all
+ !
+ CALL dom_vvl_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column
+ !
+ END SUBROUTINE dom_vvl_init
+ !
+ SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dom_vvl_init ***
+ !!
+ !! ** Purpose : Interpolation of all scale factors,
+ !! depths and water column heights
+ !!
+ !! ** Method : - interpolate scale factors
+ !!
+ !! ** Action : - e3t_(n/b) and tilde_e3t_(n/b)
+ !! - Regrid: e3(u/v)_n
+ !! e3(u/v)_b
+ !! e3w_n
+ !! e3(u/v)w_b
+ !! e3(u/v)w_n
+ !! gdept_n, gdepw_n and gde3w_n
+ !! - h(t/u/v)_0
+ !! - frq_rst_e3t and frq_rst_hdv
+ !!
+ !! Reference : Leclair, M., and G. Madec, 2011, Ocean Modelling.
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
+ !!----------------------------------------------------------------------
INTEGER :: ji, jj, jk
INTEGER :: ii0, ii1, ij0, ij1
REAL(wp):: zcoef
!!----------------------------------------------------------------------
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
- IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
- !
- CALL dom_vvl_ctl ! choose vertical coordinate (z_star, z_tilde or layer)
- !
- ! ! Allocate module arrays
- IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
- !
- ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
- CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' )
- e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all
!
! !== Set of all other vertical scale factors ==! (now and before)
@@ -266,5 +294,5 @@
ENDIF
!
- END SUBROUTINE dom_vvl_init
+ END SUBROUTINE dom_vvl_zgr
@@ -811,7 +839,9 @@
id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. )
id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. )
+ !
! ! --------- !
! ! all cases !
! ! --------- !
+ !
IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist
CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )
@@ -1027,5 +1057,4 @@
!
IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' )
- IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
!
IF(lwp) THEN ! Print the choice
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domwri.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domwri.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domwri.F90 (revision 12150)
@@ -16,4 +16,5 @@
!! dom_stiff : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate)
!!----------------------------------------------------------------------
+ !
USE dom_oce ! ocean space and time domain
USE phycst , ONLY : rsmall
@@ -155,10 +156,8 @@
! note that mbkt is set to 1 over land ==> use surface tmask
- zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp )
+ zprt(:,:) = REAL( mbkt(:,:) , wp )
CALL iom_rstput( 0, 0, inum, 'mbathy', zprt, ktype = jp_i4 ) ! ! nb of ocean T-points
- zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp )
+ zprt(:,:) = REAL( mikt(:,:) , wp )
CALL iom_rstput( 0, 0, inum, 'misf', zprt, ktype = jp_i4 ) ! ! nb of ocean T-points
- zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp )
- CALL iom_rstput( 0, 0, inum, 'isfdraft', zprt, ktype = jp_r8 ) ! ! nb of ocean T-points
! ! vertical mesh
CALL iom_rstput( 0, 0, inum, 'e3t_1d', e3t_1d, ktype = jp_r8 ) ! ! scale factors
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domzgr.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domzgr.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domzgr.F90 (revision 12150)
@@ -71,5 +71,6 @@
INTEGER, DIMENSION(:,:), INTENT(out) :: k_top, k_bot ! ocean first and last level indices
!
- INTEGER :: jk ! dummy loop index
+ INTEGER :: ji,jj,jk ! dummy loop index
+ INTEGER :: ikt, ikb ! top/bot index
INTEGER :: ioptio, ibat, ios ! local integer
REAL(wp) :: zrefdep ! depth of the reference level (~10m)
@@ -118,5 +119,14 @@
! Any closed seas (defined by closea_mask > 0 in domain_cfg file) to be filled
! in at runtime if ln_closea=.false.
- IF( .NOT.ln_closea ) CALL clo_bat( k_top, k_bot )
+ IF( ln_closea ) THEN
+ IF ( ln_maskcs ) THEN
+ ! mask all the closed sea
+ CALL clo_msk( k_top, k_bot, mask_opnsea, 'mask_opensea' )
+ ELSE IF ( ln_mask_csundef ) THEN
+ ! defined closed sea are kept
+ ! mask all the undefined closed sea
+ CALL clo_msk( k_top, k_bot, mask_csundef, 'mask_csundef' )
+ END IF
+ END IF
!
IF(lwp) THEN ! Control print
@@ -138,6 +148,15 @@
! ! top/bottom ocean level indices for t-, u- and v-points (f-point also for top)
CALL zgr_top_bot( k_top, k_bot ) ! with a minimum value set to 1
-
-
+ !
+ ! ! ice shelf draft and bathymetry
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ ikt = mikt(ji,jj)
+ ikb = mbkt(ji,jj)
+ bathy (ji,jj) = gdepw_0(ji,jj,ikb+1)
+ risfdep(ji,jj) = gdepw_0(ji,jj,ikt )
+ END DO
+ END DO
+ !
! ! deepest/shallowest W level Above/Below ~10m
!!gm BUG in s-coordinate this does not work!
Index: MO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/iscplhsb.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/iscplhsb.F90 (revision 12149)
+++ (revision )
@@ -1,326 +1,0 @@
-MODULE iscplhsb
- !!======================================================================
- !! *** MODULE iscplhsb ***
- !! Ocean forcing: ice sheet/ocean coupling (conservation)
- !!=====================================================================
- !! History : NEMO ! 2015-01 P. Mathiot: original
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! iscpl_alloc : variable allocation
- !! iscpl_hsb : compute and store the input of heat/salt/volume
- !! into the system due to the coupling process
- !! iscpl_div : correction of divergence to keep volume conservation
- !!----------------------------------------------------------------------
- USE oce ! global tra/dyn variable
- USE dom_oce ! ocean space and time domain
- USE domwri ! ocean space and time domain
- USE domngb !
- USE phycst ! physical constants
- USE sbc_oce ! surface boundary condition variables
- USE iscplini !
- !
- USE in_out_manager ! I/O manager
- USE lib_mpp ! MPP library
- USE lib_fortran ! MPP library
- USE lbclnk !
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC iscpl_div
- PUBLIC iscpl_cons
- !! * Substitutions
-# include "vectopt_loop_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id$
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE iscpl_cons( Kbb, Kmm, ptmask_b, psmask_b, pe3t_b, pts_flx, pvol_flx, prdt_iscpl )
- !!----------------------------------------------------------------------
- !! *** ROUTINE iscpl_cons ***
- !!
- !! ** Purpose : compute input into the system during the coupling step
- !! compute the correction term
- !! compute where the correction have to be applied
- !!
- !! ** Method : compute tsn*e3tn-tsb*e3tb and e3tn-e3tb
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: Kbb, Kmm !! time level indices
- REAL(wp), DIMENSION(:,:,: ), INTENT(in ) :: ptmask_b !! mask before
- REAL(wp), DIMENSION(:,:,: ), INTENT(in ) :: pe3t_b !! scale factor before
- REAL(wp), DIMENSION(:,: ), INTENT(in ) :: psmask_b !! mask before
- REAL(wp), DIMENSION(:,:,:,:), INTENT(out) :: pts_flx !! corrective flux to have tracer conservation
- REAL(wp), DIMENSION(:,:,: ), INTENT(out) :: pvol_flx !! corrective flux to have volume conservation
- REAL(wp), INTENT(in ) :: prdt_iscpl !! coupling period
- !
- INTEGER :: ji , jj , jk ! loop index
- INTEGER :: jip1, jim1, jjp1, jjm1
- REAL(wp) :: summsk, zsum , zsumn, zjip1_ratio , zjim1_ratio, zdtem, zde3t, z1_rdtiscpl
- REAL(wp) :: zarea , zsum1, zsumb, zjjp1_ratio , zjjm1_ratio, zdsal
- REAL(wp), DIMENSION(jpi,jpj) :: zdssh ! workspace
- REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat
- REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal
- INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts
- INTEGER :: jpts, npts
- !!----------------------------------------------------------------------
-
- ! get imbalance (volume heat and salt)
- ! initialisation difference
- zde3t = 0._wp ; zdsal = 0._wp ; zdtem = 0._wp
-
- ! initialisation correction term
- pvol_flx(:,:,: ) = 0._wp
- pts_flx (:,:,:,:) = 0._wp
-
- z1_rdtiscpl = 1._wp / prdt_iscpl
-
- ! mask ts(:,:,:,:,Kmm) and ts(:,:,:,:,Kbb)
- ts(:,:,:,jp_tem,Kbb) = ts(:,:,:,jp_tem,Kbb) * ptmask_b(:,:,:)
- ts(:,:,:,jp_tem,Kmm) = ts(:,:,:,jp_tem,Kmm) * tmask (:,:,:)
- ts(:,:,:,jp_sal,Kbb) = ts(:,:,:,jp_sal,Kbb) * ptmask_b(:,:,:)
- ts(:,:,:,jp_sal,Kmm) = ts(:,:,:,jp_sal,Kmm) * tmask (:,:,:)
-
- !==============================================================================
- ! diagnose the heat, salt and volume input and compute the correction variable
- !==============================================================================
-
- !
- zdssh(:,:) = ssh(:,:,Kmm) * ssmask(:,:) - ssh(:,:,Kbb) * psmask_b(:,:)
- IF (.NOT. ln_linssh ) zdssh = 0.0_wp ! already included in the levels by definition
-
- DO jk = 1,jpk-1
- DO jj = 2,jpj-1
- DO ji = fs_2,fs_jpim1
- IF (tmask_h(ji,jj) == 1._wp) THEN
-
- ! volume differences
- zde3t = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) - pe3t_b(ji,jj,jk) * ptmask_b(ji,jj,jk)
-
- ! heat diff
- zdtem = ts(ji,jj,jk,jp_tem,Kmm) * e3t(ji,jj,jk,Kmm) * tmask (ji,jj,jk) &
- - ts(ji,jj,jk,jp_tem,Kbb) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
- ! salt diff
- zdsal = ts(ji,jj,jk,jp_sal,Kmm) * e3t(ji,jj,jk,Kmm) * tmask (ji,jj,jk) &
- - ts(ji,jj,jk,jp_sal,Kbb) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
-
- ! shh changes
- IF ( ptmask_b(ji,jj,jk) == 1._wp .OR. tmask(ji,jj,jk) == 1._wp ) THEN
- zde3t = zde3t + zdssh(ji,jj) ! zdssh = 0 if vvl
- zdssh(ji,jj) = 0._wp
- END IF
-
- ! volume, heat and salt differences in each cell
- pvol_flx(ji,jj,jk) = pvol_flx(ji,jj,jk) + zde3t * z1_rdtiscpl
- pts_flx (ji,jj,jk,jp_sal)= pts_flx (ji,jj,jk,jp_sal) + zdsal * z1_rdtiscpl
- pts_flx (ji,jj,jk,jp_tem)= pts_flx (ji,jj,jk,jp_tem) + zdtem * z1_rdtiscpl
-
- ! case where we close a cell: check if the neighbour cells are wet
- IF ( tmask(ji,jj,jk) == 0._wp .AND. ptmask_b(ji,jj,jk) == 1._wp ) THEN
-
- jip1=ji+1 ; jim1=ji-1 ; jjp1=jj+1 ; jjm1=jj-1 ;
-
- zsum = e1e2t(ji ,jjp1) * tmask(ji ,jjp1,jk) + e1e2t(ji ,jjm1) * tmask(ji ,jjm1,jk) &
- & + e1e2t(jim1,jj ) * tmask(jim1,jj ,jk) + e1e2t(jip1,jj ) * tmask(jip1,jj ,jk)
-
- IF ( zsum /= 0._wp ) THEN
- zjip1_ratio = e1e2t(jip1,jj ) * tmask(jip1,jj ,jk) / zsum
- zjim1_ratio = e1e2t(jim1,jj ) * tmask(jim1,jj ,jk) / zsum
- zjjp1_ratio = e1e2t(ji ,jjp1) * tmask(ji ,jjp1,jk) / zsum
- zjjm1_ratio = e1e2t(ji ,jjm1) * tmask(ji ,jjm1,jk) / zsum
-
- pvol_flx(ji ,jjp1,jk ) = pvol_flx(ji ,jjp1,jk ) + pvol_flx(ji,jj,jk ) * zjjp1_ratio
- pvol_flx(ji ,jjm1,jk ) = pvol_flx(ji ,jjm1,jk ) + pvol_flx(ji,jj,jk ) * zjjm1_ratio
- pvol_flx(jip1,jj ,jk ) = pvol_flx(jip1,jj ,jk ) + pvol_flx(ji,jj,jk ) * zjip1_ratio
- pvol_flx(jim1,jj ,jk ) = pvol_flx(jim1,jj ,jk ) + pvol_flx(ji,jj,jk ) * zjim1_ratio
- pts_flx (ji ,jjp1,jk,jp_sal) = pts_flx (ji ,jjp1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjp1_ratio
- pts_flx (ji ,jjm1,jk,jp_sal) = pts_flx (ji ,jjm1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjm1_ratio
- pts_flx (jip1,jj ,jk,jp_sal) = pts_flx (jip1,jj ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjip1_ratio
- pts_flx (jim1,jj ,jk,jp_sal) = pts_flx (jim1,jj ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjim1_ratio
- pts_flx (ji ,jjp1,jk,jp_tem) = pts_flx (ji ,jjp1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjp1_ratio
- pts_flx (ji ,jjm1,jk,jp_tem) = pts_flx (ji ,jjm1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjm1_ratio
- pts_flx (jip1,jj ,jk,jp_tem) = pts_flx (jip1,jj ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjip1_ratio
- pts_flx (jim1,jj ,jk,jp_tem) = pts_flx (jim1,jj ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjim1_ratio
-
- ! set to 0 the cell we distributed over neigbourg cells
- pvol_flx(ji,jj,jk ) = 0._wp
- pts_flx (ji,jj,jk,jp_sal) = 0._wp
- pts_flx (ji,jj,jk,jp_tem) = 0._wp
-
- ELSE IF (zsum == 0._wp ) THEN
- ! case where we close a cell and no adjacent cell open
- ! check if the cell beneath is wet
- IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN
- pvol_flx(ji,jj,jk+1) = pvol_flx(ji,jj,jk+1) + pvol_flx(ji,jj,jk)
- pts_flx (ji,jj,jk+1,jp_sal)= pts_flx (ji,jj,jk+1,jp_sal) + pts_flx (ji,jj,jk,jp_sal)
- pts_flx (ji,jj,jk+1,jp_tem)= pts_flx (ji,jj,jk+1,jp_tem) + pts_flx (ji,jj,jk,jp_tem)
-
- ! set to 0 the cell we distributed over neigbourg cells
- pvol_flx(ji,jj,jk ) = 0._wp
- pts_flx (ji,jj,jk,jp_sal) = 0._wp
- pts_flx (ji,jj,jk,jp_tem) = 0._wp
- ELSE
- ! case no adjacent cell on the horizontal and on the vertical
- IF ( lwp ) THEN ! JMM : cAution this warning may occur on any mpp subdomain but numout is only
- ! open for narea== 1 (lwp=T)
- WRITE(numout,*) 'W A R N I N G iscpl: no adjacent cell on the vertical and horizontal'
- WRITE(numout,*) ' ',mig(ji),' ',mjg(jj),' ',jk
- WRITE(numout,*) ' ',ji,' ',jj,' ',jk,' ',narea
- WRITE(numout,*) ' we are now looking for the closest wet cell on the horizontal '
- ENDIF
- ! We deal with these points later.
- END IF
- END IF
- END IF
- END IF
- END DO
- END DO
- END DO
-
-!!gm ERROR !!!!
-!! juste use tmask_i or in case of ISF smask_i (to be created to compute the sum without halos)
-!
-! CALL lbc_sum(pvol_flx(:,:,: ),'T',1.)
-! CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.)
-! CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.)
- CALL ctl_stop( 'STOP', ' iscpl_cons: please modify this MODULE !' )
-!!gm end
- ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point
- ! allocation and initialisation of the list of problematic point
- ALLOCATE( inpts(jpnij) )
- inpts(:) = 0
-
- ! fill narea location with the number of problematic point
- DO jk = 1,jpk-1
- DO jj = 2,jpj-1
- DO ji = fs_2,fs_jpim1
- IF ( ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1) == 0._wp .AND. tmask_h(ji,jj) == 1._wp &
- .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
- inpts(narea) = inpts(narea) + 1
- END IF
- END DO
- END DO
- END DO
-
- ! build array of total problematic point on each cpu (share to each cpu)
- CALL mpp_max('iscplhsb', inpts,jpnij)
-
- ! size of the new variable
- npts = SUM(inpts)
-
- ! allocation of the coordinates, correction, index vector for the problematic points
- ALLOCATE(ixpts(npts), iypts(npts), izpts(npts), zcorr_vol(npts), zcorr_sal(npts), zcorr_tem(npts), zlon(npts), zlat(npts))
- ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20_wp ; zlat(:) = -1.0e20_wp
- zcorr_vol(:) = -1.0e20_wp
- zcorr_sal(:) = -1.0e20_wp
- zcorr_tem(:) = -1.0e20_wp
-
- ! fill new variable
- jpts = SUM(inpts(1:narea-1))
- DO jk = 1,jpk-1
- DO jj = 2,jpj-1
- DO ji = fs_2,fs_jpim1
- IF ( ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1) == 0._wp .AND. tmask_h(ji,jj) == 1._wp &
- .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
- jpts = jpts + 1 ! positioning in the inpts vector for the area narea
- ixpts(jpts) = ji ; iypts(jpts) = jj ; izpts(jpts) = jk
- zlon (jpts) = glamt(ji,jj) ; zlat (jpts) = gphit(ji,jj)
- zcorr_vol(jpts) = pvol_flx(ji,jj,jk)
- zcorr_sal(jpts) = pts_flx (ji,jj,jk,jp_sal)
- zcorr_tem(jpts) = pts_flx (ji,jj,jk,jp_tem)
-
- ! set flx to 0 (safer)
- pvol_flx(ji,jj,jk ) = 0.0_wp
- pts_flx (ji,jj,jk,jp_sal) = 0.0_wp
- pts_flx (ji,jj,jk,jp_tem) = 0.0_wp
- END IF
- END DO
- END DO
- END DO
-
- ! build array of total problematic point on each cpu (share to each cpu)
- ! point coordinates
- CALL mpp_max('iscplhsb', zlat ,npts)
- CALL mpp_max('iscplhsb', zlon ,npts)
- CALL mpp_max('iscplhsb', izpts,npts)
-
- ! correction values
- CALL mpp_max('iscplhsb', zcorr_vol,npts)
- CALL mpp_max('iscplhsb', zcorr_sal,npts)
- CALL mpp_max('iscplhsb', zcorr_tem,npts)
-
- ! put correction term in the closest cell
- DO jpts = 1,npts
- CALL dom_ngb(zlon(jpts), zlat(jpts), ixpts(jpts), iypts(jpts),'T', izpts(jpts))
- DO jj = mj0(iypts(jpts)),mj1(iypts(jpts))
- DO ji = mi0(ixpts(jpts)),mi1(ixpts(jpts))
- jk = izpts(jpts)
-
- IF (tmask_h(ji,jj) == 1._wp) THEN
- ! correct the vol_flx in the closest cell
- pvol_flx(ji,jj,jk) = pvol_flx(ji,jj,jk ) + zcorr_vol(jpts)
- pts_flx (ji,jj,jk,jp_sal) = pts_flx (ji,jj,jk,jp_sal) + zcorr_sal(jpts)
- pts_flx (ji,jj,jk,jp_tem) = pts_flx (ji,jj,jk,jp_tem) + zcorr_tem(jpts)
-
- ! set correction to 0
- zcorr_vol(jpts) = 0.0_wp
- zcorr_sal(jpts) = 0.0_wp
- zcorr_tem(jpts) = 0.0_wp
- END IF
- END DO
- END DO
- END DO
-
- ! deallocate variables
- DEALLOCATE(inpts)
- DEALLOCATE(ixpts, iypts, izpts, zcorr_vol, zcorr_sal, zcorr_tem, zlon, zlat)
-
- ! add contribution store on the hallo (lbclnk remove one of the contribution)
- pvol_flx(:,:,: ) = pvol_flx(:,:,: ) * tmask(:,:,:)
- pts_flx (:,:,:,jp_sal) = pts_flx (:,:,:,jp_sal) * tmask(:,:,:)
- pts_flx (:,:,:,jp_tem) = pts_flx (:,:,:,jp_tem) * tmask(:,:,:)
-
-!!gm ERROR !!!!
-!! juste use tmask_i or in case of ISF smask_i (to be created to compute the sum without halos)
-!
-! ! compute sum over the halo and set it to 0.
-! CALL lbc_sum(pvol_flx(:,:,: ),'T',1._wp)
-! CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp)
-! CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp)
-!!gm end
-
- !
- END SUBROUTINE iscpl_cons
-
-
- SUBROUTINE iscpl_div( Kmm, phdivn )
- !!----------------------------------------------------------------------
- !! *** ROUTINE iscpl_div ***
- !!
- !! ** Purpose : update the horizontal divergenc
- !!
- !! ** Method :
- !! CAUTION : iscpl is positive (inflow) and expressed in m/s
- !!
- !! ** Action : phdivn increase by the iscpl correction term
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: Kmm ! time level index
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phdivn ! horizontal divergence
- !!
- INTEGER :: ji, jj, jk ! dummy loop indices
- !!----------------------------------------------------------------------
- !
- DO jk = 1, jpk
- DO jj = 1, jpj
- DO ji = 1, jpi
- phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + hdiv_iscpl(ji,jj,jk) / e3t(ji,jj,jk,Kmm)
- END DO
- END DO
- END DO
- !
- END SUBROUTINE iscpl_div
-
-END MODULE iscplhsb
Index: MO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/iscplini.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/iscplini.F90 (revision 12149)
+++ (revision )
@@ -1,88 +1,0 @@
-MODULE iscplini
- !!======================================================================
- !! *** MODULE sbciscpl ***
- !! Ocean forcing: ?????
- !!=====================================================================
- !! History : NEMO ! 2015-01 P. Mathiot: original
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! iscpl_init : initialisation routine (namelist)
- !! iscpl_alloc : allocation of correction variables
- !!----------------------------------------------------------------------
- USE oce ! global tra/dyn variable
- USE dom_oce ! ocean space and time domain
- !
- USE lib_mpp ! MPP library
- USE lib_fortran ! MPP library
- USE in_out_manager ! I/O manager
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC iscpl_init
- PUBLIC iscpl_alloc
-
- ! !!* namsbc_iscpl namelist *
- LOGICAL , PUBLIC :: ln_hsb !:
- INTEGER , PUBLIC :: nn_fiscpl !:
- INTEGER , PUBLIC :: nn_drown !:
-
- INTEGER , PUBLIC :: nstp_iscpl !:
- REAL(wp), PUBLIC :: rdt_iscpl !:
- !
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_iscpl !:
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: htsc_iscpl !:
-
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id$
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- INTEGER FUNCTION iscpl_alloc()
- !!----------------------------------------------------------------------
- !! *** ROUTINE sbc_iscpl_alloc ***
- !!----------------------------------------------------------------------
- ALLOCATE( htsc_iscpl(jpi,jpj,jpk,jpts) , hdiv_iscpl(jpi,jpj,jpk) , STAT=iscpl_alloc )
- !
- CALL mpp_sum ( 'iscplini', iscpl_alloc )
- IF( iscpl_alloc > 0 ) CALL ctl_warn('iscpl_alloc: allocation of arrays failed')
- END FUNCTION iscpl_alloc
-
-
- SUBROUTINE iscpl_init()
- !!----------------------------------------------------------------------
- !!----------------------------------------------------------------------
- INTEGER :: ios ! Local integer output status for namelist read
- NAMELIST/namsbc_iscpl/ nn_fiscpl, ln_hsb, nn_drown
- !!----------------------------------------------------------------------
- !
- nn_fiscpl = 0
- ln_hsb = .FALSE.
- READ ( numnam_ref, namsbc_iscpl, IOSTAT = ios, ERR = 901)
-901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iscpl in reference namelist' )
- READ ( numnam_cfg, namsbc_iscpl, IOSTAT = ios, ERR = 902 )
-902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_iscpl in configuration namelist' )
- IF(lwm) WRITE ( numond, namsbc_iscpl )
- !
- nstp_iscpl=MIN( nn_fiscpl, nitend-nit000+1 ) ! the coupling period have to be less or egal than the total number of time step
- rdt_iscpl = nstp_iscpl * rn_rdt
- !
- IF (lwp) THEN
- WRITE(numout,*) 'iscpl_rst:'
- WRITE(numout,*) '~~~~~~~~~'
- WRITE(numout,*) ' coupling flag (ln_iscpl ) = ', ln_iscpl
- WRITE(numout,*) ' conservation flag (ln_hsb ) = ', ln_hsb
- WRITE(numout,*) ' nb of stp for cons (rn_fiscpl) = ', nstp_iscpl
- IF (nstp_iscpl .NE. nn_fiscpl) WRITE(numout,*) 'W A R N I N G: nb of stp for cons has been modified &
- & (larger than run length)'
- WRITE(numout,*) ' coupling time step = ', rdt_iscpl
- WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown
- ENDIF
- !
- END SUBROUTINE iscpl_init
-
- !!======================================================================
-END MODULE iscplini
Index: MO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/iscplrst.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/iscplrst.F90 (revision 12149)
+++ (revision )
@@ -1,410 +1,0 @@
-MODULE iscplrst
- !!======================================================================
- !! *** MODULE iscplrst ***
- !! Ocean forcing: update the restart file in case of ice sheet/ocean coupling
- !!=====================================================================
- !! History : NEMO ! 2015-01 P. Mathiot: original
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! iscpl_stp : step management
- !! iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet
- !!----------------------------------------------------------------------
- USE oce ! global tra/dyn variable
- USE dom_oce ! ocean space and time domain
- USE domwri ! ocean space and time domain
- USE domvvl , ONLY : dom_vvl_interpol
- USE phycst ! physical constants
- USE sbc_oce ! surface boundary condition variables
- USE iscplini ! ice sheet coupling: initialisation
- USE iscplhsb ! ice sheet coupling: conservation
- !
- USE in_out_manager ! I/O manager
- USE iom ! I/O module
- USE lib_mpp ! MPP library
- USE lib_fortran ! MPP library
- USE lbclnk ! communication
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC iscpl_stp ! step management
- !!
- !! * Substitutions
-# include "vectopt_loop_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id$
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE iscpl_stp( Kbb, Kmm )
- !!----------------------------------------------------------------------
- !! *** ROUTINE iscpl_stp ***
- !!
- !! ** Purpose : compute initialisation
- !! compute extrapolation of restart variable uu(Kmm), vv(Kmm), ts(Kmm), ssh(Kmm) (wetting/drying)
- !! compute correction term if needed
- !!
- !!----------------------------------------------------------------------
- INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices
- !
- INTEGER :: inum0
- REAL(wp), DIMENSION(jpi,jpj) :: zsmask_b
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b, zumask_b, zvmask_b
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t_b , ze3u_b , ze3v_b
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepw_b
- CHARACTER(20) :: cfile
- !!----------------------------------------------------------------------
- !
- ! ! get restart variable
- CALL iom_get( numror, jpdom_autoglo, 'tmask' , ztmask_b, ldxios = lrxios ) ! need to extrapolate T/S
- CALL iom_get( numror, jpdom_autoglo, 'umask' , zumask_b, ldxios = lrxios ) ! need to correct barotropic velocity
- CALL iom_get( numror, jpdom_autoglo, 'vmask' , zvmask_b, ldxios = lrxios ) ! need to correct barotropic velocity
- CALL iom_get( numror, jpdom_autoglo, 'smask' , zsmask_b, ldxios = lrxios ) ! need to correct barotropic velocity
- CALL iom_get( numror, jpdom_autoglo, 'e3t_n' , ze3t_b(:,:,:), ldxios = lrxios ) ! need to compute temperature correction
- CALL iom_get( numror, jpdom_autoglo, 'e3u_n' , ze3u_b(:,:,:), ldxios = lrxios ) ! need to correct barotropic velocity
- CALL iom_get( numror, jpdom_autoglo, 'e3v_n' , ze3v_b(:,:,:), ldxios = lrxios ) ! need to correct barotropic velocity
- CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:), ldxios = lrxios ) ! need to interpol vertical profile (vvl)
- !
- CALL iscpl_init() ! read namelist
- ! ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl)
- CALL iscpl_rst_interpol( Kbb, Kmm, ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b )
- !
- IF ( ln_hsb ) THEN ! compute correction if conservation needed
- IF( iscpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays' )
- CALL iscpl_cons( Kbb, Kmm, ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl )
- END IF
-
- ! ! create a domain file
- IF( ln_meshmask .AND. ln_iscpl ) CALL dom_wri
- !
- IF ( ln_hsb ) THEN
- cfile='correction'
- cfile = TRIM( cfile )
- CALL iom_open ( cfile, inum0, ldwrt = .TRUE. )
- CALL iom_rstput( 0, 0, inum0, 'vol_cor', hdiv_iscpl(:,:,:) )
- CALL iom_rstput( 0, 0, inum0, 'tem_cor', htsc_iscpl(:,:,:,jp_tem) )
- CALL iom_rstput( 0, 0, inum0, 'sal_cor', htsc_iscpl(:,:,:,jp_sal) )
- CALL iom_close ( inum0 )
- END IF
- !
- neuler = 0 ! next step is an euler time step
- !
- ! ! set _b and _n variables equal
- ts (:,:,:,:,Kbb) = ts (:,:,:,:,Kmm)
- uu (:,:,:,Kbb) = uu (:,:,:,Kmm)
- vv (:,:,:,Kbb) = vv (:,:,:,Kmm)
- ssh(:,:,Kbb) = ssh(:,:,Kmm)
- !
- ! ! set _b and _n vertical scale factor equal
- e3t (:,:,:,Kbb) = e3t (:,:,:,Kmm)
- e3u (:,:,:,Kbb) = e3u (:,:,:,Kmm)
- e3v (:,:,:,Kbb) = e3v (:,:,:,Kmm)
- !
- e3uw (:,:,:,Kbb) = e3uw (:,:,:,Kmm)
- e3vw (:,:,:,Kbb) = e3vw (:,:,:,Kmm)
- gdept(:,:,:,Kbb) = gdept(:,:,:,Kmm)
- gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm)
- hu (:,:,Kbb) = hu (:,:,Kmm)
- hv (:,:,Kbb) = hv (:,:,Kmm)
- r1_hu(:,:,Kbb) = r1_hu(:,:,Kmm)
- r1_hv(:,:,Kbb) = r1_hv(:,:,Kmm)
- !
- END SUBROUTINE iscpl_stp
-
-
- SUBROUTINE iscpl_rst_interpol ( Kbb, Kmm, ptmask_b, pumask_b, pvmask_b, psmask_b, pe3t_b, pe3u_b, pe3v_b, pdepw_b )
- !!----------------------------------------------------------------------
- !! *** ROUTINE iscpl_rst_interpol ***
- !!
- !! ** Purpose : compute new ts(Kmm), uu(Kmm), vv(Kmm) and ssh(Kmm) in case of evolving geometry of ice shelves
- !! compute 2d fields of heat, salt and volume correction
- !!
- !! ** Method : ts(Kmm) : extrapolation from neigbourg cells
- !! uu(Kmm), vv(Kmm) : fill with 0 velocity and keep barotropic transport by modifing surface velocity or adjacent velocity
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: Kbb, Kmm !! time level indices
- REAL(wp), DIMENSION(:,:,: ), INTENT(in ) :: ptmask_b, pumask_b, pvmask_b !! mask before
- REAL(wp), DIMENSION(:,:,: ), INTENT(in ) :: pe3t_b , pe3u_b , pe3v_b !! scale factor before
- REAL(wp), DIMENSION(:,:,: ), INTENT(in ) :: pdepw_b !! depth w before
- REAL(wp), DIMENSION(:,: ), INTENT(in ) :: psmask_b !! mask before
- !!
- INTEGER :: ji, jj, jk, iz !! loop index
- INTEGER :: jip1, jim1, jjp1, jjm1, jkp1, jkm1
- !!
- REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb
- REAL(wp):: zdz, zdzm1, zdzp1
- !!
- REAL(wp), DIMENSION(jpi,jpj) :: zdmask , zsmask0, zucorr, zbub, zbun, zssh0, zhu1, zde3t
- REAL(wp), DIMENSION(jpi,jpj) :: zdsmask, zsmask1, zvcorr, zbvb, zbvn, zssh1, zhv1
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask0, zwmaskn, ztrp
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask1, zwmaskb, ztmp3d
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0
- !!----------------------------------------------------------------------
- !
- ! ! mask value to be sure
- ts(:,:,:,jp_tem,Kmm) = ts(:,:,:,jp_tem,Kmm) * ptmask_b(:,:,:)
- ts(:,:,:,jp_sal,Kmm) = ts(:,:,:,jp_sal,Kmm) * ptmask_b(:,:,:)
- !
- ! ! compute wmask
- zwmaskn(:,:,1) = tmask (:,:,1)
- zwmaskb(:,:,1) = ptmask_b(:,:,1)
- DO jk = 2,jpk
- zwmaskn(:,:,jk) = tmask (:,:,jk) * tmask (:,:,jk-1)
- zwmaskb(:,:,jk) = ptmask_b(:,:,jk) * ptmask_b(:,:,jk-1)
- END DO
- !
- ! ! compute new ssh if we open a full water column (average of the closest neigbourgs)
- ssh (:,:,Kbb)=ssh(:,:,Kmm)
- zssh0(:,:)=ssh(:,:,Kmm)
- zsmask0(:,:) = psmask_b(:,:)
- zsmask1(:,:) = psmask_b(:,:)
- DO iz = 1, 10 ! need to be tuned (configuration dependent) (OK for ISOMIP+)
- zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:)
- DO jj = 2,jpj-1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- jip1=ji+1; jim1=ji-1;
- jjp1=jj+1; jjm1=jj-1;
- summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1))
- IF (zdsmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
- ssh(ji,jj,Kmm)=( zssh0(jip1,jj)*zsmask0(jip1,jj) &
- & + zssh0(jim1,jj)*zsmask0(jim1,jj) &
- & + zssh0(ji,jjp1)*zsmask0(ji,jjp1) &
- & + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk
- zsmask1(ji,jj)=1._wp
- ENDIF
- END DO
- END DO
- CALL lbc_lnk_multi( 'iscplrst', ssh(:,:,Kmm), 'T', 1., zsmask1, 'T', 1. )
- zssh0 = ssh(:,:,Kmm)
- zsmask0 = zsmask1
- END DO
- ssh(:,:,Kmm) = ssh(:,:,Kmm) * ssmask(:,:)
-
-!=============================================================================
-!PM: Is this needed since introduction of VVL by default?
- IF ( .NOT.ln_linssh ) THEN
- ! Reconstruction of all vertical scale factors at now time steps
- ! =============================================================================
- ! Horizontal scale factor interpolations
- ! --------------------------------------
- DO jk = 1,jpk
- DO jj=1,jpj
- DO ji=1,jpi
- IF (tmask(ji,jj,1) == 0._wp .OR. ptmask_b(ji,jj,1) == 0._wp) THEN
- e3t(ji,jj,jk,Kmm) = e3t_0(ji,jj,jk) * ( 1._wp + ssh(ji,jj,Kmm) / &
- & ( ht_0(ji,jj) + 1._wp - ssmask(ji,jj) ) * tmask(ji,jj,jk) )
- ENDIF
- END DO
- END DO
- END DO
- !
- CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' )
- CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' )
- CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' )
-
- ! Vertical scale factor interpolations
- ! ------------------------------------
- CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' )
- CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' )
- CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' )
-
- ! t- and w- points depth
- ! ----------------------
- gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm)
- gdepw(:,:,1,Kmm) = 0.0_wp
- gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)
- DO jj = 1,jpj
- DO ji = 1,jpi
- DO jk = 2,mikt(ji,jj)-1
- gdept(ji,jj,jk,Kmm) = gdept_0(ji,jj,jk)
- gdepw(ji,jj,jk,Kmm) = gdepw_0(ji,jj,jk)
- gde3w(ji,jj,jk) = gdept_0(ji,jj,jk) - ssh(ji,jj,Kmm)
- END DO
- IF (mikt(ji,jj) > 1) THEN
- jk = mikt(ji,jj)
- gdept(ji,jj,jk,Kmm) = gdepw_0(ji,jj,jk) + 0.5_wp * e3w(ji,jj,jk,Kmm)
- gdepw(ji,jj,jk,Kmm) = gdepw_0(ji,jj,jk)
- gde3w(ji,jj,jk) = gdept(ji,jj,jk ,Kmm) - ssh (ji,jj,Kmm)
- END IF
- DO jk = mikt(ji,jj)+1, jpk
- gdept(ji,jj,jk,Kmm) = gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)
- gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm)
- gde3w(ji,jj,jk) = gdept(ji,jj,jk ,Kmm) - ssh (ji,jj,Kmm)
- END DO
- END DO
- END DO
-
- ! t-, u- and v- water column thickness
- ! ------------------------------------
- ht(:,:) = 0._wp ; hu(:,:,Kmm) = 0._wp ; hv(:,:,Kmm) = 0._wp
- DO jk = 1, jpkm1
- hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm) * umask(:,:,jk)
- hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm) * vmask(:,:,jk)
- ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk)
- END DO
- ! ! Inverse of the local depth
- r1_hu(:,:,Kmm) = 1._wp / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) * ssumask(:,:)
- r1_hv(:,:,Kmm) = 1._wp / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:)
-
- END IF
-
-!=============================================================================
-! compute velocity
-! compute velocity in order to conserve barotropic velocity (modification by poderation of the scale factor).
- uu(:,:,:,Kbb)=uu(:,:,:,Kmm)
- vv(:,:,:,Kbb)=vv(:,:,:,Kmm)
- DO jk = 1,jpk
- DO jj = 1,jpj
- DO ji = 1,jpi
- uu(ji,jj,jk,Kmm) = uu(ji,jj,jk,Kbb)*pe3u_b(ji,jj,jk)*pumask_b(ji,jj,jk)/e3u(ji,jj,jk,Kmm)*umask(ji,jj,jk);
- vv(ji,jj,jk,Kmm) = vv(ji,jj,jk,Kbb)*pe3v_b(ji,jj,jk)*pvmask_b(ji,jj,jk)/e3v(ji,jj,jk,Kmm)*vmask(ji,jj,jk);
- END DO
- END DO
- END DO
-
-! compute new velocity if we close a cell (check barotropic velocity and change velocity over the water column)
-! compute barotropic velocity now and after
- ztrp(:,:,:) = uu(:,:,:,Kbb)*pe3u_b(:,:,:);
- zbub(:,:) = SUM(ztrp,DIM=3)
- ztrp(:,:,:) = vv(:,:,:,Kbb)*pe3v_b(:,:,:);
- zbvb(:,:) = SUM(ztrp,DIM=3)
- ztrp(:,:,:) = uu(:,:,:,Kmm)*e3u(:,:,:,Kmm);
- zbun(:,:) = SUM(ztrp,DIM=3)
- ztrp(:,:,:) = vv(:,:,:,Kmm)*e3v(:,:,:,Kmm);
- zbvn(:,:) = SUM(ztrp,DIM=3)
-
- ! new water column
- zhu1=0.0_wp ;
- zhv1=0.0_wp ;
- DO jk = 1,jpk
- zhu1(:,:) = zhu1(:,:) + e3u(:,:,jk,Kmm) * umask(:,:,jk)
- zhv1(:,:) = zhv1(:,:) + e3v(:,:,jk,Kmm) * vmask(:,:,jk)
- END DO
-
- ! compute correction
- zucorr = 0._wp
- zvcorr = 0._wp
- DO jj = 1,jpj
- DO ji = 1,jpi
- IF (zbun(ji,jj) /= zbub(ji,jj) .AND. zhu1(ji,jj) /= 0._wp ) THEN
- zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/zhu1(ji,jj)
- END IF
- IF (zbvn(ji,jj) /= zbvb(ji,jj) .AND. zhv1(ji,jj) /= 0._wp ) THEN
- zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/zhv1(ji,jj)
- END IF
- END DO
- END DO
-
- ! update velocity
- DO jk = 1,jpk
- uu(:,:,jk,Kmm)=(uu(:,:,jk,Kmm) - zucorr(:,:))*umask(:,:,jk)
- vv(:,:,jk,Kmm)=(vv(:,:,jk,Kmm) - zvcorr(:,:))*vmask(:,:,jk)
- END DO
-
-!=============================================================================
- ! compute temp and salt
- ! compute new tn and sn if we open a new cell
- ts (:,:,:,:,Kbb) = ts(:,:,:,:,Kmm)
- zts0(:,:,:,:) = ts(:,:,:,:,Kmm)
- ztmask1(:,:,:) = ptmask_b(:,:,:)
- ztmask0(:,:,:) = ptmask_b(:,:,:)
- DO iz = 1,nn_drown ! resolution dependent (OK for ISOMIP+ case)
- DO jk = 1,jpk-1
- zdmask=tmask(:,:,jk)-ztmask0(:,:,jk);
- DO jj = 2,jpj-1
- DO ji = fs_2,fs_jpim1
- jip1=ji+1; jim1=ji-1;
- jjp1=jj+1; jjm1=jj-1;
- summsk= (ztmask0(jip1,jj ,jk)+ztmask0(jim1,jj ,jk)+ztmask0(ji ,jjp1,jk)+ztmask0(ji ,jjm1,jk))
- IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
- !! horizontal basic extrapolation
- ts(ji,jj,jk,1,Kmm)=( zts0(jip1,jj ,jk,1)*ztmask0(jip1,jj ,jk) &
- & +zts0(jim1,jj ,jk,1)*ztmask0(jim1,jj ,jk) &
- & +zts0(ji ,jjp1,jk,1)*ztmask0(ji ,jjp1,jk) &
- & +zts0(ji ,jjm1,jk,1)*ztmask0(ji ,jjm1,jk) ) / summsk
- ts(ji,jj,jk,2,Kmm)=( zts0(jip1,jj ,jk,2)*ztmask0(jip1,jj ,jk) &
- & +zts0(jim1,jj ,jk,2)*ztmask0(jim1,jj ,jk) &
- & +zts0(ji ,jjp1,jk,2)*ztmask0(ji ,jjp1,jk) &
- & +zts0(ji ,jjm1,jk,2)*ztmask0(ji ,jjm1,jk) ) / summsk
- ztmask1(ji,jj,jk)=1
- ELSEIF (zdmask(ji,jj) == 1._wp .AND. summsk == 0._wp) THEN
- !! vertical extrapolation if horizontal extrapolation failed
- jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1)
- summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1))
- IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp ) THEN
- ts(ji,jj,jk,1,Kmm)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1) &
- & +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk
- ts(ji,jj,jk,2,Kmm)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1) &
- & +zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1))/summsk
- ztmask1(ji,jj,jk)=1._wp
- END IF
- END IF
- END DO
- END DO
- END DO
-
- CALL lbc_lnk_multi( 'iscplrst', ts(:,:,:,jp_tem,Kmm), 'T', 1., ts(:,:,:,jp_sal,Kmm), 'T', 1., ztmask1, 'T', 1.)
-
- ! update
- zts0(:,:,:,:) = ts(:,:,:,:,Kmm)
- ztmask0 = ztmask1
-
- END DO
-
- ! mask new ts(:,:,:,:,Kmm) field
- ts(:,:,:,jp_tem,Kmm) = ts(:,:,:,jp_tem,Kmm) * tmask(:,:,:)
- ts(:,:,:,jp_sal,Kmm) = ts(:,:,:,jp_sal,Kmm) * tmask(:,:,:)
-
- ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask
- !PM: Is this IF needed since change to VVL by default
- IF (.NOT.ln_linssh) THEN
- DO jk = 2,jpk-1
- DO jj = 1,jpj
- DO ji = 1,jpi
- IF (zwmaskn(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1._wp .AND. &
- & (tmask(ji,jj,1)==0._wp .OR. ptmask_b(ji,jj,1)==0._wp) ) THEN
- !compute weight
- zdzp1 = MAX(0._wp,gdepw(ji,jj,jk+1,Kmm) - pdepw_b(ji,jj,jk+1))
- zdz = gdepw(ji,jj,jk+1,Kmm) - pdepw_b(ji,jj,jk )
- zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk ) - gdepw(ji,jj,jk ,Kmm))
- IF (zdz .LT. 0._wp) THEN
- CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' )
- END IF
- ts(ji,jj,jk,jp_tem,Kmm) = ( zdzp1*ts(ji,jj,jk+1,jp_tem,Kbb) &
- & + zdz *ts(ji,jj,jk ,jp_tem,Kbb) &
- & + zdzm1*ts(ji,jj,jk-1,jp_tem,Kbb) )/e3t(ji,jj,jk,Kmm)
- ts(ji,jj,jk,jp_sal,Kmm) = ( zdzp1*ts(ji,jj,jk+1,jp_sal,Kbb) &
- & + zdz *ts(ji,jj,jk ,jp_sal,Kbb) &
- & + zdzm1*ts(ji,jj,jk-1,jp_sal,Kbb) )/e3t(ji,jj,jk,Kmm)
- END IF
- END DO
- END DO
- END DO
- END IF
-
- ! closed pool
- ! -----------------------------------------------------------------------------------------
- ! case we open a cell but no neigbour cells available to get an estimate of T and S
- WHERE (tmask(:,:,:) == 1._wp .AND. ts(:,:,:,2,Kmm) == 0._wp)
- ts(:,:,:,2,Kmm) = -99._wp ! Special value for closed pool (checking purpose in output.init)
- tmask(:,:,:) = 0._wp ! set mask to 0 to run
- umask(:,:,:) = 0._wp
- vmask(:,:,:) = 0._wp
- END WHERE
-
- ! set mbkt and mikt to 1 in thiese location
- WHERE (SUM(tmask,dim=3) == 0)
- mbkt(:,:)=1 ; mbku(:,:)=1 ; mbkv(:,:)=1
- mikt(:,:)=1 ; miku(:,:)=1 ; mikv(:,:)=1
- END WHERE
- ! -------------------------------------------------------------------------------------------
- ! compute new tn and sn if we close cell
- ! nothing to do
- !
- END SUBROUTINE iscpl_rst_interpol
-
- !!======================================================================
-END MODULE iscplrst
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/istate.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/istate.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/istate.F90 (revision 12150)
@@ -28,5 +28,4 @@
USE dtauvd ! data: U & V current (dta_uvd routine)
USE domvvl ! varying vertical mesh
- USE iscplrst ! ice sheet coupling
USE wet_dry ! wetting and drying (needed for wad_istate)
USE usrdef_istate ! User defined initial state
@@ -88,5 +87,4 @@
! ! -------------------
CALL rst_read( Kbb, Kmm ) ! Read the restart file
- IF (ln_iscpl) CALL iscpl_stp( Kbb, Kmm ) ! extrapolate restart to wet and dry
CALL day_init ! model calendar (using both namelist and restart infos)
!
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/divhor.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/divhor.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/divhor.F90 (revision 12150)
@@ -20,9 +20,8 @@
USE oce ! ocean dynamics and tracers
USE dom_oce ! ocean space and time domain
- USE sbc_oce, ONLY : ln_rnf, ln_isf ! surface boundary condition: ocean
- USE sbcrnf ! river runoff
- USE sbcisf ! ice shelf
- USE iscplhsb ! ice sheet / ocean coupling
- USE iscplini ! ice sheet / ocean coupling
+ USE sbc_oce, ONLY : ln_rnf ! river runoff
+ USE sbcrnf , ONLY : sbc_rnf_div ! river runoff
+ USE isf_oce, ONLY : ln_isf ! ice shelf
+ USE isfhdiv, ONLY : isf_hdiv ! ice shelf
#if defined key_asminc
USE asminc ! Assimilation increment
@@ -65,4 +64,5 @@
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zraur, zdep ! local scalars
+ REAL(wp), DIMENSION(jpi,jpj) :: ztmp
!!----------------------------------------------------------------------
!
@@ -86,4 +86,5 @@
END DO
END DO
+ !
#if defined key_agrif
IF( .NOT. Agrif_Root() ) THEN
@@ -101,7 +102,6 @@
!
#endif
- IF( ln_isf ) CALL sbc_isf_div( hdiv, Kmm ) !== ice shelf ==! (update hdiv field)
!
- IF( ln_iscpl .AND. ln_hsb ) CALL iscpl_div( Kmm, hdiv ) !== ice sheet ==! (update hdiv field)
+ IF( ln_isf ) CALL isf_hdiv( kt, Kmm, hdiv ) !== ice shelf ==! (update hdiv field)
!
CALL lbc_lnk( 'divhor', hdiv, 'T', 1. ) ! (no sign change)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynatf.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynatf.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynatf.F90 (revision 12150)
@@ -30,5 +30,4 @@
USE sbc_oce ! Surface boundary condition: ocean fields
USE sbcrnf ! river runoffs
- USE sbcisf ! ice shelf
USE phycst ! physical constants
USE dynadv ! dynamics: vector invariant versus flux form
@@ -42,4 +41,6 @@
USE trddyn ! trend manager: dynamics
USE trdken ! trend manager: kinetic energy
+ USE isf_oce , ONLY: ln_isf ! ice shelf
+ USE isfdynatf , ONLY: isf_dynatf ! ice shelf volume filter correction subroutine
!
USE in_out_manager ! I/O manager
@@ -145,5 +146,5 @@
# endif
!
- CALL lbc_lnk_multi( 'dynnxt', puu(:,:,:,Kaa), 'U', -1., pvv(:,:,:,Kaa), 'V', -1. ) !* local domain boundaries
+ CALL lbc_lnk_multi( 'dynatf', puu(:,:,:,Kaa), 'U', -1., pvv(:,:,:,Kaa), 'V', -1. ) !* local domain boundaries
!
! !* BDY open boundaries
@@ -218,20 +219,10 @@
ENDIF
END IF
-
- IF ( ln_isf ) THEN ! if ice shelf melting
- DO jk = 1, jpkm1 ! Deal with isf separetely, as can be through depth too
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( misfkt(ji,jj) <=jk .and. jk < misfkb(ji,jj) ) THEN
- ze3t_f(ji,jj,jk) = ze3t_f(ji,jj,jk) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) &
- & * ( pe3t(ji,jj,jk,Kmm) * r1_hisf_tbl(ji,jj) ) * tmask(ji,jj,jk)
- ELSEIF ( jk==misfkb(ji,jj) ) THEN
- ze3t_f(ji,jj,jk) = ze3t_f(ji,jj,jk) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) &
- & * ( pe3t(ji,jj,jk,Kmm) * r1_hisf_tbl(ji,jj) ) * ralpha(ji,jj) * tmask(ji,jj,jk)
- ENDIF
- END DO
- END DO
- END DO
- END IF
+ !
+ ! ice shelf melting (deal separately as it can be in depth)
+ ! PM: we could probably define a generic subroutine to do the in depth correction
+ ! to manage rnf, isf and possibly in the futur icb, tide water glacier (...)
+ ! ...(kt, coef, ktop, kbot, hz, fwf_b, fwf)
+ IF ( ln_isf ) CALL isf_dynatf( kt, Kmm, ze3t_f, atfp * rdt )
!
pe3t(:,:,1:jpkm1,Kmm) = ze3t_f(:,:,1:jpkm1) ! filtered scale factor at T-points
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynhpg.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynhpg.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynhpg.F90 (revision 12150)
@@ -31,4 +31,6 @@
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and tracers
+ USE isf_oce , ONLY : risfload ! ice shelf (risfload variable)
+ USE isfload , ONLY : isf_load ! ice shelf (isf_load routine )
USE sbc_oce ! surface variable (only for the flag with ice shelf)
USE dom_oce ! ocean space and time domain
@@ -216,44 +218,4 @@
ENDIF
!
- IF ( .NOT. ln_isfcav ) THEN !--- no ice shelf load
- riceload(:,:) = 0._wp
- !
- ELSE !--- set an ice shelf load
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' ice shelf case: set the ice-shelf load'
- ALLOCATE( zts_top(jpi,jpj,jpts) , zrhd(jpi,jpj,jpk) , zrhdtop_isf(jpi,jpj) , ziceload(jpi,jpj) )
- !
- znad = 1._wp !- To use density and not density anomaly
- !
- ! !- assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude)
- zts_top(:,:,jp_tem) = -1.9_wp ; zts_top(:,:,jp_sal) = 34.4_wp
- !
- DO jk = 1, jpk !- compute density of the water displaced by the ice shelf
- CALL eos( zts_top(:,:,:), gdept(:,:,jk,Kmm), zrhd(:,:,jk) )
- END DO
- !
- ! !- compute rhd at the ice/oce interface (ice shelf side)
- CALL eos( zts_top , risfdep, zrhdtop_isf )
- !
- ! !- Surface value + ice shelf gradient
- ziceload = 0._wp ! compute pressure due to ice shelf load
- DO jj = 1, jpj ! (used to compute hpgi/j for all the level from 1 to miku/v)
- DO ji = 1, jpi ! divided by 2 later
- ikt = mikt(ji,jj)
- ziceload(ji,jj) = ziceload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w(ji,jj,1,Kmm) * (1._wp - tmask(ji,jj,1))
- DO jk = 2, ikt-1
- ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w(ji,jj,jk,Kmm) &
- & * (1._wp - tmask(ji,jj,jk))
- END DO
- IF (ikt >= 2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) &
- & * ( risfdep(ji,jj) - gdept(ji,jj,ikt-1,Kmm) )
- END DO
- END DO
- riceload(:,:) = ziceload(:,:) ! need to be saved for diaar5
- !
- DEALLOCATE( zts_top , zrhd , zrhdtop_isf , ziceload )
- ENDIF
- !
END SUBROUTINE dyn_hpg_init
@@ -581,5 +543,5 @@
!! puu(:,:,:,Krhs) = puu(:,:,:,Krhs) - 1/e1u * zhpi
!! pvv(:,:,:,Krhs) = pvv(:,:,:,Krhs) - 1/e2v * zhpj
- !! iceload is added and partial cell case are added to the top and bottom
+ !! iceload is added
!!
!! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend
@@ -628,10 +590,10 @@
& - 0.5_wp * e3w(ji,jj,ikt,Kmm) &
& * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) ) &
- & + ( riceload(ji+1,jj) - riceload(ji,jj)) )
+ & + ( risfload(ji+1,jj) - risfload(ji,jj)) )
zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w(ji,jj+1,iktp1j,Kmm) &
& * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) ) &
& - 0.5_wp * e3w(ji,jj,ikt,Kmm) &
& * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) ) &
- & + ( riceload(ji,jj+1) - riceload(ji,jj)) )
+ & + ( risfload(ji,jj+1) - risfload(ji,jj)) )
! s-coordinate pressure gradient correction (=0 if z coordinate)
zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) &
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynspg_ts.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynspg_ts.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynspg_ts.F90 (revision 12150)
@@ -31,7 +31,7 @@
USE dom_oce ! ocean space and time domain
USE sbc_oce ! surface boundary condition: ocean
+ USE isf_oce ! ice shelf variable (fwfisf)
USE zdf_oce ! vertical physics: variables
USE zdfdrg ! vertical physics: top/bottom drag coef.
- USE sbcisf ! ice shelf variable (fwfisf)
USE sbcapr ! surface boundary condition: atmospheric pressure
USE dynadv , ONLY: ln_dynadv_vec
@@ -337,8 +337,11 @@
! ! --------------------------------------------------- !
IF (ln_bt_fw) THEN ! FORWARD integration: use kt+1/2 fluxes (NOW+1/2)
- zssh_frc(:,:) = r1_rau0 * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )
+ zssh_frc(:,:) = r1_rau0 * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) )
ELSE ! CENTRED integration: use kt-1/2 + kt+1/2 fluxes (NOW)
zztmp = r1_rau0 * r1_2
- zssh_frc(:,:) = zztmp * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) + fwfisf(:,:) + fwfisf_b(:,:) )
+ zssh_frc(:,:) = zztmp * ( emp(:,:) + emp_b(:,:) &
+ & - rnf(:,:) - rnf_b(:,:) &
+ & + fwfisf_cav(:,:) + fwfisf_cav_b(:,:) &
+ & + fwfisf_par(:,:) + fwfisf_par_b(:,:) )
ENDIF
! != Add Stokes drift divergence =! (if exist)
@@ -346,4 +349,19 @@
zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:)
ENDIF
+ !
+ ! ! ice sheet coupling
+ IF ( ln_isf .AND. ln_isfcpl ) THEN
+ !
+ ! ice sheet coupling
+ IF( ln_rstart .AND. kt == nit000 ) THEN
+ zssh_frc(:,:) = zssh_frc(:,:) + risfcpl_ssh(:,:)
+ END IF
+ !
+ ! conservation option
+ IF( ln_isfcpl_cons ) THEN
+ zssh_frc(:,:) = zssh_frc(:,:) + risfcpl_cons_ssh(:,:)
+ END IF
+ !
+ END IF
!
#if defined key_asminc
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynzdf.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynzdf.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynzdf.F90 (revision 12150)
@@ -430,5 +430,5 @@
ikv = mikv(ji,jj) ! (first wet ocean u- and v-points)
ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa) ! after scale factor at T-point
- zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va
+ zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / ze3va
END DO
END DO
@@ -448,5 +448,5 @@
! m is decomposed in the product of an upper and lower triangular matrix
! The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
- ! The solution (after velocity) is in 2d array pvv(:,:,:,Kaa)
+ ! The solution (after velocity) is in 2d array va
!-----------------------------------------------------------------------
!
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/sshwzv.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/sshwzv.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/sshwzv.F90 (revision 12150)
@@ -19,4 +19,5 @@
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and tracers variables
+ USE isf_oce ! ice shelf
USE dom_oce ! ocean space and time domain variables
USE sbc_oce ! surface boundary condition: ocean
@@ -256,6 +257,11 @@
zcoef = atfp * rdt * r1_rau0
pssh(:,:,Kmm) = pssh(:,:,Kmm) - zcoef * ( emp_b(:,:) - emp (:,:) &
- & - rnf_b(:,:) + rnf (:,:) &
- & + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:)
+ & - rnf_b(:,:) + rnf (:,:) &
+ & + fwfisf_cav_b(:,:) - fwfisf_cav(:,:) &
+ & + fwfisf_par_b(:,:) - fwfisf_par(:,:) ) * ssmask(:,:)
+
+ ! ice sheet coupling
+ IF ( ln_isf .AND. ln_isfcpl .AND. kt == nit000+1) pssh(:,:,Kbb) = pssh(:,:,Kbb) - atfp * rdt * ( risfcpl_ssh(:,:) - 0.0 ) * ssmask(:,:)
+
ENDIF
ENDIF
@@ -350,5 +356,5 @@
zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) )
! alt:
-! IF ( wn(ji,jj,jk) > 0._wp ) THEN
+! IF ( ww(ji,jj,jk) > 0._wp ) THEN
! zCu = Cu_adv(ji,jj,jk)
! ELSE
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/iom.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/iom.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/iom.F90 (revision 12150)
@@ -374,15 +374,4 @@
CALL iom_set_rstw_var_active('sshn')
CALL iom_set_rstw_var_active('rhop')
- ! extra variable needed for the ice sheet coupling
- IF ( ln_iscpl ) THEN
- CALL iom_set_rstw_var_active('tmask')
- CALL iom_set_rstw_var_active('umask')
- CALL iom_set_rstw_var_active('vmask')
- CALL iom_set_rstw_var_active('smask')
- CALL iom_set_rstw_var_active('e3t_n')
- CALL iom_set_rstw_var_active('e3u_n')
- CALL iom_set_rstw_var_active('e3v_n')
- CALL iom_set_rstw_var_active('gdepw_n')
- END IF
ENDIF
IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst')
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/restart.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/restart.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/restart.F90 (revision 12150)
@@ -162,15 +162,4 @@
CALL iom_rstput( kt, nitrst, numrow, 'sshn' ,ssh(:,: ,Kmm), ldxios = lwxios )
CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop, ldxios = lwxios )
- ! extra variable needed for the ice sheet coupling
- IF ( ln_iscpl ) THEN
- CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask, ldxios = lwxios ) ! need to extrapolate T/S
- CALL iom_rstput( kt, nitrst, numrow, 'umask' , umask, ldxios = lwxios ) ! need to correct barotropic velocity
- CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask, ldxios = lwxios ) ! need to correct barotropic velocity
- CALL iom_rstput( kt, nitrst, numrow, 'smask' , ssmask, ldxios = lwxios) ! need to correct barotropic velocity
- CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios ) ! need to compute temperature correction
- CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u(:,:,:,Kmm), ldxios = lwxios ) ! need to compute bt conservation
- CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v(:,:,:,Kmm), ldxios = lwxios ) ! need to compute bt conservation
- CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw(:,:,:,Kmm), ldxios = lwxios ) ! need to compute extrapolation if vvl
- END IF
ENDIF
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isf_oce.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isf_oce.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isf_oce.F90 (revision 12150)
@@ -0,0 +1,266 @@
+MODULE isf_oce
+ !!======================================================================
+ !! *** MODULE sbcisf ***
+ !! Surface module : compute iceshelf melt and heat flux
+ !!======================================================================
+ !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav
+ !! X.X ! 2006-02 (C. Wang ) Original code bg03
+ !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization
+ !! 4.1 ! 2019-09 (P. Mathiot) Split param/explicit ice shelf and re-organisation
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isf : define and allocate ice shelf variables
+ !!----------------------------------------------------------------------
+
+ USE par_oce , ONLY: jpi, jpj, jpk
+ USE in_out_manager, ONLY: wp, jpts ! I/O manager
+ USE lib_mpp , ONLY: ctl_stop, mpp_sum ! MPP library
+ USE fldread ! read input fields
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isf_alloc, isf_alloc_par, isf_alloc_cav, isf_alloc_cpl, isf_dealloc_cpl
+ !
+ !-------------------------------------------------------
+ ! 0 : namelist parameter
+ !-------------------------------------------------------
+ !
+ ! 0.1 -------- ice shelf cavity parameter --------------
+ CHARACTER(LEN=256), PUBLIC :: cn_isfdir
+ LOGICAL , PUBLIC :: ln_isf
+ LOGICAL , PUBLIC :: ln_isfdebug
+ !
+ ! 0.2 -------- ice shelf cavity opened namelist parameter -------------
+ LOGICAL , PUBLIC :: ln_isfcav_mlt !: logical for the use of ice shelf parametrisation
+ REAL(wp) , PUBLIC :: rn_gammat0 !: temperature exchange coeficient []
+ REAL(wp) , PUBLIC :: rn_gammas0 !: salinity exchange coeficient []
+ REAL(wp) , PUBLIC :: rn_htbl !: Losch top boundary layer thickness [m]
+ REAL(wp) , PUBLIC :: rn_isfload_T !:
+ REAL(wp) , PUBLIC :: rn_isfload_S !:
+ CHARACTER(LEN=256), PUBLIC :: cn_gammablk !: gamma formulation
+ CHARACTER(LEN=256), PUBLIC :: cn_isfcav_mlt !: melt formulation (cavity/param)
+ CHARACTER(LEN=256), PUBLIC :: cn_isfload !: ice shelf load computation method
+ TYPE(FLD_N) , PUBLIC :: sn_isfcav_fwf !: information about the isf melting file to be read
+ !
+ ! 0.3 -------- ice shelf cavity parametrised namelist parameter -------------
+ LOGICAL , PUBLIC :: ln_isfpar_mlt !: logical for the computation of melt inside the cavity
+ CHARACTER(LEN=256), PUBLIC :: cn_isfpar_mlt !: melt formulation (cavity/param)
+ TYPE(FLD_N) , PUBLIC :: sn_isfpar_fwf !: information about the isf melting file to be read
+ TYPE(FLD_N) , PUBLIC :: sn_isfpar_zmax !: information about the grounding line depth file to be read
+ TYPE(FLD_N) , PUBLIC :: sn_isfpar_zmin !: information about the calving line depth file to be read
+ TYPE(FLD_N) , PUBLIC :: sn_isfpar_Leff !: information about the effective length file to be read
+ !
+ ! 0.4 -------- coupling namelist parameter -------------
+ LOGICAL, PUBLIC :: ln_isfcpl !:
+ LOGICAL, PUBLIC :: ln_isfcpl_cons !:
+ INTEGER, PUBLIC :: nn_drown !:
+ !
+ !-------------------------------------------------------
+ ! 1 : ice shelf parameter
+ !-------------------------------------------------------
+ !
+ REAL(wp), PARAMETER, PUBLIC :: rLfusisf = 0.334e6_wp !: latent heat of fusion of ice shelf [J/kg]
+ REAL(wp), PARAMETER, PUBLIC :: rcpisf = 2000.0_wp !: specific heat of ice shelf [J/kg/K]
+ REAL(wp), PARAMETER, PUBLIC :: rkappa = 1.54e-6_wp !: heat diffusivity through the ice-shelf [m2/s]
+ REAL(wp), PARAMETER, PUBLIC :: rhoisf = 920.0_wp !: volumic mass of ice shelf [kg/m3]
+ REAL(wp), PARAMETER, PUBLIC :: rtsurf = -20.0 !: surface temperature [C]
+ !
+ !-------------------------------------------------------
+ ! 2 : ice shelf global variables
+ !-------------------------------------------------------
+ !
+ ! 2.1 -------- ice shelf cavity parameter --------------
+ LOGICAL , PUBLIC :: l_isfoasis
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfload !: ice shelf load
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf_oasis
+ !
+ ! 2.2 -------- ice shelf cavity melt namelist parameter -------------
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mskisf_cav !:
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: misfkt_cav , misfkb_cav !:
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhisf_tbl_cav, rfrac_tbl_cav !:
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf_cav , fwfisf_cav_b !: before and now net fwf from the ice shelf [kg/m2/s]
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risf_cav_tsc , risf_cav_tsc_b !: before and now T & S isf contents [K.m/s & PSU.m/s]
+ TYPE(FLD), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sf_isfcav_fwf !:
+ !
+ REAL(wp) , PUBLIC :: risf_lamb1, risf_lamb2, risf_lamb3 ! freezing point linearization coeficient
+ !
+ ! 2.3 -------- ice shelf param. melt namelist parameter -------------
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mskisf_par !:
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: misfkt_par , misfkb_par !:
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhisf_tbl_par, rfrac_tbl_par !:
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf_par , fwfisf_par_b !: before and now net fwf from the ice shelf [kg/m2/s]
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risf_par_tsc , risf_par_tsc_b !: before and now T & S isf contents [K.m/s & PSU.m/s]
+ TYPE(FLD), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sf_isfpar_fwf !:
+ !
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhisf0_tbl_par !: thickness of tbl (initial value) [m]
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfLeff !:
+ !
+ ! 2.4 -------- coupling namelist parameter -------------
+ INTEGER , PUBLIC :: nstp_iscpl !:
+ REAL(wp), PUBLIC :: rdt_iscpl !:
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfcpl_ssh, risfcpl_cons_ssh, risfcpl_cons_ssh_b !:
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risfcpl_vol, risfcpl_cons_vol, risfcpl_cons_vol_b !:
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: risfcpl_tsc, risfcpl_cons_tsc, risfcpl_cons_tsc_b !:
+ !
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE isf_alloc_par()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_alloc_par ***
+ !!
+ !! ** Purpose :
+ !!
+ !! ** Method :
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr, ialloc
+ !!----------------------------------------------------------------------
+ ierr = 0 ! set to zero if no array to be allocated
+ !
+ ALLOCATE(risfLeff(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ ALLOCATE(misfkt_par(jpi,jpj), misfkb_par(jpi,jpj), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( rfrac_tbl_par(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( rhisf_tbl_par(jpi,jpj), rhisf0_tbl_par(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( mskisf_par(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ CALL mpp_sum ( 'isf', ierr )
+ IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'isf: failed to allocate arrays.' )
+ !
+ END SUBROUTINE isf_alloc_par
+
+ SUBROUTINE isf_alloc_cav()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_alloc_cav ***
+ !!
+ !! ** Purpose :
+ !!
+ !! ** Method :
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr, ialloc
+ !!----------------------------------------------------------------------
+ ierr = 0 ! set to zero if no array to be allocated
+ !
+ ALLOCATE(misfkt_cav(jpi,jpj), misfkb_cav(jpi,jpj), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( rfrac_tbl_cav(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( rhisf_tbl_cav(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ CALL mpp_sum ( 'isf', ierr )
+ IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'isf: failed to allocate arrays.' )
+ !
+ END SUBROUTINE isf_alloc_cav
+
+ SUBROUTINE isf_alloc_cpl()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_alloc_cpl ***
+ !!
+ !! ** Purpose : allocate array use for the ice sheet coupling
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr, ialloc
+ !!----------------------------------------------------------------------
+ ierr = 0
+ !
+ ALLOCATE( risfcpl_ssh(jpi,jpj), risfcpl_tsc(jpi,jpj,jpk,jpts), risfcpl_vol(jpi,jpj,jpk), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ risfcpl_tsc(:,:,:,:) = 0.0 ; risfcpl_vol(:,:,:) = 0.0 ; risfcpl_ssh(:,:) = 0.0
+
+ IF ( ln_isfcpl_cons) THEN
+ ALLOCATE( risfcpl_cons_tsc(jpi,jpj,jpk,jpts) , risfcpl_cons_vol(jpi,jpj,jpk) ,risfcpl_cons_ssh(jpi,jpj), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ risfcpl_cons_tsc(:,:,:,:) = 0.0 ; risfcpl_cons_vol(:,:,:) = 0.0 ; risfcpl_cons_ssh(:,:) = 0.0
+ !
+ END IF
+ !
+ CALL mpp_sum ( 'isf', ierr )
+ IF( ierr /= 0 ) CALL ctl_stop('STOP','isfcpl: failed to allocate arrays.')
+ !
+ END SUBROUTINE isf_alloc_cpl
+
+ SUBROUTINE isf_dealloc_cpl()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_dealloc_cpl ***
+ !!
+ !! ** Purpose : de-allocate useless public 3d array used for ice sheet coupling
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr, ialloc
+ !!----------------------------------------------------------------------
+ ierr = 0
+ !
+ DEALLOCATE( risfcpl_ssh, risfcpl_tsc, risfcpl_vol, STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ CALL mpp_sum ( 'isf', ierr )
+ IF( ierr /= 0 ) CALL ctl_stop('STOP','isfcpl: failed to deallocate arrays.')
+ !
+ END SUBROUTINE isf_dealloc_cpl
+
+ SUBROUTINE isf_alloc()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_alloc ***
+ !!
+ !! ** Purpose : allocate array used for the ice shelf cavity (cav and par)
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr, ialloc
+ !!----------------------------------------------------------------------
+ !
+ ierr = 0 ! set to zero if no array to be allocated
+ !
+ ALLOCATE(fwfisf_par(jpi,jpj) , fwfisf_par_b(jpi,jpj), &
+ & fwfisf_cav(jpi,jpj) , fwfisf_cav_b(jpi,jpj), &
+ & fwfisf_oasis(jpi,jpj), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE(risf_par_tsc(jpi,jpj,jpts), risf_par_tsc_b(jpi,jpj,jpts), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE(risf_cav_tsc(jpi,jpj,jpts), risf_cav_tsc_b(jpi,jpj,jpts), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE(risfload(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( mskisf_cav(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ CALL mpp_sum ( 'isf', ierr )
+ IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'isf: failed to allocate arrays.' )
+ !
+ ! initalisation of fwf and tsc array to 0
+ risfload(:,:) = 0.0_wp
+ fwfisf_oasis(:,:) = 0.0_wp
+ fwfisf_par(:,:) = 0.0_wp ; fwfisf_par_b(:,:) = 0.0_wp
+ fwfisf_cav(:,:) = 0.0_wp ; fwfisf_cav_b(:,:) = 0.0_wp
+ risf_cav_tsc(:,:,:) = 0.0_wp ; risf_cav_tsc_b(:,:,:) = 0.0_wp
+ risf_par_tsc(:,:,:) = 0.0_wp ; risf_par_tsc_b(:,:,:) = 0.0_wp
+ !
+
+ END SUBROUTINE isf_alloc
+
+END MODULE isf_oce
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcav.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcav.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcav.F90 (revision 12150)
@@ -0,0 +1,233 @@
+MODULE isfcav
+ !!======================================================================
+ !! *** MODULE isfcav ***
+ !! Ice shelf cavity module : update ice shelf melting under ice
+ !! shelf
+ !!======================================================================
+ !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav
+ !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization
+ !! 4.1 ! 2019-09 (P. Mathiot) Split ice shelf cavity and ice shelf parametrisation
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isf_cav : update ice shelf melting under ice shelf
+ !!----------------------------------------------------------------------
+ USE isf_oce ! ice shelf public variables
+ !
+ USE isfrst , ONLY: isfrst_write, isfrst_read ! ice shelf restart read/write subroutine
+ USE isfutils , ONLY: debug ! ice shelf debug subroutine
+ USE isftbl , ONLY: isf_tbl ! ice shelf top boundary layer properties subroutine
+ USE isfcavmlt, ONLY: isfcav_mlt ! ice shelf melt formulation subroutine
+ USE isfcavgam, ONLY: isfcav_gammats ! ice shelf melt exchange coeficient subroutine
+ USE isfdiags , ONLY: isf_diags_flx ! ice shelf diags subroutine
+ !
+ USE oce , ONLY: ts ! ocean tracers
+ USE par_oce , ONLY: jpi,jpj ! ocean space and time domain
+ USE phycst , ONLY: grav,rau0,r1_rau0_rcp ! physical constants
+ USE eosbn2 , ONLY: ln_teos10 ! use ln_teos10 or not
+ !
+ USE in_out_manager ! I/O manager
+ USE iom ! I/O library
+ USE fldread ! read input field at current time step
+ USE lbclnk ! lbclnk
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isf_cav, isf_cav_init ! routine called in isfmlt
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE isf_cav( kt, Kmm, ptsc, pqfwf )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_cav ***
+ !!
+ !! ** Purpose : handle surface boundary condition under ice shelf
+ !!
+ !! ** Method : based on Mathiot et al. (2017)
+ !!
+ !! ** Action : - compute geometry of the Losch top bournary layer (see Losch et al. 2008)
+ !! - depending on the chooses option
+ !! - compute temperature/salt in the tbl
+ !! - compute exchange coeficient
+ !! - compute heat and fwf fluxes
+ !! - output
+ !!---------------------------------------------------------------------
+ !!-------------------------- OUT --------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(inout) :: pqfwf ! ice shelf melt (>0 out)
+ REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(inout) :: ptsc ! T & S ice shelf cavity contents
+ !!-------------------------- IN --------------------------------------
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ INTEGER, INTENT(in) :: kt ! ocean time step
+ !!---------------------------------------------------------------------
+ LOGICAL :: lit
+ INTEGER :: nit
+ REAL(wp) :: zerr
+ REAL(wp), DIMENSION(jpi,jpj) :: zqlat, zqoce, zqhc, zqh ! heat fluxes
+ REAL(wp), DIMENSION(jpi,jpj) :: zqoce_b !
+ REAL(wp), DIMENSION(jpi,jpj) :: zgammat, zgammas ! exchange coeficient
+ REAL(wp), DIMENSION(jpi,jpj) :: zttbl, zstbl ! temp. and sal. in top boundary layer
+ !!---------------------------------------------------------------------
+ !
+ ! compute T/S/U/V for the top boundary layer
+ CALL isf_tbl(Kmm, ts(:,:,:,jp_tem,Kmm), zttbl(:,:),'T', misfkt_cav, rhisf_tbl_cav, misfkb_cav, rfrac_tbl_cav )
+ CALL isf_tbl(Kmm, ts(:,:,:,jp_sal,Kmm), zstbl(:,:),'T', misfkt_cav, rhisf_tbl_cav, misfkb_cav, rfrac_tbl_cav )
+ !
+ ! output T/S/U/V for the top boundary layer
+ CALL iom_put('ttbl_cav',zttbl(:,:) * mskisf_cav(:,:))
+ CALL iom_put('stbl' ,zstbl(:,:) * mskisf_cav(:,:))
+ !
+ ! initialisation
+ IF (TRIM(cn_gammablk) == 'vel_stab' ) zqoce_b (:,:) = ptsc(:,:,jp_tem) * rau0_rcp ! last time step total heat fluxes (to speed up convergence)
+ !
+ ! compute ice shelf melting
+ nit = 1 ; lit = .TRUE.
+ DO WHILE ( lit ) ! maybe just a constant number of iteration as in blk_core is fine
+ !
+ ! compute gammat everywhere (2d)
+ ! useless if melt specified
+ IF ( TRIM(cn_isfcav_mlt) .NE. 'spe' ) THEN
+ CALL isfcav_gammats( Kmm, zttbl, zstbl, zqoce , pqfwf, &
+ & zgammat, zgammas )
+ END IF
+ !
+ ! compute tfrz, latent heat and melt (2d)
+ CALL isfcav_mlt(kt, zgammat, zgammas, zttbl, zstbl, &
+ & zqhc , zqoce, pqfwf )
+ !
+ ! define if we need to iterate
+ SELECT CASE ( cn_gammablk )
+ CASE ( 'spe','vel' )
+ ! no convergence needed
+ lit = .FALSE.
+ CASE ( 'vel_stab' )
+ ! compute error between 2 iterations
+ zerr = MAXVAL(ABS(zqoce(:,:) - zqoce_b(:,:)))
+ !
+ ! define if iteration needed
+ IF (nit >= 100) THEN ! too much iteration
+ CALL ctl_stop( 'STOP', 'isf_cav: vel_stab gamma formulation had too many iterations ...' )
+ ELSE IF ( zerr <= 0.01_wp ) THEN ! convergence is achieve
+ lit = .FALSE.
+ ELSE ! converge is not yet achieve
+ nit = nit + 1
+ zqoce_b(:,:) = zqoce(:,:)
+ END IF
+ END SELECT
+ !
+ END DO
+ !
+ ! compute heat and water flux ( > 0 out )
+ pqfwf(:,:) = pqfwf(:,:) * mskisf_cav(:,:)
+ zqoce(:,:) = zqoce(:,:) * mskisf_cav(:,:)
+ zqhc (:,:) = zqhc(:,:) * mskisf_cav(:,:)
+ !
+ ! compute heat content flux ( > 0 out )
+ zqlat(:,:) = - pqfwf(:,:) * rLfusisf ! 2d latent heat flux (W/m2)
+ !
+ ! total heat flux ( >0 out )
+ zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) )
+ !
+ ! lbclnk on melt
+ CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1., pqfwf, 'T', 1.)
+ !
+ ! output fluxes
+ CALL isf_diags_flx( Kmm, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, 'cav', pqfwf, zqoce, zqlat, zqhc)
+ !
+ ! set temperature content
+ ptsc(:,:,jp_tem) = - zqh(:,:) * r1_rau0_rcp
+ !
+ ! write restart variables (qoceisf, qhcisf, fwfisf for now and before)
+ IF (lrst_oce) CALL isfrst_write(kt, 'cav', ptsc, pqfwf)
+ !
+ IF ( ln_isfdebug ) THEN
+ CALL debug('isf_cav: ptsc T',ptsc(:,:,1))
+ CALL debug('isf_cav: ptsc S',ptsc(:,:,2))
+ CALL debug('isf_cav: pqfwf fwf',pqfwf(:,:))
+ END IF
+ !
+ END SUBROUTINE isf_cav
+
+ SUBROUTINE isf_cav_init
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_cav_init ***
+ !!
+ !! ** Purpose : initialisation of variable needed to compute melt under an ice shelf
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr
+ !!---------------------------------------------------------------------
+ !
+ !==============
+ ! 0: allocation
+ !==============
+ !
+ CALL isf_alloc_cav()
+ !
+ !==================
+ ! 1: initialisation
+ !==================
+ !
+ ! top and bottom level of the 'top boundary layer'
+ misfkt_cav(:,:) = mikt(:,:) ; misfkb_cav(:,:) = 1
+ !
+ ! thickness of 'tbl' and fraction of bottom cell affected by 'tbl'
+ rhisf_tbl_cav(:,:) = 0.0_wp ; rfrac_tbl_cav(:,:) = 0.0_wp
+ !
+ ! cavity mask
+ mskisf_cav(:,:) = (1._wp - tmask(:,:,1)) * ssmask(:,:)
+ !
+ !================
+ ! 2: read restart
+ !================
+ !
+ ! read cav variable from restart
+ IF ( ln_rstart ) CALL isfrst_read('cav', risf_cav_tsc, fwfisf_cav, risf_cav_tsc_b, fwfisf_cav_b)
+ !
+ !==========================================
+ ! 3: specific allocation and initialisation (depending of scheme choice)
+ !==========================================
+ !
+ SELECT CASE ( TRIM(cn_isfcav_mlt) )
+ CASE( 'spe' )
+
+ ALLOCATE( sf_isfcav_fwf(1), STAT=ierr )
+ ALLOCATE( sf_isfcav_fwf(1)%fnow(jpi,jpj,1), sf_isfcav_fwf(1)%fdta(jpi,jpj,1,2) )
+ CALL fld_fill( sf_isfcav_fwf, (/ sn_isfcav_fwf /), cn_isfdir, 'isf_cav_init', 'read fresh water flux isf data', 'namisf' )
+
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' ==>> The ice shelf melt inside the cavity is read from forcing files'
+
+ CASE( '2eq' )
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' ==>> The original ISOMIP melt formulation is used to compute melt under the ice shelves'
+
+ CASE( '3eq' )
+ ! coeficient for linearisation of potential tfreez
+ ! Crude approximation for pressure (but commonly used)
+ IF ( ln_teos10 ) THEN ! linearisation from Jourdain et al. (2017)
+ risf_lamb1 =-0.0564_wp
+ risf_lamb2 = 0.0773_wp
+ risf_lamb3 =-7.8633e-8 * grav * rau0
+ ELSE ! linearisation from table 4 (Asay-Davis et al., 2015)
+ risf_lamb1 =-0.0573_wp
+ risf_lamb2 = 0.0832_wp
+ risf_lamb3 =-7.5300e-8 * grav * rau0
+ ENDIF
+
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' ==>> The 3 equations melt formulation is used to compute melt under the ice shelves'
+
+ CASE DEFAULT
+ CALL ctl_stop(' cn_isfcav_mlt method unknown (spe, 2eq, 3eq), check namelist')
+ END SELECT
+ !
+ END SUBROUTINE isf_cav_init
+
+END MODULE isfcav
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcavgam.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcavgam.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcavgam.F90 (revision 12150)
@@ -0,0 +1,257 @@
+MODULE isfcavgam
+ !!======================================================================
+ !! *** MODULE isfgammats ***
+ !! Ice shelf gamma module : compute exchange coeficient at the ice/ocean interface
+ !!======================================================================
+ !! History : 4.1 ! (P. Mathiot) original
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isfcav_gammats : compute exchange coeficient gamma
+ !!----------------------------------------------------------------------
+ USE isf_oce
+ USE isfutils, ONLY: debug
+ USE isftbl , ONLY: isf_tbl
+
+ USE oce , ONLY: uu, vv, rn2 ! ocean dynamics and tracers
+ USE phycst , ONLY: grav, vkarmn ! physical constant
+ USE eosbn2 , ONLY: eos_rab ! equation of state
+ USE zdfdrg , ONLY: rCd0_top, r_ke0_top ! vertical physics: top/bottom drag coef.
+ USE iom , ONLY: iom_put !
+ USE lib_mpp , ONLY: ctl_stop
+
+ USE dom_oce ! ocean space and time domain
+ USE in_out_manager ! I/O manager
+ !
+ IMPLICIT NONE
+ !
+ PRIVATE
+ !
+ PUBLIC isfcav_gammats
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+ !
+ !!-----------------------------------------------------------------------------------------------------
+ !! PUBLIC SUBROUTINES
+ !!-----------------------------------------------------------------------------------------------------
+ !
+ SUBROUTINE isfcav_gammats( Kmm, pttbl, pstbl, pqoce, pqfwf, pgt, pgs )
+ !!----------------------------------------------------------------------
+ !! ** Purpose : compute the coefficient echange for heat and fwf flux
+ !!
+ !! ** Method : select the gamma formulation
+ !! 3 method available (cst, vel and vel_stab)
+ !!---------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pgt , pgs ! gamma t and gamma s
+ !!-------------------------- IN -------------------------------------
+ INTEGER :: Kmm ! ocean time level index
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pqoce, pqfwf ! isf heat and fwf
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pttbl, pstbl ! top boundary layer tracer
+ !!---------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) :: zutbl, zvtbl ! top boundary layer velocity
+ !!---------------------------------------------------------------------
+ !
+ !==========================================
+ ! 1.: compute velocity in the tbl if needed
+ !==========================================
+ !
+ SELECT CASE ( cn_gammablk )
+ CASE ( 'spe' )
+ ! gamma is constant (specified in namelist)
+ ! nothing to do
+ CASE ('vel', 'vel_stab')
+ ! compute velocity in tbl
+ CALL isf_tbl(Kmm, uu(:,:,:,Kmm) ,zutbl(:,:),'U', miku, rhisf_tbl_cav)
+ CALL isf_tbl(Kmm, vv(:,:,:,Kmm) ,zvtbl(:,:),'V', mikv, rhisf_tbl_cav)
+ !
+ ! mask velocity in tbl with ice shelf mask
+ zutbl(:,:) = zutbl(:,:) * mskisf_cav(:,:)
+ zvtbl(:,:) = zvtbl(:,:) * mskisf_cav(:,:)
+ !
+ ! output
+ CALL iom_put('utbl',zutbl(:,:))
+ CALL iom_put('vtbl',zvtbl(:,:))
+ CASE DEFAULT
+ CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)')
+ END SELECT
+ !
+ !==========================================
+ ! 2.: compute gamma
+ !==========================================
+ !
+ SELECT CASE ( cn_gammablk )
+ CASE ( 'spe' ) ! gamma is constant (specified in namelist)
+ pgt(:,:) = rn_gammat0
+ pgs(:,:) = rn_gammas0
+ CASE ( 'vel' ) ! gamma is proportional to u*
+ CALL gammats_vel ( zutbl, zvtbl, rCd0_top, r_ke0_top, pgt, pgs )
+ CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u*
+ CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, pgt, pgs )
+ CASE DEFAULT
+ CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)')
+ END SELECT
+ !
+ !==========================================
+ ! 3.: output and debug
+ !==========================================
+ !
+ CALL iom_put('isfgammat', pgt(:,:))
+ CALL iom_put('isfgammas', pgs(:,:))
+ !
+ IF (ln_isfdebug) THEN
+ CALL debug( 'isfcav_gam pgt:', pgt(:,:) )
+ CALL debug( 'isfcav_gam pgs:', pgs(:,:) )
+ END IF
+ !
+ END SUBROUTINE isfcav_gammats
+ !
+ !!-----------------------------------------------------------------------------------------------------
+ !! PRIVATE SUBROUTINES
+ !!-----------------------------------------------------------------------------------------------------
+ !
+ SUBROUTINE gammats_vel( putbl, pvtbl, pCd, pke2, & ! <<== in
+ & pgt, pgs ) ! ==>> out gammats [m/s]
+ !!----------------------------------------------------------------------
+ !! ** Purpose : compute the coefficient echange coefficient
+ !!
+ !! ** Method : gamma is velocity dependent ( gt= gt0 * Ustar )
+ !!
+ !! ** Reference : Asay-Davis et al., Geosci. Model Dev., 9, 2471-2497, 2016
+ !!---------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pgt, pgs ! gammat and gammas [m/s]
+ !!-------------------------- IN -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: putbl, pvtbl ! velocity in the losch top boundary layer
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pCd ! drag coefficient
+ REAL(wp), INTENT(in ) :: pke2 ! background velocity
+ !!---------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) :: zustar
+ !!---------------------------------------------------------------------
+ !
+ ! compute ustar (AD15 eq. 27)
+ zustar(:,:) = SQRT( pCd(:,:) * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) ) * mskisf_cav(:,:)
+ !
+ ! Compute gammats
+ pgt(:,:) = zustar(:,:) * rn_gammat0
+ pgs(:,:) = zustar(:,:) * rn_gammas0
+ !
+ ! output ustar
+ CALL iom_put('isfustar',zustar(:,:))
+ !
+ END SUBROUTINE gammats_vel
+
+ SUBROUTINE gammats_vel_stab( Kmm, pttbl, pstbl, putbl, pvtbl, pCd, pke2, pqoce, pqfwf, & ! <<== in
+ & pgt , pgs ) ! ==>> out gammats [m/s]
+ !!----------------------------------------------------------------------
+ !! ** Purpose : compute the coefficient echange coefficient
+ !!
+ !! ** Method : gamma is velocity dependent and stability dependent
+ !!
+ !! ** Reference : Holland and Jenkins, 1999, JPO, p1787-1800
+ !!---------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pgt, pgs ! gammat and gammas
+ !!-------------------------- IN -------------------------------------
+ INTEGER :: Kmm ! ocean time level index
+ REAL(wp), INTENT(in ) :: pke2 ! background velocity squared
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pqoce, pqfwf ! surface heat flux and fwf flux
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pCd ! drag coeficient
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: putbl, pvtbl ! velocity in the losch top boundary layer
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pttbl, pstbl ! tracer in the losch top boundary layer
+ !!---------------------------------------------------------------------
+ INTEGER :: ji, jj ! loop index
+ INTEGER :: ikt ! local integer
+ REAL(wp) :: zdku, zdkv ! U, V shear
+ REAL(wp) :: zPr, zSc, zRc ! Prandtl, Scmidth and Richardson number
+ REAL(wp) :: zmob, zmols ! Monin Obukov length, coriolis factor at T point
+ REAL(wp) :: zbuofdep, zhnu ! Bouyancy length scale, sublayer tickness
+ REAL(wp) :: zhmax ! limitation of mol
+ REAL(wp) :: zetastar ! stability parameter
+ REAL(wp) :: zgmolet, zgmoles, zgturb ! contribution of modelecular sublayer and turbulence
+ REAL(wp) :: zcoef ! temporary coef
+ REAL(wp) :: zdep
+ REAL(wp) :: zeps = 1.0e-20_wp
+ REAL(wp), PARAMETER :: zxsiN = 0.052_wp ! dimensionless constant
+ REAL(wp), PARAMETER :: znu = 1.95e-6_wp ! kinamatic viscosity of sea water (m2.s-1)
+ REAL(wp), DIMENSION(2) :: zts, zab
+ REAL(wp), DIMENSION(jpi,jpj) :: zustar ! friction velocity
+ !!---------------------------------------------------------------------
+ !
+ ! compute ustar
+ zustar(:,:) = SQRT( pCd * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) )
+ !
+ ! output ustar
+ CALL iom_put('isfustar',zustar(:,:))
+ !
+ ! compute Pr and Sc number (eq ??)
+ zPr = 13.8_wp
+ zSc = 2432.0_wp
+ !
+ ! compute gamma mole (eq ??)
+ zgmolet = 12.5_wp * zPr ** (2.0/3.0) - 6.0_wp
+ zgmoles = 12.5_wp * zSc ** (2.0/3.0) - 6.0_wp
+ !
+ ! compute gamma
+ DO ji = 2, jpi
+ DO jj = 2, jpj
+ ikt = mikt(ji,jj)
+
+ IF( zustar(ji,jj) == 0._wp ) THEN ! only for kt = 1 I think
+ pgt = rn_gammat0
+ pgs = rn_gammas0
+ ELSE
+ ! compute Rc number (as done in zdfric.F90)
+!!gm better to do it like in the new zdfric.F90 i.e. avm weighted Ri computation
+ zcoef = 0.5_wp / e3w(ji,jj,ikt+1,Kmm)
+ ! ! shear of horizontal velocity
+ zdku = zcoef * ( uu(ji-1,jj ,ikt ,Kmm) + uu(ji,jj,ikt ,Kmm) &
+ & -uu(ji-1,jj ,ikt+1,Kmm) - uu(ji,jj,ikt+1,Kmm) )
+ zdkv = zcoef * ( vv(ji ,jj-1,ikt ,Kmm) + vv(ji,jj,ikt ,Kmm) &
+ & -vv(ji ,jj-1,ikt+1,Kmm) - vv(ji,jj,ikt+1,Kmm) )
+ ! ! richardson number (minimum value set to zero)
+ zRc = MAX(rn2(ji,jj,ikt+1), 0._wp) / MAX( zdku*zdku + zdkv*zdkv, zeps )
+
+ ! compute bouyancy
+ zts(jp_tem) = pttbl(ji,jj)
+ zts(jp_sal) = pstbl(ji,jj)
+ zdep = gdepw(ji,jj,ikt,Kmm)
+ !
+ CALL eos_rab( zts, zdep, zab, Kmm )
+ !
+ ! compute length scale (Eq ??)
+ zbuofdep = grav * ( zab(jp_tem) * pqoce(ji,jj) - zab(jp_sal) * pqfwf(ji,jj) )
+ !
+ ! compute Monin Obukov Length
+ ! Maximum boundary layer depth (Eq ??)
+ zhmax = gdept(ji,jj,mbkt(ji,jj),Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) -0.001_wp
+ !
+ ! Compute Monin obukhov length scale at the surface and Ekman depth: (Eq ??)
+ zmob = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps))
+ zmols = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt)
+ !
+ ! compute eta* (stability parameter) (Eq ??)
+ zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff_f(ji,jj)) * zmols * zRc ), 0._wp)))
+ !
+ ! compute the sublayer thickness (Eq ??)
+ zhnu = 5 * znu / zustar(ji,jj)
+ !
+ ! compute gamma turb (Eq ??)
+ zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff_f(ji,jj)) * zhnu )) &
+ & + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn
+ !
+ ! compute gammats
+ pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet)
+ pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles)
+ END IF
+ END DO
+ END DO
+
+ END SUBROUTINE gammats_vel_stab
+
+END MODULE isfcavgam
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcavmlt.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcavmlt.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcavmlt.F90 (revision 12150)
@@ -0,0 +1,310 @@
+MODULE isfcavmlt
+ !!======================================================================
+ !! *** MODULE isfcavmlt ***
+ !! ice shelf module : update surface ocean boundary condition under ice
+ !! shelves
+ !!======================================================================
+ !! History : 4.0 ! 2019-09 (P. Mathiot) Original code
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isfcav_mlt : compute or read ice shelf fwf/heat fluxes in the ice shelf cavity
+ !!----------------------------------------------------------------------
+
+ USE isf_oce ! ice shelf
+ USE isftbl , ONLY: isf_tbl ! ice shelf depth average
+ USE isfutils,ONLY: debug ! debug subroutine
+
+ USE dom_oce ! ocean space and time domain
+ USE phycst , ONLY: rcp, rau0, rau0_rcp ! physical constants
+ USE eosbn2 , ONLY: eos_fzp ! equation of state
+
+ USE in_out_manager ! I/O manager
+ USE iom , ONLY: iom_put ! I/O library
+ USE fldread , ONLY: fld_read, FLD, FLD_N !
+ USE lib_fortran, ONLY: glob_sum !
+ USE lib_mpp , ONLY: ctl_stop !
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC isfcav_mlt
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+! -------------------------------------------------------------------------------------------------------
+! -------------------------------- PUBLIC SUBROUTINE ----------------------------------------------------
+! -------------------------------------------------------------------------------------------------------
+
+ SUBROUTINE isfcav_mlt(kt, pgt, pgs , pttbl, pstbl, &
+ & pqhc, pqoce, pqfwf )
+ !!----------------------------------------------------------------------
+ !!
+ !! *** ROUTINE isfcav_mlt ***
+ !!
+ !! ** Purpose : compute or read ice shelf fwf/heat fluxes in the ice shelf cavity
+ !!
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pqhc, pqoce, pqfwf ! heat and fwf fluxes
+ !!-------------------------- IN -------------------------------------
+ INTEGER, INTENT(in) :: kt
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pgt , pgs ! gamma t and gamma s
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pttbl, pstbl ! top boundary layer tracer
+ !!---------------------------------------------------------------------
+ !
+ ! compute latent heat and melt (2d)
+ SELECT CASE ( cn_isfcav_mlt )
+ CASE ( 'spe' ) ! ice shelf melt specified (read input file, and heat fluxes derived from
+ CALL isfcav_mlt_spe( kt, pstbl, &
+ & pqhc, pqoce, pqfwf )
+ CASE ( '2eq' ) ! ISOMIP formulation (2 equations) for volume flux (Hunter et al., 2006)
+ CALL isfcav_mlt_2eq( pgt, pttbl, pstbl, &
+ & pqhc , pqoce, pqfwf )
+ CASE ( '3eq' ) ! ISOMIP+ formulation (3 equations) for volume flux (Asay-Davis et al., 2015)
+ CALL isfcav_mlt_3eq( pgt, pgs , pttbl, pstbl, &
+ & pqhc, pqoce, pqfwf )
+ CASE ( 'oasis' ) ! fwf pass trough oasis
+ CALL isfcav_mlt_oasis( kt, pstbl, &
+ & pqhc, pqoce, pqfwf )
+ CASE DEFAULT
+ CALL ctl_stop('STOP', 'unknown isf melt formulation : cn_isfcav (should not see this)')
+ END SELECT
+ !
+ IF (ln_isfdebug) THEN
+ CALL debug( 'isfcav_mlt qhc :', pqhc (:,:) )
+ CALL debug( 'isfcav_mlt qoce :', pqoce(:,:) )
+ CALL debug( 'isfcav_mlt qfwf :', pqfwf(:,:) )
+ END IF
+ !
+ END SUBROUTINE isfcav_mlt
+
+! -------------------------------------------------------------------------------------------------------
+! -------------------------------- PRIVATE SUBROUTINE ---------------------------------------------------
+! -------------------------------------------------------------------------------------------------------
+
+ SUBROUTINE isfcav_mlt_spe(kt, pstbl, & ! <<== in
+ & pqhc , pqoce, pqfwf ) ! ==>> out
+ !!----------------------------------------------------------------------
+ !!
+ !! *** ROUTINE isfcav_mlt_spe ***
+ !!
+ !! ** Purpose : - read ice shelf melt from forcing file
+ !! - compute ocea-ice heat flux (assuming it is equal to latent heat)
+ !! - compute heat content flux
+ !!---------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pqhc, pqoce, pqfwf ! heat content, latent heat and fwf fluxes
+ !!-------------------------- IN -------------------------------------
+ INTEGER , INTENT(in ) :: kt ! current time step
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pstbl ! salinity in tbl
+ !!--------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) :: ztfrz ! tbl freezing temperature
+ !!--------------------------------------------------------------------
+ !
+ ! Compute freezing temperature
+ CALL eos_fzp( pstbl(:,:), ztfrz(:,:), risfdep(:,:) )
+ !
+ ! read input file
+ CALL fld_read ( kt, 1, sf_isfcav_fwf )
+ !
+ ! define fwf and qoce
+ ! ocean heat flux is assume to be equal to the latent heat
+ pqfwf(:,:) = - sf_isfcav_fwf(1)%fnow(:,:,1) ! fwf ( >0 out)
+ pqoce(:,:) = - pqfwf(:,:) * rLfusisf ! ocean heat flux ( >0 out)
+ pqhc (:,:) = pqfwf(:,:) * ztfrz(:,:) * rcp ! heat content flux ( >0 out)
+ !
+ ! output freezing point at the interface
+ CALL iom_put('isftfrz_cav', ztfrz )
+ !
+ END SUBROUTINE isfcav_mlt_spe
+
+ SUBROUTINE isfcav_mlt_2eq(pgt , pttbl, pstbl, & ! <<== in
+ & pqhc, pqoce, pqfwf ) ! ==>> out
+ !!----------------------------------------------------------------------
+ !!
+ !! *** ROUTINE isfcav_mlt_2eq ***
+ !!
+ !! ** Purpose : Compute ice shelf fwf/heqt fluxes using ISOMIP formulation (Hunter et al., 2006)
+ !!
+ !! ** Method : The ice shelf melt latent heat is defined as being equal to the ocean/ice heat flux.
+ !! From this we can derived the fwf, ocean/ice heat flux and the heat content flux as being :
+ !! qfwf = Gammat * Rau0 * Cp * ( Tw - Tfrz ) / Lf
+ !! qhoce = qlat
+ !! qhc = qfwf * Cp * Tfrz
+ !!
+ !! ** Reference : Hunter, J. R.: Specification for test models of ice shelf cavities,
+ !! Tech. Rep. June, Antarctic Climate & Ecosystems Cooperative Research Centre, available at:
+ !! http://staff.acecrc.org.au/~bkgalton/ISOMIP/test_cavities.pdf (last access: 21 July 2016), 2006.
+ !!
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pqhc, pqoce, pqfwf ! hean content, ocean-ice heat and fwf fluxes
+ !!-------------------------- IN -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pgt ! temperature exchange coeficient
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pttbl, pstbl ! temperature and salinity in top boundary layer
+ !!--------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) :: ztfrz ! freezing temperature
+ REAL(wp), DIMENSION(jpi,jpj) :: zthd ! thermal driving
+ !!--------------------------------------------------------------------
+ !
+ ! Calculate freezing temperature
+ CALL eos_fzp( pstbl(:,:), ztfrz(:,:), risfdep(:,:) )
+ !
+ ! thermal driving
+ zthd (:,:) = ( pttbl(:,:) - ztfrz(:,:) ) * mskisf_cav(:,:)
+ !
+ ! compute ocean-ice heat flux and then derive fwf assuming that ocean heat flux equal latent heat
+ pqfwf(:,:) = - pgt(:,:) * rau0_rcp * zthd(:,:) / rLfusisf ! fresh water flux ( > 0 out )
+ pqoce(:,:) = - pqfwf(:,:) * rLfusisf ! ocea-ice flux ( > 0 out )
+ pqhc (:,:) = pqfwf(:,:) * ztfrz(:,:) * rcp ! heat content flux ( > 0 out )
+ !
+ ! output thermal driving and freezinpoint at the ice shelf interface
+ CALL iom_put('isfthermald_cav', zthd )
+ CALL iom_put('isftfrz_cav' , ztfrz )
+ !
+ END SUBROUTINE isfcav_mlt_2eq
+
+ SUBROUTINE isfcav_mlt_3eq(pgt, pgs , pttbl, pstbl, & ! <<== in
+ & pqhc, pqoce, pqfwf ) ! ==>> out
+ !!----------------------------------------------------------------------
+ !!
+ !! *** ROUTINE isfcav_mlt_3eq ***
+ !!
+ !! ** Purpose : Compute ice shelf fwf/heqt fluxes using the 3 equation formulation
+ !!
+ !! ** Method : The melt rate is determined considering the heat balance, the salt balance
+ !! at the phase change interface and a linearisation of the equation of state.
+ !!
+ !! ** Reference : - Holland, D. M. and Jenkins, A.,
+ !! Modeling Thermodynamic Ice-Ocean Interactions at the Base of an Ice Shelf,
+ !! J. Phys. Oceanogr., 29, 1999.
+ !! - Asay-Davis, X. S., Cornford, S. L., Durand, G., Galton-Fenzi, B. K., Gladstone,
+ !! R. M., Gudmundsson, G. H., Hattermann, T., Holland, D. M., Holland, D., Holland,
+ !! P. R., Martin, D. F., Mathiot, P., Pattyn, F., and Seroussi, H.:
+ !! Experimental design for three interrelated marine ice sheet and ocean model intercomparison projects:
+ !! MISMIP v. 3 (MISMIP +), ISOMIP v. 2 (ISOMIP +) and MISOMIP v. 1 (MISOMIP1),
+ !! Geosci. Model Dev., 9, 2471-2497, https://doi.org/10.5194/gmd-9-2471-2016, 2016.
+ !!
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pqhc, pqoce, pqfwf ! latent heat and fwf fluxes
+ !!-------------------------- IN -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pgt , pgs ! heat/salt exchange coeficient
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pttbl, pstbl ! mean temperature and salinity in top boundary layer
+ !!--------------------------------------------------------------------
+ REAL(wp) :: zeps1,zeps2,zeps3,zeps4,zeps6,zeps7 ! dummy local scalar for quadratic equation resolution
+ REAL(wp) :: zaqe,zbqe,zcqe,zaqer,zdis,zsfrz,zcfac ! dummy local scalar for quadratic equation resolution
+ REAL(wp) :: zeps = 1.e-20
+ REAL(wp), DIMENSION(jpi,jpj) :: ztfrz ! freezing point
+ REAL(wp), DIMENSION(jpi,jpj) :: zqcon ! conductive flux through the ice shelf
+ REAL(wp), DIMENSION(jpi,jpj) :: zthd ! thermal driving
+ !
+ INTEGER :: ji, jj ! dummy loop indices
+ !!--------------------------------------------------------------------
+ !
+ ! compute upward heat flux zhtflx and upward water flux zwflx
+ ! Resolution of a 3d equation from equation 24, 25 and 26 (note conduction through the ice has been added to Eq 24)
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ !
+ ! compute coeficient to solve the 2nd order equation
+ zeps1 = rau0_rcp * pgt(ji,jj)
+ zeps2 = rLfusisf * rau0 * pgs(ji,jj)
+ zeps3 = rhoisf * rcpisf * rkappa / MAX(risfdep(ji,jj),zeps)
+ zeps4 = risf_lamb2 + risf_lamb3 * risfdep(ji,jj)
+ zeps6 = zeps4 - pttbl(ji,jj)
+ zeps7 = zeps4 - rtsurf
+ !
+ ! solve the 2nd order equation to find zsfrz
+ zaqe = risf_lamb1 * (zeps1 + zeps3)
+ zaqer = 0.5_wp / MIN(zaqe,-zeps)
+ zbqe = zeps1 * zeps6 + zeps3 * zeps7 - zeps2
+ zcqe = zeps2 * pstbl(ji,jj)
+ zdis = zbqe * zbqe - 4.0_wp * zaqe * zcqe
+ !
+ ! Presumably zdis can never be negative because gammas is very small compared to gammat
+ zsfrz=(-zbqe - SQRT(zdis)) * zaqer
+ IF ( zsfrz < 0.0_wp ) zsfrz=(-zbqe + SQRT(zdis)) * zaqer ! check this if this if is needed
+ !
+ ! compute t freeze (eq. 25)
+ ztfrz(ji,jj) = zeps4 + risf_lamb1 * zsfrz
+ !
+ ! thermal driving
+ zthd(ji,jj) = ( pttbl(ji,jj) - ztfrz(ji,jj) )
+ !
+ ! compute the upward water and heat flux (eq. 24 and eq. 26)
+ pqfwf(ji,jj) = rau0 * pgs(ji,jj) * ( zsfrz - pstbl(ji,jj) ) / MAX(zsfrz,zeps) ! fresh water flux (> 0 out)
+ pqoce(ji,jj) = rau0_rcp * pgt(ji,jj) * zthd (ji,jj) ! ocean-ice heat flux (> 0 out)
+ pqhc (ji,jj) = rcp * pqfwf(ji,jj) * ztfrz(ji,jj) ! heat content flux (> 0 out)
+ !
+ zqcon(ji,jj) = zeps3 * ( ztfrz(ji,jj) - rtsurf )
+ !
+ END DO
+ END DO
+ !
+ ! output conductive heat flux through the ice
+ CALL iom_put('qconisf', zqcon(:,:) * mskisf_cav(:,:) )
+ !
+ ! output thermal driving and freezing point at the interface
+ CALL iom_put('isfthermald_cav', zthd (:,:) * mskisf_cav(:,:) )
+ CALL iom_put('isftfrz_cav' , ztfrz(:,:) * mskisf_cav(:,:) )
+ !
+ END SUBROUTINE isfcav_mlt_3eq
+
+ SUBROUTINE isfcav_mlt_oasis(kt, pstbl, & ! <<== in
+ & pqhc , pqoce, pqfwf ) ! ==>> out
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE isfcav_mlt_oasis ***
+ !!
+ !! ** Purpose : scale the fwf read from input file by the total amount received by the sbccpl interface
+ !!
+ !! ** Purpose : - read ice shelf melt from forcing file => pattern
+ !! - total amount of fwf is given by sbccpl (fwfisf_cpl)
+ !! - scale fwf and compute heat fluxes
+ !!
+ !!---------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pqhc, pqoce, pqfwf ! heat content, latent heat and fwf fluxes
+ !!-------------------------- IN -------------------------------------
+ INTEGER , INTENT(in ) :: kt ! current time step
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pstbl ! salinity in tbl
+ !!--------------------------------------------------------------------
+ REAL(wp) :: zfwf_fld, zfwf_oasis ! total fwf in the forcing fields (pattern) and from the oasis interface (amount)
+ REAL(wp), DIMENSION(jpi,jpj) :: ztfrz ! tbl freezing temperature
+ REAL(wp), DIMENSION(jpi,jpj) :: zfwf ! 2d fwf map after scaling
+ !!--------------------------------------------------------------------
+ !
+ ! Calculate freezing temperature
+ CALL eos_fzp( pstbl(:,:), ztfrz(:,:), risfdep(:,:) )
+ !
+ ! read input file
+ CALL fld_read ( kt, 1, sf_isfcav_fwf )
+ !
+ ! ice shelf 2d map
+ zfwf(:,:) = - sf_isfcav_fwf(1)%fnow(:,:,1)
+ !
+ ! compute glob sum from input file
+ ! (PM) should consider delay sum as in fwb (1 time step offset if I well understood)
+ zfwf_fld = glob_sum('isfcav_mlt', e1e2t(:,:) * zfwf(:,:))
+ !
+ ! compute glob sum from atm->oce ice shelf fwf
+ ! (PM) should consider delay sum as in fwb (1 time step offset if I well understood)
+ zfwf_oasis = glob_sum('isfcav_mlt', e1e2t(:,:) * fwfisf_oasis(:,:))
+ !
+ ! scale fwf
+ zfwf(:,:) = zfwf(:,:) * zfwf_oasis / zfwf_fld
+ !
+ ! define fwf and qoce
+ ! ocean heat flux is assume to be equal to the latent heat
+ pqfwf(:,:) = zfwf(:,:) ! fwf ( >0 out)
+ pqoce(:,:) = - pqfwf(:,:) * rLfusisf ! ocean heat flux ( >0 out)
+ pqhc (:,:) = pqfwf(:,:) * ztfrz(:,:) * rcp ! heat content flux ( >0 out)
+ !
+ CALL iom_put('isftfrz_cav', ztfrz * mskisf_cav(:,:) )
+ !
+ END SUBROUTINE isfcav_mlt_oasis
+
+END MODULE isfcavmlt
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcpl.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcpl.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfcpl.F90 (revision 12150)
@@ -0,0 +1,759 @@
+MODULE isfcpl
+ !!======================================================================
+ !! *** MODULE isfcpl ***
+ !!
+ !! iceshelf coupling module : module managing the coupling between NEMO and an ice sheet model
+ !!
+ !!======================================================================
+ !! History : 4.1 ! 2019-07 (P. Mathiot) Original code
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isfrst : read/write iceshelf variables in/from restart
+ !!----------------------------------------------------------------------
+ USE isf_oce ! ice shelf variable
+ USE isfutils, ONLY : debug
+ USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine
+ USE domvvl , ONLY: dom_vvl_zgr ! vertical scale factor interpolation
+ !
+ USE oce ! ocean dynamics and tracers
+ USE in_out_manager ! I/O manager
+ USE iom ! I/O library
+ !
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isfcpl_rst_write, isfcpl_init ! iceshelf restart read and write
+ PUBLIC isfcpl_ssh, isfcpl_tra, isfcpl_vol, isfcpl_cons ! iceshelf correction for ssh, tra, dyn and conservation
+
+ TYPE isfcons
+ INTEGER :: ii ! i global
+ INTEGER :: jj ! j global
+ INTEGER :: kk ! k level
+ REAL(wp):: dvol ! volume increment
+ REAL(wp):: dsal ! salt increment
+ REAL(wp):: dtem ! heat increment
+ REAL(wp):: lon ! lon
+ REAL(wp):: lat ! lat
+ INTEGER :: ngb ! 0/1 (valid location or not (ie on halo or no neigbourg))
+ END TYPE
+ !
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+ SUBROUTINE isfcpl_init(Kbb, Kmm, Kaa)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE iscpl_init ***
+ !!
+ !! ** Purpose : correct ocean state for new wet cell and horizontal divergence
+ !! correction for the dynamical adjustement
+ !!
+ !! ** Action : - compute ssh on new wet cell
+ !! - compute T/S on new wet cell
+ !! - compute horizontal divergence correction as a volume flux
+ !! - compute the T/S/vol correction increment to keep trend to 0
+ !!
+ !!---------------------------------------------------------------------
+ INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
+ !!---------------------------------------------------------------------
+ INTEGER :: id
+ !!----------------------------------------------------------------------
+ !
+ ! start on an euler time step
+ neuler = 0
+ !
+ ! allocation and initialisation to 0
+ CALL isf_alloc_cpl()
+ !
+ ! check presence of variable needed for coupling
+ ! iom_varid return 0 if not found
+ id = 1
+ id = id * iom_varid(numror, 'ssmask', ldstop = .false.)
+ id = id * iom_varid(numror, 'tmask' , ldstop = .false.)
+ id = id * iom_varid(numror, 'e3t_n' , ldstop = .false.)
+ id = id * iom_varid(numror, 'e3u_n' , ldstop = .false.)
+ id = id * iom_varid(numror, 'e3v_n' , ldstop = .false.)
+ IF(lwp) WRITE(numout,*) ' isfcpl_init:', id
+ IF (id == 0) THEN
+ IF(lwp) WRITE(numout,*) ' isfcpl_init: restart variables for ice sheet coupling are missing, skip coupling for this leg '
+ IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
+ IF(lwp) WRITE(numout,*) ''
+ ELSE
+ ! extrapolation ssh
+ CALL isfcpl_ssh(Kbb, Kmm, Kaa)
+ !
+ ! extrapolation tracer properties
+ CALL isfcpl_tra(Kmm)
+ !
+ ! correction of the horizontal divergence and associated temp. and salt content flux
+ ! Need to : - include in the cpl cons the risfcpl_vol/tsc contribution
+ ! - decide how to manage thickness level change in conservation
+ CALL isfcpl_vol(Kmm)
+ !
+ ! apply the 'conservation' method
+ IF ( ln_isfcpl_cons ) CALL isfcpl_cons(Kmm)
+ !
+ END IF
+ !
+ ! mask velocity properly (mask used in restart not compatible with new mask)
+ uu(:,:,:,Kmm) = uu(:,:,:,Kmm) * umask(:,:,:)
+ vv(:,:,:,Kmm) = vv(:,:,:,Kmm) * vmask(:,:,:)
+ !
+ ! all before fields set to now values
+ ts (:,:,:,:,Kbb) = ts (:,:,:,:,Kmm)
+ uu (:,:,:,Kbb) = uu (:,:,:,Kmm)
+ vv (:,:,:,Kbb) = vv (:,:,:,Kmm)
+ ssh (:,:,Kbb) = ssh (:,:,Kmm)
+ e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
+
+ ! prepare writing restart
+ IF( lwxios ) THEN
+ CALL iom_set_rstw_var_active('ssmask')
+ CALL iom_set_rstw_var_active('tmask')
+ CALL iom_set_rstw_var_active('e3t_n')
+ CALL iom_set_rstw_var_active('e3u_n')
+ CALL iom_set_rstw_var_active('e3v_n')
+ END IF
+ !
+ END SUBROUTINE isfcpl_init
+ !
+ SUBROUTINE isfcpl_rst_write(kt, Kmm)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE iscpl_rst_write ***
+ !!
+ !! ** Purpose : write icesheet coupling variables in restart
+ !!
+ !!-------------------------- IN --------------------------------------
+ INTEGER, INTENT(in) :: kt
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!----------------------------------------------------------------------
+ !
+ IF( lwxios ) CALL iom_swap( cwxios_context )
+ CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask , ldxios = lwxios )
+ CALL iom_rstput( kt, nitrst, numrow, 'ssmask' , ssmask, ldxios = lwxios )
+ CALL iom_rstput( kt, nitrst, numrow, 'e3t_n' , e3t(:,:,:,Kmm) , ldxios = lwxios )
+ CALL iom_rstput( kt, nitrst, numrow, 'e3u_n' , e3u(:,:,:,Kmm) , ldxios = lwxios )
+ CALL iom_rstput( kt, nitrst, numrow, 'e3v_n' , e3v(:,:,:,Kmm) , ldxios = lwxios )
+ CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw(:,:,:,Kmm) , ldxios = lwxios )
+ IF( lwxios ) CALL iom_swap( cxios_context )
+ !
+ END SUBROUTINE isfcpl_rst_write
+
+ SUBROUTINE isfcpl_ssh(Kbb, Kmm, Kaa)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE iscpl_ssh ***
+ !!
+ !! ** Purpose : basic guess of ssh in new wet cell
+ !!
+ !! ** Method : basic extrapolation from neigbourg cells
+ !!
+ !!----------------------------------------------------------------------
+ !!
+ INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
+ !!----------------------------------------------------------------------
+ INTEGER :: ji, jj, jd, jk !! loop index
+ INTEGER :: jip1, jim1, jjp1, jjm1
+ !!
+ REAL(wp):: zsummsk
+ REAL(wp), DIMENSION(jpi,jpj) :: zdssmask, zssmask0, zssmask_b, zssh
+ !!----------------------------------------------------------------------
+ !
+ CALL iom_get( numror, jpdom_autoglo, 'ssmask' , zssmask_b, ldxios = lrxios ) ! need to extrapolate T/S
+
+ ! compute new ssh if we open a full water column
+ ! rude average of the closest neigbourgs (e1e2t not taking into account)
+ !
+ zssh(:,:) = ssh(:,:,Kmm)
+ zssmask0(:,:) = zssmask_b(:,:)
+ !
+ DO jd = 1, nn_drown
+ !
+ zdssmask(:,:) = ssmask(:,:) - zssmask0(:,:)
+ DO jj = 2,jpj-1
+ DO ji = 2,jpi-1
+ jip1=ji+1; jim1=ji-1;
+ jjp1=jj+1; jjm1=jj-1;
+ !
+ zsummsk = zssmask0(jip1,jj) + zssmask0(jim1,jj) + zssmask0(ji,jjp1) + zssmask0(ji,jjm1)
+ !
+ IF (zdssmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp) THEN
+ ssh(ji,jj,Kmm)=( zssh(jip1,jj)*zssmask0(jip1,jj) &
+ & + zssh(jim1,jj)*zssmask0(jim1,jj) &
+ & + zssh(ji,jjp1)*zssmask0(ji,jjp1) &
+ & + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk
+ zssmask_b(ji,jj) = 1._wp
+ ENDIF
+ END DO
+ END DO
+ !
+ zssh(:,:) = ssh(:,:,Kmm)
+ zssmask0(:,:) = zssmask_b(:,:)
+ !
+ CALL lbc_lnk_multi( 'iscplrst', zssh, 'T', 1., zssmask0, 'T', 1. )
+ !
+ END DO
+ !
+ ! update ssh(:,:,Kmm)
+ ssh(:,:,Kmm) = zssh(:,:) * ssmask(:,:)
+ !
+ ssh(:,:,Kbb) = ssh(:,:,Kmm)
+ !
+ IF ( ln_isfdebug ) CALL debug('isfcpl_ssh: sshn',ssh(:,:,Kmm))
+ !
+ ! recompute the vertical scale factor, depth and water thickness
+ IF(lwp) write(numout,*) 'isfcpl_ssh : recompute scale factor from ssh (new wet cell,Kmm)'
+ IF(lwp) write(numout,*) '~~~~~~~~~~~'
+ DO jk = 1, jpk
+ e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) &
+ & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) &
+ & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk))
+ END DO
+ e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
+ CALL dom_vvl_zgr(Kbb, Kmm, Kaa)
+ !
+ END SUBROUTINE isfcpl_ssh
+
+ SUBROUTINE isfcpl_tra(Kmm)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE iscpl_tra ***
+ !!
+ !! ** Purpose : compute new tn, sn in case of evolving geometry of ice shelves
+ !!
+ !! ** Method : tn, sn : basic extrapolation from neigbourg cells
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b
+ !REAL(wp), DIMENSION(:,:,: ), INTENT(in ) :: pdepw_b !! depth w before
+ !!
+ INTEGER :: ji, jj, jk, jd !! loop index
+ INTEGER :: jip1, jim1, jjp1, jjm1, jkp1, jkm1
+ !!
+ REAL(wp):: zsummsk
+ REAL(wp):: zdz, zdzm1, zdzp1
+ !!
+ REAL(wp), DIMENSION(jpi,jpj) :: zdmask
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask0, zwmaskn
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask1, zwmaskb, ztmp3d
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0
+ !!----------------------------------------------------------------------
+ !
+ CALL iom_get( numror, jpdom_autoglo, 'tmask' , ztmask_b, ldxios = lrxios ) ! need to extrapolate T/S
+ !CALL iom_get( numror, jpdom_autoglo, 'wmask' , zwmask_b, ldxios = lrxios ) ! need to extrapolate T/S
+ !CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:), ldxios = lrxios ) ! need to interpol vertical profile (vvl)
+ !
+ !
+ ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask
+ !PM: Is this IF needed since change to VVL by default
+ !bugged : to be corrected (PM)
+ ! back up original t/s/mask
+ !tsb (:,:,:,:) = ts(:,:,:,:,Kmm)
+ !
+ ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask
+
+! IF (.NOT.ln_linssh) THEN
+! DO jk = 2,jpk-1
+! DO jj = 1,jpj
+! DO ji = 1,jpi
+! IF (wmask(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1._wp .AND. (tmask(ji,jj,1)==0._wp .OR. ztmask_b(ji,jj,1)==0._wp) ) THEN
+!
+! !compute weight
+! zdzp1 = MAX(0._wp,pdepw_b(ji,jj,jk+1) - gdepw(ji,jj,jk+1,Kmm))
+! zdzm1 = MAX(0._wp,gdepw(ji,jj,jk ,Kmm) - pdepw_b(ji,jj,jk ))
+! zdz = e3t(ji,jj,jk,Kmm) - zdzp1 - zdzm1 ! if isf : e3t = gdepw(ji,jj,jk+1,Kmm)- gdepw(ji,jj,jk,Kmm)
+!
+! IF (zdz .LT. 0._wp) THEN
+! CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' )
+! END IF
+!
+! ts(ji,jj,jk,jp_tem,Kmm) = ( zdzp1*ts(ji,jj,jk+1,jp_tem,Kbb) &
+! & + zdz *ts(ji,jj,jk ,jp_tem,Kbb) &
+! & + zdzm1*ts(ji,jj,jk-1,jp_tem,Kbb) )/e3t(ji,jj,jk,Kmm)
+!
+! ts(ji,jj,jk,jp_sal,Kmm) = ( zdzp1*ts(ji,jj,jk+1,jp_sal,Kbb) &
+! & + zdz *ts(ji,jj,jk ,jp_sal,Kbb) &
+! & + zdzm1*ts(ji,jj,jk-1,jp_sal,Kbb) )/e3t(ji,jj,jk,Kmm)
+!
+! END IF
+! END DO
+! END DO
+! END DO
+! END IF
+
+ zts0(:,:,:,:) = ts(:,:,:,:,Kmm)
+ ztmask0(:,:,:) = ztmask_b(:,:,:)
+ ztmask1(:,:,:) = ztmask_b(:,:,:)
+ !
+ ! iterate the extrapolation processes nn_drown times
+ DO jd = 1,nn_drown ! resolution dependent (OK for ISOMIP+ case)
+ DO jk = 1,jpk-1
+ !
+ ! define new wet cell
+ zdmask(:,:) = tmask(:,:,jk) - ztmask0(:,:,jk);
+ !
+ DO jj = 2,jpj-1
+ DO ji = 2,jpi-1
+ jip1=ji+1; jim1=ji-1;
+ jjp1=jj+1; jjm1=jj-1;
+ !
+ ! check if a wet neigbourg cell is present
+ zsummsk = ztmask0(jip1,jj ,jk) + ztmask0(jim1,jj ,jk) &
+ + ztmask0(ji ,jjp1,jk) + ztmask0(ji ,jjm1,jk)
+ !
+ ! if neigbourg wet cell available at the same level
+ IF ( zdmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp ) THEN
+ !
+ ! horizontal basic extrapolation
+ ts(ji,jj,jk,1,Kmm)=( zts0(jip1,jj ,jk,1) * ztmask0(jip1,jj ,jk) &
+ & + zts0(jim1,jj ,jk,1) * ztmask0(jim1,jj ,jk) &
+ & + zts0(ji ,jjp1,jk,1) * ztmask0(ji ,jjp1,jk) &
+ & + zts0(ji ,jjm1,jk,1) * ztmask0(ji ,jjm1,jk) ) / zsummsk
+ ts(ji,jj,jk,2,Kmm)=( zts0(jip1,jj ,jk,2) * ztmask0(jip1,jj ,jk) &
+ & + zts0(jim1,jj ,jk,2) * ztmask0(jim1,jj ,jk) &
+ & + zts0(ji ,jjp1,jk,2) * ztmask0(ji ,jjp1,jk) &
+ & + zts0(ji ,jjm1,jk,2) * ztmask0(ji ,jjm1,jk) ) / zsummsk
+ !
+ ! update mask for next pass
+ ztmask1(ji,jj,jk)=1
+ !
+ ! in case no neigbourg wet cell available at the same level
+ ! check if a wet cell is available below
+ ELSEIF (zdmask(ji,jj) == 1._wp .AND. zsummsk == 0._wp) THEN
+ !
+ ! vertical extrapolation if horizontal extrapolation failed
+ jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1)
+ !
+ ! check if a wet neigbourg cell is present
+ zsummsk = ztmask0(ji,jj,jkm1) + ztmask0(ji,jj,jkp1)
+ IF (zdmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp ) THEN
+ ts(ji,jj,jk,1,Kmm)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1) &
+ & + zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1)) / zsummsk
+ ts(ji,jj,jk,2,Kmm)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1) &
+ & + zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1)) / zsummsk
+ !
+ ! update mask for next pass
+ ztmask1(ji,jj,jk)=1._wp
+ END IF
+ END IF
+ END DO
+ END DO
+ END DO
+ !
+ ! update temperature and salinity and mask
+ zts0(:,:,:,:) = ts(:,:,:,:,Kmm)
+ ztmask0(:,:,:) = ztmask1(:,:,:)
+ !
+ CALL lbc_lnk_multi( 'iscplrst', zts0(:,:,:,jp_tem), 'T', 1., zts0(:,:,:,jp_sal), 'T', 1., ztmask0, 'T', 1.)
+ !
+ END DO ! nn_drown
+ !
+ ! mask new ts(:,:,:,:,Kmm) field
+ ts(:,:,:,jp_tem,Kmm) = zts0(:,:,:,jp_tem) * tmask(:,:,:)
+ ts(:,:,:,jp_sal,Kmm) = zts0(:,:,:,jp_sal) * tmask(:,:,:)
+ !
+ ! sanity check
+ ! -----------------------------------------------------------------------------------------
+ ! case we open a cell but no neigbour cells available to get an estimate of T and S
+ DO jk = 1,jpk-1
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ IF (tmask(ji,jj,jk) == 1._wp .AND. ts(ji,jj,jk,2,Kmm) == 0._wp) &
+ & CALL ctl_stop('STOP', 'failing to fill all new weet cell, &
+ & try increase nn_drown or activate XXXX &
+ & in your domain cfg computation' )
+ END DO
+ END DO
+ END DO
+ !
+ END SUBROUTINE isfcpl_tra
+
+ SUBROUTINE isfcpl_vol(Kmm)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE iscpl_vol ***
+ !!
+ !! ** Purpose : compute the correction of the local divergence to apply
+ !! during the first time step after the coupling.
+ !!
+ !! ** Method : - compute horizontal vol div. before/after coupling
+ !! - compute vertical input
+ !! - compute correction
+ !!
+ !!----------------------------------------------------------------------
+ !!
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!----------------------------------------------------------------------
+ INTEGER :: ji, jj, jk
+ INTEGER :: ikb, ikt
+ !!
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zqvolb, zqvoln ! vol flux div. before/after coupling
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3u_b, ze3v_b ! vertical scale factor before/after coupling
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b ! mask before coupling
+ !!----------------------------------------------------------------------
+ !
+ CALL iom_get( numror, jpdom_autoglo, 'tmask' , ztmask_b, ldxios = lrxios )
+ CALL iom_get( numror, jpdom_autoglo, 'e3u_n' , ze3u_b , ldxios = lrxios )
+ CALL iom_get( numror, jpdom_autoglo, 'e3v_n' , ze3v_b , ldxios = lrxios )
+ !
+ ! 1.0: compute horizontal volume flux divergence difference before-after coupling
+ !
+ DO jk = 1, jpk ! Horizontal slab
+ ! 1.1: get volume flux before coupling (>0 out)
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1
+ zqvolb(ji,jj,jk) = ( e2u(ji,jj) * ze3u_b(ji,jj,jk) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj ) * ze3u_b(ji-1,jj ,jk) * uu(ji-1,jj ,jk,Kmm) &
+ & + e1v(ji,jj) * ze3v_b(ji,jj,jk) * vv(ji,jj,jk,Kmm) - e1v(ji ,jj-1) * ze3v_b(ji ,jj-1,jk) * vv(ji ,jj-1,jk,Kmm) ) &
+ & * ztmask_b(ji,jj,jk)
+ END DO
+ ENDDO
+ !
+ ! 1.2: get volume flux after coupling (>0 out)
+ ! properly mask velocity
+ ! (velocity are still mask with old mask at this stage)
+ uu(:,:,jk,Kmm) = uu(:,:,jk,Kmm) * umask(:,:,jk)
+ vv(:,:,jk,Kmm) = vv(:,:,jk,Kmm) * vmask(:,:,jk)
+ ! compute volume flux divergence after coupling
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1
+ zqvoln(ji,jj,jk) = ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj ) * e3u(ji-1,jj ,jk,Kmm) * uu(ji-1,jj ,jk,Kmm) &
+ & + e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) - e1v(ji ,jj-1) * e3v(ji ,jj-1,jk,Kmm) * vv(ji ,jj-1,jk,Kmm) ) &
+ & * tmask(ji,jj,jk)
+ END DO
+ ENDDO
+ !
+ ! 1.3: get 3d volume flux difference (before - after cpl) (>0 out)
+ ! correction to add is _b - _n
+ risfcpl_vol(:,:,jk) = zqvolb(:,:,jk) - zqvoln(:,:,jk)
+ END DO
+ !
+ ! 2.0: include the contribution of the vertical velocity in the volume flux correction
+ !
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1
+ !
+ ikt = mikt(ji,jj)
+ IF ( ikt > 1 .AND. ssmask(ji,jj) == 1 ) THEN
+ risfcpl_vol(ji,jj,ikt) = risfcpl_vol(ji,jj,ikt) + SUM(zqvolb(ji,jj,1:ikt-1)) ! test sign
+ ENDIF
+ !
+ END DO
+ ENDDO
+ !
+ CALL lbc_lnk( 'iscpl', risfcpl_vol, 'T', 1. )
+ !
+ ! 3.0: set total correction (div, tr(:,:,:,:,Krhs), ssh)
+ !
+ ! 3.1: mask volume flux divergence correction
+ risfcpl_vol(:,:,:) = risfcpl_vol(:,:,:) * tmask(:,:,:)
+ !
+ ! 3.2: get 3d tr(:,:,:,:,Krhs) increment to apply at the first time step
+ ! temperature and salt content flux computed using local ts(:,:,:,:,Kmm)
+ ! (very simple advection scheme)
+ ! (>0 out)
+ risfcpl_tsc(:,:,:,jp_tem) = -risfcpl_vol(:,:,:) * ts(:,:,:,jp_tem,Kmm)
+ risfcpl_tsc(:,:,:,jp_sal) = -risfcpl_vol(:,:,:) * ts(:,:,:,jp_sal,Kmm)
+ !
+ ! 3.3: ssh correction (for dynspg_ts)
+ risfcpl_ssh(:,:) = 0.0
+ DO jk = 1,jpk
+ risfcpl_ssh(:,:) = risfcpl_ssh(:,:) + risfcpl_vol(:,:,jk) * r1_e1e2t(:,:)
+ END DO
+
+ END SUBROUTINE isfcpl_vol
+
+ SUBROUTINE isfcpl_cons(Kmm)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE iscpl_cons ***
+ !!
+ !! ** Purpose : compute the corrective increment in volume/salt/heat to put back the vol/heat/salt
+ !! removed or added during the coupling processes (wet or dry new cell)
+ !!
+ !! ** Method : - compare volume/heat/salt before and after
+ !! - look for the closest wet cells (share amoung neigbourgs if there are)
+ !! - build the correction increment to applied at each time step
+ !!
+ !!----------------------------------------------------------------------
+ !
+ TYPE(isfcons), DIMENSION(:),ALLOCATABLE :: zisfpts ! list of point receiving a correction
+ !
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!----------------------------------------------------------------------
+ INTEGER :: ji , jj , jk , jproc ! loop index
+ INTEGER :: jip1 , jim1, jjp1, jjm1 ! dummy indices
+ INTEGER :: iig , ijg, ik ! dummy indices
+ INTEGER :: jisf ! start, end and current position in the increment array
+ INTEGER :: ingb, ifind ! 0/1 target found or need to be found
+ INTEGER :: nisfl_area ! global number of cell concerned by the wet->dry case
+ INTEGER, DIMENSION(jpnij) :: nisfl ! local number of cell concerned by the wet->dry case
+ !
+ REAL(wp) :: z1_sum, z1_rdtiscpl
+ REAL(wp) :: zdtem, zdsal, zdvol, zratio ! tem, sal, vol increment
+ REAL(wp) :: zlon , zlat ! target location
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b ! mask before
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t_b ! scale factor before
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zt_b ! scale factor before
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zs_b ! scale factor before
+ !!----------------------------------------------------------------------
+
+ !==============================================================================
+ ! 1.0: initialisation
+ !==============================================================================
+
+ ! get restart variable
+ CALL iom_get( numror, jpdom_autoglo, 'tmask' , ztmask_b(:,:,:), ldxios = lrxios ) ! need to extrapolate T/S
+ CALL iom_get( numror, jpdom_autoglo, 'e3t_n' , ze3t_b(:,:,:) , ldxios = lrxios )
+ CALL iom_get( numror, jpdom_autoglo, 'tn' , zt_b(:,:,:) , ldxios = lrxios )
+ CALL iom_get( numror, jpdom_autoglo, 'sn' , zs_b(:,:,:) , ldxios = lrxios )
+
+ ! compute run length
+ nstp_iscpl = nitend - nit000 + 1
+ rdt_iscpl = nstp_iscpl * rn_rdt
+ z1_rdtiscpl = 1._wp / rdt_iscpl
+
+ IF (lwp) WRITE(numout,*) ' nb of stp for cons = ', nstp_iscpl
+ IF (lwp) WRITE(numout,*) ' coupling time step = ', rdt_iscpl
+
+ ! initialisation correction
+ risfcpl_cons_vol = 0.0
+ risfcpl_cons_ssh = 0.0
+ risfcpl_cons_tsc = 0.0
+
+ !==============================================================================
+ ! 2.0: diagnose the heat, salt and volume input and compute the correction variable
+ ! for case where we wet a cell or cell still wet (no change in cell status)
+ !==============================================================================
+
+ DO jk = 1,jpk-1
+ DO jj = nldj,nlej
+ DO ji = nldi,nlei
+
+ ! volume diff
+ zdvol = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) - ze3t_b(ji,jj,jk) * ztmask_b(ji,jj,jk)
+
+ ! heat diff
+ zdtem = ts (ji,jj,jk,jp_tem,Kmm) * e3t(ji,jj,jk,Kmm) * tmask (ji,jj,jk) &
+ - zt_b(ji,jj,jk) * ze3t_b(ji,jj,jk) * ztmask_b(ji,jj,jk)
+
+ ! salt diff
+ zdsal = ts(ji,jj,jk,jp_sal,Kmm) * e3t(ji,jj,jk,Kmm) * tmask (ji,jj,jk) &
+ - zs_b(ji,jj,jk) * ze3t_b(ji,jj,jk) * ztmask_b(ji,jj,jk)
+
+ ! volume, heat and salt differences in each cell (>0 means correction is an outward flux)
+ ! in addition to the geometry change unconservation, need to add the divergence correction as it is flux across the boundary
+ risfcpl_cons_vol(ji,jj,jk) = ( zdvol * e1e2t(ji,jj) + risfcpl_vol(ji,jj,jk) ) * z1_rdtiscpl
+ risfcpl_cons_tsc(ji,jj,jk,jp_sal) = ( - zdsal * e1e2t(ji,jj) + risfcpl_tsc(ji,jj,jk,jp_sal) ) * z1_rdtiscpl
+ risfcpl_cons_tsc(ji,jj,jk,jp_tem) = ( - zdtem * e1e2t(ji,jj) + risfcpl_tsc(ji,jj,jk,jp_tem) ) * z1_rdtiscpl
+
+ END DO
+ END DO
+ END DO
+ !
+ !==============================================================================
+ ! 3.0: diagnose the heat, salt and volume input and compute the correction variable
+ ! for case where we close a cell
+ !==============================================================================
+ !
+ ! compute the total number of point receiving a correction increment for each processor
+ ! local
+ nisfl(:)=0
+ DO jk = 1,jpk-1
+ DO jj = nldj,nlej
+ DO ji = nldi,nlei
+ jip1=MIN(ji+1,jpi) ; jim1=MAX(ji-1,1) ; jjp1=MIN(jj+1,jpj) ; jjm1=MAX(jj-1,1) ;
+ IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) nisfl(narea) = nisfl(narea) + MAX(SUM(tmask(jim1:jip1,jjm1:jjp1,jk)),1._wp)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ! global
+ CALL mpp_sum('isfcpl',nisfl )
+ !
+ ! allocate list of point receiving correction
+ ALLOCATE(zisfpts(nisfl(narea)))
+ !
+ zisfpts(:) = isfcons(0,0,0,-HUGE(1.0), -HUGE(1.0), -HUGE(1.0), -HUGE(1.0), -HUGE(1.0), 0)
+ !
+ ! start computing the correction and fill zisfpts
+ ! local
+ jisf = 0
+ DO jk = 1,jpk-1
+ DO jj = nldj,nlej
+ DO ji = nldi,nlei
+ IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN
+
+ jip1=MIN(ji+1,jpi) ; jim1=MAX(ji-1,1) ; jjp1=MIN(jj+1,jpj) ; jjm1=MAX(jj-1,1) ;
+
+ zdvol = risfcpl_cons_vol(ji,jj,jk )
+ zdsal = risfcpl_cons_tsc(ji,jj,jk,jp_sal)
+ zdtem = risfcpl_cons_tsc(ji,jj,jk,jp_tem)
+
+ IF ( SUM( tmask(jim1:jip1,jjm1:jjp1,jk) ) > 0._wp ) THEN
+ ! spread correction amoung neigbourg wet cells (horizontal direction first)
+ ! as it is a rude correction corner and lateral cell have the same weight
+ !
+ z1_sum = 1._wp / SUM( tmask(jim1:jip1,jjm1:jjp1,jk) )
+ !
+ ! lateral cells
+ IF (tmask(jip1,jj ,jk) == 1) CALL update_isfpts(zisfpts, jisf, jip1, jj , jk, zdvol, zdsal, zdtem, z1_sum)
+ IF (tmask(jim1,jj ,jk) == 1) CALL update_isfpts(zisfpts, jisf, jim1, jj , jk, zdvol, zdsal, zdtem, z1_sum)
+ IF (tmask(ji ,jjp1,jk) == 1) CALL update_isfpts(zisfpts, jisf, ji , jjp1, jk, zdvol, zdsal, zdtem, z1_sum)
+ IF (tmask(ji ,jjm1,jk) == 1) CALL update_isfpts(zisfpts, jisf, ji , jjm1, jk, zdvol, zdsal, zdtem, z1_sum)
+ !
+ ! corner cells
+ IF (tmask(jip1,jjm1,jk) == 1) CALL update_isfpts(zisfpts, jisf, jip1, jjm1, jk, zdvol, zdsal, zdtem, z1_sum)
+ IF (tmask(jim1,jjm1,jk) == 1) CALL update_isfpts(zisfpts, jisf, jim1, jjm1, jk, zdvol, zdsal, zdtem, z1_sum)
+ IF (tmask(jim1,jjp1,jk) == 1) CALL update_isfpts(zisfpts, jisf, jim1, jjp1, jk, zdvol, zdsal, zdtem, z1_sum)
+ IF (tmask(jip1,jjp1,jk) == 1) CALL update_isfpts(zisfpts, jisf, jip1, jjp1, jk, zdvol, zdsal, zdtem, z1_sum)
+ !
+ ELSE IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN
+ ! spread correction amoung neigbourg wet cells (vertical direction)
+ CALL update_isfpts(zisfpts, jisf, ji , jj , jk+1, zdvol, zdsal, zdtem, 1., 0)
+ ELSE
+ ! need to find where to put correction in later on
+ CALL update_isfpts(zisfpts, jisf, ji , jj , jk , zdvol, zdsal, zdtem, 1., 1)
+ END IF
+ END IF
+ END DO
+ END DO
+ END DO
+ !
+ ! share data among all processes because for some point we need to find the closest wet point (could be on other process)
+ DO jproc=1,jpnij
+ !
+ ! share total number of isf point treated for proc jproc
+ IF (jproc==narea) THEN
+ nisfl_area=nisfl(jproc)
+ ELSE
+ nisfl_area=0
+ END IF
+ CALL mpp_max('isfcpl',nisfl_area)
+ !
+ DO jisf = 1,nisfl_area
+ !
+ IF (jproc==narea) THEN
+ ! indices (conversion to global indices and sharing)
+ iig = zisfpts(jisf)%ii ; ijg = zisfpts(jisf)%jj ; ik = zisfpts(jisf)%kk
+ !
+ ! data
+ zdvol = zisfpts(jisf)%dvol ; zdsal = zisfpts(jisf)%dsal ; zdtem = zisfpts(jisf)%dtem
+ !
+ ! location
+ zlat = zisfpts(jisf)%lat ; zlon = zisfpts(jisf)%lon
+ !
+ ! find flag
+ ingb = zisfpts(jisf)%ngb
+ ELSE
+ iig =0 ; ijg =0 ; ik =0
+ zdvol=-HUGE(1.0) ; zdsal=-HUGE(1.0) ; zdtem=-HUGE(1.0)
+ zlat =-HUGE(1.0) ; zlon =-HUGE(1.0)
+ ingb = 0
+ END IF
+ !
+ ! share data (need synchronisation of data as get_correction call a global com)
+ CALL mpp_max('isfcpl',iig) ; CALL mpp_max('isfcpl',ijg) ; CALL mpp_max('isfcpl',ik)
+ CALL mpp_max('isfcpl',zdvol) ; CALL mpp_max('isfcpl',zdsal) ; CALL mpp_max('isfcpl',zdtem)
+ CALL mpp_max('isfcpl',zlat) ; CALL mpp_max('isfcpl',zlon)
+ CALL mpp_max('isfcpl',ingb)
+ !
+ ! fill the 3d correction array
+ CALL get_correction(iig, ijg, ik, zlon, zlat, zdvol, zdsal, zdtem, ingb)
+ END DO
+ END DO
+ !
+ !==============================================================================
+ ! 4.0: finalisation and compute ssh equivalent of the volume correction
+ !==============================================================================
+ !
+ ! mask (>0 out)
+ risfcpl_cons_vol(:,:,: ) = risfcpl_cons_vol(:,:,: ) * tmask(:,:,:)
+ risfcpl_cons_tsc(:,:,:,jp_sal) = risfcpl_cons_tsc(:,:,:,jp_sal) * tmask(:,:,:)
+ risfcpl_cons_tsc(:,:,:,jp_tem) = risfcpl_cons_tsc(:,:,:,jp_tem) * tmask(:,:,:)
+ !
+ ! add lbclnk
+ CALL lbc_lnk_multi( 'iscplrst', risfcpl_cons_tsc(:,:,:,jp_tem), 'T', 1., risfcpl_cons_tsc(:,:,:,jp_sal), 'T', 1., &
+ & risfcpl_cons_vol(:,:,:) , 'T', 1.)
+ !
+ ! ssh correction (for dynspg_ts)
+ DO jk = 1,jpk
+ risfcpl_cons_ssh(:,:) = risfcpl_cons_ssh(:,:) + risfcpl_cons_vol(:,:,jk)
+ END DO
+ risfcpl_cons_ssh(:,:) = risfcpl_cons_ssh(:,:) * r1_e1e2t(:,:)
+ !
+ END SUBROUTINE isfcpl_cons
+ !
+ SUBROUTINE update_isfpts(sisfpts, kpts, ki, kj, kk, pdvol, pdsal, pdtem, pratio, kfind)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE update_isfpts ***
+ !!
+ !! ** Purpose : if a cell become dry, we need to put the corrective increment elsewhere
+ !!
+ !! ** Action : update the list of point
+ !!
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ TYPE(isfcons), DIMENSION(:), INTENT(inout) :: sisfpts
+ INTEGER, INTENT(inout) :: kpts
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in ) :: ki, kj, kk ! target location (kfind=0)
+ ! ! or source location (kfind=1)
+ INTEGER, INTENT(in ), OPTIONAL :: kfind ! 0 target cell already found
+ ! ! 1 target to be determined
+ REAL(wp), INTENT(in ) :: pdvol, pdsal, pdtem, pratio ! vol/sal/tem increment
+ ! ! and ratio in case increment span over multiple cells.
+ !!----------------------------------------------------------------------
+ INTEGER :: ifind
+ !!----------------------------------------------------------------------
+ !
+ ! increment position
+ kpts = kpts + 1
+ !
+ ! define if we need to look for closest valid wet cell (no neighbours or neigbourg on halo)
+ IF ( PRESENT(kfind) ) THEN
+ ifind = kfind
+ ELSE
+ ifind = ( 1 - tmask_h(ki,kj) ) * tmask(ki,kj,kk)
+ END IF
+ !
+ ! update isfpts structure
+ sisfpts(kpts) = isfcons(mig(ki), mjg(kj), kk, pratio * pdvol, pratio * pdsal, pratio * pdtem, glamt(ki,kj), gphit(ki,kj), ifind )
+ !
+ END SUBROUTINE update_isfpts
+ !
+ SUBROUTINE get_correction( ki, kj, kk, plon, plat, pvolinc, psalinc, pteminc, kfind)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE get_correction ***
+ !!
+ !! ** Action : - Find the closest valid cell if needed (wet and not on the halo)
+ !! - Scale the correction depending of pratio (case where multiple wet neigbourgs)
+ !! - Fill the correction array
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in) :: ki, kj, kk, kfind ! target point indices
+ REAL(wp), INTENT(in) :: plon, plat ! target point lon/lat
+ REAL(wp), INTENT(in) :: pvolinc, pteminc,psalinc ! correction increment for vol/temp/salt
+ !!----------------------------------------------------------------------
+ INTEGER :: jj, ji, iig, ijg
+ !!----------------------------------------------------------------------
+ !
+ ! define global indice of correction location
+ iig = ki ; ijg = kj
+ IF ( kfind == 1 ) CALL dom_ngb( plon, plat, iig, ijg,'T', kk)
+ !
+ ! fill the correction array
+ DO jj = mj0(ijg),mj1(ijg)
+ DO ji = mi0(iig),mi1(iig)
+ ! correct the vol_flx and corresponding heat/salt flx in the closest cell
+ risfcpl_cons_vol(ji,jj,kk) = risfcpl_cons_vol(ji,jj,kk ) + pvolinc
+ risfcpl_cons_tsc(ji,jj,kk,jp_sal) = risfcpl_cons_tsc(ji,jj,kk,jp_sal) + psalinc
+ risfcpl_cons_tsc(ji,jj,kk,jp_tem) = risfcpl_cons_tsc(ji,jj,kk,jp_tem) + pteminc
+ END DO
+ END DO
+
+ END SUBROUTINE get_correction
+
+END MODULE isfcpl
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfdiags.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfdiags.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfdiags.F90 (revision 12150)
@@ -0,0 +1,115 @@
+MODULE isfdiags
+ !!======================================================================
+ !! *** MODULE isfdiags ***
+ !! ice shelf diagnostics module : manage the 2d and 3d flux outputs from the ice shelf module
+ !!======================================================================
+ !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav
+ !! X.X ! 2006-02 (C. Wang ) Original code bg03
+ !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! sbc_isf : update sbc under ice shelf
+ !!----------------------------------------------------------------------
+
+ USE in_out_manager ! I/O manager
+ USE dom_oce
+ USE isf_oce ! ice shelf variable
+ USE iom !
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isf_diags_flx
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+
+CONTAINS
+
+ SUBROUTINE isf_diags_flx(Kmm, ktop, kbot, phtbl, pfrac, cdisf, pqfwf, pqoce, pqlat, pqhc)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_diags_flx ***
+ !!
+ !! ** Purpose : manage the 2d and 3d flux outputs of the ice shelf module
+ !! fwf, latent heat flux, heat content flux, oce->ice heat flux
+ !!
+ !!----------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ !!-------------------------- IN -------------------------------------
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ INTEGER , DIMENSION(jpi,jpj), INTENT(in) :: ktop , kbot ! top and bottom level of the tbl
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac ! thickness of the tbl and fraction of last cell affected by the tbl
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqfwf, pqoce, pqlat, pqhc ! 2d var to map in 3d
+ CHARACTER(LEN=3), INTENT(in) :: cdisf ! parametrisation or interactive melt
+ !!---------------------------------------------------------------------
+ CHARACTER(LEN=256) :: cvarqfwf , cvarqoce , cvarqlat , cvarqhc
+ CHARACTER(LEN=256) :: cvarqfwf3d, cvarqoce3d, cvarqlat3d, cvarqhc3d
+ !!---------------------------------------------------------------------
+ !
+ ! output melt
+ cvarqfwf = 'fwfisf_'//cdisf ; cvarqfwf3d = 'fwfisf3d_'//cdisf
+ cvarqoce = 'qoceisf_'//cdisf ; cvarqoce3d = 'qoceisf3d_'//cdisf
+ cvarqlat = 'qlatisf_'//cdisf ; cvarqlat3d = 'qlatisf3d_'//cdisf
+ cvarqhc = 'qhcisf_'//cdisf ; cvarqhc3d = 'qhcisf3d_'//cdisf
+ !
+ ! output 2d melt rate, latent heat and heat content flux from the injected water
+ CALL iom_put( TRIM(cvarqfwf), pqfwf(:,:) ) ! mass flux ( >0 out )
+ CALL iom_put( TRIM(cvarqoce), pqoce(:,:) ) ! oce to ice flux ( >0 out )
+ CALL iom_put( TRIM(cvarqlat), pqlat(:,:) ) ! latent heat flux ( >0 out )
+ CALL iom_put( TRIM(cvarqhc) , pqhc (:,:) ) ! heat content flux ( >0 out )
+ !
+ ! output 3d Diagnostics
+ IF ( iom_use( TRIM(cvarqfwf3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqfwf3d) , pqfwf(:,:))
+ IF ( iom_use( TRIM(cvarqoce3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqoce3d) , pqoce(:,:))
+ IF ( iom_use( TRIM(cvarqlat3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqlat3d) , pqoce(:,:))
+ IF ( iom_use( TRIM(cvarqhc3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqhc3d) , pqhc (:,:))
+ !
+ END SUBROUTINE
+
+ SUBROUTINE isf_diags_2dto3d(Kmm, ktop, kbot, phtbl, pfrac, cdvar, pvar2d)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_diags_2dto3d ***
+ !!
+ !! ** Purpose : compute the 3d flux outputs as they are injected into NEMO
+ !! (ie uniformaly spread into the top boundary layer or parametrisation layer)
+ !!
+ !!----------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ !!-------------------------- IN -------------------------------------
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ INTEGER , DIMENSION(jpi,jpj), INTENT(in) :: ktop , kbot ! top and bottom level of the tbl
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac ! thickness of the tbl and fraction of last cell affected by the tbl
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pvar2d ! 2d var to map in 3d
+ CHARACTER(LEN=256), INTENT(in) :: cdvar
+ !!---------------------------------------------------------------------
+ INTEGER :: ji, jj, jk ! loop indices
+ INTEGER :: ikt, ikb ! top and bottom level of the tbl
+ REAL(wp), DIMENSION(jpi,jpj) :: zvar2d !
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvar3d ! 3d var to output
+ !!---------------------------------------------------------------------
+ !
+ ! compute 3d output
+ zvar2d(:,:) = pvar2d(:,:) / phtbl(:,:)
+ zvar3d(:,:,:) = 0._wp
+ !
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ ikt = ktop(ji,jj)
+ ikb = kbot(ji,jj)
+ DO jk = ikt, ikb - 1
+ zvar3d(ji,jj,jk) = zvar2d(ji,jj) * e3t(ji,jj,jk,Kmm)
+ END DO
+ zvar3d(ji,jj,ikb) = zvar2d(ji,jj) * e3t(ji,jj,ikb,Kmm) * pfrac(ji,jj)
+ END DO
+ END DO
+ !
+ CALL iom_put( TRIM(cdvar) , zvar3d(:,:,:))
+ !
+ END SUBROUTINE isf_diags_2dto3d
+
+END MODULE isfdiags
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfdynatf.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfdynatf.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfdynatf.F90 (revision 12150)
@@ -0,0 +1,94 @@
+MODULE isfdynatf
+ !!=========================================================================
+ !! *** MODULE isfnxt ***
+ !! Ice shelf update: compute the dynatf ice shelf contribution
+ !!=========================================================================
+ !! History : OPA ! 2019-09 (P. Mathiot) Original code
+ !!-------------------------------------------------------------------------
+
+ !!-------------------------------------------------------------------------
+ !! isfnxt : apply correction needed for the ice shelf to ensure conservation
+ !!-------------------------------------------------------------------------
+
+ USE isf_oce
+
+ USE phycst , ONLY: r1_rau0 ! physical constant
+ USE dom_oce, ONLY: e3t, r1_e1e2t ! time and space domain
+
+ USE in_out_manager
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isf_dynatf
+
+CONTAINS
+
+ SUBROUTINE isf_dynatf ( kt, Kmm, pe3t_f, pcoef )
+ !!--------------------------------------------------------------------
+ !! *** ROUTINE isf_dynatf ***
+ !!
+ !! ** Purpose : compute the ice shelf volume filter correction for cavity, param, ice sheet coupling case
+ !!
+ !!-------------------------- OUT -------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time step
+ INTEGER , INTENT(in ) :: Kmm ! ocean time level index
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3t_f ! time filtered scale factor to be corrected
+ !
+ REAL(wp) , INTENT(in ) :: pcoef ! atfp * rdt * r1_rau0
+ !!--------------------------------------------------------------------
+ INTEGER :: jk ! loop index
+ !!--------------------------------------------------------------------
+ !
+ ! ice shelf cavity
+ IF ( ln_isfcav_mlt ) CALL isf_dynatf_mlt(Kmm, pe3t_f, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, fwfisf_cav, fwfisf_cav_b, pcoef)
+ !
+ ! ice shelf parametrised
+ IF ( ln_isfpar_mlt ) CALL isf_dynatf_mlt(Kmm, pe3t_f, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, fwfisf_par, fwfisf_par_b, pcoef)
+ !
+ IF ( ln_isfcpl .AND. ln_rstart .AND. kt == nit000+1 ) THEN
+ DO jk = 1, jpkm1
+ pe3t_f(:,:,jk) = pe3t_f(:,:,jk) - pcoef * risfcpl_vol(:,:,jk) * r1_e1e2t(:,:)
+ END DO
+ END IF
+ !
+ END SUBROUTINE isf_dynatf
+
+ SUBROUTINE isf_dynatf_mlt ( Kmm, pe3t_f, ktop, kbot, phtbl, pfrac, pfwf, pfwf_b, pcoef )
+ !!--------------------------------------------------------------------
+ !! *** ROUTINE isf_dynatf_mlt ***
+ !!
+ !! ** Purpose : compute the ice shelf volume filter correction for cavity or param
+ !!
+ !!-------------------------- IN -------------------------------------
+ INTEGER , INTENT(in ) :: Kmm ! ocean time level index
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3t_f ! time-filtered scale factor to be corrected
+ INTEGER , DIMENSION(jpi,jpj) , INTENT(in ) :: ktop , kbot ! top and bottom level of tbl
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pfrac, phtbl ! fraction of bottom cell included in tbl, tbl thickness
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pfwf , pfwf_b ! now/before fwf
+ REAL(wp), INTENT(in ) :: pcoef ! atfp * rdt * r1_rau0
+ !!----------------------------------------------------------------------
+ INTEGER :: ji,jj,jk
+ REAL(wp), DIMENSION(jpi,jpj) :: zfwfinc
+ !!----------------------------------------------------------------------
+ !
+ ! compute fwf conservation correction
+ zfwfinc(:,:) = pcoef * ( pfwf_b(:,:) - pfwf(:,:) ) / phtbl(:,:) * r1_rau0
+ !
+ ! add the increment in the tbl
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( ktop(ji,jj) <= jk .AND. jk < kbot(ji,jj) ) THEN
+ pe3t_f(ji,jj,jk) = pe3t_f(ji,jj,jk) - zfwfinc(ji,jj) * e3t(ji,jj,jk,Kmm)
+ ELSEIF ( jk == kbot(ji,jj) ) THEN
+ pe3t_f(ji,jj,jk) = pe3t_f(ji,jj,jk) - zfwfinc(ji,jj) * e3t(ji,jj,jk,Kmm) * pfrac(ji,jj)
+ ENDIF
+ END DO
+ END DO
+ END DO
+ !
+ END SUBROUTINE isf_dynatf_mlt
+
+END MODULE isfdynatf
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfhdiv.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfhdiv.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfhdiv.F90 (revision 12150)
@@ -0,0 +1,141 @@
+MODULE isfhdiv
+ !!======================================================================
+ !! *** MODULE isfhdiv ***
+ !! ice shelf horizontal divergence module : update the horizontal divergence
+ !! with the ice shelf melt and coupling correction
+ !!======================================================================
+ !! History : 4.0 ! 2019-09 (P. Mathiot) Original code
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isf_hdiv : update the horizontal divergence with the ice shelf
+ !! melt and coupling correction
+ !!----------------------------------------------------------------------
+
+ USE isf_oce ! ice shelf
+
+ USE dom_oce ! time and space domain
+ USE phycst , ONLY: r1_rau0 ! physical constant
+ USE in_out_manager !
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isf_hdiv
+
+CONTAINS
+
+ SUBROUTINE isf_hdiv( kt, Kmm, phdiv )
+ !!----------------------------------------------------------------------
+ !! *** SUBROUTINE isf_hdiv ***
+ !!
+ !! ** Purpose : update the horizontal divergence with the ice shelf contribution
+ !! (parametrisation, explicit, ice sheet coupling conservation
+ !! increment)
+ !!
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(:,:,:), INTENT( inout ) :: phdiv ! horizontal divergence
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kt
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !
+ IF ( ln_isf ) THEN
+ !
+ ! ice shelf cavity contribution
+ IF ( ln_isfcav_mlt ) CALL isf_hdiv_mlt(misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, fwfisf_cav, fwfisf_cav_b, phdiv)
+ !
+ ! ice shelf parametrisation contribution
+ IF ( ln_isfpar_mlt ) CALL isf_hdiv_mlt(misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, fwfisf_par, fwfisf_par_b, phdiv)
+ !
+ ! ice sheet coupling contribution
+ IF ( ln_isfcpl .AND. kt /= 0 ) THEN
+ !
+ ! Dynamical stability at start up after change in under ice shelf cavity geometry is achieve by correcting the divergence.
+ ! This is achieved by applying a volume flux in order to keep the horizontal divergence after remapping
+ ! the same as at the end of the latest time step. So correction need to be apply at nit000 (euler time step) and
+ ! half of it at nit000+1 (leap frog time step).
+ IF ( kt == nit000 ) CALL isf_hdiv_cpl(Kmm, risfcpl_vol , phdiv)
+ IF ( kt == nit000+1 ) CALL isf_hdiv_cpl(Kmm, risfcpl_vol*0.5_wp, phdiv)
+ !
+ ! correct divergence every time step to remove any trend due to coupling
+ ! conservation option
+ IF ( ln_isfcpl_cons ) CALL isf_hdiv_cpl(Kmm, risfcpl_cons_vol, phdiv)
+ !
+ END IF
+ !
+ END IF
+ !
+ END SUBROUTINE isf_hdiv
+
+ SUBROUTINE isf_hdiv_mlt(ktop, kbot, phtbl, pfrac, pfwf, pfwf_b, phdiv)
+ !!----------------------------------------------------------------------
+ !! *** SUBROUTINE sbc_isf_div ***
+ !!
+ !! ** Purpose : update the horizontal divergence with the ice shelf inflow
+ !!
+ !! ** Method : pfwf is positive (outflow) and expressed as kg/m2/s
+ !! increase the divergence
+ !!
+ !! ** Action : phdivn increased by the ice shelf outflow
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv
+ !!----------------------------------------------------------------------
+ INTEGER , DIMENSION(jpi,jpj), INTENT(in ) :: ktop , kbot
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pfrac, phtbl
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pfwf , pfwf_b
+ !!----------------------------------------------------------------------
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ INTEGER :: ikt, ikb
+ REAL(wp), DIMENSION(jpi,jpj) :: zhdiv
+ !!----------------------------------------------------------------------
+ !
+ !== fwf distributed over several levels ==!
+ !
+ ! compute integrated divergence correction
+ zhdiv(:,:) = 0.5_wp * ( pfwf(:,:) + pfwf_b(:,:) ) * r1_rau0 / phtbl(:,:)
+ !
+ ! update divergence at each level affected by ice shelf top boundary layer
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ ikt = ktop(ji,jj)
+ ikb = kbot(ji,jj)
+ ! level fully include in the ice shelf boundary layer
+ DO jk = ikt, ikb - 1
+ phdiv(ji,jj,jk) = phdiv(ji,jj,jk) + zhdiv(ji,jj)
+ END DO
+ ! level partially include in ice shelf boundary layer
+ phdiv(ji,jj,ikb) = phdiv(ji,jj,ikb) + zhdiv(ji,jj) * pfrac(ji,jj)
+ END DO
+ END DO
+ !
+ END SUBROUTINE isf_hdiv_mlt
+
+ SUBROUTINE isf_hdiv_cpl(Kmm, pqvol, phdiv)
+ !!----------------------------------------------------------------------
+ !! *** SUBROUTINE isf_hdiv_cpl ***
+ !!
+ !! ** Purpose : update the horizontal divergence with the ice shelf
+ !! coupling conservation increment
+ !!
+ !! ** Method : pqvol is positive (outflow) and expressed as m3/s
+ !! increase the divergence
+ !!
+ !! ** Action : phdivn increased by the ice shelf outflow
+ !!
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pqvol
+ !!----------------------------------------------------------------------
+ INTEGER :: jk
+ !!----------------------------------------------------------------------
+ !
+ DO jk=1,jpk
+ phdiv(:,:,jk) = phdiv(:,:,jk) + pqvol(:,:,jk) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm)
+ END DO
+ !
+ END SUBROUTINE isf_hdiv_cpl
+
+END MODULE isfhdiv
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfload.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfload.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfload.F90 (revision 12150)
@@ -0,0 +1,117 @@
+MODULE isfload
+ !!======================================================================
+ !! *** MODULE isfload ***
+ !! isfload module : compute ice shelf load (needed for the hpg)
+ !!======================================================================
+ !! History : 4.1 ! 2019-09 (P. Mathiot) original code
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isfload : compute ice shelf load
+ !!----------------------------------------------------------------------
+
+ USE isf_oce, ONLY: cn_isfload, rn_isfload_T, rn_isfload_S ! ice shelf variables
+
+ USE dom_oce, ONLY: e3w, gdept, risfdep, mikt ! vertical scale factor
+ USE eosbn2 , ONLY: eos ! eos routine
+
+ USE lib_mpp, ONLY: ctl_stop ! ctl_stop routine
+ USE in_out_manager !
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isf_load
+
+CONTAINS
+
+ SUBROUTINE isf_load ( Kmm, pisfload )
+ !!--------------------------------------------------------------------
+ !! *** SUBROUTINE isf_load ***
+ !!
+ !! ** Purpose : compute the ice shelf load
+ !!
+ !!--------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pisfload
+ !!-------------------------- IN -------------------------------------
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!----------------------------------------------------------------------
+ !
+ ! quality test: ice shelf in a stratify/uniform ocean should not drive any flow.
+ ! the smaller the residual flow is, the better it is.
+ !
+ ! ice shelf cavity
+ SELECT CASE ( cn_isfload )
+ CASE ( 'uniform' )
+ CALL isf_load_uniform ( Kmm, pisfload )
+ CASE DEFAULT
+ CALL ctl_stop('STOP','method cn_isfload to compute ice shelf load does not exist (isomip), check your namelist')
+ END SELECT
+ !
+ END SUBROUTINE isf_load
+
+ SUBROUTINE isf_load_uniform( Kmm, pisfload )
+ !!--------------------------------------------------------------------
+ !! *** SUBROUTINE isf_load ***
+ !!
+ !! ** Purpose : compute the ice shelf load
+ !!
+ !! ** Method : The ice shelf is assumed to be in hydro static equilibrium
+ !! in water at -1.9 C and 34.4 PSU. Weight of the ice shelf is
+ !! integrated from top to bottom.
+ !!
+ !!--------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pisfload
+ !!-------------------------- IN -------------------------------------
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!--------------------------------------------------------------------
+ INTEGER :: ji, jj, jk
+ INTEGER :: ikt
+ REAL(wp) :: znad !
+ REAL(wp), DIMENSION(jpi,jpj) :: zrhdtop_isf ! water density displaced by the ice shelf (at the interface)
+ REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts_top ! water properties displaced by the ice shelf
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrhd ! water density displaced by the ice shelf
+ !!----------------------------------------------------------------------
+ !
+ znad = 1._wp !- To use density and not density anomaly
+ !
+ ! !- assume water displaced by the ice shelf is at T=rn_isfload_T and S=rn_isfload_S (rude)
+ zts_top(:,:,jp_tem) = rn_isfload_T ; zts_top(:,:,jp_sal) = rn_isfload_S
+ !
+ DO jk = 1, jpk !- compute density of the water displaced by the ice shelf
+ CALL eos( zts_top(:,:,:), gdept(:,:,jk,Kmm), zrhd(:,:,jk) )
+ END DO
+ !
+ ! !- compute rhd at the ice/oce interface (ice shelf side)
+ CALL eos( zts_top , risfdep, zrhdtop_isf )
+ !
+ ! !- Surface value + ice shelf gradient
+ pisfload(:,:) = 0._wp ! compute pressure due to ice shelf load
+ DO jj = 1, jpj ! (used to compute hpgi/j for all the level from 1 to miku/v)
+ DO ji = 1, jpi ! divided by 2 later
+ ikt = mikt(ji,jj)
+ !
+ IF ( ikt > 1 ) THEN
+ !
+ ! top layer of the ice shelf
+ pisfload(ji,jj) = pisfload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w(ji,jj,1,Kmm)
+ !
+ ! core layers of the ice shelf
+ DO jk = 2, ikt-1
+ pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w(ji,jj,jk,Kmm)
+ END DO
+ !
+ ! deepest part of the ice shelf (between deepest T point and ice/ocean interface
+ pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) &
+ & * ( risfdep(ji,jj) - gdept(ji,jj,ikt-1,Kmm) )
+ !
+ END IF
+ END DO
+ END DO
+ !
+ END SUBROUTINE isf_load_uniform
+
+END MODULE isfload
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfpar.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfpar.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfpar.F90 (revision 12150)
@@ -0,0 +1,186 @@
+MODULE isfpar
+ !!======================================================================
+ !! *** MODULE isfpar ***
+ !! ice shelf module : update ocean boundary condition under ice
+ !! shelf
+ !!======================================================================
+ !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav
+ !! X.X ! 2006-02 (C. Wang ) Original code bg03
+ !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization
+ !! 4.1 ! 2019-09 (P. Mathiot) Restructuration
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isfpar : compute ice shelf melt using a prametrisation of ice shelf cavities
+ !!----------------------------------------------------------------------
+ USE isf_oce ! ice shelf
+ !
+ USE isfrst , ONLY: isfrst_write, isfrst_read ! ice shelf restart read/write subroutine
+ USE isftbl , ONLY: isf_tbl_ktop, isf_tbl_lvl ! ice shelf top boundary layer properties subroutine
+ USE isfparmlt, ONLY: isfpar_mlt ! ice shelf melt formulation subroutine
+ USE isfdiags , ONLY: isf_diags_flx ! ice shelf diags subroutine
+ USE isfutils , ONLY: debug, read_2dcstdta ! ice shelf debug subroutine
+ !
+ USE dom_oce , ONLY: bathy ! ocean space and time domain
+ USE par_oce , ONLY: jpi,jpj ! ocean space and time domain
+ USE phycst , ONLY: r1_rau0_rcp ! physical constants
+ !
+ USE in_out_manager ! I/O manager
+ USE iom ! I/O library
+ USE fldread ! read input field at current time step
+ USE lbclnk ! lbc_lnk
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC isf_par, isf_par_init
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE isf_par( kt, Kmm, ptsc, pqfwf )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_par ***
+ !!
+ !! ** Purpose : compute the heat and fresh water due to ice shelf melting/freezing using a parametrisation
+ !!
+ !! ** Comment : in isf_par and all its call tree,
+ !! 'tbl' means parametrisation layer (ie how the far field temperature/salinity is computed)
+ !! instead of in a proper top boundary layer as at the ice shelf ocean interface
+ !! as the action to compute the properties of the tbl or the parametrisation layer are the same,
+ !! (ie average T/S over a specific depth (can be across multiple levels))
+ !! the name tbl was kept.
+ !!
+ !!---------------------------------------------------------------------
+ !!-------------------------- OUT --------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(inout) :: pqfwf
+ REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(inout) :: ptsc
+ !!-------------------------- IN --------------------------------------
+ INTEGER, INTENT(in) :: kt ! ocean time step
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!---------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) :: zqoce, zqhc, zqlat, zqh
+ !!---------------------------------------------------------------------
+ !
+ ! compute heat content, latent heat and melt fluxes (2d)
+ CALL isfpar_mlt( kt, Kmm, zqhc, zqoce, pqfwf )
+ !
+ ! compute heat and water flux ( > 0 out )
+ pqfwf(:,:) = pqfwf(:,:) * mskisf_par(:,:)
+ zqoce(:,:) = zqoce(:,:) * mskisf_par(:,:)
+ zqhc (:,:) = zqhc(:,:) * mskisf_par(:,:)
+ !
+ ! compute heat content flux ( > 0 out )
+ zqlat(:,:) = pqfwf(:,:) * rLfusisf ! 2d latent heat flux (W/m2)
+ !
+ ! total heat flux ( > 0 out )
+ zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) )
+ !
+ ! lbclnk on melt and heat fluxes
+ CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1., pqfwf, 'T', 1.)
+ !
+ ! output fluxes
+ CALL isf_diags_flx( Kmm, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, 'par', pqfwf, zqoce, zqlat, zqhc)
+ !
+ ! set temperature content
+ ptsc(:,:,jp_tem) = zqh(:,:) * r1_rau0_rcp
+ !
+ ! write restart variables (qoceisf, qhcisf, fwfisf for now and before)
+ IF (lrst_oce) CALL isfrst_write(kt, 'par', ptsc, pqfwf)
+ !
+ IF ( ln_isfdebug ) THEN
+ CALL debug('isf_par: ptsc T',ptsc(:,:,1))
+ CALL debug('isf_par: ptsc S',ptsc(:,:,2))
+ CALL debug('isf_par: pqfwf fwf',pqfwf(:,:))
+ END IF
+ !
+ END SUBROUTINE isf_par
+
+ SUBROUTINE isf_par_init
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_par_init ***
+ !!
+ !! ** Purpose : initialisation of the variable needed for the parametrisation of ice shelf melt
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr
+ REAL(wp), DIMENSION(jpi,jpj) :: ztblmax, ztblmin
+ !!----------------------------------------------------------------------
+ !
+ ! allocation
+ CALL isf_alloc_par()
+ !
+ ! initialisation
+ misfkt_par(:,:) = 1 ; misfkb_par(:,:) = 1
+ rhisf_tbl_par(:,:) = 1e-20 ; rfrac_tbl_par(:,:) = 0.0_wp
+ !
+ ! define isf tbl tickness, top and bottom indice
+ CALL read_2dcstdta(TRIM(sn_isfpar_zmax%clname), TRIM(sn_isfpar_zmax%clvar), ztblmax)
+ CALL read_2dcstdta(TRIM(sn_isfpar_zmin%clname), TRIM(sn_isfpar_zmin%clvar), ztblmin)
+ !
+ ! mask ice shelf parametrisation location
+ ztblmax(:,:) = ztblmax(:,:) * ssmask(:,:)
+ ztblmin(:,:) = ztblmin(:,:) * ssmask(:,:)
+ !
+ ! if param used under an ice shelf overwrite ztblmin by the ice shelf draft
+ WHERE ( risfdep > 0._wp .AND. ztblmin > 0._wp )
+ ztblmin(:,:) = risfdep(:,:)
+ END WHERE
+ !
+ ! ensure ztblmax <= bathy
+ WHERE ( ztblmax(:,:) > bathy(:,:) )
+ ztblmax(:,:) = bathy(:,:)
+ END WHERE
+ !
+ ! compute ktop and update ztblmin to gdepw_0(misfkt_par)
+ CALL isf_tbl_ktop(ztblmin, misfkt_par) ! out: misfkt_par
+ ! ! inout: ztblmin
+ !
+ ! initial tbl thickness
+ rhisf0_tbl_par(:,:) = ztblmax(:,:) - ztblmin(:,:)
+ !
+ ! define iceshelf parametrisation mask
+ mskisf_par = 0
+ WHERE ( rhisf0_tbl_par(:,:) > 0._wp )
+ mskisf_par(:,:) = 1._wp
+ END WHERE
+ !
+ ! read par variable from restart
+ IF ( ln_rstart ) CALL isfrst_read('par', risf_par_tsc, fwfisf_par, risf_par_tsc_b, fwfisf_par_b)
+ !
+ SELECT CASE ( TRIM(cn_isfpar_mlt) )
+ !
+ CASE ( 'spe' )
+ !
+ ALLOCATE( sf_isfpar_fwf(1), STAT=ierr )
+ ALLOCATE( sf_isfpar_fwf(1)%fnow(jpi,jpj,1), sf_isfpar_fwf(1)%fdta(jpi,jpj,1,2) )
+ CALL fld_fill( sf_isfpar_fwf, (/ sn_isfpar_fwf /), cn_isfdir, 'isf_par_init', 'read fresh water flux isf data', 'namisf' )
+ !
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' ==>>> ice melt read from forcing field (cn_isfmlt_par = spe)'
+ !
+ CASE ( 'bg03' )
+ !
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' ==>>> bg03 parametrisation (cn_isfmlt_par = bg03)'
+ !
+ ! read effective length
+ CALL read_2dcstdta(TRIM(sn_isfpar_Leff%clname), TRIM(sn_isfpar_Leff%clvar), risfLeff)
+ risfLeff = risfLeff*1000.0_wp !: convertion in m
+ !
+ CASE ( 'oasis' )
+ !
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' ==>>> isf melt provided by OASIS (cn_isfmlt_par = oasis)'
+ !
+ CASE DEFAULT
+ CALL ctl_stop( 'sbc_isf_init: wrong value of nn_isf' )
+ END SELECT
+ !
+ END SUBROUTINE isf_par_init
+
+END MODULE isfpar
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfparmlt.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfparmlt.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfparmlt.F90 (revision 12150)
@@ -0,0 +1,224 @@
+MODULE isfparmlt
+ !!======================================================================
+ !! *** MODULE isfparmlt ***
+ !! Ice shelf parametrisation module : update surface ocean boundary condition under ice
+ !! shelf using an ice shelf melt parametrisation
+ !!======================================================================
+ !! History : 4.0 ! original code
+ !!----------------------------------------------------------------------
+
+ USE isf_oce ! ice shelf
+ USE isftbl , ONLY: isf_tbl ! ice shelf depth average
+
+ USE dom_oce ! ocean space and time domain
+ USE oce , ONLY: ts ! ocean dynamics and tracers
+ USE phycst , ONLY: rcp, rau0 ! physical constants
+ USE eosbn2 , ONLY: eos_fzp ! equation of state
+
+ USE in_out_manager ! I/O manager
+ USE iom , ONLY: iom_put ! I/O library
+ USE fldread , ONLY: fld_read, FLD, FLD_N !
+ USE lib_fortran, ONLY: glob_sum !
+ USE lib_mpp , ONLY: ctl_stop !
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isfpar_mlt
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+! -------------------------------------------------------------------------------------------------------
+! -------------------------------- PUBLIC SUBROUTINE ----------------------------------------------------
+! -------------------------------------------------------------------------------------------------------
+
+ SUBROUTINE isfpar_mlt( kt, Kmm, pqhc, pqoce, pqfwf )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isfpar_mlt ***
+ !!
+ !! ** Purpose : Compute Salt and Heat fluxes related to ice_shelf
+ !! melting and freezing
+ !!
+ !! ** Method : 2 parameterizations are available according
+ !! 1 : Specified melt flux
+ !! 2 : Beckmann & Goose parameterization
+ !!
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqfwf, pqoce, pqhc ! fresh water, ice-ocean heat and heat content fluxes
+ !!-------------------------- IN -------------------------------------
+ INTEGER, INTENT(in) :: kt ! ocean time step
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!---------------------------------------------------------------------
+ !
+ ! Choose among the available ice shelf parametrisation
+ SELECT CASE ( cn_isfpar_mlt )
+ CASE ( 'spe' ) ! specified runoff in depth (Mathiot et al., 2017 in preparation)
+ CALL isfpar_mlt_spe(kt, Kmm, pqhc, pqoce, pqfwf)
+ CASE ( 'bg03' ) ! Beckmann and Goosse parametrisation
+ CALL isfpar_mlt_bg03(kt, Kmm, pqhc, pqoce, pqfwf)
+ CASE ( 'oasis' )
+ CALL isfpar_mlt_oasis( kt, Kmm, pqhc, pqoce, pqfwf)
+ CASE DEFAULT
+ CALL ctl_stop('STOP', 'unknown isf melt formulation : cn_isfpar (should not see this)')
+ END SELECT
+ !
+ END SUBROUTINE isfpar_mlt
+
+! -------------------------------------------------------------------------------------------------------
+! -------------------------------- PRIVATE SUBROUTINE ---------------------------------------------------
+! -------------------------------------------------------------------------------------------------------
+
+ SUBROUTINE isfpar_mlt_spe(kt, Kmm, pqhc, pqoce, pqfwf)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isfpar_mlt_spe ***
+ !!
+ !! ** Purpose : prescribed ice shelf melting in case ice shelf cavities are closed.
+ !! data read into a forcing files.
+ !!
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqfwf, pqoce ! fresh water and ice-ocean heat fluxes
+ !!-------------------------- IN -------------------------------------
+ INTEGER, INTENT(in) :: kt
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!--------------------------------------------------------------------
+ INTEGER :: jk
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztfrz3d
+ REAL(wp), DIMENSION(jpi,jpj) :: ztfrz
+ !!--------------------------------------------------------------------
+ !
+ ! 0. ------------Read specified runoff
+ CALL fld_read ( kt, 1, sf_isfpar_fwf )
+ !
+ ! compute ptfrz
+ ! 1. ------------Mean freezing point
+ DO jk = 1,jpk
+ CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
+ END DO
+ CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
+ !
+ pqfwf(:,:) = - sf_isfpar_fwf(1)%fnow(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting)
+ pqoce(:,:) = pqfwf(:,:) * rLfusisf ! ocean/ice shelf flux assume to be equal to latent heat flux
+ pqhc (:,:) = pqfwf(:,:) * ztfrz(:,:) * rcp ! heat content flux
+ !
+ CALL iom_put('isftfrz_par', ztfrz )
+ !
+ END SUBROUTINE isfpar_mlt_spe
+
+ SUBROUTINE isfpar_mlt_bg03(kt, Kmm, pqhc, pqoce, pqfwf)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isfpar_mlt_bg03 ***
+ !!
+ !! ** Purpose : compute an estimate of ice shelf melting and
+ !! latent, ocean-ice and heat content heat fluxes
+ !! in case cavities are closed based on the far fields T and S properties.
+ !!
+ !! ** Method : The ice shelf melt is computed as proportional to the differences between the
+ !! mean temperature and mean freezing point in front of the ice shelf averaged
+ !! over the ice shelf min ice shelf draft and max ice shelf draft and the freezing point
+ !!
+ !! ** Reference : Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean
+ !! interaction for climate models", Ocean Modelling 5(2003) 157-170.
+ !!----------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqfwf, pqoce ! fresh water and ice-ocean heat fluxes
+ !!-------------------------- IN -------------------------------------
+ INTEGER, INTENT(in) :: kt
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!--------------------------------------------------------------------
+ INTEGER :: jk
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztfrz3d ! freezing point
+ REAL(wp), DIMENSION(jpi,jpj) :: ztfrz ! freezing point
+ REAL(wp), DIMENSION(jpi,jpj) :: ztavg ! temperature avg
+ !!----------------------------------------------------------------------
+ !
+ ! 0. ------------Mean freezing point
+ DO jk = 1,jpk
+ CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
+ END DO
+ CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
+ !
+ ! 1. ------------Mean temperature
+ CALL isf_tbl(Kmm, ts(:,:,jk,jp_tem,Kmm), ztavg, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
+ !
+ ! 2. ------------Net heat flux and fresh water flux due to the ice shelf
+ pqoce(:,:) = rau0 * rcp * rn_gammat0 * risfLeff(:,:) * e1t(:,:) * ( ztavg(:,:) - ztfrz(:,:) ) * r1_e1e2t(:,:)
+ pqfwf(:,:) = - pqoce(:,:) / rLfusisf ! derived from the latent heat flux
+ pqhc (:,:) = pqfwf(:,:) * ztfrz(:,:) * rcp ! heat content flux
+ !
+ ! 3. ------------BG03 output
+ ! output ttbl
+ CALL iom_put('ttbl_par', ztavg(:,:) * mskisf_par(:,:) )
+ !
+ ! output thermal driving
+ CALL iom_put('isfthermald_par',( ztfrz(:,:) - ztavg(:,:) ) * mskisf_par(:,:))
+ !
+ ! output freezing point used to define the thermal driving and heat content fluxes
+ CALL iom_put('isftfrz_par', ztfrz )
+ !
+ END SUBROUTINE isfpar_mlt_bg03
+
+ SUBROUTINE isfpar_mlt_oasis(kt, Kmm, pqhc , pqoce, pqfwf )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE isfpar_mlt_oasis ***
+ !!
+ !! ** Purpose : scale the fwf read from input file by the total amount received by the sbccpl interface
+ !!
+ !! ** Purpose : - read ice shelf melt from forcing file and scale it by the input file total amount => pattern
+ !! - compute total amount of fwf given by sbccpl (fwfisf_oasis)
+ !! - scale fwf and compute heat fluxes
+ !!
+ !!---------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pqhc, pqoce, pqfwf ! heat content, latent heat and fwf fluxes
+ !!-------------------------- IN -------------------------------------
+ INTEGER , INTENT(in ) :: kt ! current time step
+ INTEGER , INTENT(in ) :: Kmm ! ocean time level index
+ !!--------------------------------------------------------------------
+ INTEGER :: jk ! loop index
+ REAL(wp) :: zfwf_fld, zfwf_oasis ! total fwf in the forcing fields (pattern) and from the cpl interface (amount)
+ REAL(wp), DIMENSION(jpi,jpj) :: ztfrz ! tbl freezing temperature
+ REAL(wp), DIMENSION(jpi,jpj) :: zfwf ! 2d fwf map after scaling
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztfrz3d
+ !!--------------------------------------------------------------------
+ !
+ ! 0. ------------Read specified runoff
+ CALL fld_read ( kt, 1, sf_isfpar_fwf )
+ !
+ ! 1. ------------Mean freezing point (needed for heat content flux)
+ DO jk = 1,jpk
+ CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
+ END DO
+ CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
+ !
+ ! 2. ------------Scale isf melt pattern with total amount from oasis
+ ! ice shelf 2d map
+ zfwf(:,:) = - sf_isfpar_fwf(1)%fnow(:,:,1)
+ !
+ ! compute glob sum from input file
+ ! (PM) should we consider delay sum as in fwb ? (it will offset by 1 time step if I understood well)
+ zfwf_fld = glob_sum('isfcav_mlt', e1e2t(:,:) * zfwf(:,:))
+ !
+ ! compute glob sum from atm->oce ice shelf fwf
+ ! (PM) should we consider delay sum as in fwb ?
+ zfwf_oasis = glob_sum('isfcav_mlt', e1e2t(:,:) * fwfisf_oasis(:,:))
+ !
+ ! scale fwf
+ zfwf(:,:) = zfwf(:,:) * zfwf_oasis / zfwf_fld
+ !
+ ! 3. -----------Define fwf and qoce
+ ! ocean heat flux is assume to be equal to the latent heat
+ pqfwf(:,:) = zfwf(:,:) ! fwf ( >0 out )
+ pqoce(:,:) = - pqfwf(:,:) * rLfusisf ! ocean heat flux ( >0 out ) (assumed to be the latent heat flux)
+ pqhc (:,:) = pqfwf(:,:) * ztfrz(:,:) * rcp ! heat content flux ( >0 out )
+ !
+ CALL iom_put('isftfrz_par', ztfrz )
+ !
+ END SUBROUTINE isfpar_mlt_oasis
+
+END MODULE isfparmlt
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfrst.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfrst.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfrst.F90 (revision 12150)
@@ -0,0 +1,105 @@
+MODULE isfrst
+ !!======================================================================
+ !! *** MODULE isfrst ***
+ !! iceshelf restart module :read/write iceshelf variables from/in restart
+ !!======================================================================
+ !! History : 4.1 ! 2019-07 (P. Mathiot) Original code
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isfrst : read/write iceshelf variables in/from restart
+ !!----------------------------------------------------------------------
+ !
+ USE par_oce, ONLY: jpi,jpj,jpk,jpts ! time and space domain
+ !
+ USE in_out_manager ! I/O manager
+ USE iom ! I/O library
+ !
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isfrst_read, isfrst_write ! iceshelf restart read and write
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+ !
+ SUBROUTINE isfrst_read(cdisf, ptsc, pfwf, ptsc_b, pfwf_b )
+ !!---------------------------------------------------------------------
+ !!
+ !! isfrst_read : read iceshelf variables from restart
+ !!
+ !!-------------------------- OUT --------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pfwf_b
+ REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT( out) :: ptsc_b
+ !!-------------------------- IN --------------------------------------
+ CHARACTER(LEN=3) , INTENT(in ) :: cdisf
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pfwf
+ REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: ptsc
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=256) :: cfwf_b, chc_b, csc_b
+ !!----------------------------------------------------------------------
+ !
+ ! define variable name
+ cfwf_b = 'fwfisf_'//TRIM(cdisf)//'_b'
+ chc_b = 'isf_hc_'//TRIM(cdisf)//'_b'
+ csc_b = 'isf_sc_'//TRIM(cdisf)//'_b'
+ !
+ ! read restart
+ IF( iom_varid( numror, cfwf_b, ldstop = .FALSE. ) > 0 ) THEN
+ IF(lwp) WRITE(numout,*) ' nit000-1 isf tracer content forcing fields read in the restart file'
+ CALL iom_get( numror, jpdom_autoglo, cfwf_b, pfwf_b(:,:) , ldxios = lrxios ) ! before ice shelf melt
+ CALL iom_get( numror, jpdom_autoglo, chc_b , ptsc_b (:,:,jp_tem), ldxios = lrxios ) ! before ice shelf heat flux
+ CALL iom_get( numror, jpdom_autoglo, csc_b , ptsc_b (:,:,jp_sal), ldxios = lrxios ) ! before ice shelf heat flux
+ ELSE
+ pfwf_b(:,:) = pfwf(:,:)
+ ptsc_b(:,:,:) = ptsc(:,:,:)
+ ENDIF
+ !
+ IF( lwxios ) THEN
+ CALL iom_set_rstw_var_active(TRIM(chc_b ))
+ CALL iom_set_rstw_var_active(TRIM(csc_b ))
+ CALL iom_set_rstw_var_active(TRIM(cfwf_b))
+ ENDIF
+
+ END SUBROUTINE isfrst_read
+ !
+ SUBROUTINE isfrst_write(kt, cdisf, ptsc, pfwf )
+ !!---------------------------------------------------------------------
+ !!
+ !! isfrst_write : write iceshelf variables in restart
+ !!
+ !!-------------------------- IN --------------------------------------
+ INTEGER , INTENT(in ) :: kt
+ CHARACTER(LEN=3) , INTENT(in ) :: cdisf
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pfwf
+ REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: ptsc
+ !!---------------------------------------------------------------------
+ CHARACTER(LEN=256) :: cfwf_b, chc_b, csc_b
+ !!---------------------------------------------------------------------
+ !
+ ! ocean output print
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'isf : isf fwf and heat fluxes written in ocean restart file ', &
+ & 'at it= ', kt,' date= ', ndastp
+ IF(lwp) WRITE(numout,*) '~~~~'
+ !
+ ! define variable name
+ cfwf_b = 'fwfisf_'//TRIM(cdisf)//'_b'
+ chc_b = 'isf_hc_'//TRIM(cdisf)//'_b'
+ csc_b = 'isf_sc_'//TRIM(cdisf)//'_b'
+ !
+ ! write restart variable
+ IF( lwxios ) CALL iom_swap( cwxios_context )
+ CALL iom_rstput( kt, nitrst, numrow, cfwf_b, pfwf(:,:) , ldxios = lwxios )
+ CALL iom_rstput( kt, nitrst, numrow, chc_b , ptsc(:,:,jp_tem), ldxios = lwxios )
+ CALL iom_rstput( kt, nitrst, numrow, csc_b , ptsc(:,:,jp_sal), ldxios = lwxios )
+ IF( lwxios ) CALL iom_swap( cxios_context )
+ !
+ END SUBROUTINE isfrst_write
+ !
+END MODULE isfrst
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfstp.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfstp.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfstp.F90 (revision 12150)
@@ -0,0 +1,303 @@
+MODULE isfstp
+ !!======================================================================
+ !! *** MODULE isfstp ***
+ !! Surface module : compute iceshelf load, melt and heat flux
+ !!======================================================================
+ !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav
+ !! X.X ! 2006-02 (C. Wang ) Original code bg03
+ !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization
+ !! 4.1 ! 2019-09 (P. Mathiot) Split param/explicit ice shelf and re-organisation
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isfstp : compute iceshelf melt and heat flux
+ !!----------------------------------------------------------------------
+ !
+ USE isf_oce ! isf variables
+ USE isfload, ONLY: isf_load ! ice shelf load
+ USE isftbl , ONLY: isf_tbl_lvl ! ice shelf boundary layer
+ USE isfpar , ONLY: isf_par, isf_par_init ! ice shelf parametrisation
+ USE isfcav , ONLY: isf_cav, isf_cav_init ! ice shelf cavity
+ USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables
+
+ USE dom_oce, ONLY: ht, e3t, ln_isfcav, ln_linssh ! ocean space and time domain
+ USE domvvl, ONLY: ln_vvl_zstar ! zstar logical
+ USE zdfdrg, ONLY: r_Cdmin_top, r_ke0_top ! vertical physics: top/bottom drag coef.
+ !
+ USE lib_mpp, ONLY: ctl_stop, ctl_nam
+ USE fldread, ONLY: FLD, FLD_N
+ USE in_out_manager ! I/O manager
+ USE timing
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isf_stp, isf_init, isf_nam ! routine called in sbcmod and divhor
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id$
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE isf_stp( kt, Kmm )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_stp ***
+ !!
+ !! ** Purpose : compute total heat flux and total fwf due to ice shelf melt
+ !!
+ !! ** Method : For each case (parametrisation or explicity cavity) :
+ !! - define the before fields
+ !! - compute top boundary layer properties
+ !! (in case of parametrisation, this is the
+ !! depth range model array used to compute mean far fields properties)
+ !! - compute fluxes
+ !! - write restart variables
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kt ! ocean time step
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!---------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('isf')
+ !
+ !=======================================================================
+ ! 1.: compute melt and associated heat fluxes in the ice shelf cavities
+ !=======================================================================
+ !
+ IF ( ln_isfcav_mlt ) THEN
+ !
+ ! 1.1: before time step
+ IF ( kt /= nit000 ) THEN
+ risf_cav_tsc_b (:,:,:) = risf_cav_tsc (:,:,:)
+ fwfisf_cav_b(:,:) = fwfisf_cav(:,:)
+ END IF
+ !
+ ! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
+ rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:)
+ CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav)
+ !
+ ! 1.3: compute ice shelf melt
+ CALL isf_cav( kt, Kmm, risf_cav_tsc, fwfisf_cav)
+ !
+ END IF
+ !
+ !=================================================================================
+ ! 2.: compute melt and associated heat fluxes for not resolved ice shelf cavities
+ !=================================================================================
+ !
+ IF ( ln_isfpar_mlt ) THEN
+ !
+ ! 2.1: before time step
+ IF ( kt /= nit000 ) THEN
+ risf_par_tsc_b(:,:,:) = risf_par_tsc(:,:,:)
+ fwfisf_par_b (:,:) = fwfisf_par (:,:)
+ END IF
+ !
+ ! 2.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
+ ! by simplicity, we assume the top level where param applied do not change with time (done in init part)
+ rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:)
+ CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par)
+ !
+ ! 2.3: compute ice shelf melt
+ CALL isf_par( kt, Kmm, risf_par_tsc, fwfisf_par)
+ !
+ END IF
+ !
+ !==================================================================================
+ ! 3.: output specific restart variable in case of coupling with an ice sheet model
+ !==================================================================================
+ !
+ IF ( ln_isfcpl .AND. lrst_oce ) CALL isfcpl_rst_write(kt, Kmm)
+ !
+ IF( ln_timing ) CALL timing_stop('isf')
+ !
+ END SUBROUTINE isf_stp
+
+ SUBROUTINE isf_init(Kbb, Kmm, Kaa)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isfstp_init ***
+ !!
+ !! ** Purpose : Initialisation of the ice shelf public variables
+ !!
+ !! ** Method : Read the namisf namelist, check option compatibility and set derived parameters
+ !!
+ !! ** Action : - read namisf parameters
+ !! - allocate memory
+ !! - output print
+ !! - ckeck option compatibility
+ !! - call cav/param/isfcpl init routine
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
+ !
+ ! constrain: l_isfoasis need to be known
+ !
+ ! Read namelist
+ CALL isf_nam()
+ !
+ ! Allocate public array
+ CALL isf_alloc()
+ !
+ ! check option compatibility
+ CALL isf_ctl()
+ !
+ ! compute ice shelf load
+ IF ( ln_isfcav ) CALL isf_load( Kmm, risfload )
+ !
+ ! terminate routine now if no ice shelf melt formulation specify
+ IF ( ln_isf ) THEN
+ !
+ !---------------------------------------------------------------------------------------------------------------------
+ ! initialisation melt in the cavity
+ IF ( ln_isfcav_mlt ) CALL isf_cav_init()
+ !
+ !---------------------------------------------------------------------------------------------------------------------
+ ! initialisation parametrised melt
+ IF ( ln_isfpar_mlt ) CALL isf_par_init()
+ !
+ !---------------------------------------------------------------------------------------------------------------------
+ ! initialisation ice sheet coupling
+ IF( ln_isfcpl ) CALL isfcpl_init(Kbb, Kmm, Kaa)
+ !
+ END IF
+
+ END SUBROUTINE isf_init
+
+ SUBROUTINE isf_ctl()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_ctl ***
+ !!
+ !! ** Purpose : output print and option compatibility check
+ !!
+ !!----------------------------------------------------------------------
+ IF (lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'isf_init : ice shelf initialisation'
+ WRITE(numout,*) '~~~~~~~~~~~~'
+ WRITE(numout,*) ' Namelist namisf :'
+ !
+ WRITE(numout,*) ' ice shelf cavity (open or parametrised) ln_isf = ', ln_isf
+ WRITE(numout,*)
+ !
+ IF ( ln_isf ) THEN
+ WRITE(numout,*) ' Add debug print in isf module ln_isfdebug = ', ln_isfdebug
+ WRITE(numout,*)
+ WRITE(numout,*) ' melt inside the cavity ln_isfcav_mlt = ', ln_isfcav_mlt
+ IF ( ln_isfcav_mlt) THEN
+ WRITE(numout,*) ' melt formulation cn_isfcav_mlt= ', TRIM(cn_isfcav_mlt)
+ WRITE(numout,*) ' thickness of the top boundary layer rn_htbl = ', rn_htbl
+ WRITE(numout,*) ' gamma formulation cn_gammablk = ', TRIM(cn_gammablk)
+ IF ( TRIM(cn_gammablk) .NE. 'spe' ) THEN
+ WRITE(numout,*) ' gammat coefficient rn_gammat0 = ', rn_gammat0
+ WRITE(numout,*) ' gammas coefficient rn_gammas0 = ', rn_gammas0
+ WRITE(numout,*) ' top background ke used (from namdrg_top) rn_ke0 = ', r_ke0_top
+ WRITE(numout,*) ' top drag coef. used (from namdrg_top) rn_Cd0 = ', r_Cdmin_top
+ END IF
+ END IF
+ WRITE(numout,*) ''
+ !
+ WRITE(numout,*) ' ice shelf melt parametrisation ln_isfpar_mlt = ', ln_isfpar_mlt
+ IF ( ln_isfpar_mlt ) THEN
+ WRITE(numout,*) ' isf parametrisation formulation cn_isfpar_mlt = ', TRIM(cn_isfpar_mlt)
+ END IF
+ WRITE(numout,*) ''
+ !
+ WRITE(numout,*) ' Coupling to an ice sheet model ln_isfcpl = ', ln_isfcpl
+ IF ( ln_isfcpl ) THEN
+ WRITE(numout,*) ' conservation activated ln_isfcpl_cons = ', ln_isfcpl_cons
+ WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown
+ ENDIF
+ WRITE(numout,*) ''
+ !
+ ELSE
+ !
+ IF ( ln_isfcav ) THEN
+ WRITE(numout,*) ''
+ WRITE(numout,*) ' W A R N I N G: ice shelf cavities are open BUT no melt will be computed or read from file !'
+ WRITE(numout,*) ''
+ END IF
+ !
+ END IF
+
+ IF (ln_isfcav) THEN
+ WRITE(numout,*) ' Ice shelf load method cn_isfload = ', TRIM(cn_isfload)
+ WRITE(numout,*) ' Temperature used to compute the ice shelf load = ', rn_isfload_T
+ WRITE(numout,*) ' Salinity used to compute the ice shelf load = ', rn_isfload_S
+ END IF
+ WRITE(numout,*) ''
+ FLUSH(numout)
+
+ END IF
+ !
+
+ !---------------------------------------------------------------------------------------------------------------------
+ ! sanity check ! issue ln_isfcav not yet known as well as l_isfoasis => move this call in isf_stp ?
+ ! melt in the cavity without cavity
+ IF ( ln_isfcav_mlt .AND. (.NOT. ln_isfcav) ) &
+ & CALL ctl_stop('ice shelf melt in the cavity activated (ln_isfcav_mlt) but no cavity detected in domcfg (ln_isfcav), STOP' )
+ !
+ ! ice sheet coupling without cavity
+ IF ( ln_isfcpl .AND. (.NOT. ln_isfcav) ) &
+ & CALL ctl_stop('coupling with an ice sheet model detected (ln_isfcpl) but no cavity detected in domcfg (ln_isfcav), STOP' )
+ !
+ IF ( ln_isfcpl .AND. ln_isfcpl_cons .AND. ln_linssh ) &
+ & CALL ctl_stop( 'The coupling between NEMO and an ice sheet model with the conservation option does not work with the linssh option' )
+ !
+ IF ( l_isfoasis .AND. .NOT. ln_isf ) CALL ctl_stop( ' OASIS send ice shelf fluxes to NEMO but NEMO does not have the isf module activated' )
+ !
+ IF ( l_isfoasis .AND. ln_isf ) THEN
+ !
+ CALL ctl_stop( ' ln_ctl and ice shelf not tested' )
+ !
+ ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation
+ IF ( ln_isfcav_mlt .AND. TRIM(cn_isfcav_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis is the only option availble if fwf send by oasis' )
+ IF ( ln_isfpar_mlt .AND. TRIM(cn_isfpar_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis is the only option availble if fwf send by oasis' )
+ !
+ ! oasis melt computation not tested (coded but not tested)
+ IF ( ln_isfcav_mlt .OR. ln_isfpar_mlt ) THEN
+ IF ( TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis not tested' )
+ IF ( TRIM(cn_isfpar_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis not tested' )
+ END IF
+ !
+ ! oasis melt computation with cavity open and cavity parametrised (not coded)
+ IF ( ln_isfcav_mlt .AND. ln_isfpar_mlt ) THEN
+ IF ( TRIM(cn_isfpar_mlt) == 'oasis' .AND. TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis and cn_isfcav_mlt = oasis not coded' )
+ END IF
+ !
+ ! compatibility ice shelf and vvl
+ IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
+ !
+ END IF
+ END SUBROUTINE isf_ctl
+ !
+ SUBROUTINE isf_nam
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_nam ***
+ !!
+ !! ** Purpose : Read ice shelf namelist cfg and ref
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ios ! Local integer output status for namelist read
+ !!----------------------------------------------------------------------
+ NAMELIST/namisf/ ln_isf , &
+ & cn_gammablk , rn_gammat0 , rn_gammas0 , rn_htbl, sn_isfcav_fwf, &
+ & ln_isfcav_mlt , cn_isfcav_mlt , sn_isfcav_fwf , &
+ & ln_isfpar_mlt , cn_isfpar_mlt , sn_isfpar_fwf , &
+ & sn_isfpar_zmin, sn_isfpar_zmax, sn_isfpar_Leff, &
+ & ln_isfcpl , nn_drown , ln_isfcpl_cons, ln_isfdebug, &
+ & cn_isfload , rn_isfload_T , rn_isfload_S , cn_isfdir
+ !!----------------------------------------------------------------------
+ !
+ READ ( numnam_ref, namisf, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namisf in reference namelist' )
+ !
+ READ ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 )
+902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namisf in configuration namelist' )
+ IF(lwm) WRITE ( numond, namisf )
+
+ END SUBROUTINE isf_nam
+ !!
+ !!======================================================================
+END MODULE isfstp
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isftbl.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isftbl.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isftbl.F90 (revision 12150)
@@ -0,0 +1,275 @@
+MODULE isftbl
+ !!======================================================================
+ !! *** MODULE isftbl ***
+ !! isftbl module : compute properties of top boundary layer
+ !!======================================================================
+ !! History : 4.1 ! 2019-09 (P. Mathiot) original code
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isftbl : routine to compute :
+ !! - geometry of the ice shelf tbl (isf_tbl_lvl, isftbl_ktop, isftbl_kbot)
+ !! (top and bottom level, thickness and fraction of deepest level affected)
+ !! - tbl averaged properties (isf_tbl, isf_tbl_avg)
+ !!----------------------------------------------------------------------
+
+ USE isf_oce ! ice shelf variables
+
+ USE dom_oce ! vertical scale factor and depth
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isf_tbl, isf_tbl_avg, isf_tbl_lvl, isf_tbl_ktop, isf_tbl_kbot
+
+CONTAINS
+
+ SUBROUTINE isf_tbl( Kmm, pvarin, pvarout, cd_ptin, ktop, phtbl, kbot, pfrac )
+ !!--------------------------------------------------------------------
+ !! *** SUBROUTINE isf_tbl ***
+ !!
+ !! ** Purpose : compute mean T/S/U/V in the boundary layer at T- point
+ !!
+ !! ** Method : Average properties over a specific thickness
+ !!
+ !! ** Reference : inspired from : Losch, Modeling ice shelf cavities in a z coordinate ocean general circulation model
+ !! https://doi.org/10.1029/2007JC004368 , 2008
+ !!
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pvarout ! 2d average of pvarin
+ !!-------------------------- IN -------------------------------------
+ INTEGER , INTENT(in ) :: Kmm ! ocean time level index
+ CHARACTER(len=1) , INTENT(in ) :: cd_ptin ! point of variable in/out
+ REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pvarin ! 3d variable to average over the tbl
+ INTEGER, DIMENSION(jpi,jpj) , INTENT(in ) :: ktop ! top level
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: phtbl ! tbl thickness
+ !!-------------------------- IN OPTIONAL -----------------------------
+ INTEGER, DIMENSION(jpi,jpj), OPTIONAL, INTENT(in ) :: kbot ! bottom level
+ REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in ) :: pfrac ! fraction of bottom cell affected by tbl
+ !!--------------------------------------------------------------------
+ INTEGER :: ji, jj ! loop index
+ INTEGER , DIMENSION(jpi,jpj) :: ikbot ! bottom level of the tbl
+ REAL(wp), DIMENSION(jpi,jpj) :: zvarout ! 2d average of pvarin
+ REAL(wp), DIMENSION(jpi,jpj) :: zhtbl ! thickness of the tbl
+ REAL(wp), DIMENSION(jpi,jpj) :: zfrac ! thickness of the tbl
+ !!--------------------------------------------------------------------
+ !
+ SELECT CASE ( cd_ptin )
+ CASE ( 'U' )
+ !
+ ! copy phtbl (phtbl is INTENT in as we don't want to change it)
+ zhtbl = phtbl
+ !
+ ! compute tbl lvl and thickness
+ CALL isf_tbl_lvl( hu(:,:,Kmm), e3u(:,:,:,Kmm), ktop, ikbot, zhtbl, zfrac )
+ !
+ ! compute tbl property at U point
+ CALL isf_tbl_avg( miku, ikbot, zhtbl, zfrac, e3u(:,:,:,Kmm), pvarin, zvarout )
+ !
+ ! compute tbl property at T point
+ pvarout(1,:) = 0._wp
+ DO jj = 1, jpj
+ DO ji = 2, jpi
+ pvarout(ji,jj) = 0.5_wp * (zvarout(ji,jj) + zvarout(ji-1,jj))
+ END DO
+ END DO
+ ! lbclnk not needed as a final communication is done after the computation of fwf
+ !
+ CASE ( 'V' )
+ !
+ ! copy phtbl (phtbl is INTENT in as we don't want to change it)
+ zhtbl = phtbl
+ !
+ ! compute tbl lvl and thickness
+ CALL isf_tbl_lvl( hv(:,:,Kmm), e3v(:,:,:,Kmm), ktop, ikbot, zhtbl, zfrac )
+ !
+ ! compute tbl property at V point
+ CALL isf_tbl_avg( mikv, ikbot, zhtbl, zfrac, e3v(:,:,:,Kmm), pvarin, zvarout )
+ !
+ ! pvarout is an averaging of wet point
+ pvarout(:,1) = 0._wp
+ DO jj = 2, jpj
+ DO ji = 1, jpi
+ pvarout(ji,jj) = 0.5_wp * (zvarout(ji,jj) + zvarout(ji,jj-1))
+ END DO
+ END DO
+ ! lbclnk not needed as a final communication is done after the computation of fwf
+ !
+ CASE ( 'T' )
+ !
+ ! compute tbl property at T point
+ CALL isf_tbl_avg( ktop, kbot, phtbl, pfrac, e3t(:,:,:,Kmm), pvarin, pvarout )
+ !
+ END SELECT
+ !
+ END SUBROUTINE isf_tbl
+
+ SUBROUTINE isf_tbl_avg( ktop, kbot, phtbl, pfrac, pe3, pvarin, pvarout )
+ !!--------------------------------------------------------------------
+ !! *** ROUTINE isf_tbl_avg ***
+ !!
+ !! ** Purpose : compute mean property in the boundary layer
+ !!
+ !! ** Method : Depth average is made between the top level ktop and the bottom level kbot
+ !! over a thickness phtbl. The bottom level is partially counted (pfrac).
+ !!
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pvarout ! tbl property averaged over phtbl between level ktop and kbot
+ !!-------------------------- IN -------------------------------------
+ INTEGER, DIMENSION(jpi,jpj) , INTENT(in ) :: ktop, kbot ! top and bottom level of the top boundary layer
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: phtbl, pfrac ! fraction of bottom level to be affected by the tbl
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pe3 ! vertical scale factor
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pvarin ! tbl property to average between ktop, kbot over phtbl
+ !!--------------------------------------------------------------------
+ INTEGER :: ji,jj,jk ! loop indices
+ INTEGER :: ikt, ikb ! top and bottom levels
+ !!--------------------------------------------------------------------
+ !
+ ! compute tbl top.bottom level and thickness
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ !
+ ! tbl top/bottom indices initialisation
+ ikt = ktop(ji,jj) ; ikb = kbot(ji,jj)
+ !
+ ! level fully include in the ice shelf boundary layer
+ pvarout(ji,jj) = SUM( pvarin(ji,jj,ikt:ikb-1) * pe3(ji,jj,ikt:ikb-1) ) / phtbl(ji,jj)
+ !
+ ! level partially include in ice shelf boundary layer
+ pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * pe3(ji,jj,ikb) / phtbl(ji,jj) * pfrac(ji,jj)
+ !
+ END DO
+ END DO
+
+ END SUBROUTINE isf_tbl_avg
+
+ SUBROUTINE isf_tbl_lvl( phw, pe3, ktop, kbot, phtbl, pfrac )
+ !!--------------------------------------------------------------------
+ !! *** ROUTINE isf_tbl_lvl ***
+ !!
+ !! ** Purpose : - compute bottom level off the top boundary layer
+ !! - thickness of the top boundary layer
+ !! - fraction of the bottom level affected by the tbl
+ !!
+ !!-------------------------- OUT --------------------------------------
+ INTEGER, DIMENSION(jpi,jpj) , INTENT( out) :: kbot ! bottom level of the top boundary layer
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pfrac ! fraction of bottom level in the tbl
+ !!-------------------------- IN --------------------------------------
+ INTEGER, DIMENSION(jpi,jpj) , INTENT(in ) :: ktop ! top level of the top boundary layer
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: phw ! water column thickness
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pe3 ! vertical scale factor
+ !!-------------------------- INOUT ------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(inout) :: phtbl ! top boundary layer thickness
+ !!---------------------------------------------------------------------
+ INTEGER :: ji,jj,jk
+ INTEGER :: ikt, ikb
+ !!---------------------------------------------------------------------
+ !
+ ! get htbl
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ !
+ ! tbl top/bottom indices initialisation
+ ikt = ktop(ji,jj)
+ !
+ ! limit the tbl to water thickness.
+ phtbl(ji,jj) = MIN( phtbl(ji,jj), phw(ji,jj) )
+ !
+ ! thickness of boundary layer must be at least the top level thickness
+ phtbl(ji,jj) = MAX( phtbl(ji,jj), pe3(ji,jj,ikt) )
+ !
+ END DO
+ END DO
+ !
+ ! get ktbl
+ CALL isf_tbl_kbot(ktop, phtbl, pe3, kbot)
+ !
+ ! get pfrac
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ !
+ ! tbl top/bottom indices initialisation
+ ikt = ktop(ji,jj) ; ikb = kbot(ji,jj)
+ !
+ ! proportion of the bottom cell included in ice shelf boundary layer
+ pfrac(ji,jj) = ( phtbl(ji,jj) - SUM( pe3(ji,jj,ikt:ikb-1) ) ) / pe3(ji,jj,ikb)
+ !
+ END DO
+ END DO
+ !
+ END SUBROUTINE isf_tbl_lvl
+ !
+ SUBROUTINE isf_tbl_kbot(ktop, phtbl, pe3, kbot)
+ !!--------------------------------------------------------------------
+ !! *** ROUTINE isf_tbl_bot ***
+ !!
+ !! ** Purpose : compute bottom level of the isf top boundary layer
+ !!
+ !!-------------------------- OUT -------------------------------------
+ INTEGER, DIMENSION(jpi,jpj) , INTENT( out) :: kbot ! bottom level of the top boundary layer
+ !!-------------------------- IN -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: phtbl ! top boundary layer thickness
+ INTEGER, DIMENSION(jpi,jpj) , INTENT(in ) :: ktop ! top level of the top boundary layer
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pe3 ! vertical scale factor
+ !!--------------------------------------------------------------------
+ INTEGER :: ji, jj
+ INTEGER :: ikt, ikb
+ !!--------------------------------------------------------------------
+ !
+ ! phtbl need to be bounded by water column thickness before
+ ! test: if htbl = water column thickness, should return mbathy
+ ! test: if htbl = 0 should return ktop (phtbl cap to e3t(ji,jj,1))
+ !
+ ! get ktbl
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ !
+ ! determine the deepest level influenced by the boundary layer
+ ikt = ktop(ji,jj)
+ ikb = ikt
+ DO WHILE ( SUM(pe3(ji,jj,ikt:ikb-1)) < phtbl(ji,jj ) ) ; ikb = ikb + 1 ; END DO
+ kbot(ji,jj) = ikb - 1
+ !
+ END DO
+ END DO
+ !
+ END SUBROUTINE isf_tbl_kbot
+ !
+ SUBROUTINE isf_tbl_ktop(pdep, ktop)
+ !!--------------------------------------------------------------------
+ !! *** ROUTINE isf_tbl_top ***
+ !!
+ !! ** Purpose : compute top level of the isf top boundary layer in case of an ice shelf parametrisation
+ !!
+ !!-------------------------- OUT -------------------------------------
+ INTEGER, DIMENSION(jpi,jpj), INTENT( out) :: ktop ! top level affected by the ice shelf parametrisation
+ !!-------------------------- IN -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pdep ! top depth of the parametrisation influence
+ !!--------------------------------------------------------------------
+ INTEGER :: ji,jj
+ INTEGER :: ikt
+ !!--------------------------------------------------------------------
+ !
+ ! if we need to recompute the top level at every time stepcompute top level (z*, z~)
+ ! in case of weak ht variation we can assume the top level of htbl to be constant
+ ! => only done using gdepw_0
+ ! be sure pdep is already correctly bounded
+ ! test: this routine run on isfdraft should return mikt
+ ! test: this routine run with pdep = 0 should return 1
+ !
+ DO ji = 1, jpi
+ DO jj = 1, jpj
+ ! comput ktop
+ ikt = 2
+ DO WHILE ( gdepw_0(ji,jj,ikt) <= pdep(ji,jj ) ) ; ikt = ikt + 1 ; END DO
+ ktop(ji,jj) = ikt - 1
+ !
+ ! update pdep
+ pdep(ji,jj) = gdepw_0(ji,jj,ktop(ji,jj))
+ END DO
+ END DO
+ !
+ END SUBROUTINE isf_tbl_ktop
+
+END MODULE isftbl
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfutils.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfutils.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfutils.F90 (revision 12150)
@@ -0,0 +1,140 @@
+MODULE isfutils
+ !!======================================================================
+ !! *** MODULE isfutils ***
+ !! istutils module : miscelenious useful routines
+ !!======================================================================
+ !! History : 4.1 ! 2019-09 (P. Mathiot) original code
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isfutils : - read_2dcstdta to read a constant input file with iom_get
+ !! - debug to print array sum, min, max in ocean.output
+ !!----------------------------------------------------------------------
+
+ USE iom , ONLY: iom_open, iom_get, iom_close, jpdom_data ! read input file
+ USE lib_fortran , ONLY: glob_sum, glob_min, glob_max ! compute global value
+ USE par_oce , ONLY: jpi,jpj,jpk ! domain size
+ USE dom_oce , ONLY: nldi, nlei, nldj, nlej ! local domain
+ USE in_out_manager, ONLY: i8, wp, lwp, numout ! miscelenious
+ USE lib_mpp
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ INTERFACE debug
+ MODULE PROCEDURE debug2d, debug3d
+ END INTERFACE debug
+
+ PUBLIC read_2dcstdta, debug
+
+CONTAINS
+
+ SUBROUTINE read_2dcstdta(cdfile, cdvar, pvar)
+ !!--------------------------------------------------------------------
+ !! *** ROUTINE read_2dcstdta ***
+ !!
+ !! ** Purpose : read input file
+ !!
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pvar ! output variable
+ !!-------------------------- IN -------------------------------------
+ CHARACTER(len=256) , INTENT(in ) :: cdfile ! input file name
+ CHARACTER(len=34) , INTENT(in ) :: cdvar ! variable name
+ !!--------------------------------------------------------------------
+ INTEGER :: inum
+ !!--------------------------------------------------------------------
+
+ CALL iom_open( TRIM(cdfile), inum )
+ CALL iom_get( inum, jpdom_data, TRIM(cdvar), pvar)
+ CALL iom_close(inum)
+
+ END SUBROUTINE read_2dcstdta
+
+ SUBROUTINE debug2d(cdtxt,pvar)
+ !!--------------------------------------------------------------------
+ !! *** ROUTINE isf_debug2d ***
+ !!
+ !! ** Purpose : add debug print for 2d variables
+ !!
+ !!-------------------------- IN -------------------------------------
+ CHARACTER(LEN=*) , INTENT(in ) :: cdtxt
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pvar
+ !!--------------------------------------------------------------------
+ REAL(wp) :: zmin, zmax, zsum
+ INTEGER(i8) :: imodd, ip
+ INTEGER :: itmps,imods, ji, jj, jk
+ !!--------------------------------------------------------------------
+ !
+ ! global min/max/sum to check data range and NaN
+ zsum = glob_sum( 'debug', pvar(:,:) )
+ zmin = glob_min( 'debug', pvar(:,:) )
+ zmax = glob_max( 'debug', pvar(:,:) )
+ !
+ ! basic check sum to check reproducibility
+ ! TRANSFER function find out the integer corresponding to pvar(i,j) bit pattern
+ ! MOD allow us to keep only the latest digits during the sum
+ ! imod is not choosen to be very large as at the end there is a classic mpp_sum
+ imodd=65521 ! highest prime number < 2**16 with i8 type
+ imods=65521 ! highest prime number < 2**16 with default integer for mpp_sum subroutine
+ itmps=0
+ DO jj=nldj,nlej
+ DO ji=nldi,nlei
+ itmps = MOD(itmps + MOD(TRANSFER(pvar(ji,jj), ip),imodd), imods)
+ END DO
+ END DO
+ CALL mpp_sum('debug',itmps)
+ !
+ ! print out
+ IF (lwp) THEN
+ WRITE(numout,*) TRIM(cdtxt),' (min, max, sum, tag) : ',zmin, zmax, zsum, itmps
+ CALL FLUSH(numout)
+ END IF
+ !
+ END SUBROUTINE debug2d
+
+ SUBROUTINE debug3d(cdtxt,pvar)
+ !!--------------------------------------------------------------------
+ !! *** ROUTINE isf_debug3d ***
+ !!
+ !! ** Purpose : add debug print for 3d variables
+ !!
+ !!-------------------------- IN -------------------------------------
+ CHARACTER(LEN=*) , INTENT(in ) :: cdtxt
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pvar
+ !!--------------------------------------------------------------------
+ REAL(wp) :: zmin, zmax, zsum
+ INTEGER(i8) :: imodd, ip
+ INTEGER :: itmps,imods, ji, jj, jk
+ !!--------------------------------------------------------------------
+ !
+ ! global min/max/sum to check data range and NaN
+ zsum = glob_sum( 'debug', pvar(:,:,:) )
+ zmin = glob_min( 'debug', pvar(:,:,:) )
+ zmax = glob_max( 'debug', pvar(:,:,:) )
+ !
+ ! basic check sum to check reproducibility
+ ! TRANSFER function find out the integer corresponding to pvar(i,j) bit pattern
+ ! MOD allow us to keep only the latest digits during the sum
+ ! imod is not choosen to be very large as at the end there is a classic mpp_sum
+ imodd=65521 ! highest prime number < 2**16 with i8 type
+ imods=65521 ! highest prime number < 2**16 with default integer for mpp_sum subroutine
+ itmps=0
+ DO jk=1,jpk
+ DO jj=nldj,nlej
+ DO ji=nldi,nlei
+ itmps = MOD(itmps + MOD(TRANSFER(pvar(ji,jj,jk), ip),imodd), imods)
+ END DO
+ END DO
+ END DO
+ CALL mpp_sum('debug',itmps)
+ !
+ ! print out
+ IF (lwp) THEN
+ WRITE(numout,*) TRIM(cdtxt),' (min, max, sum, tag) : ',zmin, zmax, zsum, itmps
+ CALL FLUSH(numout)
+ END IF
+ !
+ END SUBROUTINE debug3d
+
+END MODULE isfutils
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/LDF/ldfslp.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/LDF/ldfslp.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/LDF/ldfslp.F90 (revision 12150)
@@ -21,4 +21,5 @@
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and tracers
+ USE isf_oce ! ice shelf
USE dom_oce ! ocean space and time domain
! USE ldfdyn ! lateral diffusion: eddy viscosity coef.
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/LDF/ldftra.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/LDF/ldftra.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/LDF/ldftra.F90 (revision 12150)
@@ -660,5 +660,5 @@
! eddies using the isopycnal slopes calculated in ldfslp.F :
! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
- ze3w = e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
+ ze3w = e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)
zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w
zhw(ji,jj) = zhw(ji,jj) + ze3w
@@ -678,5 +678,5 @@
! eddies using the isopycnal slopes calculated in ldfslp.F :
! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
- ze3w = e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
+ ze3w = e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)
zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk) &
& + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbc_oce.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbc_oce.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbc_oce.F90 (revision 12150)
@@ -43,5 +43,4 @@
LOGICAL , PUBLIC :: ln_dm2dc !: Daily mean to Diurnal Cycle short wave (qsr)
LOGICAL , PUBLIC :: ln_rnf !: runoffs / runoff mouths
- LOGICAL , PUBLIC :: ln_isf !: ice shelf melting
LOGICAL , PUBLIC :: ln_ssr !: Sea Surface restoring on SST and/or SSS
LOGICAL , PUBLIC :: ln_apr_dyn !: Atmospheric pressure forcing used on dynamics (ocean & ice)
@@ -122,8 +121,6 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tot !: total E-P over ocean and ice [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmflx !: freshwater budget: freezing/melting [Kg/m2/s]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf , fwfisf_b !: ice shelf melting [Kg/m2/s]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwficb , fwficb_b !: iceberg melting [Kg/m2/s]
-
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwficb , fwficb_b !: iceberg melting [Kg/m2/s]
!!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sbc_tsc, sbc_tsc_b !: sbc content trend [K.m/s] jpi,jpj,jpts
@@ -174,6 +171,6 @@
& sfx (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) )
!
- ALLOCATE( fwfisf (jpi,jpj), rnf (jpi,jpj) , sbc_tsc (jpi,jpj,jpts) , qsr_hc (jpi,jpj,jpk) , &
- & fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , &
+ ALLOCATE( rnf (jpi,jpj) , sbc_tsc (jpi,jpj,jpts) , qsr_hc (jpi,jpj,jpk) , &
+ & rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , &
& fwficb (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) )
!
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcclo.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcclo.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcclo.F90 (revision 12150)
@@ -0,0 +1,350 @@
+MODULE sbcclo
+ !!======================================================================
+ !! *** MODULE sbcclo ***
+ !! Ocean forcing: redistribution of emp unbalance over closed sea into river mouth or open ocean
+ !!=====================================================================
+ !! History : 4.0 and earlier ! see closea.F90 history
+ !! NEMO 4.1 ! 2019-09 (P. Mathiot) rewrite sbc_clo module to match new closed sea mask definition (original sbcclo.F90)
+ !!
+ !!----------------------------------------------------------------------
+ !
+ !!----------------------------------------------------------------------
+ !! Public subroutines:
+ !! sbc_clo : update emp and qns over target area and source area
+ !! sbc_clo_init : initialise all variable needed for closed sea correction
+ !!
+ !! Private subroutines:
+ !! alloc_csarr : allocate closed sea array
+ !! get_cssrcsurf : compute source surface area
+ !! get_cstrgsurf : compute target surface area
+ !! prt_csctl : closed sea control print
+ !! sbc_csupdate : compute net fw from closed sea
+ !!----------------------------------------------------------------------
+ !
+ USE closea ! closed sea
+ USE in_out_manager ! I/O manager
+ !
+ USE dom_oce, ONLY: e1e2t ! ocean space and time domain
+ USE phycst , ONLY: rcp ! physical constants
+ USE sbc_oce, ONLY: emp, qns, rnf, sst_m ! ocean surface boundary conditions
+ USE iom , ONLY: iom_put ! I/O routines
+ USE lib_fortran, ONLY: glob_sum ! fortran library
+ USE lib_mpp , ONLY: mpp_min, ctl_stop ! MPP library
+ !
+ IMPLICIT NONE
+ !
+ PRIVATE
+ !
+ PUBLIC sbc_clo
+ PUBLIC sbc_clo_init
+ !
+ REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcg, rsurftrgg !: closed sea source/target glo surface areas
+ REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcr, rsurftrgr !: closed sea source/target rnf surface areas
+ REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrce, rsurftrge !: closed sea source/target emp surface areas
+ !
+ INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: mcsgrpg, mcsgrpr, mcsgrpe !: closed sea group for glo, rnf and emp
+ !
+ CONTAINS
+ !
+ !!----------------------------------------------------------------------
+ !! Public subroutines
+ !!----------------------------------------------------------------------
+ !
+ SUBROUTINE sbc_clo_init
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE sbc_clo_init ***
+ !!
+ !! ** Purpose : Initialisation of the variable needed for the net fw closed sea correction
+ !!
+ !! ** Method : - compute source surface area for each closed sea
+ !! - defined the group of each closed sea
+ !! (needed to manage multiple closed sea and one target area like great lakes / St Laurent outlet)
+ !! - compute target surface area
+ !!----------------------------------------------------------------------
+ !
+ ! 0. Allocate cs variables (surf)
+ CALL alloc_csarr( ncsg, rsurfsrcg, rsurftrgg, mcsgrpg )
+ CALL alloc_csarr( ncsr, rsurfsrcr, rsurftrgr, mcsgrpr )
+ CALL alloc_csarr( ncse, rsurfsrce, rsurftrge, mcsgrpe )
+ !
+ ! 1. compute source surface area
+ CALL get_cssrcsurf( ncsg, mask_csglo, rsurfsrcg )
+ CALL get_cssrcsurf( ncsr, mask_csrnf, rsurfsrcr )
+ CALL get_cssrcsurf( ncse, mask_csemp, rsurfsrce )
+ !
+ ! 2. compute target surface area and group number (mcsgrp) for all cs and cases
+ ! glo could be simpler but for lisibility, all treated the same way
+ ! It is only done once, so not a big deal
+ CALL get_cstrgsurf( ncsg, mask_csglo, mask_csgrpglo, rsurftrgg, mcsgrpg )
+ CALL get_cstrgsurf( ncsr, mask_csrnf, mask_csgrprnf, rsurftrgr, mcsgrpr )
+ CALL get_cstrgsurf( ncse, mask_csemp, mask_csgrpemp, rsurftrge, mcsgrpe )
+ !
+ ! 3. print out in ocean.ouput
+ IF ( lwp ) WRITE(numout,*) 'sbc_clo_init : compute surface area for source (closed sea) and target (river mouth)'
+ IF ( lwp ) WRITE(numout,*) '~~~~~~~~~~~~~~'
+ CALL prt_csctl( ncsg, rsurfsrcg, rsurftrgg, mcsgrpg, 'glo' )
+ CALL prt_csctl( ncsr, rsurfsrcr, rsurftrgr, mcsgrpr, 'rnf' )
+ CALL prt_csctl( ncse, rsurfsrce, rsurftrge, mcsgrpe, 'emp' )
+
+ END SUBROUTINE sbc_clo_init
+
+ SUBROUTINE sbc_clo( kt )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE sbc_clo ***
+ !!
+ !! ** Purpose : Special handling of closed seas
+ !!
+ !! ** Method : Water flux is forced to zero over closed sea
+ !! Excess is shared between remaining ocean, or
+ !! put as run-off in open ocean.
+ !!
+ !! ** Action : - compute surface freshwater fluxes and associated heat content flux at kt
+ !! - output closed sea contribution to fw and heat budget
+ !! - update emp and qns
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean model time step
+ !
+ REAL(wp), DIMENSION(jpi,jpj) :: zwcs, zqcs ! water flux and heat flux correction due to closed seas
+ !!----------------------------------------------------------------------
+ !
+ ! 0. initialisation
+ zwcs(:,:) = 0._wp ; zqcs(:,:) = 0._wp
+ !
+ ! 1. update emp and qns
+ CALL sbc_csupdate( ncsg, mcsgrpg, mask_csglo, mask_csgrpglo, rsurfsrcg, rsurftrgg, 'glo', mask_opnsea, rsurftrgg, zwcs, zqcs )
+ CALL sbc_csupdate( ncsr, mcsgrpr, mask_csrnf, mask_csgrprnf, rsurfsrcr, rsurftrgr, 'rnf', mask_opnsea, rsurftrgg, zwcs, zqcs )
+ CALL sbc_csupdate( ncse, mcsgrpe, mask_csemp, mask_csgrpemp, rsurfsrce, rsurftrge, 'emp', mask_opnsea, rsurftrgg, zwcs, zqcs )
+ !
+ ! 2. ouput closed sea contributions
+ CALL iom_put('wclosea',zwcs)
+ CALL iom_put('qclosea',zqcs)
+ !
+ ! 3. update emp and qns
+ emp(:,:) = emp(:,:) + zwcs(:,:)
+ qns(:,:) = qns(:,:) + zqcs(:,:)
+ !
+ END SUBROUTINE sbc_clo
+ !
+ !!----------------------------------------------------------------------
+ !! Private subroutines
+ !!----------------------------------------------------------------------
+ !
+ SUBROUTINE get_cssrcsurf(kncs, kmaskcs, psurfsrc)
+ !!-----------------------------------------------------------------------
+ !! *** routine get_cssrcsurf ***
+ !!
+ !! ** Purpose : compute closed sea (source) surface area
+ !!----------------------------------------------------------------------
+ ! subroutine parameters
+ INTEGER , INTENT(in ) :: kncs ! closed sea number
+ INTEGER , DIMENSION(:,:), INTENT(in ) :: kmaskcs ! closed sea mask
+ REAL(wp), DIMENSION(:) , INTENT( out) :: psurfsrc ! source surface area
+
+ ! local variables
+ INTEGER :: jcs ! loop index
+ INTEGER, DIMENSION(jpi,jpj) :: imsksrc ! source mask
+ !!----------------------------------------------------------------------
+ !
+ DO jcs = 1,kncs ! loop over closed seas
+ !
+ ! 0. build river mouth mask for this lake
+ WHERE ( kmaskcs == jcs )
+ imsksrc = 1
+ ELSE WHERE
+ imsksrc = 0
+ END WHERE
+ !
+ ! 1. compute target area
+ psurfsrc(jcs) = glob_sum('closea', e1e2t(:,:) * imsksrc(:,:) )
+ !
+ END DO ! jcs
+
+ END SUBROUTINE
+
+ SUBROUTINE get_cstrgsurf(kncs, kmaskcs, kmaskcsgrp, psurftrg, kcsgrp )
+ !!-----------------------------------------------------------------------
+ !! *** routine get_cstrgsurf ***
+ !!
+ !! ** Purpose : compute closed sea (target) surface area
+ !!----------------------------------------------------------------------
+ ! subroutine parameters
+ ! input
+ INTEGER, INTENT(in ) :: kncs ! closed sea number
+ INTEGER, DIMENSION(:,:), INTENT(in ) :: kmaskcs, kmaskcsgrp ! closed sea and group mask
+
+ ! output
+ INTEGER , DIMENSION(:) , INTENT( out) :: kcsgrp ! closed sea group number
+ REAL(wp), DIMENSION(:) , INTENT( out) :: psurftrg ! target surface area
+
+ ! local variables
+ INTEGER :: jcs, jtmp ! tmp
+ INTEGER, DIMENSION(jpi,jpj) :: imskgrp, imsksrc, imsktrg, imsk ! tmp group, source, target and tmp mask
+ !!----------------------------------------------------------------------
+ !
+ DO jcs = 1,kncs ! loop over closed seas
+ !
+ !! 0. find group number for cs number jcs
+ imskgrp(:,:) = kmaskcsgrp(:,:)
+ imsksrc(:,:) = kmaskcs(:,:)
+ !
+ ! set cs value where cs is defined
+ ! imsk = HUGE outside the cs id jcs
+ imsk(:,:) = HUGE(1)
+ WHERE ( imsksrc(:,:) == jcs ) imsk(:,:) = jcs
+ !
+ ! jtmp = jcs - group id for this lake
+ imsk(:,:) = imsk(:,:) - imskgrp(:,:)
+ jtmp = MINVAL(imsk(:,:)) ; CALL mpp_min('closea',jtmp)
+ ! kcsgrp = group id corresponding to the cs id jcs
+ ! kcsgrp(jcs)=(jcs - (jcs - group id))=group id
+ kcsgrp(jcs) = jcs - jtmp
+ !
+ !! 1. build the target river mouth mask for this lake
+ WHERE ( imskgrp(:,:) * mask_opnsea(:,:) == kcsgrp(jcs) )
+ imsktrg(:,:) = 1
+ ELSE WHERE
+ imsktrg(:,:) = 0
+ END WHERE
+ !
+ !! 2. compute target area
+ psurftrg(jcs) = glob_sum('closea', e1e2t(:,:) * imsktrg(:,:) )
+ !
+ END DO ! jcs
+
+ END SUBROUTINE
+
+ SUBROUTINE prt_csctl(kncs, psurfsrc, psurftrg, kcsgrp, cdcstype)
+ !!-----------------------------------------------------------------------
+ !! *** routine prt_csctl ***
+ !!
+ !! ** Purpose : output information about each closed sea (src id, trg id, src area and trg area)
+ !!----------------------------------------------------------------------
+ ! subroutine parameters
+ INTEGER, INTENT(in ) :: kncs ! closed sea number
+ INTEGER, DIMENSION(:) , INTENT(in ) :: kcsgrp ! closed sea group number
+ !
+ REAL(wp), DIMENSION(:), INTENT(in ) :: psurfsrc, psurftrg ! source and target surface area
+ !
+ CHARACTER(LEN=3) , INTENT(in ) :: cdcstype ! closed sea scheme used for redistribution
+ !!----------------------------------------------------------------------
+ ! local variable
+ INTEGER :: jcs
+ !!----------------------------------------------------------------------
+ !
+ IF ( lwp .AND. kncs > 0 ) THEN
+ WRITE(numout,*)''
+ !
+ WRITE(numout,*)'Closed sea target ',TRIM(cdcstype),' : '
+ !
+ DO jcs = 1,kncs
+ WRITE(numout,FMT='(3a,i3,a,i3)') ' ',TRIM(cdcstype),' closed sea id is ',jcs,' and trg group id is : ', kcsgrp(jcs)
+ WRITE(numout,FMT='(a,f12.2)' ) ' src surface areas (km2) : ', psurfsrc(jcs) * 1.0e-6
+ WRITE(numout,FMT='(a,f12.2)' ) ' trg surface areas (km2) : ', psurftrg(jcs) * 1.0e-6
+ END DO
+ !
+ WRITE(numout,*)''
+ END IF
+
+ END SUBROUTINE
+
+ SUBROUTINE sbc_csupdate(kncs, kcsgrp, kmsk_src, kmsk_grp, psurfsrc, psurftrg, cdcstype, kmsk_opnsea, psurf_opnsea, pwcs, pqcs)
+ !!-----------------------------------------------------------------------
+ !! *** routine sbc_csupdate ***
+ !!
+ !! ** Purpose : - compute the net freshwater fluxes over each closed seas
+ !! - apply correction to closed sea source/target net fwf accordingly
+ !!----------------------------------------------------------------------
+ ! subroutine parameters
+ CHARACTER(LEN=3) , INTENT(in ) :: cdcstype ! closed sea scheme used for redistribution
+ !
+ INTEGER, INTENT(in) :: kncs ! closed sea id
+ INTEGER, DIMENSION(: ), INTENT(in) :: kcsgrp ! closed sea group id
+ INTEGER, DIMENSION(:,:), INTENT(in) :: kmsk_src, kmsk_grp, kmsk_opnsea ! source, target, open ocean mask
+
+ REAL(wp), DIMENSION(:) , INTENT(in ) :: psurfsrc, psurftrg, psurf_opnsea ! source, target and open ocean surface area
+ REAL(wp), DIMENSION(:,:), INTENT(inout) :: pwcs, pqcs ! water and heat flux correction due to closed seas
+
+
+ ! local variables
+ INTEGER :: jcs ! loop index over closed sea
+ INTEGER, DIMENSION(jpi,jpj) :: imsk_src, imsk_trg ! tmp array source and target closed sea masks
+
+ REAL(wp) :: zcsfw, zcsh ! total fresh water and associated heat over one closed sea
+ REAL(wp) :: zcsfwf ! mean fresh water flux over one closed sea
+ REAL(wp) :: zsurftrg, zsurfsrc ! total target surface area
+ !!----------------------------------------------------------------------
+ !
+ DO jcs = 1, kncs ! loop over closed seas
+ !
+ !! 0. get mask and surface of the closed sea
+ ! mask src
+ WHERE ( kmsk_src(:,:) == jcs )
+ imsk_src(:,:) = 1
+ ELSEWHERE
+ imsk_src(:,:) = 0
+ END WHERE
+ ! area src
+ zsurfsrc = psurfsrc(jcs)
+ !
+ !! 1. Work out net freshwater over the closed sea from EMP - RNF.
+ !! Work out net heat associated with the correction (needed for conservation)
+ !! (PM: should we consider used delayed glob sum ?)
+ zcsfw = glob_sum( 'closea', e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * imsk_src(:,:) )
+ !
+ !! 2. Deal with runoff special case (net evaporation spread globally)
+ !! and compute trg mask
+ IF (cdcstype == 'rnf' .AND. zcsfw > 0._wp) THEN
+ zsurftrg = psurf_opnsea(1) ! change the target area surface
+ imsk_trg = kcsgrp(jcs) * kmsk_opnsea ! trg mask is now the open sea mask
+ ELSE
+ zsurftrg = psurftrg(jcs)
+ imsk_trg = kmsk_grp * kmsk_opnsea
+ END IF
+ !
+ !! 3. Subtract residuals from source points
+ zcsfwf = zcsfw / zsurfsrc
+ pwcs(:,:) = pwcs(:,:) - zcsfwf * imsk_src(:,:)
+ pqcs(:,:) = pqcs(:,:) + rcp * zcsfwf * sst_m(:,:) * imsk_src(:,:)
+ !
+ !! 4. Add residuals to target points
+ !! Do not use pqcs(:,:) = pqcs(:,:) - rcp * zcsfw * sst_m(:,:) / zsurftrg
+ !! as there is no reason heat will be conserved with this formulation
+ zcsh = glob_sum( 'closea', e1e2t(:,:) * rcp * zcsfwf * sst_m(:,:) * imsk_src(:,:) )
+ WHERE( imsk_trg(:,:) == kcsgrp(jcs) )
+ pwcs(:,:) = pwcs(:,:) + zcsfw / zsurftrg
+ pqcs(:,:) = pqcs(:,:) - zcsh / zsurftrg
+ ENDWHERE
+ !
+ END DO ! jcs
+
+ END SUBROUTINE
+
+ SUBROUTINE alloc_csarr( klen, pvarsrc, pvartrg, kvargrp )
+ !!-----------------------------------------------------------------------
+ !! *** routine alloc_cssurf ***
+ !!
+ !! ** Purpose : allocate closed sea surface array
+ !!----------------------------------------------------------------------
+ ! subroutine parameters
+ INTEGER, INTENT(in) :: klen
+ INTEGER, ALLOCATABLE, DIMENSION(:), INTENT( out) :: kvargrp
+ REAL(wp), ALLOCATABLE, DIMENSION(:), INTENT( out) :: pvarsrc, pvartrg
+ !
+ ! local variables
+ INTEGER :: ierr
+ !!----------------------------------------------------------------------
+ !
+ ! klen (number of lake) can be zero so use MAX(klen,1) to avoid 0 length array
+ ALLOCATE( pvarsrc(MAX(klen,1)) , pvartrg(MAX(klen,1)) , STAT=ierr )
+ IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array')
+ !
+ ALLOCATE( kvargrp(MAX(klen,1)) , STAT=ierr )
+ IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate group array')
+ !
+ ! initialise to 0
+ pvarsrc(:) = 0.e0_wp
+ pvartrg(:) = 0.e0_wp
+ kvargrp(:) = 0
+ END SUBROUTINE
+
+END MODULE
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbccpl.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbccpl.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbccpl.F90 (revision 12150)
@@ -27,4 +27,5 @@
USE sbcwave ! surface boundary condition: waves
USE phycst ! physical constants
+ USE isf_oce , ONLY : l_isfoasis, fwfisf_oasis ! ice shelf boundary condition
#if defined key_si3
USE ice ! ice variables
@@ -36,5 +37,4 @@
USE eosbn2 !
USE sbcrnf , ONLY : l_rnfcpl
- USE sbcisf , ONLY : l_isfcpl
#if defined key_cice
USE ice_domain_size, only: ncat
@@ -472,8 +472,9 @@
srcv(jpr_icb)%clname = 'OIceberg' ; IF( TRIM( sn_rcv_icb%cldes) == 'coupled' ) srcv(jpr_icb)%laction = .TRUE.
- IF( srcv(jpr_isf)%laction .AND. ln_isf ) THEN
- l_isfcpl = .TRUE. ! -> no need to read isf in sbcisf
+ IF( srcv(jpr_isf)%laction ) THEN
+ l_isfoasis = .TRUE. ! -> isf fwf comes from oasis
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' iceshelf received from oasis '
+ CALL ctl_stop('STOP','not coded')
ENDIF
!
@@ -1404,5 +1405,9 @@
rnf(:,:) = rnf(:,:) + fwficb(:,:) ! iceberg added to runfofs
ENDIF
- IF( srcv(jpr_isf)%laction ) fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting)
+ !
+ ! ice shelf fwf
+ IF( srcv(jpr_isf)%laction ) THEN
+ fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting)
+ END IF
IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
@@ -1707,5 +1712,5 @@
ENDIF
IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting)
- fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
+ fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)
ENDIF
@@ -1746,5 +1751,5 @@
ENDIF
IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting)
- fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
+ fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)
ENDIF
!
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcfwb.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcfwb.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcfwb.F90 (revision 12150)
@@ -17,8 +17,8 @@
USE dom_oce ! ocean space and time domain
USE sbc_oce ! surface ocean boundary condition
+ USE isf_oce , ONLY : fwfisf_cav, fwfisf_par ! ice shelf melting contribution
USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass
USE phycst ! physical constants
USE sbcrnf ! ocean runoffs
- USE sbcisf ! ice shelf melting contribution
USE sbcssr ! Sea-Surface damping terms
!
@@ -105,5 +105,5 @@
!
IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
- y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) )
+ y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) )
CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 )
z_fwfprv(1) = z_fwfprv(1) / area
@@ -160,5 +160,5 @@
ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
! ! fwf global mean (excluding ocean to ice/snow exchanges)
- z_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
+ z_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) ) / area
!
IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation
Index: MO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcisf.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcisf.F90 (revision 12149)
+++ (revision )
@@ -1,907 +1,0 @@
-MODULE sbcisf
- !!======================================================================
- !! *** MODULE sbcisf ***
- !! Surface module : update surface ocean boundary condition under ice
- !! shelf
- !!======================================================================
- !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav
- !! X.X ! 2006-02 (C. Wang ) Original code bg03
- !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! sbc_isf : update sbc under ice shelf
- !!----------------------------------------------------------------------
- USE oce ! ocean dynamics and tracers
- USE dom_oce ! ocean space and time domain
- USE phycst ! physical constants
- USE eosbn2 ! equation of state
- USE sbc_oce ! surface boundary condition: ocean fields
- USE zdfdrg ! vertical physics: top/bottom drag coef.
- !
- USE in_out_manager ! I/O manager
- USE iom ! I/O library
- USE fldread ! read input field at current time step
- USE lbclnk !
- USE lib_fortran ! glob_sum
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC sbc_isf, sbc_isf_init, sbc_isf_div, sbc_isf_alloc ! routine called in sbcmod and divhor
-
- ! public in order to be able to output then
-
- REAL(wp), PUBLIC :: rn_hisf_tbl !: thickness of top boundary layer [m]
- INTEGER , PUBLIC :: nn_isf !: flag to choose between explicit/param/specified
- INTEGER , PUBLIC :: nn_isfblk !: flag to choose the bulk formulation to compute the ice shelf melting
- INTEGER , PUBLIC :: nn_gammablk !: flag to choose how the exchange coefficient is computed
- REAL(wp), PUBLIC :: rn_gammat0 !: temperature exchange coeficient []
- REAL(wp), PUBLIC :: rn_gammas0 !: salinity exchange coeficient []
-
- INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: misfkt , misfkb !: Level of ice shelf base
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rzisf_tbl !: depth of calving front (shallowest point) nn_isf ==2/3
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhisf_tbl, rhisf_tbl_0 !: thickness of tbl [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_hisf_tbl !: 1/thickness of tbl
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ralpha !: proportion of bottom cell influenced by tbl
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfLeff !: effective length (Leff) BG03 nn_isf==2
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ttbl, stbl, utbl, vtbl !: top boundary layer variable at T point
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qisf !: net heat flux from ice shelf [W/m2]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risf_tsc_b, risf_tsc !: before and now T & S isf contents [K.m/s & PSU.m/s]
-
- LOGICAL, PUBLIC :: l_isfcpl = .false. !: isf recieved from oasis
-
- REAL(wp), PUBLIC, SAVE :: rcpisf = 2000.0_wp !: specific heat of ice shelf [J/kg/K]
- REAL(wp), PUBLIC, SAVE :: rkappa = 1.54e-6_wp !: heat diffusivity through the ice-shelf [m2/s]
- REAL(wp), PUBLIC, SAVE :: rhoisf = 920.0_wp !: volumic mass of ice shelf [kg/m3]
- REAL(wp), PUBLIC, SAVE :: tsurf = -20.0_wp !: air temperature on top of ice shelf [C]
- REAL(wp), PUBLIC, SAVE :: rLfusisf = 0.334e6_wp !: latent heat of fusion of ice shelf [J/kg]
-
-!: Variable used in fldread to read the forcing file (nn_isf == 4 .OR. nn_isf == 3)
- CHARACTER(len=100), PUBLIC :: cn_dirisf = './' !: Root directory for location of ssr files
- TYPE(FLD_N) , PUBLIC :: sn_fwfisf !: information about the isf melting file to be read
- TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_fwfisf
- TYPE(FLD_N) , PUBLIC :: sn_rnfisf !: information about the isf melting param. file to be read
- TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnfisf
- TYPE(FLD_N) , PUBLIC :: sn_depmax_isf !: information about the grounding line depth file to be read
- TYPE(FLD_N) , PUBLIC :: sn_depmin_isf !: information about the calving line depth file to be read
- TYPE(FLD_N) , PUBLIC :: sn_Leff_isf !: information about the effective length file to be read
-
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id$
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE sbc_isf( kt, Kmm )
- !!---------------------------------------------------------------------
- !! *** ROUTINE sbc_isf ***
- !!
- !! ** Purpose : Compute Salt and Heat fluxes related to ice_shelf
- !! melting and freezing
- !!
- !! ** Method : 4 parameterizations are available according to nn_isf
- !! nn_isf = 1 : Realistic ice_shelf formulation
- !! 2 : Beckmann & Goose parameterization
- !! 3 : Specified runoff in deptht (Mathiot & al. )
- !! 4 : specified fwf and heat flux forcing beneath the ice shelf
- !!----------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! ocean time step
- INTEGER, INTENT(in) :: Kmm ! ocean time level indices
- !
- INTEGER :: ji, jj, jk ! loop index
- INTEGER :: ikt, ikb ! local integers
- REAL(wp), DIMENSION(jpi,jpj) :: zt_frz, zdep ! freezing temperature (zt_frz) at depth (zdep)
- REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zqhcisf2d
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zfwfisf3d, zqhcisf3d, zqlatisf3d
- !!---------------------------------------------------------------------
- !
- IF( MOD( kt-1, nn_fsbc) == 0 ) THEN ! compute salt and heat flux
- !
- SELECT CASE ( nn_isf )
- CASE ( 1 ) ! realistic ice shelf formulation
- ! compute T/S/U/V for the top boundary layer
- CALL sbc_isf_tbl(ts(:,:,:,jp_tem,Kmm),ttbl(:,:),'T',Kmm)
- CALL sbc_isf_tbl(ts(:,:,:,jp_sal,Kmm),stbl(:,:),'T',Kmm)
- CALL sbc_isf_tbl(uu(:,:,:,Kmm) ,utbl(:,:),'U',Kmm)
- CALL sbc_isf_tbl(vv(:,:,:,Kmm) ,vtbl(:,:),'V',Kmm)
- ! iom print
- CALL iom_put('ttbl',ttbl(:,:))
- CALL iom_put('stbl',stbl(:,:))
- CALL iom_put('utbl',utbl(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:))
- CALL iom_put('vtbl',vtbl(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:))
- ! compute fwf and heat flux
- ! compute fwf and heat flux
- IF( .NOT.l_isfcpl ) THEN ; CALL sbc_isf_cav (kt, Kmm)
- ELSE ; qisf(:,:) = fwfisf(:,:) * rLfusisf ! heat flux
- ENDIF
- !
- CASE ( 2 ) ! Beckmann and Goosse parametrisation
- stbl(:,:) = soce
- CALL sbc_isf_bg03(kt, Kmm)
- !
- CASE ( 3 ) ! specified runoff in depth (Mathiot et al., XXXX in preparation)
- ! specified runoff in depth (Mathiot et al., XXXX in preparation)
- IF( .NOT.l_isfcpl ) THEN
- CALL fld_read ( kt, nn_fsbc, sf_rnfisf )
- fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting)
- ENDIF
- qisf(:,:) = fwfisf(:,:) * rLfusisf ! heat flux
- stbl(:,:) = soce
- !
- CASE ( 4 ) ! specified fwf and heat flux forcing beneath the ice shelf
- ! ! specified fwf and heat flux forcing beneath the ice shelf
- IF( .NOT.l_isfcpl ) THEN
- CALL fld_read ( kt, nn_fsbc, sf_fwfisf )
- !CALL fld_read ( kt, nn_fsbc, sf_qisf )
- fwfisf(:,:) = -sf_fwfisf(1)%fnow(:,:,1) ! fwf
- ENDIF
- qisf(:,:) = fwfisf(:,:) * rLfusisf ! heat flux
- stbl(:,:) = soce
- !
- END SELECT
-
- ! compute tsc due to isf
- ! isf melting implemented as a volume flux and we assume that melt water is at 0 PSU.
- ! WARNING water add at temp = 0C, need to add a correction term (fwfisf * tfreez / rau0).
- ! compute freezing point beneath ice shelf (or top cell if nn_isf = 3)
- DO jj = 1,jpj
- DO ji = 1,jpi
- zdep(ji,jj)=gdepw(ji,jj,misfkt(ji,jj),Kmm)
- END DO
- END DO
- CALL eos_fzp( stbl(:,:), zt_frz(:,:), zdep(:,:) )
-
- risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - fwfisf(:,:) * zt_frz(:,:) * r1_rau0 !
- risf_tsc(:,:,jp_sal) = 0.0_wp
-
- ! lbclnk
- CALL lbc_lnk_multi( 'sbcisf', risf_tsc(:,:,jp_tem), 'T', 1., risf_tsc(:,:,jp_sal), 'T', 1., fwfisf,'T', 1., qisf, 'T', 1.)
- ! output
- IF( iom_use('iceshelf_cea') ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) ) ! isf mass flux
- IF( iom_use('hflx_isf_cea') ) CALL iom_put( 'hflx_isf_cea', risf_tsc(:,:,jp_tem) * rau0 * rcp ) ! isf sensible+latent heat (W/m2)
- IF( iom_use('qlatisf' ) ) CALL iom_put( 'qlatisf' , qisf(:,:) ) ! isf latent heat
- IF( iom_use('fwfisf' ) ) CALL iom_put( 'fwfisf' , fwfisf(:,:) ) ! isf mass flux (opposite sign)
-
- ! Diagnostics
- IF( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN
- ALLOCATE( zfwfisf3d(jpi,jpj,jpk) , zqhcisf3d(jpi,jpj,jpk) , zqlatisf3d(jpi,jpj,jpk) )
- ALLOCATE( zqhcisf2d(jpi,jpj) )
- !
- zfwfisf3d (:,:,:) = 0._wp ! 3d ice shelf melting (kg/m2/s)
- zqhcisf3d (:,:,:) = 0._wp ! 3d heat content flux (W/m2)
- zqlatisf3d(:,:,:) = 0._wp ! 3d ice shelf melting latent heat flux (W/m2)
- zqhcisf2d (:,:) = fwfisf(:,:) * zt_frz * rcp ! 2d heat content flux (W/m2)
- !
- DO jj = 1,jpj
- DO ji = 1,jpi
- ikt = misfkt(ji,jj)
- ikb = misfkb(ji,jj)
- DO jk = ikt, ikb - 1
- zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf (ji,jj) * r1_hisf_tbl(ji,jj) * e3t(ji,jj,jk,Kmm)
- zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * e3t(ji,jj,jk,Kmm)
- zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf (ji,jj) * r1_hisf_tbl(ji,jj) * e3t(ji,jj,jk,Kmm)
- END DO
- zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf (ji,jj) * r1_hisf_tbl(ji,jj) &
- & * ralpha(ji,jj) * e3t(ji,jj,jk,Kmm)
- zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) &
- & * ralpha(ji,jj) * e3t(ji,jj,jk,Kmm)
- zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf (ji,jj) * r1_hisf_tbl(ji,jj) &
- & * ralpha(ji,jj) * e3t(ji,jj,jk,Kmm)
- END DO
- END DO
- !
- CALL iom_put('fwfisf3d' , zfwfisf3d (:,:,:))
- CALL iom_put('qlatisf3d', zqlatisf3d(:,:,:))
- CALL iom_put('qhcisf3d' , zqhcisf3d (:,:,:))
- CALL iom_put('qhcisf' , zqhcisf2d (:,: ))
- !
- DEALLOCATE( zfwfisf3d, zqhcisf3d, zqlatisf3d )
- DEALLOCATE( zqhcisf2d )
- ENDIF
- !
- ENDIF
-
- IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 !
- IF( ln_rstart .AND. & ! Restart: read in restart file
- & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN
- IF(lwp) WRITE(numout,*) ' nit000-1 isf tracer content forcing fields read in the restart file'
- CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) , ldxios = lrxios ) ! before salt content isf_tsc trend
- CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b' , risf_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salt content isf_tsc trend
- CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b' , risf_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before salt content isf_tsc trend
- ELSE
- fwfisf_b(:,:) = fwfisf(:,:)
- risf_tsc_b(:,:,:)= risf_tsc(:,:,:)
- ENDIF
- ENDIF
- !
- IF( lrst_oce ) THEN
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'sbc : isf surface tracer content forcing fields written in ocean restart file ', &
- & 'at it= ', kt,' date= ', ndastp
- IF(lwp) WRITE(numout,*) '~~~~'
- IF( lwxios ) CALL iom_swap( cwxios_context )
- CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:) , ldxios = lwxios )
- CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem), ldxios = lwxios )
- CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal), ldxios = lwxios )
- IF( lwxios ) CALL iom_swap( cxios_context )
- ENDIF
- !
- END SUBROUTINE sbc_isf
-
-
- INTEGER FUNCTION sbc_isf_alloc()
- !!----------------------------------------------------------------------
- !! *** FUNCTION sbc_isf_rnf_alloc ***
- !!----------------------------------------------------------------------
- sbc_isf_alloc = 0 ! set to zero if no array to be allocated
- IF( .NOT. ALLOCATED( qisf ) ) THEN
- ALLOCATE( risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts), qisf(jpi,jpj) , &
- & rhisf_tbl(jpi,jpj) , r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj) , &
- & ttbl(jpi,jpj) , stbl(jpi,jpj) , utbl(jpi,jpj) , &
- & vtbl(jpi, jpj) , risfLeff(jpi,jpj) , rhisf_tbl_0(jpi,jpj), &
- & ralpha(jpi,jpj) , misfkt(jpi,jpj) , misfkb(jpi,jpj) , &
- & STAT= sbc_isf_alloc )
- !
- CALL mpp_sum ( 'sbcisf', sbc_isf_alloc )
- IF( sbc_isf_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_isf_alloc: failed to allocate arrays.' )
- !
- ENDIF
- END FUNCTION
-
-
- SUBROUTINE sbc_isf_init( Kmm )
- !!---------------------------------------------------------------------
- !! *** ROUTINE sbc_isf_init ***
- !!
- !! ** Purpose : Initialisation of variables for iceshelf fluxes formulation
- !!
- !! ** Method : 4 parameterizations are available according to nn_isf
- !! nn_isf = 1 : Realistic ice_shelf formulation
- !! 2 : Beckmann & Goose parameterization
- !! 3 : Specified runoff in deptht (Mathiot & al. )
- !! 4 : specified fwf and heat flux forcing beneath the ice shelf
- !!----------------------------------------------------------------------
- INTEGER, INTENT(in) :: Kmm ! ocean time level indices
- INTEGER :: ji, jj, jk ! loop index
- INTEGER :: ik ! current level index
- INTEGER :: ikt, ikb ! top and bottom level of the isf boundary layer
- INTEGER :: inum, ierror
- INTEGER :: ios ! Local integer output status for namelist read
- REAL(wp) :: zhk
- CHARACTER(len=256) :: cvarzisf, cvarhisf ! name for isf file
- CHARACTER(LEN=32 ) :: cvarLeff ! variable name for efficient Length scale
- !!----------------------------------------------------------------------
- NAMELIST/namsbc_isf/ nn_isfblk, rn_hisf_tbl, rn_gammat0, rn_gammas0, nn_gammablk, nn_isf, &
- & sn_fwfisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf
- !!----------------------------------------------------------------------
-
- READ ( numnam_ref, namsbc_isf, IOSTAT = ios, ERR = 901)
-901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in reference namelist' )
-
- READ ( numnam_cfg, namsbc_isf, IOSTAT = ios, ERR = 902 )
-902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist' )
- IF(lwm) WRITE ( numond, namsbc_isf )
-
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'sbc_isf_init : heat flux of the ice shelf'
- IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
- IF(lwp) WRITE(numout,*) ' Namelist namsbc_isf :'
- IF(lwp) WRITE(numout,*) ' type ice shelf melting/freezing nn_isf = ', nn_isf
- IF(lwp) WRITE(numout,*) ' bulk formulation (nn_isf=1 only) nn_isfblk = ', nn_isfblk
- IF(lwp) WRITE(numout,*) ' thickness of the top boundary layer rn_hisf_tbl = ', rn_hisf_tbl
- IF(lwp) WRITE(numout,*) ' gamma formulation nn_gammablk = ', nn_gammablk
- IF(lwp) WRITE(numout,*) ' gammat coefficient rn_gammat0 = ', rn_gammat0
- IF(lwp) WRITE(numout,*) ' gammas coefficient rn_gammas0 = ', rn_gammas0
- IF(lwp) WRITE(numout,*) ' top drag coef. used (from namdrg_top) rn_Cd0 = ', r_Cdmin_top
-
-
- ! 1 = presence of ISF 2 = bg03 parametrisation
- ! 3 = rnf file for isf 4 = ISF fwf specified
- ! option 1 and 4 need ln_isfcav = .true. (domzgr)
- !
- ! Allocate public variable
- IF ( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_isf : unable to allocate arrays' )
- !
- ! initialisation
- qisf (:,:) = 0._wp ; fwfisf (:,:) = 0._wp
- risf_tsc(:,:,:) = 0._wp ; fwfisf_b(:,:) = 0._wp
- !
- ! define isf tbl tickness, top and bottom indice
- SELECT CASE ( nn_isf )
- CASE ( 1 )
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' ==>>> presence of under iceshelf seas (nn_isf = 1)'
- rhisf_tbl(:,:) = rn_hisf_tbl
- misfkt (:,:) = mikt(:,:) ! same indice for bg03 et cav => used in isfdiv
- !
- CASE ( 2 , 3 )
- IF( .NOT.l_isfcpl ) THEN
- ALLOCATE( sf_rnfisf(1), STAT=ierror )
- ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) )
- CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
- ENDIF
- ! read effective lenght (BG03)
- IF( nn_isf == 2 ) THEN
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' ==>>> bg03 parametrisation (nn_isf = 2)'
- CALL iom_open( sn_Leff_isf%clname, inum )
- cvarLeff = TRIM(sn_Leff_isf%clvar)
- CALL iom_get( inum, jpdom_data, cvarLeff, risfLeff , 1)
- CALL iom_close(inum)
- !
- risfLeff = risfLeff*1000.0_wp !: convertion in m
- ELSE
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' ==>>> rnf file for isf (nn_isf = 3)'
- ENDIF
- ! read depth of the top and bottom of the isf top boundary layer (in this case, isf front depth and grounding line depth)
- CALL iom_open( sn_depmax_isf%clname, inum )
- cvarhisf = TRIM(sn_depmax_isf%clvar)
- CALL iom_get( inum, jpdom_data, cvarhisf, rhisf_tbl, 1) !: depth of deepest point of the ice shelf base
- CALL iom_close(inum)
- !
- CALL iom_open( sn_depmin_isf%clname, inum )
- cvarzisf = TRIM(sn_depmin_isf%clvar)
- CALL iom_get( inum, jpdom_data, cvarzisf, rzisf_tbl, 1) !: depth of shallowest point of the ice shelves base
- CALL iom_close(inum)
- !
- rhisf_tbl(:,:) = rhisf_tbl(:,:) - rzisf_tbl(:,:) !: tickness isf boundary layer
-
- !! compute first level of the top boundary layer
- DO ji = 1, jpi
- DO jj = 1, jpj
- ik = 2
-!!gm potential bug: use gdepw_0 not _n
- DO WHILE ( ik <= mbkt(ji,jj) .AND. gdepw(ji,jj,ik,Kmm) < rzisf_tbl(ji,jj) ) ; ik = ik + 1 ; END DO
- misfkt(ji,jj) = ik-1
- END DO
- END DO
- !
- CASE ( 4 )
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' ==>>> specified fresh water flux in ISF (nn_isf = 4)'
- ! as in nn_isf == 1
- rhisf_tbl(:,:) = rn_hisf_tbl
- misfkt (:,:) = mikt(:,:) ! same indice for bg03 et cav => used in isfdiv
- !
- ! load variable used in fldread (use for temporal interpolation of isf fwf forcing)
- IF( .NOT.l_isfcpl ) THEN
- ALLOCATE( sf_fwfisf(1), STAT=ierror )
- ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) )
- CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
- ENDIF
- !
- CASE DEFAULT
- CALL ctl_stop( 'sbc_isf_init: wrong value of nn_isf' )
- END SELECT
-
- rhisf_tbl_0(:,:) = rhisf_tbl(:,:)
-
- ! compute bottom level of isf tbl and thickness of tbl below the ice shelf
- DO jj = 1,jpj
- DO ji = 1,jpi
- ikt = misfkt(ji,jj)
- ikb = misfkt(ji,jj)
- ! thickness of boundary layer at least the top level thickness
- rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t(ji,jj,ikt,Kmm))
-
- ! determine the deepest level influenced by the boundary layer
- DO jk = ikt+1, mbkt(ji,jj)
- IF( (SUM(e3t(ji,jj,ikt:jk-1,Kmm)) < rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
- END DO
- rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t(ji,jj,ikt:ikb,Kmm))) ! limit the tbl to water thickness.
- misfkb(ji,jj) = ikb ! last wet level of the tbl
- r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj)
-
- zhk = SUM( e3t(ji, jj, ikt:ikb - 1,Kmm)) * r1_hisf_tbl(ji,jj) ! proportion of tbl cover by cell from ikt to ikb - 1
- ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t(ji,jj,ikb,Kmm) ! proportion of bottom cell influenced by boundary layer
- END DO
- END DO
-
- IF( lwxios ) THEN
- CALL iom_set_rstw_var_active('fwf_isf_b')
- CALL iom_set_rstw_var_active('isf_hc_b')
- CALL iom_set_rstw_var_active('isf_sc_b')
- ENDIF
-
-
- END SUBROUTINE sbc_isf_init
-
-
- SUBROUTINE sbc_isf_bg03( kt, Kmm )
- !!---------------------------------------------------------------------
- !! *** ROUTINE sbc_isf_bg03 ***
- !!
- !! ** Purpose : add net heat and fresh water flux from ice shelf melting
- !! into the adjacent ocean
- !!
- !! ** Method : See reference
- !!
- !! ** Reference : Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean
- !! interaction for climate models", Ocean Modelling 5(2003) 157-170.
- !! (hereafter BG)
- !! History : 06-02 (C. Wang) Original code
- !!----------------------------------------------------------------------
- INTEGER, INTENT ( in ) :: kt
- INTEGER, INTENT ( in ) :: Kmm ! ocean time level indices
- !
- INTEGER :: ji, jj, jk ! dummy loop index
- INTEGER :: ik ! current level
- REAL(wp) :: zt_sum ! sum of the temperature between 200m and 600m
- REAL(wp) :: zt_ave ! averaged temperature between 200m and 600m
- REAL(wp) :: zt_frz ! freezing point temperature at depth z
- REAL(wp) :: zpress ! pressure to compute the freezing point in depth
- !!----------------------------------------------------------------------
- !
- DO ji = 1, jpi
- DO jj = 1, jpj
- ik = misfkt(ji,jj)
- !! Initialize arrays to 0 (each step)
- zt_sum = 0.e0_wp
- IF ( ik > 1 ) THEN
- ! 1. -----------the average temperature between 200m and 600m ---------------------
- DO jk = misfkt(ji,jj),misfkb(ji,jj)
- ! Calculate freezing temperature
- zpress = grav*rau0*gdept(ji,jj,ik,Kmm)*1.e-04
- CALL eos_fzp(stbl(ji,jj), zt_frz, zpress)
- zt_sum = zt_sum + (ts(ji,jj,jk,jp_tem,Kmm)-zt_frz) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) ! sum temp
- END DO
- zt_ave = zt_sum/rhisf_tbl(ji,jj) ! calcul mean value
- ! 2. ------------Net heat flux and fresh water flux due to the ice shelf
- ! For those corresponding to zonal boundary
- qisf(ji,jj) = - rau0 * rcp * rn_gammat0 * risfLeff(ji,jj) * e1t(ji,jj) * zt_ave &
- & * r1_e1e2t(ji,jj) * tmask(ji,jj,jk)
-
- fwfisf(ji,jj) = qisf(ji,jj) / rLfusisf !fresh water flux kg/(m2s)
- fwfisf(ji,jj) = fwfisf(ji,jj) * ( soce / stbl(ji,jj) )
- !add to salinity trend
- ELSE
- qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp
- END IF
- END DO
- END DO
- !
- END SUBROUTINE sbc_isf_bg03
-
-
- SUBROUTINE sbc_isf_cav( kt, Kmm )
- !!---------------------------------------------------------------------
- !! *** ROUTINE sbc_isf_cav ***
- !!
- !! ** Purpose : handle surface boundary condition under ice shelf
- !!
- !! ** Method : -
- !!
- !! ** Action : utau, vtau : remain unchanged
- !! taum, wndm : remain unchanged
- !! qns : update heat flux below ice shelf
- !! emp, emps : update freshwater flux below ice shelf
- !!---------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! ocean time step
- INTEGER, INTENT(in) :: Kmm ! ocean time level index
- !
- INTEGER :: ji, jj ! dummy loop indices
- INTEGER :: nit
- LOGICAL :: lit
- REAL(wp) :: zlamb1, zlamb2, zlamb3
- REAL(wp) :: zeps1,zeps2,zeps3,zeps4,zeps6,zeps7
- REAL(wp) :: zaqe,zbqe,zcqe,zaqer,zdis,zsfrz,zcfac
- REAL(wp) :: zeps = 1.e-20_wp
- REAL(wp) :: zerr
- REAL(wp), DIMENSION(jpi,jpj) :: zfrz
- REAL(wp), DIMENSION(jpi,jpj) :: zgammat, zgammas
- REAL(wp), DIMENSION(jpi,jpj) :: zfwflx, zhtflx, zhtflx_b
- !!---------------------------------------------------------------------
- !
- ! coeficient for linearisation of potential tfreez
- ! Crude approximation for pressure (but commonly used)
- IF ( l_useCT ) THEN ! linearisation from Jourdain et al. (2017)
- zlamb1 =-0.0564_wp
- zlamb2 = 0.0773_wp
- zlamb3 =-7.8633e-8 * grav * rau0
- ELSE ! linearisation from table 4 (Asay-Davis et al., 2015)
- zlamb1 =-0.0573_wp
- zlamb2 = 0.0832_wp
- zlamb3 =-7.53e-8 * grav * rau0
- ENDIF
- !
- ! initialisation
- zgammat(:,:) = rn_gammat0 ; zgammas (:,:) = rn_gammas0
- zhtflx (:,:) = 0.0_wp ; zhtflx_b(:,:) = 0.0_wp
- zfwflx (:,:) = 0.0_wp
-
- ! compute ice shelf melting
- nit = 1 ; lit = .TRUE.
- DO WHILE ( lit ) ! maybe just a constant number of iteration as in blk_core is fine
- SELECT CASE ( nn_isfblk )
- CASE ( 1 ) ! ISOMIP formulation (2 equations) for volume flux (Hunter et al., 2006)
- ! Calculate freezing temperature
- CALL eos_fzp( stbl(:,:), zfrz(:,:), risfdep(:,:) )
-
- ! compute gammat every where (2d)
- CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx, Kmm)
-
- ! compute upward heat flux zhtflx and upward water flux zwflx
- DO jj = 1, jpj
- DO ji = 1, jpi
- zhtflx(ji,jj) = zgammat(ji,jj)*rcp*rau0*(ttbl(ji,jj)-zfrz(ji,jj))
- zfwflx(ji,jj) = - zhtflx(ji,jj)/rLfusisf
- END DO
- END DO
-
- ! Compute heat flux and upward fresh water flux
- qisf (:,:) = - zhtflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
- fwfisf(:,:) = zfwflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
-
- CASE ( 2 ) ! ISOMIP+ formulation (3 equations) for volume flux (Asay-Davis et al., 2015)
- ! compute gammat every where (2d)
- CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx, Kmm)
-
- ! compute upward heat flux zhtflx and upward water flux zwflx
- ! Resolution of a 2d equation from equation 21, 22 and 23 to find Sb (Asay-Davis et al., 2015)
- DO jj = 1, jpj
- DO ji = 1, jpi
- ! compute coeficient to solve the 2nd order equation
- zeps1 = rcp*rau0*zgammat(ji,jj)
- zeps2 = rLfusisf*rau0*zgammas(ji,jj)
- zeps3 = rhoisf*rcpisf*rkappa/MAX(risfdep(ji,jj),zeps)
- zeps4 = zlamb2+zlamb3*risfdep(ji,jj)
- zeps6 = zeps4-ttbl(ji,jj)
- zeps7 = zeps4-tsurf
- zaqe = zlamb1 * (zeps1 + zeps3)
- zaqer = 0.5_wp/MIN(zaqe,-zeps)
- zbqe = zeps1*zeps6+zeps3*zeps7-zeps2
- zcqe = zeps2*stbl(ji,jj)
- zdis = zbqe*zbqe-4.0_wp*zaqe*zcqe
-
- ! Presumably zdis can never be negative because gammas is very small compared to gammat
- ! compute s freeze
- zsfrz=(-zbqe-SQRT(zdis))*zaqer
- IF ( zsfrz < 0.0_wp ) zsfrz=(-zbqe+SQRT(zdis))*zaqer
-
- ! compute t freeze (eq. 22)
- zfrz(ji,jj)=zeps4+zlamb1*zsfrz
-
- ! zfwflx is upward water flux
- ! zhtflx is upward heat flux (out of ocean)
- ! compute the upward water and heat flux (eq. 28 and eq. 29)
- zfwflx(ji,jj) = rau0 * zgammas(ji,jj) * (zsfrz-stbl(ji,jj)) / MAX(zsfrz,zeps)
- zhtflx(ji,jj) = zgammat(ji,jj) * rau0 * rcp * (ttbl(ji,jj) - zfrz(ji,jj) )
- END DO
- END DO
-
- ! compute heat and water flux
- qisf (:,:) = - zhtflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
- fwfisf(:,:) = zfwflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
-
- END SELECT
-
- ! define if we need to iterate (nn_gammablk 0/1 do not need iteration)
- IF ( nn_gammablk < 2 ) THEN ; lit = .FALSE.
- ELSE
- ! check total number of iteration
- IF (nit >= 100) THEN ; CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
- ELSE ; nit = nit + 1
- END IF
-
- ! compute error between 2 iterations
- ! if needed save gammat and compute zhtflx_b for next iteration
- zerr = MAXVAL(ABS(zhtflx-zhtflx_b))
- IF ( zerr <= 0.01_wp ) THEN ; lit = .FALSE.
- ELSE ; zhtflx_b(:,:) = zhtflx(:,:)
- END IF
- END IF
- END DO
- !
- CALL iom_put('isfgammat', zgammat)
- CALL iom_put('isfgammas', zgammas)
- !
- END SUBROUTINE sbc_isf_cav
-
-
- SUBROUTINE sbc_isf_gammats(pgt, pgs, pqhisf, pqwisf, Kmm )
- !!----------------------------------------------------------------------
- !! ** Purpose : compute the coefficient echange for heat flux
- !!
- !! ** Method : gamma assume constant or depends of u* and stability
- !!
- !! ** References : Holland and Jenkins, 1999, JPO, p1787-1800, eq 14
- !! Jenkins et al., 2010, JPO, p2298-2312
- !!---------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:), INTENT( out) :: pgt , pgs !
- REAL(wp), DIMENSION(:,:), INTENT(in ) :: pqhisf, pqwisf !
- INTEGER , INTENT(in ) :: Kmm ! ocean time level indices
- !
- INTEGER :: ji, jj ! loop index
- INTEGER :: ikt ! local integer
- REAL(wp) :: zdku, zdkv ! U, V shear
- REAL(wp) :: zPr, zSc, zRc ! Prandtl, Scmidth and Richardson number
- REAL(wp) :: zmob, zmols ! Monin Obukov length, coriolis factor at T point
- REAL(wp) :: zbuofdep, zhnu ! Bouyancy length scale, sublayer tickness
- REAL(wp) :: zhmax ! limitation of mol
- REAL(wp) :: zetastar ! stability parameter
- REAL(wp) :: zgmolet, zgmoles, zgturb ! contribution of modelecular sublayer and turbulence
- REAL(wp) :: zcoef ! temporary coef
- REAL(wp) :: zdep
- REAL(wp) :: zeps = 1.0e-20_wp
- REAL(wp), PARAMETER :: zxsiN = 0.052_wp ! dimensionless constant
- REAL(wp), PARAMETER :: znu = 1.95e-6_wp ! kinamatic viscosity of sea water (m2.s-1)
- REAL(wp), DIMENSION(2) :: zts, zab
- REAL(wp), DIMENSION(jpi,jpj) :: zustar ! U, V at T point and friction velocity
- !!---------------------------------------------------------------------
- !
- SELECT CASE ( nn_gammablk )
- CASE ( 0 ) ! gamma is constant (specified in namelist)
- !! ISOMIP formulation (Hunter et al, 2006)
- pgt(:,:) = rn_gammat0
- pgs(:,:) = rn_gammas0
-
- CASE ( 1 ) ! gamma is assume to be proportional to u*
- !! Jenkins et al., 2010, JPO, p2298-2312
- !! Adopted by Asay-Davis et al. (2015)
- !! compute ustar (eq. 24)
-!!gm NB use pCdU here so that it will incorporate local boost of Cd0 and log layer case :
-!! zustar(:,:) = SQRT( rCdU_top(:,:) * SQRT(utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + r_ke0_top) )
-!! or better : compute ustar in zdfdrg and use it here as well as in TKE, GLS and Co
-!!
-!! ===>>>> GM to be done this chrismas
-!!
-!!gm end
- zustar(:,:) = SQRT( r_Cdmin_top * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + r_ke0_top) )
-
- !! Compute gammats
- pgt(:,:) = zustar(:,:) * rn_gammat0
- pgs(:,:) = zustar(:,:) * rn_gammas0
-
- CASE ( 2 ) ! gamma depends of stability of boundary layer
- !! Holland and Jenkins, 1999, JPO, p1787-1800, eq 14
- !! as MOL depends of flux and flux depends of MOL, best will be iteration (TO DO)
- !! compute ustar
- zustar(:,:) = SQRT( r_Cdmin_top * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + r_ke0_top) )
-
- !! compute Pr and Sc number (can be improved)
- zPr = 13.8_wp
- zSc = 2432.0_wp
-
- !! compute gamma mole
- zgmolet = 12.5_wp * zPr ** (2.0/3.0) - 6.0_wp
- zgmoles = 12.5_wp * zSc ** (2.0/3.0) - 6.0_wp
-
- !! compute gamma
- DO ji = 2, jpi
- DO jj = 2, jpj
- ikt = mikt(ji,jj)
-
- IF( zustar(ji,jj) == 0._wp ) THEN ! only for kt = 1 I think
- pgt = rn_gammat0
- pgs = rn_gammas0
- ELSE
- !! compute Rc number (as done in zdfric.F90)
-!!gm better to do it like in the new zdfric.F90 i.e. avm weighted Ri computation
-!!gm moreover, use Max(rn2,0) to take care of static instabilities....
- zcoef = 0.5_wp / e3w(ji,jj,ikt+1,Kmm)
- ! ! shear of horizontal velocity
- zdku = zcoef * ( uu(ji-1,jj ,ikt ,Kmm) + uu(ji,jj,ikt ,Kmm) &
- & -uu(ji-1,jj ,ikt+1,Kmm) - uu(ji,jj,ikt+1,Kmm) )
- zdkv = zcoef * ( vv(ji ,jj-1,ikt ,Kmm) + vv(ji,jj,ikt ,Kmm) &
- & -vv(ji ,jj-1,ikt+1,Kmm) - vv(ji,jj,ikt+1,Kmm) )
- ! ! richardson number (minimum value set to zero)
- zRc = rn2(ji,jj,ikt+1) / MAX( zdku*zdku + zdkv*zdkv, zeps )
-
- !! compute bouyancy
- zts(jp_tem) = ttbl(ji,jj)
- zts(jp_sal) = stbl(ji,jj)
- zdep = gdepw(ji,jj,ikt,Kmm)
- !
- CALL eos_rab( zts, zdep, zab, Kmm )
- !
- !! compute length scale
- zbuofdep = grav * ( zab(jp_tem) * pqhisf(ji,jj) - zab(jp_sal) * pqwisf(ji,jj) ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !! compute Monin Obukov Length
- ! Maximum boundary layer depth
- zhmax = gdept(ji,jj,mbkt(ji,jj),Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) -0.001_wp
- ! Compute Monin obukhov length scale at the surface and Ekman depth:
- zmob = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps))
- zmols = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt)
-
- !! compute eta* (stability parameter)
- zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff_f(ji,jj)) * zmols * zRc ), 0._wp)))
-
- !! compute the sublayer thickness
- zhnu = 5 * znu / zustar(ji,jj)
-
- !! compute gamma turb
- zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff_f(ji,jj)) * zhnu )) &
- & + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn
-
- !! compute gammats
- pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet)
- pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles)
- END IF
- END DO
- END DO
- CALL lbc_lnk_multi( 'sbcisf', pgt, 'T', 1., pgs, 'T', 1.)
- END SELECT
- !
- END SUBROUTINE sbc_isf_gammats
-
-
- SUBROUTINE sbc_isf_tbl( pvarin, pvarout, cd_ptin, Kmm )
- !!----------------------------------------------------------------------
- !! *** SUBROUTINE sbc_isf_tbl ***
- !!
- !! ** Purpose : compute mean T/S/U/V in the boundary layer at T- point
- !!
- !!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pvarin
- REAL(wp), DIMENSION(:,:) , INTENT( out) :: pvarout
- CHARACTER(len=1), INTENT(in ) :: cd_ptin ! point of variable in/out
- INTEGER , INTENT(in ) :: Kmm ! ocean time level indices
- !
- INTEGER :: ji, jj, jk ! loop index
- INTEGER :: ikt, ikb ! top and bottom index of the tbl
- REAL(wp) :: ze3, zhk
- REAL(wp), DIMENSION(jpi,jpj) :: zhisf_tbl ! thickness of the tbl
- !!----------------------------------------------------------------------
-
- ! initialisation
- pvarout(:,:)=0._wp
-
- SELECT CASE ( cd_ptin )
- CASE ( 'U' ) ! compute U in the top boundary layer at T- point
- DO jj = 1,jpj
- DO ji = 1,jpi
- ikt = miku(ji,jj) ; ikb = miku(ji,jj)
- ! thickness of boundary layer at least the top level thickness
- zhisf_tbl(ji,jj) = MAX( rhisf_tbl_0(ji,jj) , e3u(ji,jj,ikt,Kmm) )
-
- ! determine the deepest level influenced by the boundary layer
- DO jk = ikt+1, mbku(ji,jj)
- IF ( (SUM(e3u(ji,jj,ikt:jk-1,Kmm)) < zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk
- END DO
- zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3u(ji,jj,ikt:ikb,Kmm))) ! limit the tbl to water thickness.
-
- ! level fully include in the ice shelf boundary layer
- DO jk = ikt, ikb - 1
- ze3 = e3u(ji,jj,jk,Kmm)
- pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3
- END DO
-
- ! level partially include in ice shelf boundary layer
- zhk = SUM( e3u(ji, jj, ikt:ikb - 1,Kmm)) / zhisf_tbl(ji,jj)
- pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
- END DO
- END DO
- DO jj = 2, jpj
- DO ji = 2, jpi
-!!gm a wet-point only average should be used here !!!
- pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji-1,jj))
- END DO
- END DO
- CALL lbc_lnk('sbcisf', pvarout,'T',-1.)
-
- CASE ( 'V' ) ! compute V in the top boundary layer at T- point
- DO jj = 1,jpj
- DO ji = 1,jpi
- ikt = mikv(ji,jj) ; ikb = mikv(ji,jj)
- ! thickness of boundary layer at least the top level thickness
- zhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3v(ji,jj,ikt,Kmm))
-
- ! determine the deepest level influenced by the boundary layer
- DO jk = ikt+1, mbkv(ji,jj)
- IF ( (SUM(e3v(ji,jj,ikt:jk-1,Kmm)) < zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk
- END DO
- zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3v(ji,jj,ikt:ikb,Kmm))) ! limit the tbl to water thickness.
-
- ! level fully include in the ice shelf boundary layer
- DO jk = ikt, ikb - 1
- ze3 = e3v(ji,jj,jk,Kmm)
- pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3
- END DO
-
- ! level partially include in ice shelf boundary layer
- zhk = SUM( e3v(ji, jj, ikt:ikb - 1,Kmm)) / zhisf_tbl(ji,jj)
- pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
- END DO
- END DO
- DO jj = 2, jpj
- DO ji = 2, jpi
-!!gm a wet-point only average should be used here !!!
- pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji,jj-1))
- END DO
- END DO
- CALL lbc_lnk('sbcisf', pvarout,'T',-1.)
-
- CASE ( 'T' ) ! compute T in the top boundary layer at T- point
- DO jj = 1,jpj
- DO ji = 1,jpi
- ikt = misfkt(ji,jj)
- ikb = misfkb(ji,jj)
-
- ! level fully include in the ice shelf boundary layer
- DO jk = ikt, ikb - 1
- ze3 = e3t(ji,jj,jk,Kmm)
- pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) * r1_hisf_tbl(ji,jj) * ze3
- END DO
-
- ! level partially include in ice shelf boundary layer
- zhk = SUM( e3t(ji, jj, ikt:ikb - 1,Kmm)) * r1_hisf_tbl(ji,jj)
- pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
- END DO
- END DO
- END SELECT
- !
- ! mask mean tbl value
- pvarout(:,:) = pvarout(:,:) * ssmask(:,:)
- !
- END SUBROUTINE sbc_isf_tbl
-
-
- SUBROUTINE sbc_isf_div( phdivn, Kmm )
- !!----------------------------------------------------------------------
- !! *** SUBROUTINE sbc_isf_div ***
- !!
- !! ** Purpose : update the horizontal divergence with the runoff inflow
- !!
- !! ** Method :
- !! CAUTION : risf_tsc(:,:,jp_sal) is negative (outflow) increase the
- !! divergence and expressed in m/s
- !!
- !! ** Action : phdivn decreased by the runoff inflow
- !!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT( inout ) :: phdivn ! horizontal divergence
- INTEGER , INTENT( in ) :: Kmm ! ocean time level indices
- !
- INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: ikt, ikb
- REAL(wp) :: zhk
- REAL(wp) :: zfact ! local scalar
- !!----------------------------------------------------------------------
- !
- zfact = 0.5_wp
- !
- IF(.NOT.ln_linssh ) THEN ! need to re compute level distribution of isf fresh water
- DO jj = 1,jpj
- DO ji = 1,jpi
- ikt = misfkt(ji,jj)
- ikb = misfkt(ji,jj)
- ! thickness of boundary layer at least the top level thickness
- rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t(ji,jj,ikt,Kmm))
-
- ! determine the deepest level influenced by the boundary layer
- DO jk = ikt, mbkt(ji,jj)
- IF ( (SUM(e3t(ji,jj,ikt:jk-1,Kmm)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
- END DO
- rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t(ji,jj,ikt:ikb,Kmm))) ! limit the tbl to water thickness.
- misfkb(ji,jj) = ikb ! last wet level of the tbl
- r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj)
-
- zhk = SUM( e3t(ji, jj, ikt:ikb - 1,Kmm)) * r1_hisf_tbl(ji,jj) ! proportion of tbl cover by cell from ikt to ikb - 1
- ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t(ji,jj,ikb,Kmm) ! proportion of bottom cell influenced by boundary layer
- END DO
- END DO
- END IF
- !
- !== ice shelf melting distributed over several levels ==!
- DO jj = 1,jpj
- DO ji = 1,jpi
- ikt = misfkt(ji,jj)
- ikb = misfkb(ji,jj)
- ! level fully include in the ice shelf boundary layer
- DO jk = ikt, ikb - 1
- phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + ( fwfisf(ji,jj) + fwfisf_b(ji,jj) ) &
- & * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact
- END DO
- ! level partially include in ice shelf boundary layer
- phdivn(ji,jj,ikb) = phdivn(ji,jj,ikb) + ( fwfisf(ji,jj) &
- & + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact * ralpha(ji,jj)
- END DO
- END DO
- !
- END SUBROUTINE sbc_isf_div
-
- !!======================================================================
-END MODULE sbcisf
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcmod.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcmod.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcmod.F90 (revision 12150)
@@ -24,4 +24,5 @@
USE oce ! ocean dynamics and tracers
USE dom_oce ! ocean space and time domain
+ USE closea ! closed seas
USE phycst ! physical constants
USE sbc_oce ! Surface boundary condition: ocean fields
@@ -37,11 +38,10 @@
#endif
USE sbcice_cice ! surface boundary condition: CICE sea-ice model
- USE sbcisf ! surface boundary condition: ice-shelf
USE sbccpl ! surface boundary condition: coupled formulation
USE cpl_oasis3 ! OASIS routines for coupling
+ USE sbcclo ! surface boundary condition: closed sea correction
USE sbcssr ! surface boundary condition: sea surface restoring
USE sbcrnf ! surface boundary condition: runoffs
USE sbcapr ! surface boundary condition: atmo pressure
- USE sbcisf ! surface boundary condition: ice shelf
USE sbcfwb ! surface boundary condition: freshwater budget
USE icbstp ! Icebergs
@@ -92,12 +92,12 @@
LOGICAL :: ll_purecpl, ll_opa, ll_not_nemo ! local logical
!!
- NAMELIST/namsbc/ nn_fsbc , &
- & ln_usr , ln_flx , ln_blk , &
- & ln_cpl , ln_mixcpl, nn_components, &
- & nn_ice , ln_ice_embd, &
- & ln_traqsr, ln_dm2dc , &
- & ln_rnf , nn_fwb , ln_ssr , ln_isf , ln_apr_dyn , &
- & ln_wave , ln_cdgw , ln_sdw , ln_tauwoc , ln_stcor , &
- & ln_tauw , nn_lsm, nn_sdrift
+ NAMELIST/namsbc/ nn_fsbc , &
+ & ln_usr , ln_flx , ln_blk , &
+ & ln_cpl , ln_mixcpl , nn_components, &
+ & nn_ice , ln_ice_embd, &
+ & ln_traqsr, ln_dm2dc , &
+ & ln_rnf , nn_fwb , ln_ssr , ln_apr_dyn, &
+ & ln_wave , ln_cdgw , ln_sdw , ln_tauwoc , ln_stcor, &
+ & ln_tauw , nn_lsm , nn_sdrift
!!----------------------------------------------------------------------
!
@@ -152,5 +152,4 @@
WRITE(numout,*) ' Patm gradient added in ocean & ice Eqs. ln_apr_dyn = ', ln_apr_dyn
WRITE(numout,*) ' runoff / runoff mouths ln_rnf = ', ln_rnf
- WRITE(numout,*) ' iceshelf formulation ln_isf = ', ln_isf
WRITE(numout,*) ' nb of iterations if land-sea-mask applied nn_lsm = ', nn_lsm
WRITE(numout,*) ' surface wave ln_wave = ', ln_wave
@@ -239,9 +238,4 @@
#endif
!
- IF( .NOT.ln_isf ) THEN !* No ice-shelf in the domain : allocate and set to zero
- IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
- fwfisf (:,:) = 0._wp ; risf_tsc (:,:,:) = 0._wp
- fwfisf_b(:,:) = 0._wp ; risf_tsc_b(:,:,:) = 0._wp
- END IF
IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero
IF( nn_components /= jp_iam_opa ) fr_i(:,:) = 0._wp ! except for OPA in SAS-OPA coupled case
@@ -329,9 +323,10 @@
CALL sbc_ssm_init ( Kbb, Kmm ) ! Sea-surface mean fields initialization
!
+ IF( l_sbc_clo ) CALL sbc_clo_init ! closed sea surface initialisation
+ !
IF( ln_blk ) CALL sbc_blk_init ! bulk formulae initialization
IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialization
!
- IF( ln_isf ) CALL sbc_isf_init( Kmm ) ! Compute iceshelves
!
CALL sbc_rnf_init( Kmm ) ! Runof initialization
@@ -402,8 +397,4 @@
rnf_b (:,: ) = rnf (:,: )
rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
- ENDIF
- IF( ln_isf ) THEN
- fwfisf_b (:,: ) = fwfisf (:,: )
- risf_tsc_b(:,:,:) = risf_tsc(:,:,:)
ENDIF
!
@@ -456,7 +447,5 @@
ENDIF
- IF( ln_isf ) CALL sbc_isf( kt, Kmm ) ! compute iceshelves
-
- IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes
+ IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes
IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term
@@ -466,5 +455,5 @@
! Special treatment of freshwater fluxes over closed seas in the model domain
! Should not be run if ln_diurnal_only
- IF( l_sbc_clo .AND. (.NOT. ln_diurnal_only) ) CALL sbc_clo( kt )
+ IF( l_sbc_clo ) CALL sbc_clo( kt )
!!$!RBbug do not understand why see ticket 667
@@ -559,10 +548,10 @@
!
IF(ln_ctl) THEN ! print mean trends (used for debugging)
- CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ' , mask1=tmask )
- CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf) , clinfo1=' emp-rnf - : ' , mask1=tmask )
- CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf) , clinfo1=' sfx-rnf - : ' , mask1=tmask )
- CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask )
- CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask )
- CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk )
+ CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=(sfx-rnf) , clinfo1=' sfx-rnf - : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask )
+ CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk )
CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst - : ', mask1=tmask, kdim=1 )
CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss - : ', mask1=tmask, kdim=1 )
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcrnf.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcrnf.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcrnf.F90 (revision 12150)
@@ -19,7 +19,6 @@
USE phycst ! physical constants
USE sbc_oce ! surface boundary condition variables
- USE sbcisf ! PM we could remove it I think
USE eosbn2 ! Equation Of State
- USE closea ! closed seas
+ USE closea, ONLY: l_clo_rnf, clo_rnf ! closed seas
!
USE in_out_manager ! I/O manager
@@ -127,7 +126,4 @@
rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
END WHERE
- WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg
- rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * rLfusisf * r1_rau0_rcp
- END WHERE
ELSE ! use SST as runoffs temperature
!CEOD River is fresh water so must at least be 0 unless we consider ice
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcssm.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcssm.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcssm.F90 (revision 12150)
@@ -61,10 +61,6 @@
!
! !* surface T-, U-, V- ocean level variables (T, S, depth, velocity)
- DO jj = 1, jpj
- DO ji = 1, jpi
- zts(ji,jj,jp_tem) = ts(ji,jj,mikt(ji,jj),jp_tem,Kmm)
- zts(ji,jj,jp_sal) = ts(ji,jj,mikt(ji,jj),jp_sal,Kmm)
- END DO
- END DO
+ zts(:,:,jp_tem) = ts(:,:,1,jp_tem,Kmm)
+ zts(:,:,jp_sal) = ts(:,:,1,jp_sal,Kmm)
!
IF( nn_fsbc == 1 ) THEN ! Instantaneous surface fields !
@@ -73,5 +69,5 @@
ssv_m(:,:) = vv(:,:,1,Kbb)
IF( l_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
- ELSE ; sst_m(:,:) = zts(:,:,jp_tem)
+ ELSE ; sst_m(:,:) = zts(:,:,jp_tem)
ENDIF
sss_m(:,:) = zts(:,:,jp_sal)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/eosbn2.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/eosbn2.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/eosbn2.F90 (revision 12150)
@@ -29,5 +29,4 @@
!! eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass
!! eos_insitu_2d : Compute the in situ density for 2d fields
- !! bn2 : Compute the Brunt-Vaisala frequency
!! bn2 : compute the Brunt-Vaisala frequency
!! eos_pt_from_ct: compute the potential temperature from the Conservative Temperature
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traatf.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traatf.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traatf.F90 (revision 12150)
@@ -29,5 +29,5 @@
USE sbc_oce ! surface boundary condition: ocean
USE sbcrnf ! river runoffs
- USE sbcisf ! ice shelf melting
+ USE isf_oce ! ice shelf melting
USE zdf_oce ! ocean vertical mixing
USE domvvl ! variable volume
@@ -302,19 +302,22 @@
!
IF( jk == mikt(ji,jj) ) THEN ! first level
- ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj) - emp(ji,jj) ) &
- & + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) )
+ ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) )
ztc_f = ztc_f - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
ENDIF
IF( ln_rnf_depth ) THEN
! Rivers are not just at the surface must go down to nk_rnf(ji,jj)
- IF( mikt(ji,jj) <=jk .and. jk <= nk_rnf(ji,jj) ) THEN
+ IF( jk <= nk_rnf(ji,jj) ) THEN
ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj) ) ) &
& * ( e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj) )
ENDIF
ELSE
- IF( jk == mikt(ji,jj) ) THEN ! first level
+ IF( jk == 1 ) THEN ! first level
ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj) ) )
ENDIF
ENDIF
+ !
+ IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) &
+ & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &
+ & * e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj)
!
@@ -323,19 +326,55 @@
& ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )
!
- ! river runoff
- IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) &
- & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &
- & * e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj)
- !
+ !
! ice shelf
IF( ll_isf ) THEN
- ! level fully include in the Losch_2008 ice shelf boundary layer
- IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) ) &
- ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) &
- & * e3t(ji,jj,jk,Kmm) * r1_hisf_tbl (ji,jj)
- ! level partially include in Losch_2008 ice shelf boundary layer
- IF ( jk == misfkb(ji,jj) ) &
- ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) &
- & * e3t(ji,jj,jk,Kmm) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
+ !
+ ! melt in the cavity
+ IF ( ln_isfcav_mlt ) THEN
+ ! level fully include in the Losch_2008 ice shelf boundary layer
+ IF ( jk >= misfkt_cav(ji,jj) .AND. jk < misfkb_cav(ji,jj) ) THEN
+ ztc_f = ztc_f - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) ) &
+ & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj)
+ ze3t_f = ze3t_f - zfact2 * ( fwfisf_cav_b(ji,jj) - fwfisf_cav(ji,jj) ) &
+ & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj)
+ END IF
+ ! level partially include in Losch_2008 ice shelf boundary layer
+ IF ( jk == misfkb_cav(ji,jj) ) THEN
+ ztc_f = ztc_f - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) ) &
+ & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) * rfrac_tbl_cav(ji,jj)
+ ze3t_f = ze3t_f - zfact2 * ( fwfisf_cav_b(ji,jj) - fwfisf_cav(ji,jj) ) &
+ & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) * rfrac_tbl_cav(ji,jj)
+ END IF
+ END IF
+ !
+ ! parametrised melt (cavity closed)
+ IF ( ln_isfpar_mlt ) THEN
+ ! level fully include in the Losch_2008 ice shelf boundary layer
+ IF ( jk >= misfkt_par(ji,jj) .AND. jk < misfkb_par(ji,jj) ) THEN
+ ztc_f = ztc_f - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) ) &
+ & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj)
+ ze3t_f = ze3t_f - zfact2 * ( fwfisf_par_b(ji,jj) - fwfisf_par(ji,jj) ) &
+ & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj)
+ END IF
+ ! level partially include in Losch_2008 ice shelf boundary layer
+ IF ( jk == misfkb_par(ji,jj) ) THEN
+ ztc_f = ztc_f - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) ) &
+ & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) * rfrac_tbl_par(ji,jj)
+ ze3t_f = ze3t_f - zfact2 * ( fwfisf_par_b(ji,jj) - fwfisf_par(ji,jj) ) &
+ & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) * rfrac_tbl_par(ji,jj)
+ END IF
+ END IF
+ !
+ ! ice sheet coupling correction
+ IF ( ln_isfcpl ) THEN
+ !
+ ! at kt = nit000, risfcpl_vol_n = 0 and risfcpl_vol_b = risfcpl_vol so contribution nul
+ IF ( ln_rstart .AND. kt == nit000+1 ) THEN
+ ztc_f = ztc_f + zfact1 * risfcpl_tsc(ji,jj,jk,jn) * r1_e1e2t(ji,jj)
+ ze3t_f = ze3t_f - zfact1 * risfcpl_vol(ji,jj,jk ) * r1_e1e2t(ji,jj)
+ END IF
+ !
+ END IF
+ !
END IF
!
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traisf.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traisf.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traisf.F90 (revision 12150)
@@ -0,0 +1,150 @@
+MODULE traisf
+ !!==============================================================================
+ !! *** MODULE traisf ***
+ !! Ocean active tracers: ice shelf boundary condition
+ !!==============================================================================
+ !! History : 4.0 ! 2019-09 (P. Mathiot) original file
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! tra_isf : update the tracer trend at ocean surface
+ !!----------------------------------------------------------------------
+ USE isf_oce ! Ice shelf variables
+ USE dom_oce , ONLY : e3t, r1_e1e2t ! ocean space domain variables
+ USE isfutils, ONLY : debug ! debug option
+ USE timing , ONLY : timing_start, timing_stop ! Timing
+ USE in_out_manager ! I/O manager
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC tra_isf ! routine called by step.F90
+
+ !! * Substitutions
+# include "vectopt_loop_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: trasbc.F90 10499 2019-01-10 15:12:24Z deazer $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE tra_isf ( kt, Kmm, pts, Krhs )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE tra_isf ***
+ !!
+ !! ** Purpose : Compute the temperature trend due to the ice shelf melting (qhoce + qhc)
+ !!
+ !! ** Action : - update pts(:,:,:,:,Krhs) for cav, par and cpl case
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time step
+ INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('tra_isf')
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'tra_isf : Ice shelf heat fluxes'
+ IF(lwp) WRITE(numout,*) '~~~~~~~ '
+ ENDIF
+ !
+ ! cavity case
+ IF ( ln_isfcav_mlt ) CALL tra_isf_mlt(misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, risf_cav_tsc, risf_cav_tsc_b, pts(:,:,:,:,Krhs))
+ !
+ ! parametrisation case
+ IF ( ln_isfpar_mlt ) CALL tra_isf_mlt(misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, risf_par_tsc, risf_par_tsc_b, pts(:,:,:,:,Krhs))
+ !
+ ! ice sheet coupling case
+ IF ( ln_isfcpl ) THEN
+ !
+ ! Dynamical stability at start up after change in under ice shelf cavity geometry is achieve by correcting the divergence.
+ ! This is achieved by applying a volume flux in order to keep the horizontal divergence after remapping
+ ! the same as at the end of the latest time step. So correction need to be apply at nit000 (euler time step) and
+ ! half of it at nit000+1 (leap frog time step).
+ ! in accordance to this, the heat content flux due to injected water need to be added in the temperature and salt trend
+ ! at time step nit000 and nit000+1
+ IF ( kt == nit000 ) CALL tra_isf_cpl(Kmm, risfcpl_tsc , pts(:,:,:,:,Krhs))
+ IF ( kt == nit000+1) CALL tra_isf_cpl(Kmm, risfcpl_tsc*0.5_wp, pts(:,:,:,:,Krhs))
+ !
+ ! ensure 0 trend due to unconservation of the ice shelf coupling
+ IF ( ln_isfcpl_cons ) CALL tra_isf_cpl(Kmm, risfcpl_cons_tsc, pts(:,:,:,:,Krhs))
+ !
+ END IF
+ !
+ IF ( ln_isfdebug ) THEN
+ CALL debug('tra_isf: pts(:,:,:,:,Krhs) T', pts(:,:,:,1,Krhs))
+ CALL debug('tra_isf: pts(:,:,:,:,Krhs) S', pts(:,:,:,2,Krhs))
+ END IF
+ !
+ IF( ln_timing ) CALL timing_stop('tra_isf')
+ !
+ END SUBROUTINE tra_isf
+ !
+ SUBROUTINE tra_isf_mlt(ktop, kbot, phtbl, pfrac, ptsc, ptsc_b, pts)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE tra_isf_mlt ***
+ !!
+ !! *** Purpose : Compute the temperature trend due to the ice shelf melting (qhoce + qhc) for cav or par case
+ !!
+ !! *** Action :: Update pts(:,:,:,:,Krhs) with the surface boundary condition trend
+ !!
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts
+ !!----------------------------------------------------------------------
+ INTEGER , DIMENSION(jpi,jpj) , INTENT(in ) :: ktop , kbot
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: phtbl, pfrac
+ REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: ptsc , ptsc_b
+ !!----------------------------------------------------------------------
+ INTEGER :: ji,jj,jk ! loop index
+ INTEGER :: ikt, ikb ! top and bottom level of the tbl
+ REAL(wp), DIMENSION(jpi,jpj) :: ztc ! total ice shelf tracer trend
+ !!----------------------------------------------------------------------
+ !
+ ! compute 2d total trend due to isf
+ ztc(:,:) = 0.5_wp * ( ptsc(:,:,jp_tem) + ptsc_b(:,:,jp_tem) ) / phtbl(:,:)
+ !
+ ! update pts(:,:,:,:,Krhs)
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ !
+ ikt = ktop(ji,jj)
+ ikb = kbot(ji,jj)
+ !
+ ! level fully include in the ice shelf boundary layer
+ DO jk = ikt, ikb - 1
+ pts(ji,jj,jk,jp_tem) = pts(ji,jj,jk,jp_tem) + ztc(ji,jj)
+ END DO
+ !
+ ! level partially include in ice shelf boundary layer
+ pts(ji,jj,ikb,jp_tem) = pts(ji,jj,ikb,jp_tem) + ztc(ji,jj) * pfrac(ji,jj)
+ !
+ END DO
+ END DO
+ !
+ END SUBROUTINE tra_isf_mlt
+ !
+ SUBROUTINE tra_isf_cpl( Kmm, ptsc, ptsa )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE tra_isf_cpl ***
+ !!
+ !! *** Action :: Update pts(:,:,:,:,Krhs) with the ice shelf coupling trend
+ !!
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: ptsa
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: Kmm ! ocean time level index
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: ptsc
+ !!----------------------------------------------------------------------
+ INTEGER :: jk
+ !!----------------------------------------------------------------------
+ !
+ DO jk = 1,jpk
+ ptsa(:,:,jk,jp_tem) = ptsa(:,:,jk,jp_tem) + ptsc(:,:,jk,jp_tem) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm)
+ ptsa(:,:,jk,jp_sal) = ptsa(:,:,jk,jp_sal) + ptsc(:,:,jk,jp_sal) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm)
+ END DO
+ !
+ END SUBROUTINE tra_isf_cpl
+ !
+END MODULE traisf
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/trasbc.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/trasbc.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/trasbc.F90 (revision 12150)
@@ -10,4 +10,5 @@
!! - ! 2010-09 (C. Ethe, G. Madec) Merge TRA-TRC
!! 3.6 ! 2014-11 (P. Mathiot) isf melting forcing
+ !! 4.1 ! 2019-09 (P. Mathiot) isf moved in traisf
!!----------------------------------------------------------------------
@@ -22,6 +23,4 @@
USE sbcmod ! ln_rnf
USE sbcrnf ! River runoff
- USE sbcisf ! Ice shelf
- USE iscplini ! Ice sheet coupling
USE traqsr ! solar radiation penetration
USE trd_oce ! trends: ocean variables
@@ -62,5 +61,5 @@
!! (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface);
!! (2) Fwe , tracer carried with the water that is exchanged with air+ice.
- !! The input forcing fields (emp, rnf, sfx, isf) contain Fext+Fwe,
+ !! The input forcing fields (emp, rnf, sfx) contain Fext+Fwe,
!! they are simply added to the tracer trend (ts(Krhs)).
!! In linear free surface case (ln_linssh=T), the volume of the
@@ -155,38 +154,4 @@
IF( lwxios ) CALL iom_swap( cxios_context )
ENDIF
- !
- !----------------------------------------
- ! Ice Shelf effects (ISF)
- ! tbl treated as in Losh (2008) JGR
- !----------------------------------------
- !
-!!gm BUG ? Why no differences between non-linear and linear free surface ?
-!!gm probably taken into account in r1_hisf_tbl : to be verified
- IF( ln_isf ) THEN
- zfact = 0.5_wp
- DO jj = 2, jpj
- DO ji = fs_2, fs_jpim1
- !
- ikt = misfkt(ji,jj)
- ikb = misfkb(ji,jj)
- !
- ! level fully include in the ice shelf boundary layer
- ! sign - because fwf sign of evapo (rnf sign of precip)
- DO jk = ikt, ikb - 1
- ! compute trend
- pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) &
- & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) ) &
- & * r1_hisf_tbl(ji,jj)
- END DO
-
- ! level partially include in ice shelf boundary layer
- ! compute trend
- pts(ji,jj,ikb,jp_tem,Krhs) = pts(ji,jj,ikb,jp_tem,Krhs) &
- & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) ) &
- & * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
-
- END DO
- END DO
- END IF
!
!----------------------------------------
@@ -244,20 +209,4 @@
#endif
!
- !----------------------------------------
- ! Ice Sheet coupling imbalance correction to have conservation
- !----------------------------------------
- !
- IF( ln_iscpl .AND. ln_hsb) THEN ! input of heat and salt due to river runoff
- DO jk = 1,jpk
- DO jj = 2, jpj
- DO ji = fs_2, fs_jpim1
- zdep = 1._wp / e3t(ji,jj,jk,Kmm)
- pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) - htsc_iscpl(ji,jj,jk,jp_tem) * zdep
- pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) - htsc_iscpl(ji,jj,jk,jp_sal) * zdep
- END DO
- END DO
- END DO
- ENDIF
-
IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics
ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ZDF/zdfmxl.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ZDF/zdfmxl.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ZDF/zdfmxl.F90 (revision 12150)
@@ -12,4 +12,5 @@
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and tracers variables
+ USE isf_oce ! ice shelf
USE dom_oce ! ocean space and time domain variables
USE trc_oce , ONLY: l_offline ! ocean space and time domain variables
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/nemogcm.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/nemogcm.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/nemogcm.F90 (revision 12150)
@@ -61,4 +61,5 @@
USE diaharm ! tidal harmonics diagnostics (dia_harm_init routine)
USE step ! NEMO time-stepping (stp routine)
+ USE isfstp ! ice shelf (isf_stp_init routine)
USE icbini ! handle bergs, initialisation
USE icbstp ! handle bergs, calving, themodynamics and transport
@@ -432,4 +433,5 @@
RETURN ! end of initialization
ENDIF
+ !
CALL istate_init( Nbb, Nnn, Naa ) ! ocean initial state (Dynamics and tracers)
@@ -472,4 +474,7 @@
! ! Icebergs
CALL icb_init( rdt, nit000) ! initialise icebergs instance
+
+ ! ice shelf
+ CALL isf_init( Nbb, Nnn, Naa )
! ! Misc. options
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/par_oce.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/par_oce.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/par_oce.F90 (revision 12150)
@@ -27,4 +27,5 @@
! ! with the extended grids used in the under ice shelf configurations to
! ! be used without redundant rows when the ice shelves are not in use.
+ LOGICAL :: ln_closea !: (=T) special treatment of closed sea
!
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/step.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/step.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/step.F90 (revision 12150)
@@ -115,9 +115,10 @@
!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
- ! Update external forcing (tides, open boundaries, and surface boundary condition (including sea-ice)
+ ! Update external forcing (tides, open boundaries, ice shelf interaction and surface boundary condition (including sea-ice)
!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
IF( ln_tide ) CALL sbc_tide( kstp ) ! update tide potential
IF( ln_apr_dyn ) CALL sbc_apr ( kstp ) ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib)
IF( ln_bdy ) CALL bdy_dta ( kstp, Nnn, kt_offset = +1 ) ! update dynamic & tracer data at open boundaries
+ IF( ln_isf ) CALL isf_stp ( kstp, Nnn )
CALL sbc ( kstp, Nbb, Nnn ) ! Sea Boundary Condition (including sea-ice)
@@ -237,4 +238,5 @@
CALL tra_sbc ( kstp, Nnn, ts, Nrhs ) ! surface boundary condition
IF( ln_traqsr ) CALL tra_qsr ( kstp, Nnn, ts, Nrhs ) ! penetrative solar radiation qsr
+ IF( ln_isf ) CALL tra_isf ( kstp, Nnn, ts, Nrhs ) ! ice shelf heat flux
IF( ln_trabbc ) CALL tra_bbc ( kstp, Nnn, ts, Nrhs ) ! bottom heat flux
IF( ln_trabbl ) CALL tra_bbl ( kstp, Nbb, Nnn, ts, Nrhs ) ! advective (and/or diffusive) bottom boundary layer scheme
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/step_oce.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/step_oce.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/step_oce.F90 (revision 12150)
@@ -22,5 +22,9 @@
USE sbcwave ! Wave intialisation
+ USE isf_oce ! ice shelf boundary condition
+ USE isfstp ! ice shelf boundary condition (isf_stp routine)
+
USE traqsr ! solar radiation penetration (tra_qsr routine)
+ USE traisf ! ice shelf (tra_isf routine)
USE trasbc ! surface boundary condition (tra_sbc routine)
USE trabbc ! bottom boundary condition (tra_bbc routine)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ICE_AGRIF/EXPREF/file_def_nemo-ice.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ICE_AGRIF/EXPREF/file_def_nemo-ice.xml (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ICE_AGRIF/EXPREF/file_def_nemo-ice.xml (revision 12150)
@@ -26,15 +26,8 @@
-
-
-
-
-
-
-
@@ -81,9 +74,5 @@
-
-
-
-
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/README
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/README (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/README (revision 12150)
@@ -0,0 +1,25 @@
+# ISOMIP is a simple TEST_CASE to test the iceshelves in NEMO.
+# no input files are needed (all is prescribed in MY_SRC/usr_def routines
+# for a reference documentation on the ISOMIP test case, see experiement 1 on http://efdl.cims.nyu.edu/project_oisi/isomip/experiments/phase_I/idealized_numerical_models_5.pdf
+
+# default namelist is setup for a 30y run on 32 processors with the minimum output using XIOS in attached mode with single file output
+
+# How to build moc.nc and psi.nc
+ - Download or clone the CDFTOOLS (see https://github.com/meom-group/CDFTOOLS)
+ - Compile all the tools (or at least cdfpsi and cdfmoc) on your cluster (see https://github.com/meom-group/CDFTOOLS#using-cdftools)
+ - if mesh_mask.nc is splitted, you need to rebuild them using the rebuild NEMO tools (see in NEMOGCM/TOOLS) or run 1 (or more) time step on a single processor (nn_itend variable in the namelist).
+ - set the correct link: ln -s mesh_mask.nc mask.nc ; ln -s mesh_mask.nc mesh_hgr.nc ; ln -s mesh_mask.nc mesh_zgr.nc
+ - run the cdftools :
+ - cdfmoc ISOMIP_1m_00010101_00301231_grid_V.nc => moc.nc
+ - cdfpsi ISOMIP_1m_00010101_00301231_grid_U.nc ISOMIP_1m_00010101_00301231_grid_V.nc => psi.nc
+
+# How to plt moc/psi and melt (python with netcdf and matplotlib library requiried):
+ - psi.png => python2.7 plot_psi.py -f psi.nc -v sobarstf
+ - moc.png => python2.7 plot_moc.py -f moc.nc -v zomsfglo
+ - mlt.png => python2.7 plot_mlt.py -f ISOMIP_1m_00010101_00301231_grid_T.nc -v sowflisf
+by default the last time frame is plotted.
+
+# location the expected circulation and melt plot after 30y of run:
+ - ISOMIP/EXP00/ISOMIP_psi.png
+ - ISOMIP/EXP00/ISOMIP_moc.png
+ - ISOMIP/EXP00/ISOMIP_mlt.png
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/context_nemo.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/context_nemo.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/context_nemo.xml (revision 12150)
@@ -0,0 +1,35 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/domain_def_nemo.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/domain_def_nemo.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/domain_def_nemo.xml (revision 12150)
@@ -0,0 +1,1 @@
+link ../../../cfgs/SHARED/domain_def_nemo.xml
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/field_def_nemo-oce.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/field_def_nemo-oce.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/field_def_nemo-oce.xml (revision 12150)
@@ -0,0 +1,1 @@
+link ../../../cfgs/SHARED/field_def_nemo-oce.xml
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/file_def_nemo-oce.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/file_def_nemo-oce.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/file_def_nemo-oce.xml (revision 12150)
@@ -0,0 +1,54 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/grid_def_nemo.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/grid_def_nemo.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/grid_def_nemo.xml (revision 12150)
@@ -0,0 +1,1 @@
+link ../../../cfgs/SHARED/grid_def_nemo.xml
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/iodef.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/iodef.xml (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/iodef.xml (revision 12150)
@@ -0,0 +1,26 @@
+
+
+
+
+
+
+
+
+
+
+
+ 10
+ false
+ false
+ oceanx
+
+
+
+
+
+
+
+
+
+
+
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/namelist_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/namelist_cfg (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/namelist_cfg (revision 12150)
@@ -0,0 +1,553 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE : Reference namelist_ref !!
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE : 1 - Domain & run manager (namrun, namcfg, namdom, namtsd, namcrs, namc1d, namc1d_uvd)
+!! namelists 2 - Surface boundary (namsbc, namsbc_flx, namsbc_blk, namsbc_cpl,
+!! namsbc_sas, namtra_qsr, namsbc_rnf,
+!! namisf, namsbc_apr,
+!! namsbc_ssr, namsbc_wave, namberg)
+!! 3 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide)
+!! 4 - top/bot boundary (namdrg, namdrg_top, namdrg_bot, nambbc, nambbl)
+!! 5 - Tracer (nameos, namtra_adv, namtra_ldf, namtra_eiv, namtra_dmp)
+!! 6 - dynamics (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!! 7 - Vertical physics (namzdf, namzdf_ric, namzdf_tke, namzdf_gls, namzdf_iwm)
+!! 8 - diagnostics (namnc4, namtrd, namspr, namflo, namhsb)
+!! 9 - Obs & Assim (namobs, nam_asminc)
+!! 10 - miscellaneous (nammpp, namctl, namsto)
+!! skeleton built : egrep -E '(^/ *$|^! *$|^ *$|&nam.*|!---.*|!! .*|!!==.*|!!>>>.*)' namelist_ref > namelist_skl
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!! *** Domain & Run management namelists *** !!
+!! !!
+!! namrun parameters of the run
+!! namdom space and time domain
+!! namcfg parameters of the configuration (default: user defined GYRE)
+!! namwad Wetting and drying (default: OFF)
+!! namtsd data: temperature & salinity (default: OFF)
+!! namcrs coarsened grid (for outputs and/or TOP) (ln_crs =T)
+!! namc1d 1D configuration options ("key_c1d")
+!! namc1d_dyndmp 1D newtonian damping applied on currents ("key_c1d")
+!! namc1d_uvd 1D data (currents) ("key_c1d")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun ! parameters of the run
+!-----------------------------------------------------------------------
+ cn_exp = "ISOMIP+" ! experience name
+ nn_it000 = 1 ! first time step
+ nn_itend = 43800 ! last time step (std 5840)
+ nn_date0 = 010101 ! date at nit_0000
+ nn_stock = 43800 ! frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&namdom ! time and space domain
+!-----------------------------------------------------------------------
+rn_rdt = 720.
+/
+!-----------------------------------------------------------------------
+&namcfg ! parameters of the configuration (default: use namusr_def in namelist_cfg)
+!-----------------------------------------------------------------------
+ ln_read_cfg = .true. ! (=T) read the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namtsd ! Temperature & Salinity Data (init/dmp) (default: OFF)
+!-----------------------------------------------------------------------
+ ! ! =T read T-S fields for:
+ ln_tsd_init = .true. ! ocean initialisation
+ ln_tsd_dmp = .true. ! T-S restoring (see namtra_dmp)
+ !
+ cn_dir = './' ! root directory for the T-S data location
+ !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename !
+ sn_tem = 'nemo_base_WARM.nc' , -12. , 'Tinit', .false. , .true. , 'yearly' , '' , '' , ''
+ sn_sal = 'nemo_base_WARM.nc' , -12. , 'Sinit', .false. , .true. , 'yearly' , '' , '' , ''
+
+ sn_dmpt = 'nemo_base_WARM.nc' , -12. , 'Tinit', .false. , .true. , 'yearly' , '' , '' , ''
+ sn_dmps = 'nemo_base_WARM.nc' , -12. , 'Sinit', .false. , .true. , 'yearly' , '' , '' , ''
+/
+!-----------------------------------------------------------------------
+&namwad ! Wetting and Drying (WaD) (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs ! coarsened grid (for outputs and/or TOP) (ln_crs =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d ! 1D configuration options ("key_c1d" default: PAPA station)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d_dyndmp ! U & V newtonian damping ("key_c1d" default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d_uvd ! data: U & V currents ("key_c1d" default: OFF)
+!-----------------------------------------------------------------------
+
+/
+
+!!======================================================================
+!! *** Surface Boundary Condition namelists *** !!
+!! !!
+!! namsbc surface boundary condition manager (default: NO selection)
+!! namsbc_flx flux formulation (ln_flx =T)
+!! namsbc_blk Bulk formulae formulation (ln_blk =T)
+!! namsbc_cpl CouPLed formulation ("key_oasis3" )
+!! namsbc_sas Stand-Alone Surface module (SAS_SRC only)
+!! namsbc_iif Ice-IF: use observed ice cover (nn_ice = 1 )
+!! namtra_qsr penetrative solar radiation (ln_traqsr =T)
+!! namsbc_ssr sea surface restoring term (for T and/or S) (ln_ssr =T)
+!! namsbc_rnf river runoffs (ln_rnf =T)
+!! namsbc_apr Atmospheric Pressure (ln_apr_dyn =T)
+!! namsbc_wave external fields from wave model (ln_wave =T)
+!! namberg iceberg floats (ln_icebergs=T)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc ! Surface Boundary Condition manager (default: NO selection)
+!-----------------------------------------------------------------------
+ nn_fsbc = 1 ! frequency of SBC module call
+
+
+ ln_usr = .true. ! user defined formulation (T => check usrdef_sbc)
+ nn_fwb = 1
+/
+!-----------------------------------------------------------------------
+&namsbc_flx ! surface boundary condition : flux formulation (ln_flx =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_blk ! namsbc_blk generic Bulk formula (ln_blk =T)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_sas ! Stand-Alone Surface module: ocean data (SAS_SRC only)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_iif ! Ice-IF : use observed ice cover (nn_ice = 1)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr ! penetrative solar radiation (ln_traqsr =T)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr ! surface boundary condition : sea surface restoring (ln_ssr =T)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf ! runoffs (ln_rnf =T)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_apr ! Atmospheric pressure used as ocean forcing (ln_apr_dyn =T)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namisf ! Top boundary layer (ISF) (default: OFF)
+!-----------------------------------------------------------------------
+ !
+ ! ---------------- ice shelf load -------------------------------
+ !
+ cn_isfload = 'uniform' ! scheme to compute ice shelf load (ln_isfcav = .true. in domain_cfg.nc)
+ rn_isfload_T = -1.0
+ rn_isfload_S = 34.2
+ !
+ ! ---------------- ice shelf melt formulation -------------------------------
+ !
+ ln_isf = .true. ! activate ice shelf module
+ ln_isfdebug = .false. ! add debug print in ISF code (global min/max/sum of specific variable)
+ cn_isfdir = './' ! directory for all ice shelf input file
+ !
+ ! ---------------- cavities opened -------------------------------
+ !
+ ln_isfcav_mlt = .true. ! ice shelf melting into the cavity (need ln_isfcav = .true. in domain_cfg.nc)
+ cn_isfcav_mlt = '3eq' ! ice shelf melting formulation (spe/2eq/3eq/oasis)
+ ! ! spe = fwfisf is read from a forcing field
+ ! ! 2eq = ISOMIP like: 2 equations formulation (Hunter et al., 2006)
+ ! ! 3eq = ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)
+ ! ! oasis = fwfisf is given by oasis and pattern by file sn_isfcav_fwf
+ ! ! cn_isfcav_mlt = 2eq or 3eq cases:
+ cn_gammablk = 'vel' ! scheme to compute gammat/s (spe,ad15,hj99)
+ ! ! spe = constant transfert velocity (rn_gammat0, rn_gammas0)
+ ! ! vel = velocity dependent transfert velocity (u* * gammat/s) (Asay-Davis et al. 2016 for a short description)
+ ! ! vel_stab = velocity and stability dependent transfert coeficient (Holland et al. 1999 for a complete description)
+ rn_gammat0 = 0.0215 ! gammat coefficient used in blk formula
+ rn_gammas0 = 0.614e-3 ! gammas coefficient used in blk formula
+ rn_vtide = 0.01 ! tidal velocity [m/s]
+ !
+ rn_htbl = 20. ! thickness of the top boundary layer (Losh et al. 2008)
+ ! ! 0 => thickness of the tbl = thickness of the first wet cell
+ !
+ !* 'spe' and 'oasis' case
+ !___________!_____________!___________________!___________!_____________!_________!___________!__________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !
+ sn_isfcav_fwf = 'isfmlt_cav', -12. , 'fwflisf' , .false. , .true. , 'yearly' , '' , '' , ''
+ !
+ !
+ ! ---------------- ice sheet coupling -------------------------------
+ !
+ ln_isfcpl = .false.
+ nn_drown = 10 ! number of iteration of the extrapolation loop (fill the new wet cells)
+ ln_isfcpl_cons = .false.
+/
+!-----------------------------------------------------------------------
+&namsbc_wave ! External fields from wave model (ln_wave=T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg ! iceberg parameters (default: OFF)
+!-----------------------------------------------------------------------
+
+/
+
+!!======================================================================
+!! *** Lateral boundary condition *** !!
+!! !!
+!! namlbc lateral momentum boundary condition (default: NO selection)
+!! namagrif agrif nested grid (read by child model only) ("key_agrif")
+!! nam_tide Tidal forcing (default: OFF)
+!! nambdy Unstructured open boundaries (default: OFF)
+!! nambdy_dta Unstructured open boundaries - external data (see nambdy)
+!! nambdy_tide tidal forcing at open boundaries (default: OFF)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc ! lateral momentum boundary condition (default: NO selection)
+!-----------------------------------------------------------------------
+ ! ! free slip ! partial slip ! no slip ! strong slip
+ rn_shlat = 2. ! shlat = 0 ! 0 < shlat < 2 ! shlat = 2 ! 2 < shlat
+/
+!-----------------------------------------------------------------------
+&namagrif ! AGRIF zoom ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide ! tide parameters (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy ! unstructured open boundaries (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_dta ! open boundaries - external data (see nam_bdy)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&nambdy_tide ! tidal forcing at open boundaries (default: OFF)
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! *** Top/Bottom boundary condition *** !!
+!! !!
+!! namdrg top/bottom drag coefficient (default: NO selection)
+!! namdrg_top top friction (ln_OFF=F & ln_isfcav=T)
+!! namdrg_bot bottom friction (ln_OFF=F)
+!! nambbc bottom temperature boundary condition (default: OFF)
+!! nambbl bottom boundary layer scheme (default: OFF)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdrg ! top/bottom drag coefficient (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_non_lin = .true. ! non-linear drag: Cd = Cd0 |U|
+/
+!-----------------------------------------------------------------------
+&namdrg_top ! TOP friction (ln_OFF =F & ln_isfcav=T)
+!-----------------------------------------------------------------------
+ rn_Cd0 = 2.5e-3 ! drag coefficient [-]
+ rn_ke0 = 0.0e-3 ! background kinetic energy [m2/s2] (non-linear cases)
+/
+!-----------------------------------------------------------------------
+&namdrg_bot ! BOTTOM friction (ln_OFF =F)
+!-----------------------------------------------------------------------
+ rn_Cd0 = 2.5e-3 ! drag coefficient [-]
+ rn_ke0 = 0.0e-3 ! background kinetic energy [m2/s2] (non-linear cases)
+/
+!-----------------------------------------------------------------------
+&nambbc ! bottom temperature boundary condition (default: OFF)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&nambbl ! bottom boundary layer scheme (default: OFF)
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! Tracer (T-S) namelists !!
+!! !!
+!! nameos equation of state (default: NO selection)
+!! namtra_adv advection scheme (default: NO selection)
+!! namtra_ldf lateral diffusion scheme (default: NO selection)
+!! namtra_mle mixed layer eddy param. (Fox-Kemper param.) (default: OFF)
+!! namtra_eiv eddy induced velocity param. (default: OFF)
+!! namtra_dmp T & S newtonian damping (default: OFF)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos ! ocean Equation Of Seawater (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_teos10 = .false. ! = Use TEOS-10
+ ln_eos80 = .false. ! = Use EOS80
+ ln_leos = .true. ! = Use S-EOS (simplified Eq.)
+ !
+ ! ! S-EOS coefficients (ln_seos=T):
+ ! ! rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+ ! ! L-EOS coefficients (ln_seos=T):
+ ! ! rd(T,S,Z)*rau0 = rau0*(-a0*dT+b0*dS)
+ rn_a0 = 3.7330e-5 ! thermal expension coefficient
+ rn_b0 = 7.8430e-4 ! saline expension coefficient
+/
+!-----------------------------------------------------------------------
+&namtra_adv ! advection scheme for tracer (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_traadv_fct = .true. ! FCT scheme
+/
+!-----------------------------------------------------------------------
+&namtra_ldf ! lateral diffusion scheme for tracers (default: NO selection)
+!-----------------------------------------------------------------------
+ ! ! Operator type:
+ ln_traldf_lap = .true. ! laplacian operator
+ !
+ ! ! Direction of action:
+ ln_traldf_iso = .true. ! iso-neutral (standard operator)
+ !
+ ! ! Coefficients:
+ nn_aht_ijk_t = 0
+ ! ! time invariant coefficients: aht0 = 1/2 Ud*Ld (lap case)
+ ! ! or = 1/12 Ud*Ld^3 (blp case)
+ rn_Ud = 0.01 ! lateral diffusive velocity [m/s] (nn_aht_ijk_t= 0, 10, 20, 30)
+ rn_Ld = 200. ! lateral diffusive length [m] (nn_aht_ijk_t= 0, 10)
+/
+!-----------------------------------------------------------------------
+&namtra_mle ! mixed layer eddy parametrisation (Fox-Kemper) (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_eiv ! eddy induced velocity param. (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp ! tracer: T & S newtonian damping (default: OFF)
+!-----------------------------------------------------------------------
+ ln_tradmp = .true. ! add a damping term (using resto.nc coef.)
+/
+
+!!======================================================================
+!! *** Dynamics namelists *** !!
+!! !!
+!! nam_vvl vertical coordinate options (default: z-star)
+!! namdyn_adv formulation of the momentum advection (default: NO selection)
+!! namdyn_vor advection scheme (default: NO selection)
+!! namdyn_hpg hydrostatic pressure gradient (default: NO selection)
+!! namdyn_spg surface pressure gradient (default: NO selection)
+!! namdyn_ldf lateral diffusion scheme (default: NO selection)
+!! namdta_dyn offline TOP: dynamics read in files (OFF_SRC only)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nam_vvl ! vertical coordinate options (default: z-star)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_adv ! formulation of the momentum advection (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_dynadv_vec = .true. ! vector form - 2nd centered scheme
+/
+!-----------------------------------------------------------------------
+&namdyn_vor ! Vorticity / Coriolis scheme (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_dynvor_een = .true. ! energy & enstrophy scheme
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg ! Hydrostatic pressure gradient option (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_hpg_isf = .true. ! s-coordinate (sco ) adapted to isf
+/
+!-----------------------------------------------------------------------
+&namdyn_spg ! surface pressure gradient (default: NO selection)
+!-----------------------------------------------------------------------
+ ln_dynspg_ts = .true. ! split-explicit free surface
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf ! lateral diffusion on momentum (default: NO selection)
+!-----------------------------------------------------------------------
+ ! ! Type of the operator :
+ ln_dynldf_lap = .true. ! laplacian operator
+ ! ! Direction of action :
+ ln_dynldf_hor = .true. ! horizontal (geopotential)
+ ! ! Coefficient
+ nn_ahm_ijk_t = 0 ! space/time variation of eddy coefficient :
+ ! ! = 0 constant
+ ! ! time invariant coefficients : ahm = 1/2 Uv*Lv (lap case)
+ rn_Uv = 0.1 ! lateral viscous velocity [m/s] (nn_ahm_ijk_t= 0, 10, 20, 30)
+ rn_Lv = 120 ! lateral viscous length [m] (nn_ahm_ijk_t= 0, 10)
+/
+!-----------------------------------------------------------------------
+&namdta_dyn ! offline ocean input files (OFF_SRC only)
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! vertical physics namelists !!
+!! !!
+!! namzdf vertical physics manager (default: NO selection)
+!! namzdf_ric richardson number vertical mixing (ln_zdfric=T)
+!! namzdf_tke TKE vertical mixing (ln_zdftke=T)
+!! namzdf_gls GLS vertical mixing (ln_zdfgls=T)
+!! namzdf_osm OSM vertical diffusion (ln_zdfosm=T)
+!! namzdf_iwm tidal mixing parameterization (ln_zdfiwm=T)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf ! vertical physics manager (default: NO selection)
+!-----------------------------------------------------------------------
+ !
+ ! ! type of vertical closure (required)
+ ln_zdfcst = .true. ! constant mixing
+ !
+ ! ! convection
+ ln_zdfevd = .true. ! enhanced vertical diffusion
+ nn_evdm = 1 ! apply on tracer (=0) or on tracer and momentum (=1)
+ rn_evd = 0.1 ! mixing coefficient [m2/s]
+ !
+ ! ! coefficients
+ rn_avm0 = 1.0e-3 ! vertical eddy viscosity [m2/s] (background Kz if ln_zdfcst=F)
+ rn_avt0 = 5.0e-5 ! vertical eddy diffusivity [m2/s] (background Kz if ln_zdfcst=F)
+ nn_avb = 0 ! profile for background avt & avm (=1) or not (=0)
+ nn_havtb = 0 ! horizontal shape for avtb (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric ! richardson number dependent vertical diffusion (ln_zdfric =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke ! turbulent eddy kinetic dependent vertical diffusion (ln_zdftke =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls ! GLS vertical diffusion (ln_zdfgls =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_osm ! OSM vertical diffusion (ln_zdfosm =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_iwm ! internal wave-driven mixing parameterization (ln_zdfiwm =T)
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! *** Diagnostics namelists *** !!
+!! !!
+!! namtrd dynamics and/or tracer trends (default: OFF)
+!! namptr Poleward Transport Diagnostics (default: OFF)
+!! namhsb Heat and salt budgets (default: OFF)
+!! namdiu Cool skin and warm layer models (default: OFF)
+!! namdiu Cool skin and warm layer models (default: OFF)
+!! namflo float parameters ("key_float")
+!! nam_diaharm Harmonic analysis of tidal constituents ("key_diaharm")
+!! namdct transports through some sections ("key_diadct")
+!! nam_diatmb Top Middle Bottom Output (default: OFF)
+!! nam_dia25h 25h Mean Output (default: OFF)
+!! namnc4 netcdf4 chunking and compression settings ("key_netcdf4")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namtrd ! trend diagnostics (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr ! Poleward Transport Diagnostic (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb ! Heat and salt budgets (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdiu ! Cool skin and warm layer models (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namflo ! float parameters ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_diaharm ! Harmonic analysis of tidal constituents ("key_diaharm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct ! transports through some sections ("key_diadct")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_diatmb ! Top Middle Bottom Output (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_dia25h ! 25h Mean Output (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! *** Observation & Assimilation *** !!
+!! !!
+!! namobs observation and model comparison (default: OFF)
+!! nam_asminc assimilation increments ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs ! observation usage switch (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc ! assimilation increments ('key_asminc')
+!-----------------------------------------------------------------------
+/
+
+!!======================================================================
+!! *** Miscellaneous namelists *** !!
+!! !!
+!! nammpp Massively Parallel Processing ("key_mpp_mpi")
+!! namctl Control prints (default: OFF)
+!! namsto Stochastic parametrization of EOS (default: OFF)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nammpp ! Massively Parallel Processing ("key_mpp_mpi")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl ! Control prints (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsto ! Stochastic parametrization of EOS (default: OFF)
+!-----------------------------------------------------------------------
+/
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/namelist_ref
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/namelist_ref (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/EXPREF/namelist_ref (revision 12150)
@@ -0,0 +1,1 @@
+link ../../../cfgs/SHARED/namelist_ref
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/dtatsd.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/dtatsd.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/dtatsd.F90 (revision 12150)
@@ -0,0 +1,264 @@
+MODULE dtatsd
+ !!======================================================================
+ !! *** MODULE dtatsd ***
+ !! Ocean data : read ocean Temperature & Salinity Data from gridded data
+ !!======================================================================
+ !! History : OPA ! 1991-03 () Original code
+ !! - ! 1992-07 (M. Imbard)
+ !! 8.0 ! 1999-10 (M.A. Foujols, M. Imbard) NetCDF FORMAT
+ !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module
+ !! 3.3 ! 2010-10 (C. Bricaud, S. Masson) use of fldread
+ !! 3.4 ! 2010-11 (G. Madec, C. Ethe) Merge of dtatem and dtasal + remove CPP keys
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! dta_tsd : read and time interpolated ocean Temperature & Salinity Data
+ !!----------------------------------------------------------------------
+ USE oce ! ocean dynamics and tracers
+ USE phycst ! physical constants
+ USE dom_oce ! ocean space and time domain
+ USE fldread ! read input fields
+ !
+ USE in_out_manager ! I/O manager
+ USE lib_mpp ! MPP library
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC dta_tsd_init ! called by opa.F90
+ PUBLIC dta_tsd ! called by istate.F90 and tradmp.90
+
+ ! !!* namtsd namelist : Temperature & Salinity Data *
+ LOGICAL , PUBLIC :: ln_tsd_init !: T & S data flag
+ LOGICAL , PUBLIC :: ln_tsd_dmp !: internal damping toward input data flag
+
+ TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tsdini ! structure of input SST (file informations, fields read)
+ TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tsddmp ! structure of input SST (file informations, fields read)
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: dtatsd.F90 10213 2018-10-23 14:40:09Z aumont $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE dta_tsd_init( ld_tradmp )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dta_tsd_init ***
+ !!
+ !! ** Purpose : initialisation of T & S input data
+ !!
+ !! ** Method : - Read namtsd namelist
+ !! - allocates T & S data structure
+ !!----------------------------------------------------------------------
+ LOGICAL, INTENT(in), OPTIONAL :: ld_tradmp ! force the initialization when tradp is used
+ !
+ INTEGER :: ios, ierr0, ierr1, ierr2, ierr3 ! local integers
+ !!
+ CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files
+ TYPE(FLD_N), DIMENSION( jpts) :: slf_i ! array of namelist informations on the fields to read
+ TYPE(FLD_N) :: sn_tem, sn_sal
+ TYPE(FLD_N) :: sn_dmpt, sn_dmps
+ !!
+ NAMELIST/namtsd/ ln_tsd_init, ln_tsd_dmp, cn_dir, sn_tem, sn_sal, sn_dmpt, sn_dmps
+ !!----------------------------------------------------------------------
+ !
+ ! Initialisation
+ ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0
+ !
+ REWIND( numnam_ref ) ! Namelist namtsd in reference namelist :
+ READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in reference namelist' )
+ REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run
+ READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )
+902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist' )
+ IF(lwm) WRITE ( numond, namtsd )
+
+ IF( PRESENT( ld_tradmp ) ) ln_tsd_dmp = .TRUE. ! forces the initialization when tradmp is used
+
+ IF(lwp) THEN ! control print
+ WRITE(numout,*)
+ WRITE(numout,*) 'dta_tsd_init : Temperature & Salinity data '
+ WRITE(numout,*) '~~~~~~~~~~~~ '
+ WRITE(numout,*) ' Namelist namtsd'
+ WRITE(numout,*) ' Initialisation of ocean T & S with T &S input data ln_tsd_init = ', ln_tsd_init
+ WRITE(numout,*) ' damping of ocean T & S toward T &S input data ln_tsd_dmp = ', ln_tsd_dmp
+ WRITE(numout,*)
+ IF( .NOT.ln_tsd_init .AND. .NOT.ln_tsd_dmp ) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) ' ===>> T & S data not used'
+ ENDIF
+ ENDIF
+ !
+ IF( ln_rstart .AND. ln_tsd_init ) THEN
+ CALL ctl_warn( 'dta_tsd_init: ocean restart and T & S data intialisation, ', &
+ & 'we keep the restart T & S values and set ln_tsd_init to FALSE' )
+ ln_tsd_init = .FALSE.
+ ENDIF
+ !
+ ! ! allocate the arrays (if necessary)
+ IF( ln_tsd_init ) THEN
+ !
+ ALLOCATE( sf_tsdini(jpts), STAT=ierr0 )
+ IF( ierr0 > 0 ) THEN
+ CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' ) ; RETURN
+ ENDIF
+ !
+ ALLOCATE( sf_tsdini(jp_tem)%fnow(jpi,jpj,jpk) , STAT=ierr0 )
+ IF( sn_tem%ln_tint ) ALLOCATE( sf_tsdini(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
+ ALLOCATE( sf_tsdini(jp_sal)%fnow(jpi,jpj,jpk) , STAT=ierr2 )
+ IF( sn_sal%ln_tint ) ALLOCATE( sf_tsdini(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
+ !
+ IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
+ CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' ) ; RETURN
+ ENDIF
+ !
+ ! ! fill sf_tsd with sn_tem & sn_sal and control print
+ slf_i(jp_tem) = sn_tem ; slf_i(jp_sal) = sn_sal
+ CALL fld_fill( sf_tsdini, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd', no_print )
+ !
+ END IF
+
+ IF( ln_tsd_dmp ) THEN
+ !
+ ALLOCATE( sf_tsddmp(jpts), STAT=ierr0 )
+ IF( ierr0 > 0 ) THEN
+ CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsddmp structure' ) ; RETURN
+ ENDIF
+ !
+ ! dmp file
+ ALLOCATE( sf_tsddmp(jp_tem)%fnow(jpi,jpj,jpk) , STAT=ierr0 )
+ IF( sn_dmpt%ln_tint ) ALLOCATE( sf_tsddmp(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
+ ALLOCATE( sf_tsddmp(jp_sal)%fnow(jpi,jpj,jpk) , STAT=ierr2 )
+ IF( sn_dmps%ln_tint ) ALLOCATE( sf_tsddmp(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
+ !
+ IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
+ CALL ctl_stop( 'dta_tsd : unable to allocate T & S dmp data arrays' ) ; RETURN
+ ENDIF
+ !
+ ! ! fill sf_tsd with sn_tem & sn_sal and control print
+ slf_i(jp_tem) = sn_dmpt ; slf_i(jp_sal) = sn_dmps
+ CALL fld_fill( sf_tsddmp, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity dmp data', 'namtsd', no_print )
+ !
+ ENDIF
+ !
+ END SUBROUTINE dta_tsd_init
+
+
+ SUBROUTINE dta_tsd( kt, cddta, ptsd )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dta_tsd ***
+ !!
+ !! ** Purpose : provides T and S data at kt
+ !!
+ !! ** Method : - call fldread routine
+ !! - ORCA_R2: add some hand made alteration to read data
+ !! - 'key_orca_lev10' interpolates on 10 times more levels
+ !! - s- or mixed z-s coordinate: vertical interpolation on model mesh
+ !! - ln_tsd_dmp=F: deallocates the T-S data structure
+ !! as T-S data are no are used
+ !!
+ !! ** Action : ptsd T-S data on medl mesh and interpolated at time-step kt
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time-step
+ CHARACTER(LEN=3) , INTENT(in ) :: cddta ! dmp or ini
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: ptsd ! T & S data
+ !
+ INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies
+ INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers
+ REAL(wp):: zl, zi ! local scalars
+ REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace
+ !!----------------------------------------------------------------------
+ !
+ SELECT CASE(cddta)
+ CASE('ini')
+ CALL fld_read( kt, 1, sf_tsdini ) !== read T & S data at kt time step ==!
+ ptsd(:,:,:,jp_tem) = sf_tsdini(jp_tem)%fnow(:,:,:) ! NO mask
+ ptsd(:,:,:,jp_sal) = sf_tsdini(jp_sal)%fnow(:,:,:)
+ CASE('dmp')
+ CALL fld_read( kt, 1, sf_tsddmp ) !== read T & S data at kt time step ==!
+ ptsd(:,:,:,jp_tem) = sf_tsddmp(jp_tem)%fnow(:,:,:) ! NO mask
+ ptsd(:,:,:,jp_sal) = sf_tsddmp(jp_sal)%fnow(:,:,:)
+ CASE DEFAULT
+ CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown')
+ END SELECT
+ !
+ IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==!
+ !
+ IF( kt == nit000 .AND. lwp )THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh'
+ ENDIF
+ !
+ DO jj = 1, jpj ! vertical interpolation of T & S
+ DO ji = 1, jpi
+ DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points
+ zl = gdept_0(ji,jj,jk)
+ IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data
+ ztp(jk) = ptsd(ji,jj,1 ,jp_tem)
+ zsp(jk) = ptsd(ji,jj,1 ,jp_sal)
+ ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data
+ ztp(jk) = ptsd(ji,jj,jpkm1,jp_tem)
+ zsp(jk) = ptsd(ji,jj,jpkm1,jp_sal)
+ ELSE ! inbetween : vertical interpolation between jkk & jkk+1
+ DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1)
+ IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
+ zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
+ ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi
+ zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi
+ ENDIF
+ END DO
+ ENDIF
+ END DO
+ DO jk = 1, jpkm1
+ ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord
+ ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk)
+ END DO
+ ptsd(ji,jj,jpk,jp_tem) = 0._wp
+ ptsd(ji,jj,jpk,jp_sal) = 0._wp
+ END DO
+ END DO
+ !
+ ELSE !== z- or zps- coordinate ==!
+ !
+ ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:) ! Mask
+ ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:)
+ !
+ IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ ik = mbkt(ji,jj)
+ IF( ik > 1 ) THEN
+ zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+ ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
+ ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
+ ENDIF
+ ik = mikt(ji,jj)
+ IF( ik > 1 ) THEN
+ zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
+ ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem)
+ ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
+ END IF
+ END DO
+ END DO
+ ENDIF
+ !
+ ENDIF
+ !
+ SELECT CASE(cddta)
+ CASE('ini')
+ ! !== deallocate T & S structure ==!
+ ! (data used only for initialisation)
+ IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run'
+ DEALLOCATE( sf_tsdini(jp_tem)%fnow ) ! T arrays in the structure
+ IF( sf_tsdini(jp_tem)%ln_tint ) DEALLOCATE( sf_tsdini(jp_tem)%fdta )
+ DEALLOCATE( sf_tsdini(jp_sal)%fnow ) ! S arrays in the structure
+ IF( sf_tsdini(jp_sal)%ln_tint ) DEALLOCATE( sf_tsdini(jp_sal)%fdta )
+ DEALLOCATE( sf_tsdini ) ! the structure itself
+ !
+ END SELECT
+ !
+ END SUBROUTINE dta_tsd
+
+ !!======================================================================
+END MODULE dtatsd
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/eosbn2.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/eosbn2.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/eosbn2.F90 (revision 12150)
@@ -0,0 +1,1853 @@
+MODULE eosbn2
+ !!==============================================================================
+ !! *** MODULE eosbn2 ***
+ !! Equation Of Seawater : in situ density - Brunt-Vaisala frequency
+ !!==============================================================================
+ !! History : OPA ! 1989-03 (O. Marti) Original code
+ !! 6.0 ! 1994-07 (G. Madec, M. Imbard) add bn2
+ !! 6.0 ! 1994-08 (G. Madec) Add Jackett & McDougall eos
+ !! 7.0 ! 1996-01 (G. Madec) statement function for e3
+ !! 8.1 ! 1997-07 (G. Madec) density instead of volumic mass
+ !! - ! 1999-02 (G. Madec, N. Grima) semi-implicit pressure gradient
+ !! 8.2 ! 2001-09 (M. Ben Jelloul) bugfix on linear eos
+ !! NEMO 1.0 ! 2002-10 (G. Madec) add eos_init
+ !! - ! 2002-11 (G. Madec, A. Bozec) partial step, eos_insitu_2d
+ !! - ! 2003-08 (G. Madec) F90, free form
+ !! 3.0 ! 2006-08 (G. Madec) add tfreez function (now eos_fzp function)
+ !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA
+ !! - ! 2010-10 (G. Nurser, G. Madec) add alpha/beta used in ldfslp
+ !! 3.7 ! 2012-03 (F. Roquet, G. Madec) add primitive of alpha and beta used in PE computation
+ !! - ! 2012-05 (F. Roquet) add Vallis and original JM95 equation of state
+ !! - ! 2013-04 (F. Roquet, G. Madec) add eos_rab, change bn2 computation and reorganize the module
+ !! - ! 2014-09 (F. Roquet) add TEOS-10, S-EOS, and modify EOS-80
+ !! - ! 2015-06 (P.A. Bouttier) eos_fzp functions changed to subroutines for AGRIF
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! eos : generic interface of the equation of state
+ !! eos_insitu : Compute the in situ density
+ !! eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass
+ !! eos_insitu_2d : Compute the in situ density for 2d fields
+ !! bn2 : compute the Brunt-Vaisala frequency
+ !! eos_pt_from_ct: compute the potential temperature from the Conservative Temperature
+ !! eos_rab : generic interface of in situ thermal/haline expansion ratio
+ !! eos_rab_3d : compute in situ thermal/haline expansion ratio
+ !! eos_rab_2d : compute in situ thermal/haline expansion ratio for 2d fields
+ !! eos_fzp_2d : freezing temperature for 2d fields
+ !! eos_fzp_0d : freezing temperature for scalar
+ !! eos_init : set eos parameters (namelist)
+ !!----------------------------------------------------------------------
+ USE dom_oce ! ocean space and time domain
+ USE phycst ! physical constants
+ USE stopar ! Stochastic T/S fluctuations
+ USE stopts ! Stochastic T/S fluctuations
+ !
+ USE in_out_manager ! I/O manager
+ USE lib_mpp ! MPP library
+ USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+ USE prtctl ! Print control
+ USE lbclnk ! ocean lateral boundary conditions
+ USE timing ! Timing
+
+ IMPLICIT NONE
+ PRIVATE
+
+ ! !! * Interface
+ INTERFACE eos
+ MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
+ END INTERFACE
+ !
+ INTERFACE eos_rab
+ MODULE PROCEDURE rab_3d, rab_2d, rab_0d
+ END INTERFACE
+ !
+ INTERFACE eos_fzp
+ MODULE PROCEDURE eos_fzp_2d, eos_fzp_0d
+ END INTERFACE
+ !
+ PUBLIC eos ! called by step, istate, tranpc and zpsgrd modules
+ PUBLIC bn2 ! called by step module
+ PUBLIC eos_rab ! called by ldfslp, zdfddm, trabbl
+ PUBLIC eos_pt_from_ct ! called by sbcssm
+ PUBLIC eos_fzp ! called by traadv_cen2 and sbcice_... modules
+ PUBLIC eos_pen ! used for pe diagnostics in trdpen module
+ PUBLIC eos_init ! called by istate module
+
+ ! !!** Namelist nameos **
+ LOGICAL , PUBLIC :: ln_TEOS10
+ LOGICAL , PUBLIC :: ln_EOS80
+ LOGICAL , PUBLIC :: ln_SEOS
+ LOGICAL , PUBLIC :: ln_LEOS ! determine if linear eos is used
+
+ ! Parameters
+ LOGICAL , PUBLIC :: l_useCT ! =T in ln_TEOS10=T (i.e. use eos_pt_from_ct to compute sst_m), =F otherwise
+ INTEGER , PUBLIC :: neos ! Identifier for equation of state used
+
+ INTEGER , PARAMETER :: np_teos10 = -1 ! parameter for using TEOS10
+ INTEGER , PARAMETER :: np_eos80 = 0 ! parameter for using EOS80
+ INTEGER , PARAMETER :: np_seos = 1 ! parameter for using Simplified Equation of state
+ INTEGER , PARAMETER :: np_leos = 2 ! parameter for using linear equation of state (ISOMIP+)
+
+ ! !!! simplified eos coefficients (default value: Vallis 2006)
+ REAL(wp) :: rn_a0 = 1.6550e-1_wp ! thermal expansion coeff.
+ REAL(wp) :: rn_b0 = 7.6554e-1_wp ! saline expansion coeff.
+ REAL(wp) :: rn_lambda1 = 5.9520e-2_wp ! cabbeling coeff. in T^2
+ REAL(wp) :: rn_lambda2 = 5.4914e-4_wp ! cabbeling coeff. in S^2
+ REAL(wp) :: rn_mu1 = 1.4970e-4_wp ! thermobaric coeff. in T
+ REAL(wp) :: rn_mu2 = 1.1090e-5_wp ! thermobaric coeff. in S
+ REAL(wp) :: rn_nu = 2.4341e-3_wp ! cabbeling coeff. in theta*salt
+
+ ! TEOS10/EOS80 parameters
+ REAL(wp) :: r1_S0, r1_T0, r1_Z0, rdeltaS
+
+ ! EOS parameters
+ REAL(wp) :: EOS000 , EOS100 , EOS200 , EOS300 , EOS400 , EOS500 , EOS600
+ REAL(wp) :: EOS010 , EOS110 , EOS210 , EOS310 , EOS410 , EOS510
+ REAL(wp) :: EOS020 , EOS120 , EOS220 , EOS320 , EOS420
+ REAL(wp) :: EOS030 , EOS130 , EOS230 , EOS330
+ REAL(wp) :: EOS040 , EOS140 , EOS240
+ REAL(wp) :: EOS050 , EOS150
+ REAL(wp) :: EOS060
+ REAL(wp) :: EOS001 , EOS101 , EOS201 , EOS301 , EOS401
+ REAL(wp) :: EOS011 , EOS111 , EOS211 , EOS311
+ REAL(wp) :: EOS021 , EOS121 , EOS221
+ REAL(wp) :: EOS031 , EOS131
+ REAL(wp) :: EOS041
+ REAL(wp) :: EOS002 , EOS102 , EOS202
+ REAL(wp) :: EOS012 , EOS112
+ REAL(wp) :: EOS022
+ REAL(wp) :: EOS003 , EOS103
+ REAL(wp) :: EOS013
+
+ ! ALPHA parameters
+ REAL(wp) :: ALP000 , ALP100 , ALP200 , ALP300 , ALP400 , ALP500
+ REAL(wp) :: ALP010 , ALP110 , ALP210 , ALP310 , ALP410
+ REAL(wp) :: ALP020 , ALP120 , ALP220 , ALP320
+ REAL(wp) :: ALP030 , ALP130 , ALP230
+ REAL(wp) :: ALP040 , ALP140
+ REAL(wp) :: ALP050
+ REAL(wp) :: ALP001 , ALP101 , ALP201 , ALP301
+ REAL(wp) :: ALP011 , ALP111 , ALP211
+ REAL(wp) :: ALP021 , ALP121
+ REAL(wp) :: ALP031
+ REAL(wp) :: ALP002 , ALP102
+ REAL(wp) :: ALP012
+ REAL(wp) :: ALP003
+
+ ! BETA parameters
+ REAL(wp) :: BET000 , BET100 , BET200 , BET300 , BET400 , BET500
+ REAL(wp) :: BET010 , BET110 , BET210 , BET310 , BET410
+ REAL(wp) :: BET020 , BET120 , BET220 , BET320
+ REAL(wp) :: BET030 , BET130 , BET230
+ REAL(wp) :: BET040 , BET140
+ REAL(wp) :: BET050
+ REAL(wp) :: BET001 , BET101 , BET201 , BET301
+ REAL(wp) :: BET011 , BET111 , BET211
+ REAL(wp) :: BET021 , BET121
+ REAL(wp) :: BET031
+ REAL(wp) :: BET002 , BET102
+ REAL(wp) :: BET012
+ REAL(wp) :: BET003
+
+ ! PEN parameters
+ REAL(wp) :: PEN000 , PEN100 , PEN200 , PEN300 , PEN400
+ REAL(wp) :: PEN010 , PEN110 , PEN210 , PEN310
+ REAL(wp) :: PEN020 , PEN120 , PEN220
+ REAL(wp) :: PEN030 , PEN130
+ REAL(wp) :: PEN040
+ REAL(wp) :: PEN001 , PEN101 , PEN201
+ REAL(wp) :: PEN011 , PEN111
+ REAL(wp) :: PEN021
+ REAL(wp) :: PEN002 , PEN102
+ REAL(wp) :: PEN012
+
+ ! ALPHA_PEN parameters
+ REAL(wp) :: APE000 , APE100 , APE200 , APE300
+ REAL(wp) :: APE010 , APE110 , APE210
+ REAL(wp) :: APE020 , APE120
+ REAL(wp) :: APE030
+ REAL(wp) :: APE001 , APE101
+ REAL(wp) :: APE011
+ REAL(wp) :: APE002
+
+ ! BETA_PEN parameters
+ REAL(wp) :: BPE000 , BPE100 , BPE200 , BPE300
+ REAL(wp) :: BPE010 , BPE110 , BPE210
+ REAL(wp) :: BPE020 , BPE120
+ REAL(wp) :: BPE030
+ REAL(wp) :: BPE001 , BPE101
+ REAL(wp) :: BPE011
+ REAL(wp) :: BPE002
+
+ !! * Substitutions
+# include "vectopt_loop_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: eosbn2.F90 10425 2018-12-19 21:54:16Z smasson $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE eos_insitu( pts, prd, pdep )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE eos_insitu ***
+ !!
+ !! ** Purpose : Compute the in situ density (ratio rho/rau0) from
+ !! potential temperature and salinity using an equation of state
+ !! selected in the nameos namelist
+ !!
+ !! ** Method : prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0
+ !! with prd in situ density anomaly no units
+ !! t TEOS10: CT or EOS80: PT Celsius
+ !! s TEOS10: SA or EOS80: SP TEOS10: g/kg or EOS80: psu
+ !! z depth meters
+ !! rho in situ density kg/m^3
+ !! rau0 reference density kg/m^3
+ !!
+ !! ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z).
+ !! Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celsius, sa=35.5 g/kg
+ !!
+ !! ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z).
+ !! Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celsius, sp=35.5 psu
+ !!
+ !! ln_seos : simplified equation of state
+ !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0
+ !! linear case function of T only: rn_alpha<>0, other coefficients = 0
+ !! linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0
+ !! Vallis like equation: use default values of coefficients
+ !!
+ !! ln_leos : linear ISOMIP equation of state
+ !! prd(t,s,z) = ( -a0*(T-T0) + b0*(S-S0) ) / rau0
+ !! setup for ISOMIP linear eos
+ !!
+ !! ** Action : compute prd , the in situ density (no units)
+ !!
+ !! References : Roquet et al, Ocean Modelling, in preparation (2014)
+ !! Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006
+ !! TEOS-10 Manual, 2010
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
+ ! ! 2 : salinity [psu]
+ REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-]
+ REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m]
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zt , zh , zs , ztm ! local scalars
+ REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('eos-insitu')
+ !
+ SELECT CASE( neos )
+ !
+ CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ !
+ zh = pdep(ji,jj,jk) * r1_Z0 ! depth
+ zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature
+ zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
+ ztm = tmask(ji,jj,jk) ! tmask
+ !
+ zn3 = EOS013*zt &
+ & + EOS103*zs+EOS003
+ !
+ zn2 = (EOS022*zt &
+ & + EOS112*zs+EOS012)*zt &
+ & + (EOS202*zs+EOS102)*zs+EOS002
+ !
+ zn1 = (((EOS041*zt &
+ & + EOS131*zs+EOS031)*zt &
+ & + (EOS221*zs+EOS121)*zs+EOS021)*zt &
+ & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt &
+ & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+ !
+ zn0 = (((((EOS060*zt &
+ & + EOS150*zs+EOS050)*zt &
+ & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
+ & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
+ & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
+ & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
+ & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+ !
+ zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+ !
+ prd(ji,jj,jk) = ( zn * r1_rau0 - 1._wp ) * ztm ! density anomaly (masked)
+ !
+ END DO
+ END DO
+ END DO
+ !
+ CASE( np_seos ) !== simplified EOS ==!
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zt = pts (ji,jj,jk,jp_tem) - 10._wp
+ zs = pts (ji,jj,jk,jp_sal) - 35._wp
+ zh = pdep (ji,jj,jk)
+ ztm = tmask(ji,jj,jk)
+ !
+ zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt &
+ & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs &
+ & - rn_nu * zt * zs
+ !
+ prd(ji,jj,jk) = zn * r1_rau0 * ztm ! density anomaly (masked)
+ END DO
+ END DO
+ END DO
+ !
+ CASE( np_leos ) !== linear ISOMIP EOS ==!
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zt = pts (ji,jj,jk,jp_tem) - (-1._wp)
+ zs = pts (ji,jj,jk,jp_sal) - 34.2_wp
+ zh = pdep (ji,jj,jk)
+ ztm = tmask(ji,jj,jk)
+ !
+ zn = rau0 * ( - rn_a0 * zt + rn_b0 * zs )
+ !
+ prd(ji,jj,jk) = zn * r1_rau0 * ztm ! density anomaly (masked)
+ END DO
+ END DO
+ END DO
+ !
+ END SELECT
+ !
+ IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', kdim=jpk )
+ !
+ IF( ln_timing ) CALL timing_stop('eos-insitu')
+ !
+ END SUBROUTINE eos_insitu
+
+
+ SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE eos_insitu_pot ***
+ !!
+ !! ** Purpose : Compute the in situ density (ratio rho/rau0) and the
+ !! potential volumic mass (Kg/m3) from potential temperature and
+ !! salinity fields using an equation of state selected in the
+ !! namelist.
+ !!
+ !! ** Action : - prd , the in situ density (no units)
+ !! - prhop, the potential volumic mass (Kg/m3)
+ !!
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
+ ! ! 2 : salinity [psu]
+ REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-]
+ REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced)
+ REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m]
+ !
+ INTEGER :: ji, jj, jk, jsmp ! dummy loop indices
+ INTEGER :: jdof
+ REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars
+ REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('eos-pot')
+ !
+ SELECT CASE ( neos )
+ !
+ CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
+ !
+ ! Stochastic equation of state
+ IF ( ln_sto_eos ) THEN
+ ALLOCATE(zn0_sto(1:2*nn_sto_eos))
+ ALLOCATE(zn_sto(1:2*nn_sto_eos))
+ ALLOCATE(zsign(1:2*nn_sto_eos))
+ DO jsmp = 1, 2*nn_sto_eos, 2
+ zsign(jsmp) = 1._wp
+ zsign(jsmp+1) = -1._wp
+ END DO
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ !
+ ! compute density (2*nn_sto_eos) times:
+ ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts)
+ ! (2) for t-dt, s-ds (with the opposite fluctuation)
+ DO jsmp = 1, nn_sto_eos*2
+ jdof = (jsmp + 1) / 2
+ zh = pdep(ji,jj,jk) * r1_Z0 ! depth
+ zt = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0 ! temperature
+ zstemp = pts (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp)
+ zs = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 ) ! square root salinity
+ ztm = tmask(ji,jj,jk) ! tmask
+ !
+ zn3 = EOS013*zt &
+ & + EOS103*zs+EOS003
+ !
+ zn2 = (EOS022*zt &
+ & + EOS112*zs+EOS012)*zt &
+ & + (EOS202*zs+EOS102)*zs+EOS002
+ !
+ zn1 = (((EOS041*zt &
+ & + EOS131*zs+EOS031)*zt &
+ & + (EOS221*zs+EOS121)*zs+EOS021)*zt &
+ & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt &
+ & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+ !
+ zn0_sto(jsmp) = (((((EOS060*zt &
+ & + EOS150*zs+EOS050)*zt &
+ & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
+ & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
+ & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
+ & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
+ & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+ !
+ zn_sto(jsmp) = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp)
+ END DO
+ !
+ ! compute stochastic density as the mean of the (2*nn_sto_eos) densities
+ prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp
+ DO jsmp = 1, nn_sto_eos*2
+ prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface
+ !
+ prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rau0 - 1._wp ) ! density anomaly (masked)
+ END DO
+ prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos
+ prd (ji,jj,jk) = 0.5_wp * prd (ji,jj,jk) * ztm / nn_sto_eos
+ END DO
+ END DO
+ END DO
+ DEALLOCATE(zn0_sto,zn_sto,zsign)
+ ! Non-stochastic equation of state
+ ELSE
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ !
+ zh = pdep(ji,jj,jk) * r1_Z0 ! depth
+ zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature
+ zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
+ ztm = tmask(ji,jj,jk) ! tmask
+ !
+ zn3 = EOS013*zt &
+ & + EOS103*zs+EOS003
+ !
+ zn2 = (EOS022*zt &
+ & + EOS112*zs+EOS012)*zt &
+ & + (EOS202*zs+EOS102)*zs+EOS002
+ !
+ zn1 = (((EOS041*zt &
+ & + EOS131*zs+EOS031)*zt &
+ & + (EOS221*zs+EOS121)*zs+EOS021)*zt &
+ & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt &
+ & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+ !
+ zn0 = (((((EOS060*zt &
+ & + EOS150*zs+EOS050)*zt &
+ & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
+ & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
+ & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
+ & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
+ & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+ !
+ zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+ !
+ prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface
+ !
+ prd(ji,jj,jk) = ( zn * r1_rau0 - 1._wp ) * ztm ! density anomaly (masked)
+ END DO
+ END DO
+ END DO
+ ENDIF
+
+ CASE( np_seos ) !== simplified EOS ==!
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zt = pts (ji,jj,jk,jp_tem) - 10._wp
+ zs = pts (ji,jj,jk,jp_sal) - 35._wp
+ zh = pdep (ji,jj,jk)
+ ztm = tmask(ji,jj,jk)
+ ! ! potential density referenced at the surface
+ zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt &
+ & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs &
+ & - rn_nu * zt * zs
+ prhop(ji,jj,jk) = ( rau0 + zn ) * ztm
+ ! ! density anomaly (masked)
+ zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh
+ prd(ji,jj,jk) = zn * r1_rau0 * ztm
+ !
+ END DO
+ END DO
+ END DO
+ !
+ CASE( np_leos ) !== linear ISOMIP EOS ==!
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zt = pts (ji,jj,jk,jp_tem) - (-1._wp)
+ zs = pts (ji,jj,jk,jp_sal) - 34.2_wp
+ zh = pdep (ji,jj,jk)
+ ztm = tmask(ji,jj,jk)
+ ! ! potential density referenced at the surface
+ zn = rau0 * ( - rn_a0 * zt + rn_b0 * zs )
+ prhop(ji,jj,jk) = ( rau0 + zn ) * ztm
+ ! ! density anomaly (masked)
+ prd(ji,jj,jk) = zn * r1_rau0 * ztm
+ !
+ END DO
+ END DO
+ END DO
+ !
+ END SELECT
+ !
+ IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk )
+ !
+ IF( ln_timing ) CALL timing_stop('eos-pot')
+ !
+ END SUBROUTINE eos_insitu_pot
+
+
+ SUBROUTINE eos_insitu_2d( pts, pdep, prd )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE eos_insitu_2d ***
+ !!
+ !! ** Purpose : Compute the in situ density (ratio rho/rau0) from
+ !! potential temperature and salinity using an equation of state
+ !! selected in the nameos namelist. * 2D field case
+ !!
+ !! ** Action : - prd , the in situ density (no units) (unmasked)
+ !!
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
+ ! ! 2 : salinity [psu]
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m]
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zt , zh , zs ! local scalars
+ REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('eos2d')
+ !
+ prd(:,:) = 0._wp
+ !
+ SELECT CASE( neos )
+ !
+ CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
+ !
+ DO jj = 1, jpjm1
+ DO ji = 1, fs_jpim1 ! vector opt.
+ !
+ zh = pdep(ji,jj) * r1_Z0 ! depth
+ zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature
+ zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
+ !
+ zn3 = EOS013*zt &
+ & + EOS103*zs+EOS003
+ !
+ zn2 = (EOS022*zt &
+ & + EOS112*zs+EOS012)*zt &
+ & + (EOS202*zs+EOS102)*zs+EOS002
+ !
+ zn1 = (((EOS041*zt &
+ & + EOS131*zs+EOS031)*zt &
+ & + (EOS221*zs+EOS121)*zs+EOS021)*zt &
+ & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt &
+ & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+ !
+ zn0 = (((((EOS060*zt &
+ & + EOS150*zs+EOS050)*zt &
+ & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
+ & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
+ & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
+ & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
+ & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+ !
+ zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+ !
+ prd(ji,jj) = zn * r1_rau0 - 1._wp ! unmasked in situ density anomaly
+ !
+ END DO
+ END DO
+ !
+ CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions
+ !
+ CASE( np_seos ) !== simplified EOS ==!
+ !
+ DO jj = 1, jpjm1
+ DO ji = 1, fs_jpim1 ! vector opt.
+ !
+ zt = pts (ji,jj,jp_tem) - 10._wp
+ zs = pts (ji,jj,jp_sal) - 35._wp
+ zh = pdep (ji,jj) ! depth at the partial step level
+ !
+ zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt &
+ & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs &
+ & - rn_nu * zt * zs
+ !
+ prd(ji,jj) = zn * r1_rau0 ! unmasked in situ density anomaly
+ !
+ END DO
+ END DO
+ !
+ CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions
+ !
+ CASE( np_leos ) !== ISOMIP EOS ==!
+ !
+ DO jj = 1, jpjm1
+ DO ji = 1, fs_jpim1 ! vector opt.
+ !
+ zt = pts (ji,jj,jp_tem) - (-1._wp)
+ zs = pts (ji,jj,jp_sal) - 34.2_wp
+ zh = pdep (ji,jj) ! depth at the partial step level
+ !
+ zn = rau0 * ( - rn_a0 * zt + rn_b0 * zs )
+ !
+ prd(ji,jj) = zn * r1_rau0 ! unmasked in situ density anomaly
+ !
+ END DO
+ END DO
+ !
+ CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions
+ !
+ END SELECT
+ !
+ IF(ln_ctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
+ !
+ IF( ln_timing ) CALL timing_stop('eos2d')
+ !
+ END SUBROUTINE eos_insitu_2d
+
+
+ SUBROUTINE rab_3d( pts, pab, Kmm )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE rab_3d ***
+ !!
+ !! ** Purpose : Calculates thermal/haline expansion ratio at T-points
+ !!
+ !! ** Method : calculates alpha / beta at T-points
+ !!
+ !! ** Action : - pab : thermal/haline expansion ratio at T-points
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: Kmm ! time level index
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab ! thermal/haline expansion ratio
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zt , zh , zs , ztm ! local scalars
+ REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('rab_3d')
+ !
+ SELECT CASE ( neos )
+ !
+ CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ !
+ zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth
+ zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature
+ zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
+ ztm = tmask(ji,jj,jk) ! tmask
+ !
+ ! alpha
+ zn3 = ALP003
+ !
+ zn2 = ALP012*zt + ALP102*zs+ALP002
+ !
+ zn1 = ((ALP031*zt &
+ & + ALP121*zs+ALP021)*zt &
+ & + (ALP211*zs+ALP111)*zs+ALP011)*zt &
+ & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
+ !
+ zn0 = ((((ALP050*zt &
+ & + ALP140*zs+ALP040)*zt &
+ & + (ALP230*zs+ALP130)*zs+ALP030)*zt &
+ & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt &
+ & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt &
+ & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
+ !
+ zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+ !
+ pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm
+ !
+ ! beta
+ zn3 = BET003
+ !
+ zn2 = BET012*zt + BET102*zs+BET002
+ !
+ zn1 = ((BET031*zt &
+ & + BET121*zs+BET021)*zt &
+ & + (BET211*zs+BET111)*zs+BET011)*zt &
+ & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
+ !
+ zn0 = ((((BET050*zt &
+ & + BET140*zs+BET040)*zt &
+ & + (BET230*zs+BET130)*zs+BET030)*zt &
+ & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt &
+ & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt &
+ & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
+ !
+ zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+ !
+ pab(ji,jj,jk,jp_sal) = zn / zs * r1_rau0 * ztm
+ !
+ END DO
+ END DO
+ END DO
+ !
+ CASE( np_seos ) !== simplified EOS ==!
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0)
+ zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
+ zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
+ ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask
+ !
+ zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
+ pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm ! alpha
+ !
+ zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
+ pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm ! beta
+ !
+ END DO
+ END DO
+ END DO
+ !
+ CASE( np_leos ) !== linear ISOMIP EOS ==!
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zt = pts (ji,jj,jk,jp_tem) - (-1._wp)
+ zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0)
+ zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
+ ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask
+ !
+ zn = rn_a0 * rau0
+ pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm ! alpha
+ !
+ zn = rn_b0 * rau0
+ pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm ! beta
+ !
+ END DO
+ END DO
+ END DO
+ !
+ CASE DEFAULT
+ WRITE(ctmp1,*) ' bad flag value for neos = ', neos
+ CALL ctl_stop( 'rab_3d:', ctmp1 )
+ !
+ END SELECT
+ !
+ IF(ln_ctl) CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', &
+ & tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk )
+ !
+ IF( ln_timing ) CALL timing_stop('rab_3d')
+ !
+ END SUBROUTINE rab_3d
+
+
+ SUBROUTINE rab_2d( pts, pdep, pab, Kmm )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE rab_2d ***
+ !!
+ !! ** Purpose : Calculates thermal/haline expansion ratio for a 2d field (unmasked)
+ !!
+ !! ** Action : - pab : thermal/haline expansion ratio at T-points
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: Kmm ! time level index
+ REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT(in ) :: pts ! pot. temperature & salinity
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m]
+ REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT( out) :: pab ! thermal/haline expansion ratio
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zt , zh , zs ! local scalars
+ REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('rab_2d')
+ !
+ pab(:,:,:) = 0._wp
+ !
+ SELECT CASE ( neos )
+ !
+ CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
+ !
+ DO jj = 1, jpjm1
+ DO ji = 1, fs_jpim1 ! vector opt.
+ !
+ zh = pdep(ji,jj) * r1_Z0 ! depth
+ zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature
+ zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
+ !
+ ! alpha
+ zn3 = ALP003
+ !
+ zn2 = ALP012*zt + ALP102*zs+ALP002
+ !
+ zn1 = ((ALP031*zt &
+ & + ALP121*zs+ALP021)*zt &
+ & + (ALP211*zs+ALP111)*zs+ALP011)*zt &
+ & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
+ !
+ zn0 = ((((ALP050*zt &
+ & + ALP140*zs+ALP040)*zt &
+ & + (ALP230*zs+ALP130)*zs+ALP030)*zt &
+ & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt &
+ & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt &
+ & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
+ !
+ zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+ !
+ pab(ji,jj,jp_tem) = zn * r1_rau0
+ !
+ ! beta
+ zn3 = BET003
+ !
+ zn2 = BET012*zt + BET102*zs+BET002
+ !
+ zn1 = ((BET031*zt &
+ & + BET121*zs+BET021)*zt &
+ & + (BET211*zs+BET111)*zs+BET011)*zt &
+ & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
+ !
+ zn0 = ((((BET050*zt &
+ & + BET140*zs+BET040)*zt &
+ & + (BET230*zs+BET130)*zs+BET030)*zt &
+ & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt &
+ & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt &
+ & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
+ !
+ zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+ !
+ pab(ji,jj,jp_sal) = zn / zs * r1_rau0
+ !
+ !
+ END DO
+ END DO
+ ! ! Lateral boundary conditions
+ CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. )
+ !
+ CASE( np_seos ) !== simplified EOS ==!
+ !
+ DO jj = 1, jpjm1
+ DO ji = 1, fs_jpim1 ! vector opt.
+ !
+ zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0)
+ zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
+ zh = pdep (ji,jj) ! depth at the partial step level
+ !
+ zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
+ pab(ji,jj,jp_tem) = zn * r1_rau0 ! alpha
+ !
+ zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
+ pab(ji,jj,jp_sal) = zn * r1_rau0 ! beta
+ !
+ END DO
+ END DO
+ ! ! Lateral boundary conditions
+ CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. )
+ !
+ CASE( np_leos ) !== linear ISOMIP EOS ==!
+ !
+ DO jj = 1, jpjm1
+ DO ji = 1, fs_jpim1 ! vector opt.
+ !
+ zt = pts (ji,jj,jp_tem) - (-1._wp) ! pot. temperature anomaly (t-T0)
+ zs = pts (ji,jj,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0)
+ zh = pdep (ji,jj) ! depth at the partial step level
+ !
+ zn = rn_a0 * rau0
+ pab(ji,jj,jp_tem) = zn * r1_rau0 ! alpha
+ !
+ zn = rn_b0 * rau0
+ pab(ji,jj,jp_sal) = zn * r1_rau0 ! beta
+ !
+ END DO
+ END DO
+ !
+ CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. ) ! Lateral boundary conditions
+ !
+ CASE DEFAULT
+ WRITE(ctmp1,*) ' bad flag value for neos = ', neos
+ CALL ctl_stop( 'rab_2d:', ctmp1 )
+ !
+ END SELECT
+ !
+ IF(ln_ctl) CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', &
+ & tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' )
+ !
+ IF( ln_timing ) CALL timing_stop('rab_2d')
+ !
+ END SUBROUTINE rab_2d
+
+
+ SUBROUTINE rab_0d( pts, pdep, pab, Kmm )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE rab_0d ***
+ !!
+ !! ** Purpose : Calculates thermal/haline expansion ratio for a 2d field (unmasked)
+ !!
+ !! ** Action : - pab : thermal/haline expansion ratio at T-points
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: Kmm ! time level index
+ REAL(wp), DIMENSION(jpts) , INTENT(in ) :: pts ! pot. temperature & salinity
+ REAL(wp), INTENT(in ) :: pdep ! depth [m]
+ REAL(wp), DIMENSION(jpts) , INTENT( out) :: pab ! thermal/haline expansion ratio
+ !
+ REAL(wp) :: zt , zh , zs ! local scalars
+ REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('rab_0d')
+ !
+ pab(:) = 0._wp
+ !
+ SELECT CASE ( neos )
+ !
+ CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
+ !
+ !
+ zh = pdep * r1_Z0 ! depth
+ zt = pts (jp_tem) * r1_T0 ! temperature
+ zs = SQRT( ABS( pts(jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
+ !
+ ! alpha
+ zn3 = ALP003
+ !
+ zn2 = ALP012*zt + ALP102*zs+ALP002
+ !
+ zn1 = ((ALP031*zt &
+ & + ALP121*zs+ALP021)*zt &
+ & + (ALP211*zs+ALP111)*zs+ALP011)*zt &
+ & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
+ !
+ zn0 = ((((ALP050*zt &
+ & + ALP140*zs+ALP040)*zt &
+ & + (ALP230*zs+ALP130)*zs+ALP030)*zt &
+ & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt &
+ & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt &
+ & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
+ !
+ zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+ !
+ pab(jp_tem) = zn * r1_rau0
+ !
+ ! beta
+ zn3 = BET003
+ !
+ zn2 = BET012*zt + BET102*zs+BET002
+ !
+ zn1 = ((BET031*zt &
+ & + BET121*zs+BET021)*zt &
+ & + (BET211*zs+BET111)*zs+BET011)*zt &
+ & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
+ !
+ zn0 = ((((BET050*zt &
+ & + BET140*zs+BET040)*zt &
+ & + (BET230*zs+BET130)*zs+BET030)*zt &
+ & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt &
+ & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt &
+ & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
+ !
+ zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+ !
+ pab(jp_sal) = zn / zs * r1_rau0
+ !
+ !
+ !
+ CASE( np_seos ) !== simplified EOS ==!
+ !
+ zt = pts(jp_tem) - 10._wp ! pot. temperature anomaly (t-T0)
+ zs = pts(jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
+ zh = pdep ! depth at the partial step level
+ !
+ zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
+ pab(jp_tem) = zn * r1_rau0 ! alpha
+ !
+ zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
+ pab(jp_sal) = zn * r1_rau0 ! beta
+ !
+ CASE( np_leos ) !== linear ISOMIP EOS ==!
+ !
+ zt = pts(jp_tem) - (-1._wp) ! pot. temperature anomaly (t-T0)
+ zs = pts(jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0)
+ zh = pdep ! depth at the partial step level
+ !
+ zn = rn_a0 * rau0
+ pab(jp_tem) = zn * r1_rau0 ! alpha
+ !
+ zn = rn_b0 * rau0
+ pab(jp_sal) = zn * r1_rau0 ! beta
+ !
+ CASE DEFAULT
+ WRITE(ctmp1,*) ' bad flag value for neos = ', neos
+ CALL ctl_stop( 'rab_0d:', ctmp1 )
+ !
+ END SELECT
+ !
+ IF( ln_timing ) CALL timing_stop('rab_0d')
+ !
+ END SUBROUTINE rab_0d
+
+
+ SUBROUTINE bn2( pts, pab, pn2, Kmm )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE bn2 ***
+ !!
+ !! ** Purpose : Compute the local Brunt-Vaisala frequency at the
+ !! time-step of the input arguments
+ !!
+ !! ** Method : pn2 = grav * (alpha dk[T] + beta dk[S] ) / e3w
+ !! where alpha and beta are given in pab, and computed on T-points.
+ !! N.B. N^2 is set one for all to zero at jk=1 in istate module.
+ !!
+ !! ** Action : pn2 : square of the brunt-vaisala frequency at w-point
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: Kmm ! time level index
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu]
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1]
+ REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2]
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zaw, zbw, zrw ! local scalars
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('bn2')
+ !
+ DO jk = 2, jpkm1 ! interior points only (2=< jk =< jpkm1 )
+ DO jj = 1, jpj ! surface and bottom value set to zero one for all in istate.F90
+ DO ji = 1, jpi
+ zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) &
+ & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) )
+ !
+ zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw
+ zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw
+ !
+ pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) &
+ & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) &
+ & / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)
+ END DO
+ END DO
+ END DO
+ !
+ IF(ln_ctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ', kdim=jpk )
+ !
+ IF( ln_timing ) CALL timing_stop('bn2')
+ !
+ END SUBROUTINE bn2
+
+
+ FUNCTION eos_pt_from_ct( ctmp, psal ) RESULT( ptmp )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE eos_pt_from_ct ***
+ !!
+ !! ** Purpose : Compute pot.temp. from cons. temp. [Celsius]
+ !!
+ !! ** Method : rational approximation (5/3th order) of TEOS-10 algorithm
+ !! checkvalue: pt=20.02391895 Celsius for sa=35.7g/kg, ct=20degC
+ !!
+ !! Reference : TEOS-10, UNESCO
+ !! Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC)
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celsius]
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu]
+ ! Leave result array automatic rather than making explicitly allocated
+ REAL(wp), DIMENSION(jpi,jpj) :: ptmp ! potential temperature [Celsius]
+ !
+ INTEGER :: ji, jj ! dummy loop indices
+ REAL(wp) :: zt , zs , ztm ! local scalars
+ REAL(wp) :: zn , zd ! local scalars
+ REAL(wp) :: zdeltaS , z1_S0 , z1_T0
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('eos_pt_from_ct')
+ !
+ zdeltaS = 5._wp
+ z1_S0 = 0.875_wp/35.16504_wp
+ z1_T0 = 1._wp/40._wp
+ !
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ !
+ zt = ctmp (ji,jj) * z1_T0
+ zs = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 )
+ ztm = tmask(ji,jj,1)
+ !
+ zn = ((((-2.1385727895e-01_wp*zt &
+ & - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt &
+ & + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt &
+ & + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt &
+ & + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs &
+ & +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt &
+ & + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs &
+ & -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp
+ !
+ zd = (2.0035003456_wp*zt &
+ & -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt &
+ & + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp
+ !
+ ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm
+ !
+ END DO
+ END DO
+ !
+ IF( ln_timing ) CALL timing_stop('eos_pt_from_ct')
+ !
+ END FUNCTION eos_pt_from_ct
+
+
+ SUBROUTINE eos_fzp_2d( psal, ptf, pdep )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE eos_fzp ***
+ !!
+ !! ** Purpose : Compute the freezing point temperature [Celsius]
+ !!
+ !! ** Method : UNESCO freezing point (ptf) in Celsius is given by
+ !! ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z
+ !! checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m
+ !!
+ !! Reference : UNESCO tech. papers in the marine science no. 28. 1978
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu]
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m]
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(out ) :: ptf ! freezing temperature [Celsius]
+ !
+ INTEGER :: ji, jj ! dummy loop indices
+ REAL(wp) :: zt, zs, z1_S0 ! local scalars
+ !!----------------------------------------------------------------------
+ !
+ SELECT CASE ( neos )
+ !
+ CASE ( np_teos10, np_seos ) !== CT,SA (TEOS-10 and S-EOS formulations) ==!
+ !
+ z1_S0 = 1._wp / 35.16504_wp
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 ) ! square root salinity
+ ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
+ & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
+ END DO
+ END DO
+ ptf(:,:) = ptf(:,:) * psal(:,:)
+ !
+ IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
+ !
+ CASE ( np_eos80, np_leos ) !== PT,SP (UNESCO formulation) ==!
+ !
+ ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) &
+ & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:)
+ !
+ IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
+ !
+ CASE DEFAULT
+ WRITE(ctmp1,*) ' bad flag value for neos = ', neos
+ CALL ctl_stop( 'eos_fzp_2d:', ctmp1 )
+ !
+ END SELECT
+ !
+ END SUBROUTINE eos_fzp_2d
+
+
+ SUBROUTINE eos_fzp_0d( psal, ptf, pdep )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE eos_fzp ***
+ !!
+ !! ** Purpose : Compute the freezing point temperature [Celsius]
+ !!
+ !! ** Method : UNESCO freezing point (ptf) in Celsius is given by
+ !! ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z
+ !! checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m
+ !!
+ !! Reference : UNESCO tech. papers in the marine science no. 28. 1978
+ !!----------------------------------------------------------------------
+ REAL(wp), INTENT(in ) :: psal ! salinity [psu]
+ REAL(wp), INTENT(in ), OPTIONAL :: pdep ! depth [m]
+ REAL(wp), INTENT(out) :: ptf ! freezing temperature [Celsius]
+ !
+ REAL(wp) :: zs ! local scalars
+ !!----------------------------------------------------------------------
+ !
+ SELECT CASE ( neos )
+ !
+ CASE ( np_teos10, np_seos ) !== CT,SA (TEOS-10 and S-EOS formulations) ==!
+ !
+ zs = SQRT( ABS( psal ) / 35.16504_wp ) ! square root salinity
+ ptf = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
+ & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
+ ptf = ptf * psal
+ !
+ IF( PRESENT( pdep ) ) ptf = ptf - 7.53e-4 * pdep
+ !
+ CASE ( np_eos80, np_leos ) !== PT,SP (UNESCO formulation) ==!
+ !
+ ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal ) &
+ & - 2.154996e-4_wp * psal ) * psal
+ !
+ IF( PRESENT( pdep ) ) ptf = ptf - 7.53e-4 * pdep
+ !
+ CASE DEFAULT
+ WRITE(ctmp1,*) ' bad flag value for neos = ', neos
+ CALL ctl_stop( 'eos_fzp_0d:', ctmp1 )
+ !
+ END SELECT
+ !
+ END SUBROUTINE eos_fzp_0d
+
+
+ SUBROUTINE eos_pen( pts, pab_pe, ppen, Kmm )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE eos_pen ***
+ !!
+ !! ** Purpose : Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points
+ !!
+ !! ** Method : PE is defined analytically as the vertical
+ !! primitive of EOS times -g integrated between 0 and z>0.
+ !! pen is the nonlinear bsq-PE anomaly: pen = ( PE - rau0 gz ) / rau0 gz - rd
+ !! = 1/z * /int_0^z rd dz - rd
+ !! where rd is the density anomaly (see eos_rhd function)
+ !! ab_pe are partial derivatives of PE anomaly with respect to T and S:
+ !! ab_pe(1) = - 1/(rau0 gz) * dPE/dT + drd/dT = - d(pen)/dT
+ !! ab_pe(2) = 1/(rau0 gz) * dPE/dS + drd/dS = d(pen)/dS
+ !!
+ !! ** Action : - pen : PE anomaly given at T-points
+ !! : - pab_pe : given at T-points
+ !! pab_pe(:,:,:,jp_tem) is alpha_pe
+ !! pab_pe(:,:,:,jp_sal) is beta_pe
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: Kmm ! time level index
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab_pe ! alpha_pe and beta_pe
+ REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: ppen ! potential energy anomaly
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zt , zh , zs , ztm ! local scalars
+ REAL(wp) :: zn , zn0, zn1, zn2 ! - -
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('eos_pen')
+ !
+ SELECT CASE ( neos )
+ !
+ CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ !
+ zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth
+ zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature
+ zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
+ ztm = tmask(ji,jj,jk) ! tmask
+ !
+ ! potential energy non-linear anomaly
+ zn2 = (PEN012)*zt &
+ & + PEN102*zs+PEN002
+ !
+ zn1 = ((PEN021)*zt &
+ & + PEN111*zs+PEN011)*zt &
+ & + (PEN201*zs+PEN101)*zs+PEN001
+ !
+ zn0 = ((((PEN040)*zt &
+ & + PEN130*zs+PEN030)*zt &
+ & + (PEN220*zs+PEN120)*zs+PEN020)*zt &
+ & + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt &
+ & + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000
+ !
+ zn = ( zn2 * zh + zn1 ) * zh + zn0
+ !
+ ppen(ji,jj,jk) = zn * zh * r1_rau0 * ztm
+ !
+ ! alphaPE non-linear anomaly
+ zn2 = APE002
+ !
+ zn1 = (APE011)*zt &
+ & + APE101*zs+APE001
+ !
+ zn0 = (((APE030)*zt &
+ & + APE120*zs+APE020)*zt &
+ & + (APE210*zs+APE110)*zs+APE010)*zt &
+ & + ((APE300*zs+APE200)*zs+APE100)*zs+APE000
+ !
+ zn = ( zn2 * zh + zn1 ) * zh + zn0
+ !
+ pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rau0 * ztm
+ !
+ ! betaPE non-linear anomaly
+ zn2 = BPE002
+ !
+ zn1 = (BPE011)*zt &
+ & + BPE101*zs+BPE001
+ !
+ zn0 = (((BPE030)*zt &
+ & + BPE120*zs+BPE020)*zt &
+ & + (BPE210*zs+BPE110)*zs+BPE010)*zt &
+ & + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000
+ !
+ zn = ( zn2 * zh + zn1 ) * zh + zn0
+ !
+ pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rau0 * ztm
+ !
+ END DO
+ END DO
+ END DO
+ !
+ CASE( np_seos ) !== Vallis (2006) simplified EOS ==!
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0)
+ zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
+ zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
+ ztm = tmask(ji,jj,jk) ! tmask
+ zn = 0.5_wp * zh * r1_rau0 * ztm
+ ! ! Potential Energy
+ ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn
+ ! ! alphaPE
+ pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn
+ pab_pe(ji,jj,jk,jp_sal) = rn_b0 * rn_mu2 * zn
+ !
+ END DO
+ END DO
+ END DO
+ !
+ CASE( np_leos ) !== linear ISOMIP EOS ==!
+ !
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zt = pts(ji,jj,jk,jp_tem) - (-1._wp) ! temperature anomaly (t-T0)
+ zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0)
+ zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
+ ztm = tmask(ji,jj,jk) ! tmask
+ zn = 0.5_wp * zh * r1_rau0 * ztm
+ ! ! Potential Energy
+ ppen(ji,jj,jk) = 0.
+ ! ! alphaPE
+ pab_pe(ji,jj,jk,jp_tem) = 0.
+ pab_pe(ji,jj,jk,jp_sal) = 0.
+ !
+ END DO
+ END DO
+ END DO
+ !
+ CASE DEFAULT
+ WRITE(ctmp1,*) ' bad flag value for neos = ', neos
+ CALL ctl_stop( 'eos_pen:', ctmp1 )
+ !
+ END SELECT
+ !
+ IF( ln_timing ) CALL timing_stop('eos_pen')
+ !
+ END SUBROUTINE eos_pen
+
+
+ SUBROUTINE eos_init
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE eos_init ***
+ !!
+ !! ** Purpose : initializations for the equation of state
+ !!
+ !! ** Method : Read the namelist nameos and control the parameters
+ !!----------------------------------------------------------------------
+ INTEGER :: ios ! local integer
+ INTEGER :: ioptio ! local integer
+ !!
+ NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS , ln_LEOS, &
+ & rn_a0 , rn_b0 , rn_lambda1, rn_mu1 , &
+ & rn_lambda2, rn_mu2 , rn_nu
+ !!----------------------------------------------------------------------
+ !
+ REWIND( numnam_ref ) ! Namelist nameos in reference namelist : equation of state
+ READ ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 )
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist' )
+ !
+ REWIND( numnam_cfg ) ! Namelist nameos in configuration namelist : equation of state
+ READ ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 )
+902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist' )
+ IF(lwm) WRITE( numond, nameos )
+ !
+ rau0 = 1027.51_wp !: volumic mass of reference [kg/m3]
+ rcp = 3974.00_wp !: heat capacity [J/K]
+ !
+ IF(lwp) THEN ! Control print
+ WRITE(numout,*)
+ WRITE(numout,*) 'eos_init : equation of state'
+ WRITE(numout,*) '~~~~~~~~'
+ WRITE(numout,*) ' Namelist nameos : Chosen the Equation Of Seawater (EOS)'
+ WRITE(numout,*) ' TEOS-10 : rho=F(Conservative Temperature, Absolute Salinity, depth) ln_TEOS10 = ', ln_TEOS10
+ WRITE(numout,*) ' EOS-80 : rho=F(Potential Temperature, Practical Salinity, depth) ln_EOS80 = ', ln_EOS80
+ WRITE(numout,*) ' S-EOS : rho=F(Conservative Temperature, Absolute Salinity, depth) ln_SEOS = ', ln_SEOS
+ WRITE(numout,*) ' L-EOS : rho=F(Potential Temperature, Practical Salinity, depth) ln_LEOS = ', ln_LEOS
+ ENDIF
+
+ ! Check options for equation of state & set neos based on logical flags
+ ioptio = 0
+ IF( ln_TEOS10 ) THEN ; ioptio = ioptio+1 ; neos = np_teos10 ; ENDIF
+ IF( ln_EOS80 ) THEN ; ioptio = ioptio+1 ; neos = np_eos80 ; ENDIF
+ IF( ln_SEOS ) THEN ; ioptio = ioptio+1 ; neos = np_seos ; ENDIF
+ IF( ln_LEOS ) THEN ; ioptio = ioptio+1 ; neos = np_leos ; ENDIF
+ IF( ioptio /= 1 ) CALL ctl_stop("Exactly one equation of state option must be selected")
+ !
+ SELECT CASE( neos ) ! check option
+ !
+ CASE( np_teos10 ) !== polynomial TEOS-10 ==!
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' ==>>> use of TEOS-10 equation of state (cons. temp. and abs. salinity)'
+ !
+ l_useCT = .TRUE. ! model temperature is Conservative temperature
+ !
+ rdeltaS = 32._wp
+ r1_S0 = 0.875_wp/35.16504_wp
+ r1_T0 = 1._wp/40._wp
+ r1_Z0 = 1.e-4_wp
+ !
+ EOS000 = 8.0189615746e+02_wp
+ EOS100 = 8.6672408165e+02_wp
+ EOS200 = -1.7864682637e+03_wp
+ EOS300 = 2.0375295546e+03_wp
+ EOS400 = -1.2849161071e+03_wp
+ EOS500 = 4.3227585684e+02_wp
+ EOS600 = -6.0579916612e+01_wp
+ EOS010 = 2.6010145068e+01_wp
+ EOS110 = -6.5281885265e+01_wp
+ EOS210 = 8.1770425108e+01_wp
+ EOS310 = -5.6888046321e+01_wp
+ EOS410 = 1.7681814114e+01_wp
+ EOS510 = -1.9193502195_wp
+ EOS020 = -3.7074170417e+01_wp
+ EOS120 = 6.1548258127e+01_wp
+ EOS220 = -6.0362551501e+01_wp
+ EOS320 = 2.9130021253e+01_wp
+ EOS420 = -5.4723692739_wp
+ EOS030 = 2.1661789529e+01_wp
+ EOS130 = -3.3449108469e+01_wp
+ EOS230 = 1.9717078466e+01_wp
+ EOS330 = -3.1742946532_wp
+ EOS040 = -8.3627885467_wp
+ EOS140 = 1.1311538584e+01_wp
+ EOS240 = -5.3563304045_wp
+ EOS050 = 5.4048723791e-01_wp
+ EOS150 = 4.8169980163e-01_wp
+ EOS060 = -1.9083568888e-01_wp
+ EOS001 = 1.9681925209e+01_wp
+ EOS101 = -4.2549998214e+01_wp
+ EOS201 = 5.0774768218e+01_wp
+ EOS301 = -3.0938076334e+01_wp
+ EOS401 = 6.6051753097_wp
+ EOS011 = -1.3336301113e+01_wp
+ EOS111 = -4.4870114575_wp
+ EOS211 = 5.0042598061_wp
+ EOS311 = -6.5399043664e-01_wp
+ EOS021 = 6.7080479603_wp
+ EOS121 = 3.5063081279_wp
+ EOS221 = -1.8795372996_wp
+ EOS031 = -2.4649669534_wp
+ EOS131 = -5.5077101279e-01_wp
+ EOS041 = 5.5927935970e-01_wp
+ EOS002 = 2.0660924175_wp
+ EOS102 = -4.9527603989_wp
+ EOS202 = 2.5019633244_wp
+ EOS012 = 2.0564311499_wp
+ EOS112 = -2.1311365518e-01_wp
+ EOS022 = -1.2419983026_wp
+ EOS003 = -2.3342758797e-02_wp
+ EOS103 = -1.8507636718e-02_wp
+ EOS013 = 3.7969820455e-01_wp
+ !
+ ALP000 = -6.5025362670e-01_wp
+ ALP100 = 1.6320471316_wp
+ ALP200 = -2.0442606277_wp
+ ALP300 = 1.4222011580_wp
+ ALP400 = -4.4204535284e-01_wp
+ ALP500 = 4.7983755487e-02_wp
+ ALP010 = 1.8537085209_wp
+ ALP110 = -3.0774129064_wp
+ ALP210 = 3.0181275751_wp
+ ALP310 = -1.4565010626_wp
+ ALP410 = 2.7361846370e-01_wp
+ ALP020 = -1.6246342147_wp
+ ALP120 = 2.5086831352_wp
+ ALP220 = -1.4787808849_wp
+ ALP320 = 2.3807209899e-01_wp
+ ALP030 = 8.3627885467e-01_wp
+ ALP130 = -1.1311538584_wp
+ ALP230 = 5.3563304045e-01_wp
+ ALP040 = -6.7560904739e-02_wp
+ ALP140 = -6.0212475204e-02_wp
+ ALP050 = 2.8625353333e-02_wp
+ ALP001 = 3.3340752782e-01_wp
+ ALP101 = 1.1217528644e-01_wp
+ ALP201 = -1.2510649515e-01_wp
+ ALP301 = 1.6349760916e-02_wp
+ ALP011 = -3.3540239802e-01_wp
+ ALP111 = -1.7531540640e-01_wp
+ ALP211 = 9.3976864981e-02_wp
+ ALP021 = 1.8487252150e-01_wp
+ ALP121 = 4.1307825959e-02_wp
+ ALP031 = -5.5927935970e-02_wp
+ ALP002 = -5.1410778748e-02_wp
+ ALP102 = 5.3278413794e-03_wp
+ ALP012 = 6.2099915132e-02_wp
+ ALP003 = -9.4924551138e-03_wp
+ !
+ BET000 = 1.0783203594e+01_wp
+ BET100 = -4.4452095908e+01_wp
+ BET200 = 7.6048755820e+01_wp
+ BET300 = -6.3944280668e+01_wp
+ BET400 = 2.6890441098e+01_wp
+ BET500 = -4.5221697773_wp
+ BET010 = -8.1219372432e-01_wp
+ BET110 = 2.0346663041_wp
+ BET210 = -2.1232895170_wp
+ BET310 = 8.7994140485e-01_wp
+ BET410 = -1.1939638360e-01_wp
+ BET020 = 7.6574242289e-01_wp
+ BET120 = -1.5019813020_wp
+ BET220 = 1.0872489522_wp
+ BET320 = -2.7233429080e-01_wp
+ BET030 = -4.1615152308e-01_wp
+ BET130 = 4.9061350869e-01_wp
+ BET230 = -1.1847737788e-01_wp
+ BET040 = 1.4073062708e-01_wp
+ BET140 = -1.3327978879e-01_wp
+ BET050 = 5.9929880134e-03_wp
+ BET001 = -5.2937873009e-01_wp
+ BET101 = 1.2634116779_wp
+ BET201 = -1.1547328025_wp
+ BET301 = 3.2870876279e-01_wp
+ BET011 = -5.5824407214e-02_wp
+ BET111 = 1.2451933313e-01_wp
+ BET211 = -2.4409539932e-02_wp
+ BET021 = 4.3623149752e-02_wp
+ BET121 = -4.6767901790e-02_wp
+ BET031 = -6.8523260060e-03_wp
+ BET002 = -6.1618945251e-02_wp
+ BET102 = 6.2255521644e-02_wp
+ BET012 = -2.6514181169e-03_wp
+ BET003 = -2.3025968587e-04_wp
+ !
+ PEN000 = -9.8409626043_wp
+ PEN100 = 2.1274999107e+01_wp
+ PEN200 = -2.5387384109e+01_wp
+ PEN300 = 1.5469038167e+01_wp
+ PEN400 = -3.3025876549_wp
+ PEN010 = 6.6681505563_wp
+ PEN110 = 2.2435057288_wp
+ PEN210 = -2.5021299030_wp
+ PEN310 = 3.2699521832e-01_wp
+ PEN020 = -3.3540239802_wp
+ PEN120 = -1.7531540640_wp
+ PEN220 = 9.3976864981e-01_wp
+ PEN030 = 1.2324834767_wp
+ PEN130 = 2.7538550639e-01_wp
+ PEN040 = -2.7963967985e-01_wp
+ PEN001 = -1.3773949450_wp
+ PEN101 = 3.3018402659_wp
+ PEN201 = -1.6679755496_wp
+ PEN011 = -1.3709540999_wp
+ PEN111 = 1.4207577012e-01_wp
+ PEN021 = 8.2799886843e-01_wp
+ PEN002 = 1.7507069098e-02_wp
+ PEN102 = 1.3880727538e-02_wp
+ PEN012 = -2.8477365341e-01_wp
+ !
+ APE000 = -1.6670376391e-01_wp
+ APE100 = -5.6087643219e-02_wp
+ APE200 = 6.2553247576e-02_wp
+ APE300 = -8.1748804580e-03_wp
+ APE010 = 1.6770119901e-01_wp
+ APE110 = 8.7657703198e-02_wp
+ APE210 = -4.6988432490e-02_wp
+ APE020 = -9.2436260751e-02_wp
+ APE120 = -2.0653912979e-02_wp
+ APE030 = 2.7963967985e-02_wp
+ APE001 = 3.4273852498e-02_wp
+ APE101 = -3.5518942529e-03_wp
+ APE011 = -4.1399943421e-02_wp
+ APE002 = 7.1193413354e-03_wp
+ !
+ BPE000 = 2.6468936504e-01_wp
+ BPE100 = -6.3170583896e-01_wp
+ BPE200 = 5.7736640125e-01_wp
+ BPE300 = -1.6435438140e-01_wp
+ BPE010 = 2.7912203607e-02_wp
+ BPE110 = -6.2259666565e-02_wp
+ BPE210 = 1.2204769966e-02_wp
+ BPE020 = -2.1811574876e-02_wp
+ BPE120 = 2.3383950895e-02_wp
+ BPE030 = 3.4261630030e-03_wp
+ BPE001 = 4.1079296834e-02_wp
+ BPE101 = -4.1503681096e-02_wp
+ BPE011 = 1.7676120780e-03_wp
+ BPE002 = 1.7269476440e-04_wp
+ !
+ CASE( np_eos80 ) !== polynomial EOS-80 formulation ==!
+ !
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' ==>>> use of EOS-80 equation of state (pot. temp. and pract. salinity)'
+ !
+ l_useCT = .FALSE. ! model temperature is Potential temperature
+ rdeltaS = 20._wp
+ r1_S0 = 1._wp/40._wp
+ r1_T0 = 1._wp/40._wp
+ r1_Z0 = 1.e-4_wp
+ !
+ EOS000 = 9.5356891948e+02_wp
+ EOS100 = 1.7136499189e+02_wp
+ EOS200 = -3.7501039454e+02_wp
+ EOS300 = 5.1856810420e+02_wp
+ EOS400 = -3.7264470465e+02_wp
+ EOS500 = 1.4302533998e+02_wp
+ EOS600 = -2.2856621162e+01_wp
+ EOS010 = 1.0087518651e+01_wp
+ EOS110 = -1.3647741861e+01_wp
+ EOS210 = 8.8478359933_wp
+ EOS310 = -7.2329388377_wp
+ EOS410 = 1.4774410611_wp
+ EOS510 = 2.0036720553e-01_wp
+ EOS020 = -2.5579830599e+01_wp
+ EOS120 = 2.4043512327e+01_wp
+ EOS220 = -1.6807503990e+01_wp
+ EOS320 = 8.3811577084_wp
+ EOS420 = -1.9771060192_wp
+ EOS030 = 1.6846451198e+01_wp
+ EOS130 = -2.1482926901e+01_wp
+ EOS230 = 1.0108954054e+01_wp
+ EOS330 = -6.2675951440e-01_wp
+ EOS040 = -8.0812310102_wp
+ EOS140 = 1.0102374985e+01_wp
+ EOS240 = -4.8340368631_wp
+ EOS050 = 1.2079167803_wp
+ EOS150 = 1.1515380987e-01_wp
+ EOS060 = -2.4520288837e-01_wp
+ EOS001 = 1.0748601068e+01_wp
+ EOS101 = -1.7817043500e+01_wp
+ EOS201 = 2.2181366768e+01_wp
+ EOS301 = -1.6750916338e+01_wp
+ EOS401 = 4.1202230403_wp
+ EOS011 = -1.5852644587e+01_wp
+ EOS111 = -7.6639383522e-01_wp
+ EOS211 = 4.1144627302_wp
+ EOS311 = -6.6955877448e-01_wp
+ EOS021 = 9.9994861860_wp
+ EOS121 = -1.9467067787e-01_wp
+ EOS221 = -1.2177554330_wp
+ EOS031 = -3.4866102017_wp
+ EOS131 = 2.2229155620e-01_wp
+ EOS041 = 5.9503008642e-01_wp
+ EOS002 = 1.0375676547_wp
+ EOS102 = -3.4249470629_wp
+ EOS202 = 2.0542026429_wp
+ EOS012 = 2.1836324814_wp
+ EOS112 = -3.4453674320e-01_wp
+ EOS022 = -1.2548163097_wp
+ EOS003 = 1.8729078427e-02_wp
+ EOS103 = -5.7238495240e-02_wp
+ EOS013 = 3.8306136687e-01_wp
+ !
+ ALP000 = -2.5218796628e-01_wp
+ ALP100 = 3.4119354654e-01_wp
+ ALP200 = -2.2119589983e-01_wp
+ ALP300 = 1.8082347094e-01_wp
+ ALP400 = -3.6936026529e-02_wp
+ ALP500 = -5.0091801383e-03_wp
+ ALP010 = 1.2789915300_wp
+ ALP110 = -1.2021756164_wp
+ ALP210 = 8.4037519952e-01_wp
+ ALP310 = -4.1905788542e-01_wp
+ ALP410 = 9.8855300959e-02_wp
+ ALP020 = -1.2634838399_wp
+ ALP120 = 1.6112195176_wp
+ ALP220 = -7.5817155402e-01_wp
+ ALP320 = 4.7006963580e-02_wp
+ ALP030 = 8.0812310102e-01_wp
+ ALP130 = -1.0102374985_wp
+ ALP230 = 4.8340368631e-01_wp
+ ALP040 = -1.5098959754e-01_wp
+ ALP140 = -1.4394226233e-02_wp
+ ALP050 = 3.6780433255e-02_wp
+ ALP001 = 3.9631611467e-01_wp
+ ALP101 = 1.9159845880e-02_wp
+ ALP201 = -1.0286156825e-01_wp
+ ALP301 = 1.6738969362e-02_wp
+ ALP011 = -4.9997430930e-01_wp
+ ALP111 = 9.7335338937e-03_wp
+ ALP211 = 6.0887771651e-02_wp
+ ALP021 = 2.6149576513e-01_wp
+ ALP121 = -1.6671866715e-02_wp
+ ALP031 = -5.9503008642e-02_wp
+ ALP002 = -5.4590812035e-02_wp
+ ALP102 = 8.6134185799e-03_wp
+ ALP012 = 6.2740815484e-02_wp
+ ALP003 = -9.5765341718e-03_wp
+ !
+ BET000 = 2.1420623987_wp
+ BET100 = -9.3752598635_wp
+ BET200 = 1.9446303907e+01_wp
+ BET300 = -1.8632235232e+01_wp
+ BET400 = 8.9390837485_wp
+ BET500 = -1.7142465871_wp
+ BET010 = -1.7059677327e-01_wp
+ BET110 = 2.2119589983e-01_wp
+ BET210 = -2.7123520642e-01_wp
+ BET310 = 7.3872053057e-02_wp
+ BET410 = 1.2522950346e-02_wp
+ BET020 = 3.0054390409e-01_wp
+ BET120 = -4.2018759976e-01_wp
+ BET220 = 3.1429341406e-01_wp
+ BET320 = -9.8855300959e-02_wp
+ BET030 = -2.6853658626e-01_wp
+ BET130 = 2.5272385134e-01_wp
+ BET230 = -2.3503481790e-02_wp
+ BET040 = 1.2627968731e-01_wp
+ BET140 = -1.2085092158e-01_wp
+ BET050 = 1.4394226233e-03_wp
+ BET001 = -2.2271304375e-01_wp
+ BET101 = 5.5453416919e-01_wp
+ BET201 = -6.2815936268e-01_wp
+ BET301 = 2.0601115202e-01_wp
+ BET011 = -9.5799229402e-03_wp
+ BET111 = 1.0286156825e-01_wp
+ BET211 = -2.5108454043e-02_wp
+ BET021 = -2.4333834734e-03_wp
+ BET121 = -3.0443885826e-02_wp
+ BET031 = 2.7786444526e-03_wp
+ BET002 = -4.2811838287e-02_wp
+ BET102 = 5.1355066072e-02_wp
+ BET012 = -4.3067092900e-03_wp
+ BET003 = -7.1548119050e-04_wp
+ !
+ PEN000 = -5.3743005340_wp
+ PEN100 = 8.9085217499_wp
+ PEN200 = -1.1090683384e+01_wp
+ PEN300 = 8.3754581690_wp
+ PEN400 = -2.0601115202_wp
+ PEN010 = 7.9263222935_wp
+ PEN110 = 3.8319691761e-01_wp
+ PEN210 = -2.0572313651_wp
+ PEN310 = 3.3477938724e-01_wp
+ PEN020 = -4.9997430930_wp
+ PEN120 = 9.7335338937e-02_wp
+ PEN220 = 6.0887771651e-01_wp
+ PEN030 = 1.7433051009_wp
+ PEN130 = -1.1114577810e-01_wp
+ PEN040 = -2.9751504321e-01_wp
+ PEN001 = -6.9171176978e-01_wp
+ PEN101 = 2.2832980419_wp
+ PEN201 = -1.3694684286_wp
+ PEN011 = -1.4557549876_wp
+ PEN111 = 2.2969116213e-01_wp
+ PEN021 = 8.3654420645e-01_wp
+ PEN002 = -1.4046808820e-02_wp
+ PEN102 = 4.2928871430e-02_wp
+ PEN012 = -2.8729602515e-01_wp
+ !
+ APE000 = -1.9815805734e-01_wp
+ APE100 = -9.5799229402e-03_wp
+ APE200 = 5.1430784127e-02_wp
+ APE300 = -8.3694846809e-03_wp
+ APE010 = 2.4998715465e-01_wp
+ APE110 = -4.8667669469e-03_wp
+ APE210 = -3.0443885826e-02_wp
+ APE020 = -1.3074788257e-01_wp
+ APE120 = 8.3359333577e-03_wp
+ APE030 = 2.9751504321e-02_wp
+ APE001 = 3.6393874690e-02_wp
+ APE101 = -5.7422790533e-03_wp
+ APE011 = -4.1827210323e-02_wp
+ APE002 = 7.1824006288e-03_wp
+ !
+ BPE000 = 1.1135652187e-01_wp
+ BPE100 = -2.7726708459e-01_wp
+ BPE200 = 3.1407968134e-01_wp
+ BPE300 = -1.0300557601e-01_wp
+ BPE010 = 4.7899614701e-03_wp
+ BPE110 = -5.1430784127e-02_wp
+ BPE210 = 1.2554227021e-02_wp
+ BPE020 = 1.2166917367e-03_wp
+ BPE120 = 1.5221942913e-02_wp
+ BPE030 = -1.3893222263e-03_wp
+ BPE001 = 2.8541225524e-02_wp
+ BPE101 = -3.4236710714e-02_wp
+ BPE011 = 2.8711395266e-03_wp
+ BPE002 = 5.3661089288e-04_wp
+ !
+ CASE( np_seos ) !== Simplified EOS ==!
+
+ r1_S0 = 0.875_wp/35.16504_wp ! Used to convert CT in potential temperature when using bulk formulae (eos_pt_from_ct)
+
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) ' ==>>> use of simplified eos: '
+ WRITE(numout,*) ' rhd(dT=T-10,dS=S-35,Z) = [-a0*(1+lambda1/2*dT+mu1*Z)*dT '
+ WRITE(numout,*) ' + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rau0'
+ WRITE(numout,*) ' with the following coefficients :'
+ WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a0
+ WRITE(numout,*) ' saline cont. coef. rn_b0 = ', rn_b0
+ WRITE(numout,*) ' cabbeling coef. rn_lambda1 = ', rn_lambda1
+ WRITE(numout,*) ' cabbeling coef. rn_lambda2 = ', rn_lambda2
+ WRITE(numout,*) ' thermobar. coef. rn_mu1 = ', rn_mu1
+ WRITE(numout,*) ' thermobar. coef. rn_mu2 = ', rn_mu2
+ WRITE(numout,*) ' 2nd cabbel. coef. rn_nu = ', rn_nu
+ WRITE(numout,*) ' Caution: rn_beta0=0 incompatible with ddm parameterization '
+ ENDIF
+ l_useCT = .TRUE. ! Use conservative temperature
+ !
+ CASE( np_leos ) !== Linear ISOMIP EOS ==!
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) ' use of linear ISOMIP eos: rhd(dT=T-(-1),dS=S-(34.2),Z) = '
+ WRITE(numout,*) ' [ -a0*dT + b0*dS ]/rau0'
+ WRITE(numout,*)
+ WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a0
+ WRITE(numout,*) ' saline cont. coef. rn_b0 = ', rn_b0
+ ENDIF
+ !
+ CASE DEFAULT !== ERROR in neos ==!
+ WRITE(ctmp1,*) ' bad flag value for neos = ', neos, '. You should never see this error'
+ CALL ctl_stop( ctmp1 )
+ !
+ END SELECT
+ !
+ rau0_rcp = rau0 * rcp
+ r1_rau0 = 1._wp / rau0
+ r1_rcp = 1._wp / rcp
+ r1_rau0_rcp = 1._wp / rau0_rcp
+ !
+ IF(lwp) THEN
+ IF( l_useCT ) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) ' ==>>> model uses Conservative Temperature'
+ WRITE(numout,*) ' Important: model must be initialized with CT and SA fields'
+ ELSE
+ WRITE(numout,*)
+ WRITE(numout,*) ' ==>>> model does not use Conservative Temperature'
+ ENDIF
+ ENDIF
+ !
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' Associated physical constant'
+ IF(lwp) WRITE(numout,*) ' volumic mass of reference rau0 = ', rau0 , ' kg/m^3'
+ IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0 = ', r1_rau0, ' m^3/kg'
+ IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin'
+ IF(lwp) WRITE(numout,*) ' rau0 * rcp rau0_rcp = ', rau0_rcp
+ IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp
+ !
+ END SUBROUTINE eos_init
+
+ !!======================================================================
+END MODULE eosbn2
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/isf_oce.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/isf_oce.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/isf_oce.F90 (revision 12150)
@@ -0,0 +1,267 @@
+MODULE isf_oce
+ !!======================================================================
+ !! *** MODULE sbcisf ***
+ !! Surface module : compute iceshelf melt and heat flux
+ !!======================================================================
+ !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav
+ !! X.X ! 2006-02 (C. Wang ) Original code bg03
+ !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization
+ !! 4.1 ! 2019-09 (P. Mathiot) Split param/explicit ice shelf and re-organisation
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isf : define and allocate ice shelf variables
+ !!----------------------------------------------------------------------
+
+ USE par_oce , ONLY: jpi, jpj, jpk
+ USE in_out_manager, ONLY: wp, jpts ! I/O manager
+ USE lib_mpp , ONLY: ctl_stop, mpp_sum ! MPP library
+ USE fldread ! read input fields
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isf_alloc, isf_alloc_par, isf_alloc_cav, isf_alloc_cpl, isf_dealloc_cpl
+ !
+ !-------------------------------------------------------
+ ! 0 : namelist parameter
+ !-------------------------------------------------------
+ !
+ ! 0.1 -------- ice shelf cavity parameter --------------
+ CHARACTER(LEN=256), PUBLIC :: cn_isfdir
+ LOGICAL , PUBLIC :: ln_isf
+ LOGICAL , PUBLIC :: ln_isfdebug
+ !
+ ! 0.2 -------- ice shelf cavity opened namelist parameter -------------
+ LOGICAL , PUBLIC :: ln_isfcav_mlt !: logical for the use of ice shelf parametrisation
+ REAL(wp) , PUBLIC :: rn_gammat0 !: temperature exchange coeficient []
+ REAL(wp) , PUBLIC :: rn_gammas0 !: salinity exchange coeficient []
+ REAL(wp) , PUBLIC :: rn_vtide !: tidal background velocity (can be different to what is used in the
+ REAL(wp) , PUBLIC :: rn_htbl !: Losch top boundary layer thickness [m]
+ REAL(wp) , PUBLIC :: rn_isfload_T !:
+ REAL(wp) , PUBLIC :: rn_isfload_S !:
+ CHARACTER(LEN=256), PUBLIC :: cn_gammablk !: gamma formulation
+ CHARACTER(LEN=256), PUBLIC :: cn_isfcav_mlt !: melt formulation (cavity/param)
+ CHARACTER(LEN=256), PUBLIC :: cn_isfload !: ice shelf load computation method
+ TYPE(FLD_N) , PUBLIC :: sn_isfcav_fwf !: information about the isf melting file to be read
+ !
+ ! 0.3 -------- ice shelf cavity parametrised namelist parameter -------------
+ LOGICAL , PUBLIC :: ln_isfpar_mlt !: logical for the computation of melt inside the cavity
+ CHARACTER(LEN=256), PUBLIC :: cn_isfpar_mlt !: melt formulation (cavity/param)
+ TYPE(FLD_N) , PUBLIC :: sn_isfpar_fwf !: information about the isf melting file to be read
+ TYPE(FLD_N) , PUBLIC :: sn_isfpar_zmax !: information about the grounding line depth file to be read
+ TYPE(FLD_N) , PUBLIC :: sn_isfpar_zmin !: information about the calving line depth file to be read
+ TYPE(FLD_N) , PUBLIC :: sn_isfpar_Leff !: information about the effective length file to be read
+ !
+ ! 0.4 -------- coupling namelist parameter -------------
+ LOGICAL, PUBLIC :: ln_isfcpl !:
+ LOGICAL, PUBLIC :: ln_isfcpl_cons !:
+ INTEGER, PUBLIC :: nn_drown !:
+ !
+ !-------------------------------------------------------
+ ! 1 : ice shelf parameter
+ !-------------------------------------------------------
+ !
+ REAL(wp), PARAMETER, PUBLIC :: rLfusisf = 0.334e6_wp !: latent heat of fusion of ice shelf [J/kg]
+ REAL(wp), PARAMETER, PUBLIC :: rcpisf = 2000.0_wp !: specific heat of ice shelf [J/kg/K]
+ REAL(wp), PARAMETER, PUBLIC :: rkappa = 0.0_wp !: ISOMIP+ no heat diffusivity through the ice-shelf [m2/s]
+ REAL(wp), PARAMETER, PUBLIC :: rhoisf = 920.0_wp !: volumic mass of ice shelf [kg/m3]
+ REAL(wp), PARAMETER, PUBLIC :: rtsurf = -20.0 !: surface temperature [C]
+ !
+ !-------------------------------------------------------
+ ! 2 : ice shelf global variables
+ !-------------------------------------------------------
+ !
+ ! 2.1 -------- ice shelf cavity parameter --------------
+ LOGICAL , PUBLIC :: l_isfoasis
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfload !: ice shelf load
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf_oasis
+ !
+ ! 2.2 -------- ice shelf cavity melt namelist parameter -------------
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mskisf_cav !:
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: misfkt_cav , misfkb_cav !:
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhisf_tbl_cav, rfrac_tbl_cav !:
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf_cav , fwfisf_cav_b !: before and now net fwf from the ice shelf [kg/m2/s]
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risf_cav_tsc , risf_cav_tsc_b !: before and now T & S isf contents [K.m/s & PSU.m/s]
+ TYPE(FLD), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sf_isfcav_fwf !:
+ !
+ REAL(wp) , PUBLIC :: risf_lamb1, risf_lamb2, risf_lamb3 ! freezing point linearization coeficient
+ !
+ ! 2.3 -------- ice shelf param. melt namelist parameter -------------
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mskisf_par !:
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: misfkt_par , misfkb_par !:
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhisf_tbl_par, rfrac_tbl_par !:
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf_par , fwfisf_par_b !: before and now net fwf from the ice shelf [kg/m2/s]
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risf_par_tsc , risf_par_tsc_b !: before and now T & S isf contents [K.m/s & PSU.m/s]
+ TYPE(FLD), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sf_isfpar_fwf !:
+ !
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhisf0_tbl_par !: thickness of tbl (initial value) [m]
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfLeff !:
+ !
+ ! 2.4 -------- coupling namelist parameter -------------
+ INTEGER , PUBLIC :: nstp_iscpl !:
+ REAL(wp), PUBLIC :: rdt_iscpl !:
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfcpl_ssh, risfcpl_cons_ssh, risfcpl_cons_ssh_b !:
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risfcpl_vol, risfcpl_cons_vol, risfcpl_cons_vol_b !:
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: risfcpl_tsc, risfcpl_cons_tsc, risfcpl_cons_tsc_b !:
+ !
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE isf_alloc_par()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_alloc_par ***
+ !!
+ !! ** Purpose :
+ !!
+ !! ** Method :
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr, ialloc
+ !!----------------------------------------------------------------------
+ ierr = 0 ! set to zero if no array to be allocated
+ !
+ ALLOCATE(risfLeff(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ ALLOCATE(misfkt_par(jpi,jpj), misfkb_par(jpi,jpj), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( rfrac_tbl_par(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( rhisf_tbl_par(jpi,jpj), rhisf0_tbl_par(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( mskisf_par(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ CALL mpp_sum ( 'isf', ierr )
+ IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'isf: failed to allocate arrays.' )
+ !
+ END SUBROUTINE isf_alloc_par
+
+ SUBROUTINE isf_alloc_cav()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_alloc_cav ***
+ !!
+ !! ** Purpose :
+ !!
+ !! ** Method :
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr, ialloc
+ !!----------------------------------------------------------------------
+ ierr = 0 ! set to zero if no array to be allocated
+ !
+ ALLOCATE(misfkt_cav(jpi,jpj), misfkb_cav(jpi,jpj), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( rfrac_tbl_cav(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( rhisf_tbl_cav(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ CALL mpp_sum ( 'isf', ierr )
+ IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'isf: failed to allocate arrays.' )
+ !
+ END SUBROUTINE isf_alloc_cav
+
+ SUBROUTINE isf_alloc_cpl()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_alloc_cpl ***
+ !!
+ !! ** Purpose : allocate array use for the ice sheet coupling
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr, ialloc
+ !!----------------------------------------------------------------------
+ ierr = 0
+ !
+ ALLOCATE( risfcpl_ssh(jpi,jpj), risfcpl_tsc(jpi,jpj,jpk,jpts), risfcpl_vol(jpi,jpj,jpk), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ risfcpl_tsc(:,:,:,:) = 0.0 ; risfcpl_vol(:,:,:) = 0.0 ; risfcpl_ssh(:,:) = 0.0
+
+ IF ( ln_isfcpl_cons) THEN
+ ALLOCATE( risfcpl_cons_tsc(jpi,jpj,jpk,jpts) , risfcpl_cons_vol(jpi,jpj,jpk) ,risfcpl_cons_ssh(jpi,jpj), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ risfcpl_cons_tsc(:,:,:,:) = 0.0 ; risfcpl_cons_vol(:,:,:) = 0.0 ; risfcpl_cons_ssh(:,:) = 0.0
+ !
+ END IF
+ !
+ CALL mpp_sum ( 'isf', ierr )
+ IF( ierr /= 0 ) CALL ctl_stop('STOP','isfcpl: failed to allocate arrays.')
+ !
+ END SUBROUTINE isf_alloc_cpl
+
+ SUBROUTINE isf_dealloc_cpl()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_dealloc_cpl ***
+ !!
+ !! ** Purpose : de-allocate useless public 3d array used for ice sheet coupling
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr, ialloc
+ !!----------------------------------------------------------------------
+ ierr = 0
+ !
+ DEALLOCATE( risfcpl_ssh, risfcpl_tsc, risfcpl_vol, STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ CALL mpp_sum ( 'isf', ierr )
+ IF( ierr /= 0 ) CALL ctl_stop('STOP','isfcpl: failed to deallocate arrays.')
+ !
+ END SUBROUTINE isf_dealloc_cpl
+
+ SUBROUTINE isf_alloc()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_alloc ***
+ !!
+ !! ** Purpose : allocate array used for the ice shelf cavity (cav and par)
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr, ialloc
+ !!----------------------------------------------------------------------
+ !
+ ierr = 0 ! set to zero if no array to be allocated
+ !
+ ALLOCATE(fwfisf_par(jpi,jpj) , fwfisf_par_b(jpi,jpj), &
+ & fwfisf_cav(jpi,jpj) , fwfisf_cav_b(jpi,jpj), &
+ & fwfisf_oasis(jpi,jpj), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE(risf_par_tsc(jpi,jpj,jpts), risf_par_tsc_b(jpi,jpj,jpts), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE(risf_cav_tsc(jpi,jpj,jpts), risf_cav_tsc_b(jpi,jpj,jpts), STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE(risfload(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( mskisf_cav(jpi,jpj), STAT=ialloc)
+ ierr = ierr + ialloc
+ !
+ CALL mpp_sum ( 'isf', ierr )
+ IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'isf: failed to allocate arrays.' )
+ !
+ ! initalisation of fwf and tsc array to 0
+ risfload(:,:) = 0.0_wp
+ fwfisf_oasis(:,:) = 0.0_wp
+ fwfisf_par(:,:) = 0.0_wp ; fwfisf_par_b(:,:) = 0.0_wp
+ fwfisf_cav(:,:) = 0.0_wp ; fwfisf_cav_b(:,:) = 0.0_wp
+ risf_cav_tsc(:,:,:) = 0.0_wp ; risf_cav_tsc_b(:,:,:) = 0.0_wp
+ risf_par_tsc(:,:,:) = 0.0_wp ; risf_par_tsc_b(:,:,:) = 0.0_wp
+ !
+
+ END SUBROUTINE isf_alloc
+
+END MODULE isf_oce
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/isfcavgam.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/isfcavgam.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/isfcavgam.F90 (revision 12150)
@@ -0,0 +1,257 @@
+MODULE isfcavgam
+ !!======================================================================
+ !! *** MODULE isfgammats ***
+ !! Ice shelf gamma module : compute exchange coeficient at the ice/ocean interface
+ !!======================================================================
+ !! History : 4.1 ! (P. Mathiot) original
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isfcav_gammats : compute exchange coeficient gamma
+ !!----------------------------------------------------------------------
+ USE isf_oce
+ USE isfutils, ONLY: debug
+ USE isftbl , ONLY: isf_tbl
+
+ USE oce , ONLY: uu, vv, rn2 ! ocean dynamics and tracers
+ USE phycst , ONLY: grav, vkarmn ! physical constant
+ USE eosbn2 , ONLY: eos_rab ! equation of state
+ USE zdfdrg , ONLY: rCd0_top, r_ke0_top ! vertical physics: top/bottom drag coef.
+ USE iom , ONLY: iom_put !
+ USE lib_mpp , ONLY: ctl_stop
+
+ USE dom_oce ! ocean space and time domain
+ USE in_out_manager ! I/O manager
+ !
+ IMPLICIT NONE
+ !
+ PRIVATE
+ !
+ PUBLIC isfcav_gammats
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+ !
+ !!-----------------------------------------------------------------------------------------------------
+ !! PUBLIC SUBROUTINES
+ !!-----------------------------------------------------------------------------------------------------
+ !
+ SUBROUTINE isfcav_gammats( Kmm, pttbl, pstbl, pqoce, pqfwf, pgt, pgs )
+ !!----------------------------------------------------------------------
+ !! ** Purpose : compute the coefficient echange for heat and fwf flux
+ !!
+ !! ** Method : select the gamma formulation
+ !! 3 method available (cst, vel and vel_stab)
+ !!---------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pgt , pgs ! gamma t and gamma s
+ !!-------------------------- IN -------------------------------------
+ INTEGER :: Kmm ! ocean time level index
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pqoce, pqfwf ! isf heat and fwf
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pttbl, pstbl ! top boundary layer tracer
+ !!---------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) :: zutbl, zvtbl ! top boundary layer velocity
+ !!---------------------------------------------------------------------
+ !
+ !==========================================
+ ! 1.: compute velocity in the tbl if needed
+ !==========================================
+ !
+ SELECT CASE ( cn_gammablk )
+ CASE ( 'spe' )
+ ! gamma is constant (specified in namelist)
+ ! nothing to do
+ CASE ('vel', 'vel_stab')
+ ! compute velocity in tbl
+ CALL isf_tbl(Kmm, uu(:,:,:,Kmm) ,zutbl(:,:),'U', miku, rhisf_tbl_cav)
+ CALL isf_tbl(Kmm, vv(:,:,:,Kmm) ,zvtbl(:,:),'V', mikv, rhisf_tbl_cav)
+ !
+ ! mask velocity in tbl with ice shelf mask
+ zutbl(:,:) = zutbl(:,:) * mskisf_cav(:,:)
+ zvtbl(:,:) = zvtbl(:,:) * mskisf_cav(:,:)
+ !
+ ! output
+ CALL iom_put('utbl',zutbl(:,:))
+ CALL iom_put('vtbl',zvtbl(:,:))
+ CASE DEFAULT
+ CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)')
+ END SELECT
+ !
+ !==========================================
+ ! 2.: compute gamma
+ !==========================================
+ !
+ SELECT CASE ( cn_gammablk )
+ CASE ( 'spe' ) ! gamma is constant (specified in namelist)
+ pgt(:,:) = rn_gammat0
+ pgs(:,:) = rn_gammas0
+ CASE ( 'vel' ) ! gamma is proportional to u*
+ CALL gammats_vel ( zutbl, zvtbl, rCd0_top, r_ke0_top, pgt, pgs )
+ CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u*
+ CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, pgt, pgs )
+ CASE DEFAULT
+ CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)')
+ END SELECT
+ !
+ !==========================================
+ ! 3.: output and debug
+ !==========================================
+ !
+ CALL iom_put('isfgammat', pgt(:,:))
+ CALL iom_put('isfgammas', pgs(:,:))
+ !
+ IF (ln_isfdebug) THEN
+ CALL debug( 'isfcav_gam pgt:', pgt(:,:) )
+ CALL debug( 'isfcav_gam pgs:', pgs(:,:) )
+ END IF
+ !
+ END SUBROUTINE isfcav_gammats
+ !
+ !!-----------------------------------------------------------------------------------------------------
+ !! PRIVATE SUBROUTINES
+ !!-----------------------------------------------------------------------------------------------------
+ !
+ SUBROUTINE gammats_vel( putbl, pvtbl, pCd, pke2, & ! <<== in
+ & pgt, pgs ) ! ==>> out gammats [m/s]
+ !!----------------------------------------------------------------------
+ !! ** Purpose : compute the coefficient echange coefficient
+ !!
+ !! ** Method : gamma is velocity dependent ( gt= gt0 * Ustar )
+ !!
+ !! ** Reference : Asay-Davis et al., Geosci. Model Dev., 9, 2471-2497, 2016
+ !!---------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pgt, pgs ! gammat and gammas [m/s]
+ !!-------------------------- IN -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: putbl, pvtbl ! velocity in the losch top boundary layer
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pCd ! drag coefficient
+ REAL(wp), INTENT(in ) :: pke2 ! background velocity
+ !!---------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj) :: zustar
+ !!---------------------------------------------------------------------
+ !
+ ! compute ustar (AD15 eq. 27)
+ zustar(:,:) = SQRT( pCd(:,:) * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) ) * mskisf_cav(:,:)
+ !
+ ! Compute gammats
+ pgt(:,:) = zustar(:,:) * rn_gammat0
+ pgs(:,:) = zustar(:,:) * rn_gammas0
+ !
+ ! output ustar
+ CALL iom_put('isfustar',zustar(:,:))
+ !
+ END SUBROUTINE gammats_vel
+
+ SUBROUTINE gammats_vel_stab( Kmm, pttbl, pstbl, putbl, pvtbl, pCd, pke2, pqoce, pqfwf, & ! <<== in
+ & pgt , pgs ) ! ==>> out gammats [m/s]
+ !!----------------------------------------------------------------------
+ !! ** Purpose : compute the coefficient echange coefficient
+ !!
+ !! ** Method : gamma is velocity dependent and stability dependent
+ !!
+ !! ** Reference : Holland and Jenkins, 1999, JPO, p1787-1800
+ !!---------------------------------------------------------------------
+ !!-------------------------- OUT -------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pgt, pgs ! gammat and gammas
+ !!-------------------------- IN -------------------------------------
+ INTEGER :: Kmm ! ocean time level index
+ REAL(wp), INTENT(in ) :: pke2 ! background velocity squared
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pqoce, pqfwf ! surface heat flux and fwf flux
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pCd ! drag coeficient
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: putbl, pvtbl ! velocity in the losch top boundary layer
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pttbl, pstbl ! tracer in the losch top boundary layer
+ !!---------------------------------------------------------------------
+ INTEGER :: ji, jj ! loop index
+ INTEGER :: ikt ! local integer
+ REAL(wp) :: zdku, zdkv ! U, V shear
+ REAL(wp) :: zPr, zSc, zRc ! Prandtl, Scmidth and Richardson number
+ REAL(wp) :: zmob, zmols ! Monin Obukov length, coriolis factor at T point
+ REAL(wp) :: zbuofdep, zhnu ! Bouyancy length scale, sublayer tickness
+ REAL(wp) :: zhmax ! limitation of mol
+ REAL(wp) :: zetastar ! stability parameter
+ REAL(wp) :: zgmolet, zgmoles, zgturb ! contribution of modelecular sublayer and turbulence
+ REAL(wp) :: zcoef ! temporary coef
+ REAL(wp) :: zdep
+ REAL(wp) :: zeps = 1.0e-20_wp
+ REAL(wp), PARAMETER :: zxsiN = 0.052_wp ! dimensionless constant
+ REAL(wp), PARAMETER :: znu = 1.95e-6_wp ! kinamatic viscosity of sea water (m2.s-1)
+ REAL(wp), DIMENSION(2) :: zts, zab
+ REAL(wp), DIMENSION(jpi,jpj) :: zustar ! friction velocity
+ !!---------------------------------------------------------------------
+ !
+ ! compute ustar
+ zustar(:,:) = SQRT( pCd * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) )
+ !
+ ! output ustar
+ CALL iom_put('isfustar',zustar(:,:))
+ !
+ ! compute Pr and Sc number (eq ??)
+ zPr = 13.8_wp
+ zSc = 2432.0_wp
+ !
+ ! compute gamma mole (eq ??)
+ zgmolet = 12.5_wp * zPr ** (2.0/3.0) - 6.0_wp
+ zgmoles = 12.5_wp * zSc ** (2.0/3.0) - 6.0_wp
+ !
+ ! compute gamma
+ DO ji = 2, jpi
+ DO jj = 2, jpj
+ ikt = mikt(ji,jj)
+
+ IF( zustar(ji,jj) == 0._wp ) THEN ! only for kt = 1 I think
+ pgt = rn_gammat0
+ pgs = rn_gammas0
+ ELSE
+ ! compute Rc number (as done in zdfric.F90)
+!!gm better to do it like in the new zdfric.F90 i.e. avm weighted Ri computation
+ zcoef = 0.5_wp / e3w(ji,jj,ikt+1,Kmm)
+ ! ! shear of horizontal velocity
+ zdku = zcoef * ( uu(ji-1,jj ,ikt ,Kmm) + uu(ji,jj,ikt ,Kmm) &
+ & -uu(ji-1,jj ,ikt+1,Kmm) - uu(ji,jj,ikt+1,Kmm) )
+ zdkv = zcoef * ( vv(ji ,jj-1,ikt ,Kmm) + vv(ji,jj,ikt ,Kmm) &
+ & -vv(ji ,jj-1,ikt+1,Kmm) - vv(ji,jj,ikt+1,Kmm) )
+ ! ! richardson number (minimum value set to zero)
+ zRc = MAX(rn2(ji,jj,ikt+1), 0._wp) / MAX( zdku*zdku + zdkv*zdkv, zeps )
+
+ ! compute bouyancy
+ zts(jp_tem) = pttbl(ji,jj)
+ zts(jp_sal) = pstbl(ji,jj)
+ zdep = gdepw(ji,jj,ikt,Kmm)
+ !
+ CALL eos_rab( zts, zdep, zab, Kmm )
+ !
+ ! compute length scale (Eq ??)
+ zbuofdep = grav * ( zab(jp_tem) * pqoce(ji,jj) - zab(jp_sal) * pqfwf(ji,jj) )
+ !
+ ! compute Monin Obukov Length
+ ! Maximum boundary layer depth (Eq ??)
+ zhmax = gdept(ji,jj,mbkt(ji,jj),Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) -0.001_wp
+ !
+ ! Compute Monin obukhov length scale at the surface and Ekman depth: (Eq ??)
+ zmob = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps))
+ zmols = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt)
+ !
+ ! compute eta* (stability parameter) (Eq ??)
+ zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff_f(ji,jj)) * zmols * zRc ), 0._wp)))
+ !
+ ! compute the sublayer thickness (Eq ??)
+ zhnu = 5 * znu / zustar(ji,jj)
+ !
+ ! compute gamma turb (Eq ??)
+ zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff_f(ji,jj)) * zhnu )) &
+ & + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn
+ !
+ ! compute gammats
+ pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet)
+ pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles)
+ END IF
+ END DO
+ END DO
+
+ END SUBROUTINE gammats_vel_stab
+
+END MODULE isfcavgam
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/isfstp.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/isfstp.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/isfstp.F90 (revision 12150)
@@ -0,0 +1,305 @@
+MODULE isfstp
+ !!======================================================================
+ !! *** MODULE isfstp ***
+ !! Surface module : compute iceshelf load, melt and heat flux
+ !!======================================================================
+ !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav
+ !! X.X ! 2006-02 (C. Wang ) Original code bg03
+ !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization
+ !! 4.1 ! 2019-09 (P. Mathiot) Split param/explicit ice shelf and re-organisation
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! isfstp : compute iceshelf melt and heat flux
+ !!----------------------------------------------------------------------
+ !
+ USE isf_oce ! isf variables
+ USE isfload, ONLY: isf_load ! ice shelf load
+ USE isftbl , ONLY: isf_tbl_lvl ! ice shelf boundary layer
+ USE isfpar , ONLY: isf_par, isf_par_init ! ice shelf parametrisation
+ USE isfcav , ONLY: isf_cav, isf_cav_init ! ice shelf cavity
+ USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables
+
+ USE dom_oce, ONLY: ht, e3t, ln_isfcav, ln_linssh ! ocean space and time domain
+ USE domvvl, ONLY: ln_vvl_zstar ! zstar logical
+ USE zdfdrg, ONLY: r_Cdmin_top, r_ke0_top ! vertical physics: top/bottom drag coef.
+ !
+ USE lib_mpp, ONLY: ctl_stop, ctl_nam
+ USE fldread, ONLY: FLD, FLD_N
+ USE in_out_manager ! I/O manager
+ USE timing
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC isf_stp, isf_init, isf_nam ! routine called in sbcmod and divhor
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: isfstp.F90 11876 2019-11-08 11:26:42Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE isf_stp( kt, Kmm )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_stp ***
+ !!
+ !! ** Purpose : compute total heat flux and total fwf due to ice shelf melt
+ !!
+ !! ** Method : For each case (parametrisation or explicity cavity) :
+ !! - define the before fields
+ !! - compute top boundary layer properties
+ !! (in case of parametrisation, this is the
+ !! depth range model array used to compute mean far fields properties)
+ !! - compute fluxes
+ !! - write restart variables
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kt ! ocean time step
+ INTEGER, INTENT(in) :: Kmm ! ocean time level index
+ !!---------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('isf')
+ !
+ !=======================================================================
+ ! 1.: compute melt and associated heat fluxes in the ice shelf cavities
+ !=======================================================================
+ !
+ IF ( ln_isfcav_mlt ) THEN
+ !
+ ! 1.1: before time step
+ IF ( kt /= nit000 ) THEN
+ risf_cav_tsc_b (:,:,:) = risf_cav_tsc (:,:,:)
+ fwfisf_cav_b(:,:) = fwfisf_cav(:,:)
+ END IF
+ !
+ ! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
+ rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:)
+ CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav)
+ !
+ ! 1.3: compute ice shelf melt
+ CALL isf_cav( kt, Kmm, risf_cav_tsc, fwfisf_cav)
+ !
+ END IF
+ !
+ !=================================================================================
+ ! 2.: compute melt and associated heat fluxes for not resolved ice shelf cavities
+ !=================================================================================
+ !
+ IF ( ln_isfpar_mlt ) THEN
+ !
+ ! 2.1: before time step
+ IF ( kt /= nit000 ) THEN
+ risf_par_tsc_b(:,:,:) = risf_par_tsc(:,:,:)
+ fwfisf_par_b (:,:) = fwfisf_par (:,:)
+ END IF
+ !
+ ! 2.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
+ ! by simplicity, we assume the top level where param applied do not change with time (done in init part)
+ rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:)
+ CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par)
+ !
+ ! 2.3: compute ice shelf melt
+ CALL isf_par( kt, Kmm, risf_par_tsc, fwfisf_par)
+ !
+ END IF
+ !
+ !==================================================================================
+ ! 3.: output specific restart variable in case of coupling with an ice sheet model
+ !==================================================================================
+ !
+ IF ( ln_isfcpl .AND. lrst_oce ) CALL isfcpl_rst_write(kt, Kmm)
+ !
+ IF( ln_timing ) CALL timing_stop('isf')
+ !
+ END SUBROUTINE isf_stp
+
+ SUBROUTINE isf_init(Kbb, Kmm, Kaa)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isfstp_init ***
+ !!
+ !! ** Purpose : Initialisation of the ice shelf public variables
+ !!
+ !! ** Method : Read the namisf namelist, check option compatibility and set derived parameters
+ !!
+ !! ** Action : - read namisf parameters
+ !! - allocate memory
+ !! - output print
+ !! - ckeck option compatibility
+ !! - call cav/param/isfcpl init routine
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
+ !
+ ! constrain: l_isfoasis need to be known
+ !
+ ! Read namelist
+ CALL isf_nam()
+ !
+ ! Allocate public array
+ CALL isf_alloc()
+ !
+ ! check option compatibility
+ CALL isf_ctl()
+ !
+ ! compute ice shelf load
+ IF ( ln_isfcav ) CALL isf_load( Kmm, risfload )
+ !
+ ! terminate routine now if no ice shelf melt formulation specify
+ IF ( ln_isf ) THEN
+ !
+ !---------------------------------------------------------------------------------------------------------------------
+ ! initialisation melt in the cavity
+ IF ( ln_isfcav_mlt ) CALL isf_cav_init()
+ !
+ !---------------------------------------------------------------------------------------------------------------------
+ ! initialisation parametrised melt
+ IF ( ln_isfpar_mlt ) CALL isf_par_init()
+ !
+ !---------------------------------------------------------------------------------------------------------------------
+ ! initialisation ice sheet coupling
+ IF( ln_isfcpl ) CALL isfcpl_init(Kbb, Kmm, Kaa)
+ !
+ END IF
+
+ END SUBROUTINE isf_init
+
+ SUBROUTINE isf_ctl()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_ctl ***
+ !!
+ !! ** Purpose : output print and option compatibility check
+ !!
+ !!----------------------------------------------------------------------
+ IF (lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'isf_init : ice shelf initialisation'
+ WRITE(numout,*) '~~~~~~~~~~~~'
+ WRITE(numout,*) ' Namelist namisf :'
+ !
+ WRITE(numout,*) ' ice shelf cavity (open or parametrised) ln_isf = ', ln_isf
+ WRITE(numout,*)
+ !
+ IF ( ln_isf ) THEN
+ WRITE(numout,*) ' Add debug print in isf module ln_isfdebug = ', ln_isfdebug
+ WRITE(numout,*)
+ WRITE(numout,*) ' melt inside the cavity ln_isfcav_mlt = ', ln_isfcav_mlt
+ IF ( ln_isfcav_mlt) THEN
+ WRITE(numout,*) ' melt formulation cn_isfcav_mlt= ', TRIM(cn_isfcav_mlt)
+ WRITE(numout,*) ' thickness of the top boundary layer rn_htbl = ', rn_htbl
+ WRITE(numout,*) ' gamma formulation cn_gammablk = ', TRIM(cn_gammablk)
+ IF ( TRIM(cn_gammablk) .NE. 'spe' ) THEN
+ WRITE(numout,*) ' gammat coefficient rn_gammat0 = ', rn_gammat0
+ WRITE(numout,*) ' gammas coefficient rn_gammas0 = ', rn_gammas0
+ WRITE(numout,*) ' top background ke used (from namdrg_top) rn_vtide**2 = ', rn_vtide**2
+ WRITE(numout,*) ' top drag coef. used (from namdrg_top) rn_Cd0 = ', r_Cdmin_top
+ END IF
+ END IF
+ WRITE(numout,*) ''
+ !
+ WRITE(numout,*) ' ice shelf melt parametrisation ln_isfpar_mlt = ', ln_isfpar_mlt
+ IF ( ln_isfpar_mlt ) THEN
+ WRITE(numout,*) ' isf parametrisation formulation cn_isfpar_mlt = ', TRIM(cn_isfpar_mlt)
+ END IF
+ WRITE(numout,*) ''
+ !
+ WRITE(numout,*) ' Coupling to an ice sheet model ln_isfcpl = ', ln_isfcpl
+ IF ( ln_isfcpl ) THEN
+ WRITE(numout,*) ' conservation activated ln_isfcpl_cons = ', ln_isfcpl_cons
+ WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown
+ ENDIF
+ WRITE(numout,*) ''
+ !
+ ELSE
+ !
+ IF ( ln_isfcav ) THEN
+ WRITE(numout,*) ''
+ WRITE(numout,*) ' W A R N I N G: ice shelf cavities are open BUT no melt will be computed or read from file !'
+ WRITE(numout,*) ''
+ END IF
+ !
+ END IF
+
+ IF (ln_isfcav) THEN
+ WRITE(numout,*) ' Ice shelf load method cn_isfload = ', TRIM(cn_isfload)
+ WRITE(numout,*) ' Temperature used to compute the ice shelf load = ', rn_isfload_T
+ WRITE(numout,*) ' Salinity used to compute the ice shelf load = ', rn_isfload_S
+ END IF
+ WRITE(numout,*) ''
+ FLUSH(numout)
+
+ END IF
+ !
+
+ !---------------------------------------------------------------------------------------------------------------------
+ ! sanity check ! issue ln_isfcav not yet known as well as l_isfoasis => move this call in isf_stp ?
+ ! melt in the cavity without cavity
+ IF ( ln_isfcav_mlt .AND. (.NOT. ln_isfcav) ) &
+ & CALL ctl_stop('ice shelf melt in the cavity activated (ln_isfcav_mlt) but no cavity detected in domcfg (ln_isfcav), STOP' )
+ !
+ ! ice sheet coupling without cavity
+ IF ( ln_isfcpl .AND. (.NOT. ln_isfcav) ) &
+ & CALL ctl_stop('coupling with an ice sheet model detected (ln_isfcpl) but no cavity detected in domcfg (ln_isfcav), STOP' )
+ !
+ IF ( ln_isfcpl .AND. ln_isfcpl_cons .AND. ln_linssh ) &
+ & CALL ctl_stop( 'The coupling between NEMO and an ice sheet model with the conservation option does not work with the linssh option' )
+ !
+ IF ( l_isfoasis .AND. .NOT. ln_isf ) CALL ctl_stop( ' OASIS send ice shelf fluxes to NEMO but NEMO does not have the isf module activated' )
+ !
+ IF ( l_isfoasis .AND. ln_isf ) THEN
+ !
+ CALL ctl_stop( ' ln_ctl and ice shelf not tested' )
+ !
+ ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation
+ IF ( ln_isfcav_mlt .AND. TRIM(cn_isfcav_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis is the only option availble if fwf send by oasis' )
+ IF ( ln_isfpar_mlt .AND. TRIM(cn_isfpar_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis is the only option availble if fwf send by oasis' )
+ !
+ ! oasis melt computation not tested (coded but not tested)
+ IF ( ln_isfcav_mlt .OR. ln_isfpar_mlt ) THEN
+ IF ( TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis not tested' )
+ IF ( TRIM(cn_isfpar_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis not tested' )
+ END IF
+ !
+ ! oasis melt computation with cavity open and cavity parametrised (not coded)
+ IF ( ln_isfcav_mlt .AND. ln_isfpar_mlt ) THEN
+ IF ( TRIM(cn_isfpar_mlt) == 'oasis' .AND. TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis and cn_isfcav_mlt = oasis not coded' )
+ END IF
+ !
+ ! compatibility ice shelf and vvl
+ IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
+ !
+ END IF
+ END SUBROUTINE isf_ctl
+ !
+ SUBROUTINE isf_nam
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE isf_nam ***
+ !!
+ !! ** Purpose : Read ice shelf namelist cfg and ref
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: ios ! Local integer output status for namelist read
+ !!----------------------------------------------------------------------
+ NAMELIST/namisf/ ln_isf , &
+ & cn_gammablk , rn_gammat0 , rn_gammas0 , rn_htbl, sn_isfcav_fwf, &
+ & ln_isfcav_mlt , cn_isfcav_mlt , sn_isfcav_fwf , &
+ & ln_isfpar_mlt , cn_isfpar_mlt , sn_isfpar_fwf , &
+ & sn_isfpar_zmin, sn_isfpar_zmax, sn_isfpar_Leff, &
+ & ln_isfcpl , nn_drown , ln_isfcpl_cons, ln_isfdebug, rn_vtide, &
+ & cn_isfload , rn_isfload_T , rn_isfload_S , cn_isfdir
+ !!----------------------------------------------------------------------
+ !
+ REWIND( numnam_ref ) ! Namelist namsbc_rnf in reference namelist : Runoffs
+ READ ( numnam_ref, namisf, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namisf in reference namelist' )
+ !
+ REWIND( numnam_cfg ) ! Namelist namsbc_rnf in configuration namelist : Runoffs
+ READ ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 )
+902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namisf in configuration namelist' )
+ IF(lwm) WRITE ( numond, namisf )
+
+ END SUBROUTINE isf_nam
+ !!
+ !!======================================================================
+END MODULE isfstp
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/istate.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/istate.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/istate.F90 (revision 12150)
@@ -0,0 +1,184 @@
+MODULE istate
+ !!======================================================================
+ !! *** MODULE istate ***
+ !! Ocean state : initial state setting
+ !!=====================================================================
+ !! History : OPA ! 1989-12 (P. Andrich) Original code
+ !! 5.0 ! 1991-11 (G. Madec) rewritting
+ !! 6.0 ! 1996-01 (G. Madec) terrain following coordinates
+ !! 8.0 ! 2001-09 (M. Levy, M. Ben Jelloul) istate_eel
+ !! 8.0 ! 2001-09 (M. Levy, M. Ben Jelloul) istate_uvg
+ !! NEMO 1.0 ! 2003-08 (G. Madec, C. Talandier) F90: Free form, modules + EEL R5
+ !! - ! 2004-05 (A. Koch-Larrouy) istate_gyre
+ !! 2.0 ! 2006-07 (S. Masson) distributed restart using iom
+ !! 3.3 ! 2010-10 (C. Ethe) merge TRC-TRA
+ !! 3.4 ! 2011-04 (G. Madec) Merge of dtatem and dtasal & suppression of tb,tn/sb,sn
+ !! 3.7 ! 2016-04 (S. Flavoni) introduce user defined initial state
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! istate_init : initial state setting
+ !! istate_uvg : initial velocity in geostropic balance
+ !!----------------------------------------------------------------------
+ USE oce ! ocean dynamics and active tracers
+ USE dom_oce ! ocean space and time domain
+ USE daymod ! calendar
+ USE divhor ! horizontal divergence (div_hor routine)
+ USE dtatsd ! data temperature and salinity (dta_tsd routine)
+ USE dtauvd ! data: U & V current (dta_uvd routine)
+ USE domvvl ! varying vertical mesh
+ USE wet_dry ! wetting and drying (needed for wad_istate)
+ USE usrdef_istate ! User defined initial state
+ !
+ USE in_out_manager ! I/O manager
+ USE iom ! I/O library
+ USE lib_mpp ! MPP library
+ USE restart ! restart
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC istate_init ! routine called by step.F90
+
+ !! * Substitutions
+# include "vectopt_loop_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: istate.F90 11423 2019-08-08 14:02:49Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE istate_init( Kbb, Kmm, Kaa )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE istate_init ***
+ !!
+ !! ** Purpose : Initialization of the dynamics and tracer fields.
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! ocean time level indices
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+!!gm see comment further down
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace
+!!gm end
+ !!----------------------------------------------------------------------
+ !
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'istate_init : Initialization of the dynamics and tracers'
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+
+!!gm Why not include in the first call of dta_tsd ?
+!!gm probably associated with the use of internal damping...
+ CALL dta_tsd_init ! Initialisation of T & S input data
+!!gm to be moved in usrdef of C1D case
+! IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data
+!!gm
+
+ rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk
+ rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk
+ ts (:,:,:,:,Kaa) = 0._wp ! set one for all to 0 at level jpk
+ rab_b(:,:,:,:) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk
+#if defined key_agrif
+ uu (:,:,: ,Kaa) = 0._wp ! used in agrif_oce_sponge at initialization
+ vv (:,:,: ,Kaa) = 0._wp ! used in agrif_oce_sponge at initialization
+#endif
+
+ IF( ln_rstart ) THEN ! Restart from a file
+ ! ! -------------------
+ CALL rst_read( Kbb, Kmm ) ! Read the restart file
+ CALL day_init ! model calendar (using both namelist and restart infos)
+ !
+ ELSE ! Start from rest
+ ! ! ---------------
+ numror = 0 ! define numror = 0 -> no restart file to read
+ neuler = 0 ! Set time-step indicator at nit000 (euler forward)
+ CALL day_init ! model calendar (using both namelist and restart infos)
+ ! ! Initialization of ocean to zero
+ !
+ IF( ln_tsd_init ) THEN
+ CALL dta_tsd( nit000, 'ini', ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000
+ !
+ ssh(:,:,Kbb) = 0._wp ! set the ocean at rest
+ IF( ll_wd ) THEN
+ ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD
+ !
+ ! Apply minimum wetdepth criterion
+ !
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN
+ ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )
+ ENDIF
+ END DO
+ END DO
+ ENDIF
+ uu (:,:,:,Kbb) = 0._wp
+ vv (:,:,:,Kbb) = 0._wp
+ !
+ ELSE ! user defined initial T and S
+ CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) )
+ ENDIF
+ ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones
+ ssh (:,:,Kmm) = ssh(:,:,Kbb)
+ uu (:,:,:,Kmm) = uu (:,:,:,Kbb)
+ vv (:,:,:,Kmm) = vv (:,:,:,Kbb)
+ hdiv(:,:,jpk) = 0._wp ! bottom divergence set one for 0 to zero at jpk level
+ CALL div_hor( 0, Kbb, Kmm ) ! compute interior hdiv value
+!!gm hdiv(:,:,:) = 0._wp
+
+!!gm POTENTIAL BUG :
+!!gm ISSUE : if ssh(:,:,Kbb) /= 0 then, in non linear free surface, the e3._n, e3._b should be recomputed
+!! as well as gdept and gdepw.... !!!!!
+!! ===>>>> probably a call to domvvl initialisation here....
+
+
+ !
+!!gm to be moved in usrdef of C1D case
+! IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000
+! ALLOCATE( zuvd(jpi,jpj,jpk,2) )
+! CALL dta_uvd( nit000, zuvd )
+! uu(:,:,:,Kbb) = zuvd(:,:,:,1) ; uu(:,:,:,Kmm) = uu(:,:,:,Kbb)
+! vv(:,:,:,Kbb) = zuvd(:,:,:,2) ; vv(:,:,:,Kmm) = vv(:,:,:,Kbb)
+! DEALLOCATE( zuvd )
+! ENDIF
+ !
+!!gm This is to be changed !!!!
+! ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here
+! IF( .NOT.ln_linssh ) THEN
+! DO jk = 1, jpk
+! e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm)
+! END DO
+! ENDIF
+!!gm
+ !
+ ENDIF
+ !
+ ! Initialize "now" and "before" barotropic velocities:
+ ! Do it whatever the free surface method, these arrays being eventually used
+ !
+ uu_b(:,:,Kmm) = 0._wp ; vv_b(:,:,Kmm) = 0._wp
+ uu_b(:,:,Kbb) = 0._wp ; vv_b(:,:,Kbb) = 0._wp
+ !
+!!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk)
+ vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
+ !
+ uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk)
+ vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk)
+ END DO
+ END DO
+ END DO
+ !
+ uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm)
+ vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm)
+ !
+ uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb)
+ vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb)
+ !
+ END SUBROUTINE istate_init
+
+ !!======================================================================
+END MODULE istate
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/sbcfwb.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/sbcfwb.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/sbcfwb.F90 (revision 12150)
@@ -0,0 +1,240 @@
+MODULE sbcfwb
+ !!======================================================================
+ !! *** MODULE sbcfwb ***
+ !! Ocean fluxes : domain averaged freshwater budget
+ !!======================================================================
+ !! History : OPA ! 2001-02 (E. Durand) Original code
+ !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module
+ !! 3.0 ! 2006-08 (G. Madec) Surface module
+ !! 3.2 ! 2009-07 (C. Talandier) emp mean s spread over erp area
+ !! 3.6 ! 2014-11 (P. Mathiot ) add ice shelf melting
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! sbc_fwb : freshwater budget for global ocean configurations (free surface & forced mode)
+ !!----------------------------------------------------------------------
+ USE oce ! ocean dynamics and tracers
+ USE dom_oce ! ocean space and time domain
+ USE sbc_oce ! surface ocean boundary condition
+ USE isf_oce ! ice shelf melting contribution
+ USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass
+ USE phycst ! physical constants
+ USE sbcrnf ! ocean runoffs
+ USE sbcssr ! Sea-Surface damping terms
+ !
+ USE in_out_manager ! I/O manager
+ USE lib_mpp ! distribued memory computing library
+ USE timing ! Timing
+ USE lbclnk ! ocean lateral boundary conditions
+ USE lib_fortran !
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC sbc_fwb ! routine called by step
+
+ REAL(wp) :: a_fwb_b ! annual domain averaged freshwater budget
+ REAL(wp) :: a_fwb ! for 2 year before (_b) and before year.
+ REAL(wp) :: fwfold ! fwfold to be suppressed
+ REAL(wp) :: area ! global mean ocean surface (interior domain)
+
+ !! * Substitutions
+# include "vectopt_loop_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: sbcfwb.F90 11395 2019-08-02 14:19:00Z mathiot $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc, Kmm )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE sbc_fwb ***
+ !!
+ !! ** Purpose : Control the mean sea surface drift
+ !!
+ !! ** Method : several ways depending on kn_fwb
+ !! =0 no control
+ !! =1 global mean of emp set to zero at each nn_fsbc time step
+ !! =2 annual global mean corrected from previous year
+ !! =3 global mean of emp set to zero at each nn_fsbc time step
+ !! & spread out over erp area depending its sign
+ !! Note: if sea ice is embedded it is taken into account when computing the budget
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT( in ) :: kt ! ocean time-step index
+ INTEGER, INTENT( in ) :: kn_fsbc !
+ INTEGER, INTENT( in ) :: kn_fwb ! ocean time-step index
+ INTEGER, INTENT( in ) :: Kmm ! ocean time level index
+ !
+ INTEGER :: inum, ikty, iyear ! local integers
+ REAL(wp) :: z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp ! local scalars
+ REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread, zcoef ! - -
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmsk_tospread, zerp_cor ! - -
+ REAL(wp) ,DIMENSION(1) :: z_fwfprv
+ COMPLEX(wp),DIMENSION(1) :: y_fwfnow
+ !!----------------------------------------------------------------------
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'sbc_fwb : FreshWater Budget correction'
+ WRITE(numout,*) '~~~~~~~'
+ IF( kn_fwb == 1 ) WRITE(numout,*) ' instantaneously set to zero'
+ IF( kn_fwb == 2 ) WRITE(numout,*) ' adjusted from previous year budget'
+ IF( kn_fwb == 3 ) WRITE(numout,*) ' fwf set to zero and spread out over erp area'
+ IF( kn_fwb == 4 ) WRITE(numout,*) ' instantaneously set to zero with heat and salt flux correction (ISOMIP+)'
+ ENDIF
+ !
+ IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' )
+ IF( kn_fwb == 3 .AND. ln_isfcav ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' )
+ !
+ area = glob_sum( 'sbcfwb', e1e2t(:,:) * tmask(:,:,1)) ! interior global domain surface
+ ! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes
+ ! and in case of no melt, it can generate HSSW.
+ !
+#if ! defined key_si3 && ! defined key_cice
+ snwice_mass_b(:,:) = 0.e0 ! no sea-ice model is being used : no snow+ice mass
+ snwice_mass (:,:) = 0.e0
+#endif
+ !
+ ENDIF
+
+ SELECT CASE ( kn_fwb )
+ !
+ CASE ( 1 ) !== global mean fwf set to zero ==!
+ !
+ IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
+ y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) )
+ CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 )
+ z_fwfprv(1) = z_fwfprv(1) / area
+ zcoef = z_fwfprv(1) * rcp
+ emp(:,:) = emp(:,:) - z_fwfprv(1) * tmask(:,:,1)
+ qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
+ ENDIF
+ !
+ CASE ( 4 ) !== global mean fwf set to zero (ISOMIP case) ==!
+ !
+ IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
+ z_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) )
+ !
+ ! correction for ice sheet coupling testing (ie remove the excess through the surface)
+ ! test impact on the melt as conservation correction made in depth
+ ! test conservation level as sbcfwb is conserving
+ ! avoid the model to blow up for large ssh drop (isomip OCEAN3 with melt switch off and uniform T/S)
+ IF (ln_isfcpl .AND. ln_isfcpl_cons) THEN
+ z_fwf = z_fwf + glob_sum( 'sbcfwb', e1e2t(:,:) * risfcpl_cons_ssh(:,:) * rau0 )
+ END IF
+ !
+ z_fwf = z_fwf / area
+ zcoef = z_fwf * rcp
+ emp(:,:) = emp(:,:) - z_fwf * tmask(:,:,1) ! (Eq. 34 AD2015)
+ qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! (Eq. 35 AD2015) ! use sst_m to avoid generation of any bouyancy fluxes
+ sfx(:,:) = sfx(:,:) + z_fwf * sss_m(:,:) * tmask(:,:,1) ! (Eq. 36 AD2015) ! use sss_m to avoid generation of any bouyancy fluxes
+ !qns(:,:) = qns(:,:) + zcoef * ( -1.9 ) * tmask(:,:,1) ! (Eq. 35 AD2015) ! could be sst_m if we don't want any bouyancy fluxes
+ !sfx(:,:) = sfx(:,:) + z_fwf * ( 33.8 ) * tmask(:,:,1) ! (Eq. 36 AD2015) ! could be sss_m if we don't want any bouyancy fluxes
+ !qns(:,:) = qns(:,:) + zcoef * ( -1.0 ) * tmask(:,:,1) ! use for ISOMIP+ coupling sanity check (keep ssh cst while playing with cpl conservation option)
+ !sfx(:,:) = sfx(:,:) + z_fwf * ( 34.2 ) * tmask(:,:,1) ! use for ISOMIP+ coupling sanity check (keep ssh cst while playing with cpl conservation option)
+ ENDIF
+ !
+ CASE ( 2 ) !== fwf budget adjusted from the previous year ==!
+ !
+ IF( kt == nit000 ) THEN ! initialisation
+ ! ! Read the corrective factor on precipitations (fwfold)
+ CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+ READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb
+ CLOSE( inum )
+ fwfold = a_fwb ! current year freshwater budget correction
+ ! ! estimate from the previous year budget
+ IF(lwp)WRITE(numout,*)
+ IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear , ' freshwater budget correction = ', fwfold
+ IF(lwp)WRITE(numout,*)' year = ',iyear-1, ' freshwater budget read = ', a_fwb
+ IF(lwp)WRITE(numout,*)' year = ',iyear-2, ' freshwater budget read = ', a_fwb_b
+ ENDIF
+ ! ! Update fwfold if new year start
+ ikty = 365 * 86400 / rdt !!bug use of 365 days leap year or 360d year !!!!!!!
+ IF( MOD( kt, ikty ) == 0 ) THEN
+ a_fwb_b = a_fwb ! mean sea level taking into account the ice+snow
+ ! sum over the global domain
+ a_fwb = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rau0 ) )
+ a_fwb = a_fwb * 1.e+3 / ( area * rday * 365. ) ! convert in Kg/m3/s = mm/s
+!!gm ! !!bug 365d year
+ fwfold = a_fwb ! current year freshwater budget correction
+ ! ! estimate from the previous year budget
+ ENDIF
+ !
+ IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes
+ zcoef = fwfold * rcp
+ emp(:,:) = emp(:,:) + fwfold * tmask(:,:,1)
+ qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
+ ENDIF
+ !
+ IF( kt == nitend .AND. lwm ) THEN ! save fwfold value in a file (only one required)
+ CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+ WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb
+ CLOSE( inum )
+ ENDIF
+ !
+ CASE ( 3 ) !== global fwf set to zero and spread out over erp area ==!
+ !
+ ALLOCATE( ztmsk_neg(jpi,jpj) , ztmsk_pos(jpi,jpj) , ztmsk_tospread(jpi,jpj) , z_wgt(jpi,jpj) , zerp_cor(jpi,jpj) )
+ !
+ IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
+ ztmsk_pos(:,:) = tmask_i(:,:) ! Select <0 and >0 area of erp
+ WHERE( erp < 0._wp ) ztmsk_pos = 0._wp
+ ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
+ ! ! fwf global mean (excluding ocean to ice/snow exchanges)
+ z_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) ) / area
+ !
+ IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation
+ zsurf_pos = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_pos(:,:) )
+ zsurf_tospread = zsurf_pos
+ ztmsk_tospread(:,:) = ztmsk_pos(:,:)
+ ELSE ! spread out over <0 erp area to increase precipitation
+ zsurf_neg = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp
+ zsurf_tospread = zsurf_neg
+ ztmsk_tospread(:,:) = ztmsk_neg(:,:)
+ ENDIF
+ !
+ zsum_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * z_fwf ) ! fwf global mean over <0 or >0 erp area
+!!gm : zsum_fwf = z_fwf * area ??? it is right? I think so....
+ z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall )
+ ! ! weight to respect erp field 2D structure
+ zsum_erp = glob_sum( 'sbcfwb', ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )
+ z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
+ ! ! final correction term to apply
+ zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:)
+ !
+!!gm ===>>>> lbc_lnk should be useless as all the computation is done over the whole domain !
+ CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1. )
+ !
+ emp(:,:) = emp(:,:) + zerp_cor(:,:)
+ qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:) ! account for change to the heat budget due to fw correction
+ erp(:,:) = erp(:,:) + zerp_cor(:,:)
+ !
+ IF( nprint == 1 .AND. lwp ) THEN ! control print
+ IF( z_fwf < 0._wp ) THEN
+ WRITE(numout,*)' z_fwf < 0'
+ WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+ ELSE
+ WRITE(numout,*)' z_fwf >= 0'
+ WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+ ENDIF
+ WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv'
+ WRITE(numout,*)' z_fwf = ', z_fwf ,' Kg/m2/s'
+ WRITE(numout,*)' z_fwf_nsrf = ', z_fwf_nsrf ,' Kg/m2/s'
+ WRITE(numout,*)' MIN(zerp_cor) = ', MINVAL(zerp_cor)
+ WRITE(numout,*)' MAX(zerp_cor) = ', MAXVAL(zerp_cor)
+ ENDIF
+ ENDIF
+ DEALLOCATE( ztmsk_neg , ztmsk_pos , ztmsk_tospread , z_wgt , zerp_cor )
+ !
+ CASE DEFAULT !== you should never be there ==!
+ CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' )
+ !
+ END SELECT
+ !
+ END SUBROUTINE sbc_fwb
+
+ !!======================================================================
+END MODULE sbcfwb
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/tradmp.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/tradmp.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/tradmp.F90 (revision 12150)
@@ -0,0 +1,231 @@
+MODULE tradmp
+ !!======================================================================
+ !! *** MODULE tradmp ***
+ !! Ocean physics: internal restoring trend on active tracers (T and S)
+ !!======================================================================
+ !! History : OPA ! 1991-03 (O. Marti, G. Madec) Original code
+ !! ! 1992-06 (M. Imbard) doctor norme
+ !! ! 1998-07 (M. Imbard, G. Madec) ORCA version
+ !! 7.0 ! 2001-02 (M. Imbard) add distance to coast, Original code
+ !! 8.1 ! 2001-02 (G. Madec, E. Durand) cleaning
+ !! NEMO 1.0 ! 2002-08 (G. Madec, E. Durand) free form + modules
+ !! 3.2 ! 2009-08 (G. Madec, C. Talandier) DOCTOR norm for namelist parameter
+ !! 3.3 ! 2010-06 (C. Ethe, G. Madec) merge TRA-TRC
+ !! 3.4 ! 2011-04 (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
+ !! 3.6 ! 2015-06 (T. Graham) read restoring coefficient in a file
+ !! 3.7 ! 2015-10 (G. Madec) remove useless trends arrays
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! tra_dmp_alloc : allocate tradmp arrays
+ !! tra_dmp : update the tracer trend with the internal damping
+ !! tra_dmp_init : initialization, namlist read, parameters control
+ !!----------------------------------------------------------------------
+ USE oce ! ocean: variables
+ USE dom_oce ! ocean: domain variables
+ USE c1d ! 1D vertical configuration
+ USE trd_oce ! trends: ocean variables
+ USE trdtra ! trends manager: tracers
+ USE zdf_oce ! ocean: vertical physics
+ USE phycst ! physical constants
+ USE dtatsd ! data: temperature & salinity
+ USE zdfmxl ! vertical physics: mixed layer depth
+ !
+ USE in_out_manager ! I/O manager
+ USE iom ! XIOS
+ USE lib_mpp ! MPP library
+ USE prtctl ! Print control
+ USE timing ! Timing
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC tra_dmp ! called by step.F90
+ PUBLIC tra_dmp_init ! called by nemogcm.F90
+
+ ! !!* Namelist namtra_dmp : T & S newtonian damping *
+ LOGICAL , PUBLIC :: ln_tradmp !: internal damping flag
+ INTEGER , PUBLIC :: nn_zdmp !: = 0/1/2 flag for damping in the mixed layer
+ CHARACTER(LEN=200) , PUBLIC :: cn_resto !: name of netcdf file containing restoration coefficient field
+ !
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto !: restoring coeff. on T and S (s-1)
+
+ !! * Substitutions
+# include "vectopt_loop_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: tradmp.F90 10425 2018-12-19 21:54:16Z smasson $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ INTEGER FUNCTION tra_dmp_alloc()
+ !!----------------------------------------------------------------------
+ !! *** FUNCTION tra_dmp_alloc ***
+ !!----------------------------------------------------------------------
+ ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
+ !
+ CALL mpp_sum ( 'tradmp', tra_dmp_alloc )
+ IF( tra_dmp_alloc > 0 ) CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed')
+ !
+ END FUNCTION tra_dmp_alloc
+
+
+ SUBROUTINE tra_dmp( kt, Kbb, Kmm, pts, Krhs )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE tra_dmp ***
+ !!
+ !! ** Purpose : Compute the tracer trend due to a newtonian damping
+ !! of the tracer field towards given data field and add it to the
+ !! general tracer trends.
+ !!
+ !! ** Method : Newtonian damping towards t_dta and s_dta computed
+ !! and add to the general tracer trends:
+ !! ta = ta + resto * (t_dta - tb)
+ !! sa = sa + resto * (s_dta - sb)
+ !! The trend is computed either throughout the water column
+ !! (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or
+ !! below the well mixed layer (nlmdmp=2)
+ !!
+ !! ** Action : - tsa: tracer trends updated with the damping trend
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in ) :: kt ! ocean time-step index
+ INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
+ !
+ INTEGER :: ji, jj, jk, jn ! dummy loop indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts_dta
+ REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrdts
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('tra_dmp')
+ !
+ IF( l_trdtra ) THEN !* Save ta and sa trends
+ ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) )
+ ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs)
+ ENDIF
+ ! !== input T-S data at kt ==!
+ CALL dta_tsd( kt, 'dmp', zts_dta ) ! read and interpolates T-S data at kt
+ !
+ SELECT CASE ( nn_zdmp ) !== type of damping ==!
+ !
+ CASE( 0 ) !* newtonian damping throughout the water column *!
+ DO jn = 1, jpts
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs) &
+ & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) )
+ END DO
+ END DO
+ END DO
+ END DO
+ !
+ CASE ( 1 ) !* no damping in the turbocline (avt > 5 cm2/s) *!
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ IF( avt(ji,jj,jk) <= avt_c ) THEN
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) &
+ & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) )
+ pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) &
+ & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) )
+ ENDIF
+ END DO
+ END DO
+ END DO
+ !
+ CASE ( 2 ) !* no damping in the mixed layer *!
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) &
+ & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) )
+ pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) &
+ & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) )
+ ENDIF
+ END DO
+ END DO
+ END DO
+ !
+ END SELECT
+ !
+ IF( l_trdtra ) THEN ! trend diagnostic
+ ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) - ztrdts(:,:,:,:)
+ CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
+ CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
+ DEALLOCATE( ztrdts )
+ ENDIF
+ ! ! Control print
+ IF(ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp - Ta: ', mask1=tmask, &
+ & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
+ !
+ IF( ln_timing ) CALL timing_stop('tra_dmp')
+ !
+ END SUBROUTINE tra_dmp
+
+
+ SUBROUTINE tra_dmp_init
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE tra_dmp_init ***
+ !!
+ !! ** Purpose : Initialization for the newtonian damping
+ !!
+ !! ** Method : read the namtra_dmp namelist and check the parameters
+ !!----------------------------------------------------------------------
+ INTEGER :: ios, imask ! local integers
+ !
+ NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
+ !!----------------------------------------------------------------------
+ !
+ REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : T & S relaxation
+ READ ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' )
+ !
+ REWIND( numnam_cfg ) ! Namelist namtra_dmp in configuration namelist : T & S relaxation
+ READ ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
+902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' )
+ IF(lwm) WRITE ( numond, namtra_dmp )
+ !
+ IF(lwp) THEN ! Namelist print
+ WRITE(numout,*)
+ WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
+ WRITE(numout,*) '~~~~~~~~~~~~'
+ WRITE(numout,*) ' Namelist namtra_dmp : set relaxation parameters'
+ WRITE(numout,*) ' Apply relaxation or not ln_tradmp = ', ln_tradmp
+ WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp
+ WRITE(numout,*) ' Damping file name cn_resto = ', cn_resto
+ WRITE(numout,*)
+ ENDIF
+ !
+ IF( ln_tradmp ) THEN
+ ! ! Allocate arrays
+ IF( tra_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
+ !
+ SELECT CASE (nn_zdmp) ! Check values of nn_zdmp
+ CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping as specified by mask'
+ CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixing layer (kz > 5 cm2/s)'
+ CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer'
+ CASE DEFAULT
+ CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
+ END SELECT
+ !
+ !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
+ ! so can damp to something other than intitial conditions files?
+ !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
+ IF( .NOT.ln_tsd_dmp ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout, *) ' read T-S data not initialized, we force ln_tsd_dmp=T'
+ CALL dta_tsd_init( ld_tradmp=ln_tradmp ) ! forces the initialisation of T-S data
+ ENDIF
+ ! ! Read in mask from file
+ CALL iom_open ( cn_resto, imask)
+ CALL iom_get ( imask, jpdom_autoglo, 'resto', resto )
+ CALL iom_close( imask )
+ ENDIF
+ !
+ END SUBROUTINE tra_dmp_init
+
+ !!======================================================================
+END MODULE tradmp
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/usrdef_sbc.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/usrdef_sbc.F90 (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/MY_SRC/usrdef_sbc.F90 (revision 12150)
@@ -0,0 +1,88 @@
+MODULE usrdef_sbc
+ !!======================================================================
+ !! *** MODULE usrdef_sbc ***
+ !!
+ !! === ISOMIP configuration ===
+ !!
+ !! User defined : surface forcing of a user configuration
+ !!======================================================================
+ !! History : 4.0 ! 2016-03 (S. Flavoni, G. Madec) user defined interface
+ !! ! 2017-02 (P. Mathiot, S. Flavoni) adapt code to ISOMIP case
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! usr_def_sbc : user defined surface bounday conditions in ISOMIP case
+ !!----------------------------------------------------------------------
+ USE oce ! ocean dynamics and tracers
+ USE dom_oce ! ocean space and time domain
+ USE sbc_oce ! Surface boundary condition: ocean fields
+ USE sbc_ice ! Surface boundary condition: ice fields
+ USE phycst ! physical constants
+ !
+ USE in_out_manager ! I/O manager
+ USE lib_mpp ! distribued memory computing library
+ USE lbclnk ! ocean lateral boundary conditions (or mpp link)
+ USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC usrdef_sbc_oce ! routine called in sbcmod module
+ PUBLIC usrdef_sbc_ice_tau ! routine called by icestp.F90 for ice dynamics
+ PUBLIC usrdef_sbc_ice_flx ! routine called by icestp.F90 for ice thermo
+
+ !! * Substitutions
+# include "vectopt_loop_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: usrdef_sbc.F90 10074 2018-08-28 16:15:49Z nicolasmartin $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE usrdef_sbc_oce( kt, Kbb )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE usr_def_sbc ***
+ !!
+ !! ** Purpose : provide at each time-step the surface boundary
+ !! condition, i.e. the momentum, heat and freshwater fluxes.
+ !!
+ !! ** Method : all 0 fields, for ISOMIP case
+ !! CAUTION : never mask the surface stress field !
+ !!
+ !! ** Action : - set to ZERO all the ocean surface boundary condition, i.e.
+ !! utau, vtau, taum, wndm, qns, qsr, emp, sfx
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kt ! ocean time step
+ INTEGER, INTENT(in) :: Kbb ! ocean time index
+ !!---------------------------------------------------------------------
+ !
+ !
+ IF (kt == nit000) THEN
+ IF(lwp) WRITE(numout,*)' usr_sbc : ISOMIP case: NO surface forcing'
+ IF(lwp) WRITE(numout,*)' ~~~~~~~~~~~ utau = vtau = taum = wndm = qns = qsr = emp = sfx = 0'
+ END IF
+ !
+ utau(:,:) = 0._wp
+ vtau(:,:) = 0._wp
+ taum(:,:) = 0._wp
+ wndm(:,:) = 0._wp
+ !
+ emp (:,:) = 0._wp
+ sfx (:,:) = 0._wp
+ qns (:,:) = 0._wp
+ qsr (:,:) = 0._wp
+ !
+ END SUBROUTINE usrdef_sbc_oce
+
+ SUBROUTINE usrdef_sbc_ice_tau( kt )
+ INTEGER, INTENT(in) :: kt ! ocean time step
+ END SUBROUTINE usrdef_sbc_ice_tau
+
+ SUBROUTINE usrdef_sbc_ice_flx( kt )
+ INTEGER, INTENT(in) :: kt ! ocean time step
+ END SUBROUTINE usrdef_sbc_ice_flx
+
+ !!======================================================================
+END MODULE usrdef_sbc
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/cpp_ISOMIP+.fcm
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/cpp_ISOMIP+.fcm (revision 12150)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP+/cpp_ISOMIP+.fcm (revision 12150)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_iomput key_mpp_mpi
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP/EXPREF/file_def_nemo-oce.xml
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP/EXPREF/file_def_nemo-oce.xml (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP/EXPREF/file_def_nemo-oce.xml (revision 12150)
@@ -27,6 +27,5 @@
-
-
+
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP/EXPREF/namelist_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP/EXPREF/namelist_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/ISOMIP/EXPREF/namelist_cfg (revision 12150)
@@ -46,4 +46,35 @@
rn_rdt = 1800. ! time step for the dynamics (and tracer if nn_acc=0)
/
+!-----------------------------------------------------------------------
+&namcfg ! parameters of the configuration (default: use namusr_def in namelist_cfg)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd ! Temperature & Salinity Data (init/dmp) (default: OFF)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namwad ! Wetting and Drying (WaD) (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs ! coarsened grid (for outputs and/or TOP) (ln_crs =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d ! 1D configuration options ("key_c1d" default: PAPA station)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d_dyndmp ! U & V newtonian damping ("key_c1d" default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d_uvd ! data: U & V currents ("key_c1d" default: OFF)
+!-----------------------------------------------------------------------
+
+/
+
!!======================================================================
!! *** Surface Boundary Condition namelists *** !!
@@ -59,6 +90,4 @@
!! namsbc_rnf river runoffs (ln_rnf =T)
!! namsbc_apr Atmospheric Pressure (ln_apr_dyn =T)
-!! namsbc_isf ice shelf melting/freezing (ln_isfcav =T : read (ln_read_cfg=T) or set or usr_def_zgr )
-!! namsbc_iscpl coupling option between land ice model and ocean (ln_isfcav =T)
!! namsbc_wave external fields from wave model (ln_wave =T)
!! namberg iceberg floats (ln_icebergs=T)
@@ -66,46 +95,94 @@
!
!-----------------------------------------------------------------------
-&namsbc ! Surface Boundary Condition (surface module)
-!-----------------------------------------------------------------------
- nn_fsbc = 1 ! frequency of surface boundary condition computation
+&namsbc ! Surface Boundary Condition manager (default: NO selection)
+!-----------------------------------------------------------------------
+ nn_fsbc = 1 ! frequency of SBC module call
+ ! ! (control sea-ice & iceberg model call)
ln_usr = .true. ! user defined formulation (T => check usrdef_sbc)
- ln_isf = .true. ! ice shelf melting/freezing (T => fill namsbc_isf)
-/
-!-----------------------------------------------------------------------
-&namsbc_isf ! Top boundary layer (ISF) (ln_isfcav =T : read (ln_read_cfg=T)
-!----------------------------------------------------------------------- or set or usr_def_zgr )
-! ! file name ! frequency (hours) ! variable ! time interpol. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !
-! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !
-! nn_isf == 4
- sn_fwfisf = 'rnfisf' , -12. ,'sowflisf', .false. , .true. , 'yearly' , '' , '' , ''
-! nn_isf == 3
- sn_rnfisf = 'rnfisf' , -12. ,'sofwfisf', .false. , .true. , 'yearly' , '' , '' , ''
-! nn_isf == 2 and 3
- sn_depmax_isf = 'rnfisf' , -12. ,'sozisfmax' , .false. , .true. , 'yearly' , '' , '' , ''
- sn_depmin_isf = 'rnfisf' , -12. ,'sozisfmin' , .false. , .true. , 'yearly' , '' , '' , ''
-! nn_isf == 2
- sn_Leff_isf = 'rnfisf' , -12. ,'Leff' , .false. , .true. , 'yearly' , '' , '' , ''
-! for all case
- nn_isf = 1 ! ice shelf melting/freezing
- ! 1 = presence of ISF 2 = bg03 parametrisation
- ! 3 = rnf file for isf 4 = ISF fwf specified
- ! option 1 and 4 need ln_isfcav = .true. (domzgr)
-! only for nn_isf = 1 or 2
- rn_gammat0 = 1.0e-4 ! gammat coefficient used in blk formula
- rn_gammas0 = 1.0e-4 ! gammas coefficient used in blk formula
-! only for nn_isf = 1 or 4
- rn_hisf_tbl = 30. ! thickness of the top boundary layer (Losh et al. 2008)
- ! 0 => thickness of the tbl = thickness of the first wet cell
-! only for nn_isf = 1
- nn_isfblk = 1 ! 1 ISOMIP like: 2 equations formulation (Hunter et al., 2006)
- ! 2 ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)
- nn_gammablk = 0 ! 0 = cst Gammat (= gammat/s)
- ! 1 = velocity dependend Gamma (u* * gammat/s) (Jenkins et al. 2010)
- ! 2 = velocity and stability dependent Gamma (Holland et al. 1999)
-/
-!-----------------------------------------------------------------------
-&namsbc_iscpl ! land ice / ocean coupling option
-!-----------------------------------------------------------------------
-/
+/
+!-----------------------------------------------------------------------
+&namsbc_flx ! surface boundary condition : flux formulation (ln_flx =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_blk ! namsbc_blk generic Bulk formula (ln_blk =T)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_sas ! Stand-Alone Surface module: ocean data (SAS_SRC only)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_iif ! Ice-IF : use observed ice cover (nn_ice = 1)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr ! penetrative solar radiation (ln_traqsr =T)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr ! surface boundary condition : sea surface restoring (ln_ssr =T)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf ! runoffs (ln_rnf =T)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namsbc_apr ! Atmospheric pressure used as ocean forcing (ln_apr_dyn =T)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&namisf ! Top boundary layer (ISF) (default: OFF)
+!-----------------------------------------------------------------------
+ !
+ ! ---------------- ice shelf load -------------------------------
+ !
+ !
+ ! ---------------- ice shelf melt formulation -------------------------------
+ !
+ ln_isf = .true. ! activate ice shelf module
+ cn_isfdir = './' ! directory for all ice shelf input file
+ !
+ ! ---------------- cavities opened -------------------------------
+ !
+ ln_isfcav_mlt = .true. ! ice shelf melting into the cavity (need ln_isfcav = .true. in domain_cfg.nc)
+ cn_isfcav_mlt = '2eq' ! ice shelf melting formulation (spe/2eq/3eq/oasis)
+ ! ! spe = fwfisf is read from a forcing field
+ ! ! 2eq = ISOMIP like: 2 equations formulation (Hunter et al., 2006)
+ ! ! 3eq = ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)
+ ! ! oasis = fwfisf is given by oasis and pattern by file sn_isfcav_fwf
+ ! ! cn_isfcav_mlt = 2eq or 3eq cases:
+ cn_gammablk = 'spe' ! scheme to compute gammat/s (spe,ad15,hj99)
+ ! ! ad15 = velocity dependend Gamma (u* * gammat/s) (Jenkins et al. 2010)
+ ! ! hj99 = velocity and stability dependent Gamma (Holland et al. 1999)
+ rn_gammat0 = 1.e-4 ! gammat coefficient used in blk formula
+ rn_gammas0 = 1.e-4 ! gammas coefficient used in blk formula
+ !
+ rn_htbl = 30. ! thickness of the top boundary layer (Losh et al. 2008)
+ ! ! 0 => thickness of the tbl = thickness of the first wet cell
+ !
+/
+!-----------------------------------------------------------------------
+&namsbc_wave ! External fields from wave model (ln_wave=T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg ! iceberg parameters (default: OFF)
+!-----------------------------------------------------------------------
+
+/
+
!!======================================================================
!! *** Lateral boundary condition *** !!
@@ -124,4 +201,26 @@
rn_shlat = 0. ! free slip
/
+!-----------------------------------------------------------------------
+&namagrif ! AGRIF zoom ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide ! tide parameters (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy ! unstructured open boundaries (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_dta ! open boundaries - external data (see nam_bdy)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&nambdy_tide ! tidal forcing at open boundaries (default: OFF)
+!-----------------------------------------------------------------------
+/
+
!!======================================================================
!! *** Top/Bottom boundary condition *** !!
@@ -145,5 +244,5 @@
/
!-----------------------------------------------------------------------
-&namdrg_top ! TOP friction (ln_isfcav=T)
+&namdrg_top ! TOP friction (ln_OFF =F & ln_isfcav=T)
!-----------------------------------------------------------------------
rn_Cd0 = 2.5e-3 ! drag coefficient [-]
@@ -156,5 +255,5 @@
/
!-----------------------------------------------------------------------
-&namdrg_bot ! BOTTOM friction
+&namdrg_bot ! BOTTOM friction (ln_OFF =F)
!-----------------------------------------------------------------------
rn_Cd0 = 1.e-3 ! drag coefficient [-]
@@ -166,4 +265,14 @@
rn_boost = 50. ! local boost factor [-]
/
+!-----------------------------------------------------------------------
+&nambbc ! bottom temperature boundary condition (default: OFF)
+!-----------------------------------------------------------------------
+
+/
+!-----------------------------------------------------------------------
+&nambbl ! bottom boundary layer scheme (default: OFF)
+!-----------------------------------------------------------------------
+/
+
!!======================================================================
!! Tracer (T-S) namelists !!
@@ -178,5 +287,5 @@
!
!-----------------------------------------------------------------------
-&nameos ! ocean Equation Of Seawater (default: OFF)
+&nameos ! ocean Equation Of Seawater (default: NO selection)
!-----------------------------------------------------------------------
ln_eos80 = .true. ! = Use EOS80 equation of state
@@ -199,4 +308,17 @@
rn_Ld = 10.e+3 ! lateral diffusive length [m]
/
+!-----------------------------------------------------------------------
+&namtra_mle ! mixed layer eddy parametrisation (Fox-Kemper) (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_eiv ! eddy induced velocity param. (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp ! tracer: T & S newtonian damping (default: OFF)
+!-----------------------------------------------------------------------
+/
+
!!======================================================================
!! *** Dynamics namelists *** !!
@@ -212,4 +334,8 @@
!
!-----------------------------------------------------------------------
+&nam_vvl ! vertical coordinate options (default: z-star)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
&namdyn_adv ! formulation of the momentum advection (default: NO selection)
!-----------------------------------------------------------------------
@@ -218,5 +344,5 @@
/
!-----------------------------------------------------------------------
-&namdyn_vor ! Vorticity / Coriolis scheme (default: OFF)
+&namdyn_vor ! Vorticity / Coriolis scheme (default: NO selection)
!-----------------------------------------------------------------------
ln_dynvor_ene = .true. ! energy conserving scheme
@@ -241,4 +367,10 @@
rn_Lv = 10.e+3 ! lateral viscous length [m]
/
+!-----------------------------------------------------------------------
+&namdta_dyn ! offline ocean input files (OFF_SRC only)
+!-----------------------------------------------------------------------
+
+/
+
!!======================================================================
!! vertical physics namelists !!
@@ -253,15 +385,38 @@
!
!-----------------------------------------------------------------------
-&namzdf ! vertical physics (default: NO selection)
-!-----------------------------------------------------------------------
- ! ! type of vertical closure
+&namzdf ! vertical physics manager (default: NO selection)
+!-----------------------------------------------------------------------
+ ! ! type of vertical closure (required)
ln_zdfcst = .true. ! constant mixing
+ !
+ ! ! convection
ln_zdfevd = .true. ! enhanced vertical diffusion
- nn_evdm = 1 ! apply on tracer (=0) or on tracer and momentum (=1)
- rn_evd = 0.1 ! mixing coefficient [m2/s]
+ rn_evd = 0.1 ! mixing coefficient [m2/s]
+ !
! ! coefficients
- rn_avm0 = 1.e-3 ! vertical eddy viscosity [m2/s]
- rn_avt0 = 5.e-5 ! vertical eddy diffusivity [m2/s]
-/
+ rn_avm0 = 1.e-3 ! vertical eddy viscosity [m2/s] (background Kz if ln_zdfcst)
+ rn_avt0 = 5.e-5 ! vertical eddy diffusivity [m2/s] (background Kz if ln_zdfcst)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric ! richardson number dependent vertical diffusion (ln_zdfric =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke ! turbulent eddy kinetic dependent vertical diffusion (ln_zdftke =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls ! GLS vertical diffusion (ln_zdfgls =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_osm ! OSM vertical diffusion (ln_zdfosm =T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_iwm ! internal wave-driven mixing parameterization (ln_zdfiwm =T)
+!-----------------------------------------------------------------------
+/
+
!!======================================================================
!! *** Diagnostics namelists *** !!
@@ -280,4 +435,45 @@
!!======================================================================
!
+!-----------------------------------------------------------------------
+&namtrd ! trend diagnostics (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr ! Poleward Transport Diagnostic (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb ! Heat and salt budgets (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdiu ! Cool skin and warm layer models (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namflo ! float parameters ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_diaharm ! Harmonic analysis of tidal constituents ("key_diaharm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct ! transports through some sections ("key_diadct")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_diatmb ! Top Middle Bottom Output (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_dia25h ! 25h Mean Output (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+
!!======================================================================
!! *** Observation & Assimilation *** !!
@@ -287,4 +483,13 @@
!!======================================================================
!
+!-----------------------------------------------------------------------
+&namobs ! observation usage switch (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc ! assimilation increments ('key_asminc')
+!-----------------------------------------------------------------------
+/
+
!!======================================================================
!! *** Miscellaneous namelists *** !!
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_cen2_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_cen2_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_cen2_cfg (revision 12150)
@@ -32,6 +32,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_ubs_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_ubs_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_ubs_cfg (revision 12150)
@@ -46,6 +46,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_eenH_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_eenH_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_eenH_cfg (revision 12150)
@@ -32,6 +32,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_een_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_een_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_een_cfg (revision 12150)
@@ -32,6 +32,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ene_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ene_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ene_cfg (revision 12150)
@@ -32,6 +32,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ens_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ens_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ens_cfg (revision 12150)
@@ -32,6 +32,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_flux_cen2_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_flux_cen2_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_flux_cen2_cfg (revision 12150)
@@ -32,6 +32,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_flux_ubs_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_flux_ubs_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_flux_ubs_cfg (revision 12150)
@@ -32,6 +32,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_eenH_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_eenH_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_eenH_cfg (revision 12150)
@@ -32,6 +32,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_een_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_een_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_een_cfg (revision 12150)
@@ -32,6 +32,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_ene_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_ene_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_ene_cfg (revision 12150)
@@ -32,6 +32,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_ens_cfg
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_ens_cfg (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT4_vect_ens_cfg (revision 12150)
@@ -32,6 +32,4 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- !
- rn_isfhmin = 0.00 ! treshold (m) to discriminate grounding ice to floating ice
!
rn_rdt = 1. ! time step for the dynamics (and tracer if nn_acc=0)
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/VORTEX/MY_SRC/domvvl.F90
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/VORTEX/MY_SRC/domvvl.F90 (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/VORTEX/MY_SRC/domvvl.F90 (revision 12150)
@@ -37,4 +37,5 @@
PUBLIC dom_vvl_init ! called by domain.F90
+ PUBLIC dom_vvl_zgr ! called by isfcpl.F90
PUBLIC dom_vvl_sf_nxt ! called by step.F90
PUBLIC dom_vvl_sf_update ! called by step.F90
@@ -118,21 +119,48 @@
INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
!
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+ !
+ CALL dom_vvl_ctl ! choose vertical coordinate (z_star, z_tilde or layer)
+ !
+ ! ! Allocate module arrays
+ IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
+ !
+ ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
+ CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' )
+ e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all
+ !
+ CALL dom_vvl_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column
+ !
+ END SUBROUTINE dom_vvl_init
+ !
+ SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dom_vvl_init ***
+ !!
+ !! ** Purpose : Interpolation of all scale factors,
+ !! depths and water column heights
+ !!
+ !! ** Method : - interpolate scale factors
+ !!
+ !! ** Action : - e3t_(n/b) and tilde_e3t_(n/b)
+ !! - Regrid: e3(u/v)_n
+ !! e3(u/v)_b
+ !! e3w_n
+ !! e3(u/v)w_b
+ !! e3(u/v)w_n
+ !! gdept_n, gdepw_n and gde3w_n
+ !! - h(t/u/v)_0
+ !! - frq_rst_e3t and frq_rst_hdv
+ !!
+ !! Reference : Leclair, M., and G. Madec, 2011, Ocean Modelling.
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
+ !!----------------------------------------------------------------------
INTEGER :: ji, jj, jk
INTEGER :: ii0, ii1, ij0, ij1
REAL(wp):: zcoef
!!----------------------------------------------------------------------
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
- IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
- !
- CALL dom_vvl_ctl ! choose vertical coordinate (z_star, z_tilde or layer)
- !
- ! ! Allocate module arrays
- IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
- !
- ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
- CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' )
- e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all
!
! !== Set of all other vertical scale factors ==! (now and before)
@@ -266,5 +294,5 @@
ENDIF
!
- END SUBROUTINE dom_vvl_init
+ END SUBROUTINE dom_vvl_zgr
@@ -1028,5 +1056,4 @@
!
IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' )
- IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
!
IF(lwp) THEN ! Print the choice
Index: /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/demo_cfgs.txt
===================================================================
--- /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/demo_cfgs.txt (revision 12149)
+++ /NEMO/branches/2019/dev_r11943_MERGE_2019/tests/demo_cfgs.txt (revision 12150)
@@ -1,4 +1,5 @@
CANAL OCE
ISOMIP OCE
+ISOMIP+ OCE
LOCK_EXCHANGE OCE
OVERFLOW OCE