diff --git a/cfgs/C1D_PAPA/MY_SRC/usrdef_nam.F90 b/cfgs/C1D_PAPA/MY_SRC/usrdef_nam.F90
index 768a0d0862c4c61e45e578f44b93606d2a40e8dd..6269b43bfec8a0923318896ce25de900b9ffe001 100644
--- a/cfgs/C1D_PAPA/MY_SRC/usrdef_nam.F90
+++ b/cfgs/C1D_PAPA/MY_SRC/usrdef_nam.F90
@@ -14,7 +14,6 @@ MODULE usrdef_nam
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain
- USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
!
@@ -84,10 +83,6 @@ CONTAINS
WRITE(numout,*) 'usr_def_nam : read the user defined namelist (namusr_def) in namelist_cfg'
WRITE(numout,*) '~~~~~~~~~~~ '
WRITE(numout,*) ' Namelist namusr_def : C1 case'
- WRITE(numout,*) ' type of vertical coordinate : '
- WRITE(numout,*) ' z-coordinate flag ln_zco = ', ln_zco
- WRITE(numout,*) ' z-partial-step coordinate flag ln_zps = ', ln_zps
- WRITE(numout,*) ' s-coordinate flag ln_sco = ', ln_sco
WRITE(numout,*) ' C1D domain = 1 x 1 x 75 grid-points '
WRITE(numout,*) ' resulting global domain size : jpiglo = ', kpi
WRITE(numout,*) ' jpjglo = ', kpj
diff --git a/cfgs/C1D_PAPA/MY_SRC/usrdef_zgr.F90 b/cfgs/C1D_PAPA/MY_SRC/usrdef_zgr.F90
index e02d23fb5d7b47263588a51ff124bbfbf830b453..400efb419c08525a5f7fe4b5f318b5fa2bc77b78 100644
--- a/cfgs/C1D_PAPA/MY_SRC/usrdef_zgr.F90
+++ b/cfgs/C1D_PAPA/MY_SRC/usrdef_zgr.F90
@@ -7,6 +7,7 @@ MODULE usrdef_zgr
!! User defined : vertical coordinate system of a user configuration
!!======================================================================
!! History : 4.0 ! 2016-06 (R. Bourdalle-Badie) Original code
+ !! 4.3 ! 2023-01 (S. Techene,G. Madec) New zps : depth and w-level scale factors are horizontally uniform
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -39,25 +40,25 @@ MODULE usrdef_zgr
CONTAINS
SUBROUTINE usr_def_zgr( ld_zco , ld_zps , ld_sco , ld_isfcav, & ! type of vertical coordinate
+ & k_top , k_bot , & ! top & bottom ocean level
& pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d , & ! 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f , & ! 3D t-level vertical scale factors
& pdept , pdepw , & ! 3D t & w-points depth
- & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw , & ! - - -
- & k_top , k_bot ) ! top & bottom ocean level
+ & pe3w , pe3uw , pe3vw ) ! 3D w-level vertical scale factors
!!---------------------------------------------------------------------
!! *** ROUTINE usr_def_zgr ***
!!
!! ** Purpose : User defined the vertical coordinates
!!
!!----------------------------------------------------------------------
- LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
- LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
- REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
- INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
+ LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
+ INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! t-level vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pdept, pdepw ! grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3w , pe3uw, pe3vw ! w-level vertical scale factors [m]
!
INTEGER :: ji, jj, jk ! dummy indices
INTEGER :: ik ! local integers
@@ -148,34 +149,37 @@ CONTAINS
!
! !* vertical coordinate system
DO jk = 1, jpk ! initialization to the reference z-coordinate
- pdept(:,:,jk) = pdept_1d(jk)
- pdepw(:,:,jk) = pdepw_1d(jk)
pe3t (:,:,jk) = pe3t_1d (jk)
pe3u (:,:,jk) = pe3t_1d (jk)
pe3v (:,:,jk) = pe3t_1d (jk)
pe3f (:,:,jk) = pe3t_1d (jk)
+!!st : new zps framework toward penalization only fluxed at t-level are affected by scale factor change
+#if defined key_vco_3d
+ pdept(:,:,jk) = pdept_1d(jk)
+ pdepw(:,:,jk) = pdepw_1d(jk)
pe3w (:,:,jk) = pe3w_1d (jk)
pe3uw(:,:,jk) = pe3w_1d (jk)
pe3vw(:,:,jk) = pe3w_1d (jk)
+#endif
END DO
! bottom scale factors and depth at T- and W-points
DO_2D( 1, 1, 1, 1 )
ik = k_bot(ji,jj)
- pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
- pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
+!!st pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
+ pe3t (ji,jj,ik ) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )- pdepw_1d(ik)
pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik )
!
- pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp
- pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
- pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) ! = pe3t (ji,jj,ik )
+!!st pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp
+!!st pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
+!!st pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) ! = pe3t (ji,jj,ik )
END_2D
! ! bottom scale factors and depth at U-, V-, UW and VW-points
! ! usually Computed as the minimum of neighbooring scale factors
pe3u (:,:,:) = pe3t(:,:,:) ! HERE C1D configuration :
pe3v (:,:,:) = pe3t(:,:,:) ! e3 increases with k-index
pe3f (:,:,:) = pe3t(:,:,:) ! so e3 minimum of (i,i+1) points is (i) point
- pe3uw(:,:,:) = pe3w(:,:,:) ! in j-direction e3v=e3t and e3f=e3v
- pe3vw(:,:,:) = pe3w(:,:,:) ! ==>> no need of lbc_lnk calls
+!!st pe3uw(:,:,:) = pe3w(:,:,:) ! in j-direction e3v=e3t and e3f=e3v
+!!st pe3vw(:,:,:) = pe3w(:,:,:) ! ==>> no need of lbc_lnk calls
!
!
END SUBROUTINE usr_def_zgr
diff --git a/cfgs/C1D_PAPA/cpp_C1D_PAPA.fcm b/cfgs/C1D_PAPA/cpp_C1D_PAPA.fcm
index af414a0d39264d0bef1903b7015de04cdec0251b..2ffc02d692078409285fda1692abba2e528b2c5b 100644
--- a/cfgs/C1D_PAPA/cpp_C1D_PAPA.fcm
+++ b/cfgs/C1D_PAPA/cpp_C1D_PAPA.fcm
@@ -1 +1 @@
- bld::tool::fppkeys key_xios key_linssh
+ bld::tool::fppkeys key_xios key_linssh key_vco_1d3d
diff --git a/cfgs/GYRE_BFM/cpp_GYRE_BFM.fcm b/cfgs/GYRE_BFM/cpp_GYRE_BFM.fcm
index 188b7d7a06ff0a05eb659e9162e7baa0b72b75e1..16687ebfdc68bdc1a380d78a0e35bd5524541ce5 100644
--- a/cfgs/GYRE_BFM/cpp_GYRE_BFM.fcm
+++ b/cfgs/GYRE_BFM/cpp_GYRE_BFM.fcm
@@ -1,2 +1,2 @@
-bld::tool::fppkeys key_top key_xios key_linssh
+bld::tool::fppkeys key_top key_xios key_linssh key_vco_1d3d
inc $BFMDIR/src/nemo/bfm.fcm
diff --git a/cfgs/ORCA2_ICE_ABL/cpp_ORCA2_ICE_ABL.fcm b/cfgs/ORCA2_ICE_ABL/cpp_ORCA2_ICE_ABL.fcm
index b477eb7695a54aa32f9181faf8830c62d37ebb72..8597359e33246c5fbbed523f9ca6c9e3cf0ee682 100644
--- a/cfgs/ORCA2_ICE_ABL/cpp_ORCA2_ICE_ABL.fcm
+++ b/cfgs/ORCA2_ICE_ABL/cpp_ORCA2_ICE_ABL.fcm
@@ -1 +1 @@
-bld::tool::fppkeys key_si3 key_xios key_qco
+bld::tool::fppkeys key_si3 key_xios key_qco key_vco_1d3d
diff --git a/cfgs/ORCA2_OFF_TRC/cpp_ORCA2_OFF_TRC.fcm b/cfgs/ORCA2_OFF_TRC/cpp_ORCA2_OFF_TRC.fcm
index 8128f8cc416311baaa454829ff15795ee1be5108..0a0c37f9207e3cbccdb793936add426fc896459b 100644
--- a/cfgs/ORCA2_OFF_TRC/cpp_ORCA2_OFF_TRC.fcm
+++ b/cfgs/ORCA2_OFF_TRC/cpp_ORCA2_OFF_TRC.fcm
@@ -1 +1 @@
-bld::tool::fppkeys key_top key_xios key_qco
+bld::tool::fppkeys key_top key_xios key_qco key_vco_1d3d
diff --git a/cfgs/SHARED/axis_def_nemo.xml b/cfgs/SHARED/axis_def_nemo.xml
index 374d193e2047ae6a0145725fb947a032a527ba9a..b83f1c381905cbd69026cdc242b5e2208a047150 100644
--- a/cfgs/SHARED/axis_def_nemo.xml
+++ b/cfgs/SHARED/axis_def_nemo.xml
@@ -6,22 +6,23 @@
<axis_definition>
<axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
- <!-- Vertical zoom for a 31-levels ORCA2 grid for eORCA1 300m corresponds to n=35 -->
+ <!-- Vertical zoom for a 31-levels ORCA2 grid. For eORCA1 300m corresponds to n=35 -->
<axis id="deptht300" axis_ref="deptht" >
<zoom_axis begin="0" n="19" />
</axis>
- <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
- <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
- <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
- <axis id="depthf" long_name="Vertical F levels" unit="m" positive="down" />
- <axis id="nfloat" long_name="Float number" unit="-" />
- <axis id="icbcla" long_name="Iceberg class" unit="1" />
- <axis id="ncatice" long_name="Ice category" unit="1" />
- <axis id="iax_20C" long_name="20 degC isotherm" unit="degC" />
- <axis id="iax_26C" long_name="26 degC isotherm" unit="degC" />
- <axis id="iax_28C" long_name="28 degC isotherm" unit="degC" />
+ <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+ <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+ <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+ <axis id="depthf" long_name="Vertical F levels" unit="m" positive="down" />
+ <axis id="nfloat" long_name="Float number" unit="-" />
+ <axis id="icbcla" long_name="Iceberg class" unit="1" />
+ <axis id="ncatice" long_name="Ice category" unit="1" />
+ <axis id="nlayice" long_name="Ice layer" unit="1" />
+ <axis id="iax_20C" long_name="20 degC isotherm" unit="degC" />
+ <axis id="iax_26C" long_name="26 degC isotherm" unit="degC" />
+ <axis id="iax_28C" long_name="28 degC isotherm" unit="degC" />
<axis id="basin" long_name="Sub-basin mask (1=Global 2=Atlantic 3=Indo-Pacific 4=Indian, 5=Pacific)" unit="1" />
- <axis id="nstrait" long_name="Number of straits" unit="1" />
+ <axis id="nstrait" long_name="Number of straits" unit="1" />
<!-- ABL vertical axis definition -->
<axis id="ght_abl" long_name="ABL Vertical T levels" unit="m" positive="up" />
<axis id="ghw_abl" long_name="ABL Vertical W levels" unit="m" positive="up" />
diff --git a/cfgs/SHARED/field_def_nemo-ice.xml b/cfgs/SHARED/field_def_nemo-ice.xml
index 2768a8905a5f6ba1d13a688444aa1268a03d89b5..14fd6ef2f8f6252c03d84ccdfffa1dd846ad93da 100644
--- a/cfgs/SHARED/field_def_nemo-ice.xml
+++ b/cfgs/SHARED/field_def_nemo-ice.xml
@@ -342,8 +342,31 @@
<field id="tice_cvgerr" long_name="sea ice temperature convergence error" standard_name="sea_ice_temperature_convergence_err" unit="K" />
<field id="tice_cvgstp" long_name="sea ice temperature convergence iterations" standard_name="sea_ice_temperature_convergence_stp" unit="" />
+ <!-- salt drainage and flushing sanity checks -->
+ <field id="cfl_flush" long_name="max CFL during flushing" unit="" />
+ <field id="cfl_drain" long_name="max CFL during drainage" unit="" />
+ <field id="sice_flush_dserr" long_name="positive sea ice salinity derivative during flushing" detect_missing_value="true" unit="g/kg" />
+ <field id="sice_drain_dserr" long_name="positive sea ice salinity derivative during drainage" detect_missing_value="true" unit="g/kg" />
+ <field id="sice_flush_serr" long_name="negative sea ice salinity during flushing" detect_missing_value="true" unit="g/kg" />
+ <field id="sice_drain_serr" long_name="negative sea ice salinity during drainage" detect_missing_value="true" unit="g/kg" />
+
</field_group> <!-- SBC_3D -->
+ <!-- layers -->
+ <field_group id="SBC_4D" grid_ref="grid_T_nlayice_inner" >
+
+ <!-- standard ice fields -->
+ <field id="icesalt_lay" long_name="Sea-Ice salinity per layer" unit="g/kg" detect_missing_value="true" />
+ <field id="icetemp_lay" long_name="Ice temperature per layer" unit="degC" detect_missing_value="true" />
+
+ <!-- salt drainage and flushing sanity checks -->
+ <field id="tice_flush_dserr" long_name="temperature when positive sea ice salinity derivative during flushing" detect_missing_value="true" unit="degC" />
+ <field id="tice_drain_dserr" long_name="temperature when positive sea ice salinity derivative during drainage" detect_missing_value="true" unit="degC" />
+ <field id="tice_flush_serr" long_name="temperature when negative sea ice salinity during flushing" detect_missing_value="true" unit="degC" />
+ <field id="tice_drain_serr" long_name="temperature when negative sea ice salinity during drainage" detect_missing_value="true" unit="degC" />
+
+ </field_group> <!-- SBC_4D -->
+
<!-- scalar variables -->
<field_group id="SBC_scalar" grid_ref="grid_scalar" >
<field id="NH_iceextt" long_name="Sea ice extent North" standard_name="sea_ice_extent_n" unit="1e6_km2" />
diff --git a/cfgs/SHARED/grid_def_nemo.xml b/cfgs/SHARED/grid_def_nemo.xml
index eb0aab010e849c268be2121a104e42c29673a4f1..1fe20b0c37b96680f76a01fbebbacd892537d4ec 100644
--- a/cfgs/SHARED/grid_def_nemo.xml
+++ b/cfgs/SHARED/grid_def_nemo.xml
@@ -24,6 +24,17 @@
<axis axis_ref="ncatice" />
</grid>
<!-- -->
+ <grid id="grid_T_nlayice" >
+ <domain domain_ref="grid_T" />
+ <axis axis_ref="nlayice" />
+ <axis axis_ref="ncatice" />
+ </grid>
+ <grid id="grid_T_nlayice_inner" >
+ <domain domain_ref="grid_T_inner" name="grid_T" />
+ <axis axis_ref="nlayice" />
+ <axis axis_ref="ncatice" />
+ </grid>
+ <!-- -->
<grid id="grid_T_3D" >
<domain domain_ref="grid_T" />
<axis axis_ref="deptht" />
diff --git a/cfgs/SHARED/namelist_ice_ref b/cfgs/SHARED/namelist_ice_ref
index 886aa1635ce584109dea8b1285c1c255bfdf105c..02cb0a908374275a0dc75b6369a3d58db0c7b371 100644
--- a/cfgs/SHARED/namelist_ice_ref
+++ b/cfgs/SHARED/namelist_ice_ref
@@ -22,8 +22,8 @@
&nampar ! Generic parameters
!------------------------------------------------------------------------------
jpl = 5 ! number of ice categories
- nlay_i = 2 ! number of ice layers
- nlay_s = 2 ! number of snow layers
+ nlay_i = 5 ! number of ice layers
+ nlay_s = 3 ! number of snow layers
ln_virtual_itd = .false. ! virtual ITD mono-category parameterization (jpl=1 only)
! i.e. enhanced thermal conductivity & virtual thin ice melting
ln_icedyn = .true. ! ice dynamics (T) or not (F)
@@ -156,8 +156,6 @@
ln_icedH = .true. ! activate ice thickness change from growing/melting (T) or not (F)
ln_icedA = .true. ! activate lateral melting param. (T) or not (F)
ln_icedO = .true. ! activate ice growth in open-water (T) or not (F)
- ln_icedS = .true. ! activate brine drainage (T) or not (F)
- !
ln_leadhfx = .true. ! heat in the leads is used to melt sea-ice before warming the ocean
/
!------------------------------------------------------------------------------
@@ -201,13 +199,46 @@
! 1: constant ice salinity (S=rn_icesal)
! 2: varying salinity parameterization S(z,t)
! 3: prescribed salinity profile S(z) (Schwarzacher 1959)
- rn_icesal = 4. ! (nn_icesal=1) ice salinity (g/kg)
- rn_sal_gd = 5. ! (nn_icesal=2) restoring ice salinity, gravity drainage (g/kg)
- rn_time_gd = 1.73e+6 ! (nn_icesal=2) restoring time scale, gravity drainage (s)
- rn_sal_fl = 2. ! (nn_icesal=2) restoring ice salinity, flushing (g/kg)
- rn_time_fl = 8.64e+5 ! (nn_icesal=2) restoring time scale, flushing (s)
- rn_simax = 20. ! maximum tolerated ice salinity (g/kg)
+ ! 4: Gravity Drainage and Flushing
+ ln_flushing = .true. ! activate ice salt flushing
+ ln_drainage = .true. ! activate ice salt gravity drainage
rn_simin = 0.1 ! minimum tolerated ice salinity (g/kg)
+ rn_sinew = 0.75 ! fraction of sss that is entrapped in new ice
+ ! -- nn_icesal=1 -- !
+ rn_icesal = 4. ! ice salinity (g/kg)
+ ! -- nn_icesal=2 -- !
+ rn_sal_gd = 5. ! restoring ice salinity, gravity drainage (g/kg)
+ rn_time_gd = 1.73e+6 ! restoring time scale, gravity drainage (s)
+ rn_sal_fl = 2. ! restoring ice salinity, flushing (g/kg)
+ rn_time_fl = 8.64e+5 ! restoring time scale, flushing (s)
+ ! -- nn_icesal=4 -- !
+ rn_sal_himin = 0.1 ! min ice thickness for gravity drainage and flushing calculation
+ nn_liquidus = 2 ! formulation of liquidus (also used for outputs)
+ ! 1 = linear liquidus
+ ! 2 = Vancopenolle et al (2019) formulation
+ ! 3 = Weast 71 (used in RJW2014)
+ nn_drainage = 20 ! number of subcycles for gravity drainage
+ nn_flushing = 2 ! number of subcycles for flushing
+ rn_flushrate = 0.3 ! rate of flushing (fraction of melt water used for flushing)
+ rn_vbrc = 0.05 ! critical brines volume above which flushing can occur
+ ! ** drainage convection scheme **
+ nn_sal_scheme = 2 ! 1 = Rees Jones and Worster (2014) => RJW2014 !!! be carfeul: this one gives wrong results for now
+ ! 2 = Griewank and Notz (2013) => GN2013
+ ! 3 = Cox and Weeks (1988) => CW1988
+ ! ** parameters for each scheme **
+ rn_alpha_RJW = 0.037 ! 1: Intensity of the Brine flow ==> 0.13 from Thomas 2020
+ ! ==> 0.037 from Martin pers. com.
+ rn_Rc_RJW = 2.7 ! 1: Critical Rayleigh number ==> 2.9 from Thomas 2020
+ ! ==> 2.7 from Martin pers. com.
+ rn_alpha_GN = 0.681e-3 ! 2: Intensity of the Brine flow ==> 6.7e-3 from Thomas 2020
+ ! ==> [0.510e-3 ; 0.681e-3] from Griewank and Notz 2015
+ ! ==> 1.56e-3 from Martin pers. com.
+ rn_Rc_GN = 3.23 ! 2: Critical Rayleigh number ==> 2.4 from Thomas 2020
+ ! ! ==> [7.10 ; 3.23] from Griewank and Notz 2015
+ ! ! ==> 1.01 from Martin pers. com.
+ rn_alpha_CW = 7.2e-7 ! 3: Intensity of the Brine flow
+ !
+ ln_sal_chk = .FALSE. ! sanity checks for drainage and flushing
/
!------------------------------------------------------------------------------
&namthd_pnd ! Melt ponds
diff --git a/cfgs/SPITZ12/cpp_SPITZ12.fcm b/cfgs/SPITZ12/cpp_SPITZ12.fcm
index e321d86098a0a46c99efd7050bcc162121435ce7..f94e70ac2c7d24d2885d05f579cc63073433c8e7 100644
--- a/cfgs/SPITZ12/cpp_SPITZ12.fcm
+++ b/cfgs/SPITZ12/cpp_SPITZ12.fcm
@@ -1 +1 @@
- bld::tool::fppkeys key_xios key_si3 key_qco
+ bld::tool::fppkeys key_xios key_si3 key_qco key_vco_3d
diff --git a/makenemo b/makenemo
index 7e563da7c95fa612e347b70921950f5edba602ef..752ec9e8c835a384ac7859ccb44e23b2e865dc6d 100755
--- a/makenemo
+++ b/makenemo
@@ -336,9 +336,9 @@ fi
# CPP keys addition/removal
-[ -n "${list_add_key}" ] && ${COMPIL_DIR}/Fadd_keys.sh ${NEMO_TDIR}/${CUR_CONF} ${list_add_key}
-[ -n "${list_def_key}" ] && ${COMPIL_DIR}/Fdef_keys.sh ${NEMO_TDIR}/${CUR_CONF} ${list_def_key}
-[ -n "${list_del_key}" ] && ${COMPIL_DIR}/Fdel_keys.sh ${NEMO_TDIR}/${CUR_CONF} ${list_del_key}
+[ -n "${list_add_key}" ] && ${COMPIL_DIR}/Fadd_keys.sh ${NEMO_TDIR}/${CUR_CONF} "${list_add_key}"
+[ -n "${list_def_key}" ] && ${COMPIL_DIR}/Fdef_keys.sh ${NEMO_TDIR}/${CUR_CONF} "${list_def_key}"
+[ -n "${list_del_key}" ] && ${COMPIL_DIR}/Fdel_keys.sh ${NEMO_TDIR}/${CUR_CONF} "${list_del_key}"
# CPP keys check
diff --git a/sette/fcm_job.sh b/sette/fcm_job.sh
index 235fb9e97de7d65f863995001ecd86df2a1df37b..1c0c24432bb5079902301847c7feb943fe10bdea 100755
--- a/sette/fcm_job.sh
+++ b/sette/fcm_job.sh
@@ -100,9 +100,9 @@ else if [ "${INTERACT_FLAG}" == "no" ]; then
fi
# submit job to batch system
if [ "${NB_PROC}" == "1" ]; then
- BATCH_LST+=( $( ${BATCH_COMMAND_SEQ} ${JOB_FILE} ) ) ; echo ${BATCH_COMMAND_SEQ} ${JOB_FILE}
+ BATCH_LST+=( $( eval "${BATCH_COMMAND_SEQ} ${JOB_FILE}" ) ) ; echo ${BATCH_COMMAND_SEQ} ${JOB_FILE}
else
- BATCH_LST+=( $( ${BATCH_COMMAND_PAR} ${JOB_FILE} ) ) ; echo ${BATCH_COMMAND_PAR} ${JOB_FILE}
+ BATCH_LST+=( $( eval "${BATCH_COMMAND_PAR} ${JOB_FILE}" ) ) ; echo ${BATCH_COMMAND_PAR} ${JOB_FILE}
fi
fi
fi
diff --git a/src/ICE/ice.F90 b/src/ICE/ice.F90
index 1eb9d9943214f7a294fb9381f440d996ee0b059b..c3dfd2ba18a2abc902955b7c56f4664ef06b51df 100644
--- a/src/ICE/ice.F90
+++ b/src/ICE/ice.F90
@@ -61,7 +61,8 @@ MODULE ice
!! a_i | a_i_1d | Ice concentration | |
!! v_i | - | Ice volume per unit area | m |
!! v_s | - | Snow volume per unit area | m |
- !! sv_i | - | Sea ice salt content | pss.m |
+ !! sv_i | - | Sea ice salt content (3D) | g/kg.m|
+ !! szv_i | - | Sea ice salt content (4D) | g/kg.m|
!! oa_i | - | Sea ice areal age content | s |
!! e_i | | Ice enthalpy | J/m2 |
!! | e_i_1d | Ice enthalpy per unit vol. | J/m3 |
@@ -78,12 +79,12 @@ MODULE ice
!! |
!! h_i | h_i_1d | Ice thickness | m |
!! h_s ! h_s_1d | Snow depth | m |
- !! s_i ! s_i_1d | Sea ice bulk salinity ! pss |
- !! sz_i ! sz_i_1d | Sea ice salinity profile ! pss |
- !! o_i ! - | Sea ice Age ! s |
- !! t_i ! t_i_1d | Sea ice temperature ! K |
- !! t_s ! t_s_1d | Snow temperature ! K |
- !! t_su ! t_su_1d | Sea ice surface temperature ! K |
+ !! s_i ! s_i_1d | Sea ice bulk salinity | g/kg |
+ !! sz_i ! sz_i_1d | Sea ice salinity profile | g/kg |
+ !! o_i ! - | Sea ice Age | s |
+ !! t_i ! t_i_1d | Sea ice temperature | K |
+ !! t_s ! t_s_1d | Snow temperature | K |
+ !! t_su ! t_su_1d | Sea ice surface temperature | K |
!! h_ip | h_ip_1d | Ice pond thickness | m |
!! h_il | h_il_1d | Ice pond lid thickness | m |
!! |
@@ -103,13 +104,13 @@ MODULE ice
!! at_i | at_i_1d | Total ice concentration | |
!! vt_i | - | Total ice vol. per unit area | m |
!! vt_s | - | Total snow vol. per unit ar. | m |
- !! st_i | - | Total Sea ice salt content | pss.m |
- !! sm_i | - | Mean sea ice salinity | pss |
+ !! st_i | - | Total Sea ice salt content | g/kg.m|
+ !! sm_i | - | Mean sea ice salinity | g/kg |
!! tm_i | - | Mean sea ice temperature | K |
!! tm_s | - | Mean snow temperature | K |
!! et_i | - | Total ice enthalpy | J/m2 |
!! et_s | - | Total snow enthalpy | J/m2 |
- !! bv_i | - | relative brine volume | ??? |
+ !! v_ibr | - | relative brine volume | ??? |
!! at_ip | - | Total ice pond concentration | |
!! hm_ip | - | Mean ice pond depth | m |
!! vt_ip | - | Total ice pond vol. per unit area| m |
@@ -200,7 +201,6 @@ MODULE ice
LOGICAL , PUBLIC :: ln_icedH ! activate ice thickness change from growing/melting (T) or not (F)
LOGICAL , PUBLIC :: ln_icedA ! activate lateral melting param. (T) or not (F)
LOGICAL , PUBLIC :: ln_icedO ! activate ice growth in open-water (T) or not (F)
- LOGICAL , PUBLIC :: ln_icedS ! activate gravity drainage and flushing (T) or not (F)
LOGICAL , PUBLIC :: ln_leadhfx ! heat in the leads is used to melt sea-ice before warming the ocean
!
! !!** namelist (namthd_do) **
@@ -226,8 +226,13 @@ MODULE ice
! ! 2 - prognostic salinity (s(z,t))
! ! 3 - salinity profile, constant in time
REAL(wp), PUBLIC :: rn_icesal !: bulk salinity (ppt) in case of constant salinity
- REAL(wp), PUBLIC :: rn_simax !: maximum ice salinity [PSU]
+ REAL(wp), PUBLIC :: rn_sinew !: fraction of sss that is kept in new ice
REAL(wp), PUBLIC :: rn_simin !: minimum ice salinity [PSU]
+ LOGICAL , PUBLIC :: ln_sal_chk !: sanity checks for salt drainage and flushing
+ INTEGER , PUBLIC :: nn_liquidus !: formulation of liquidus
+ ! 1 = linear liquidus
+ ! 2 = Vancopenolle et al (2019) formulation
+ ! 3 = Weast formulation (used in RJW2014)
! !!** ice-ponds namelist (namthd_pnd)
LOGICAL , PUBLIC :: ln_pnd !: Melt ponds (T) or not (F)
@@ -301,16 +306,16 @@ MODULE ice
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: mass flux from residual component of wfx_ice [kg.m-2.s-1]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice bottom growth [pss.kg.m-2.s-1 => g.m-2.s-1]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice bottom melt [pss.kg.m-2.s-1 => g.m-2.s-1]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_lam !: salt flux due to ice lateral melt [pss.kg.m-2.s-1 => g.m-2.s-1]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice surface melt [pss.kg.m-2.s-1 => g.m-2.s-1]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to snow-ice growth [pss.kg.m-2.s-1 => g.m-2.s-1]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_opw !: salt flux due to growth in open water [pss.kg.m-2.s-1 => g.m-2.s-1]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bri !: salt flux due to brine rejection [pss.kg.m-2.s-1 => g.m-2.s-1]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_dyn !: salt flux due to porous ridged ice formation [pss.kg.m-2.s-1 => g.m-2.s-1]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: salt flux due to correction on ice thick. (residual) [pss.kg.m-2.s-1 => g.m-2.s-1]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sub !: salt flux due to ice sublimation [pss.kg.m-2.s-1 => g.m-2.s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice bottom growth [g/kg.kg.m-2.s-1 => g.m-2.s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice bottom melt [g/kg.kg.m-2.s-1 => g.m-2.s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_lam !: salt flux due to ice lateral melt [g/kg.kg.m-2.s-1 => g.m-2.s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice surface melt [g/kg.kg.m-2.s-1 => g.m-2.s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to snow-ice growth [g/kg.kg.m-2.s-1 => g.m-2.s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_opw !: salt flux due to growth in open water [g/kg.kg.m-2.s-1 => g.m-2.s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bri !: salt flux due to brine rejection [g/kg.kg.m-2.s-1 => g.m-2.s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_dyn !: salt flux due to porous ridged ice formation [g/kg.kg.m-2.s-1 => g.m-2.s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: salt flux due to correction on ice thick. (residual) [g/kg.kg.m-2.s-1 => g.m-2.s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sub !: salt flux due to ice sublimation [g/kg.kg.m-2.s-1 => g.m-2.s-1]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bog !: total heat flux causing bottom ice growth [W.m-2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bom !: total heat flux causing bottom ice melt [W.m-2]
@@ -346,23 +351,23 @@ MODULE ice
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area (m)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_s !: Snow thickness (m)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su !: Sea-Ice Surface Temperature (K)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_i !: Sea-Ice Bulk salinity (pss)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sv_i !: Sea-Ice Bulk salinity * volume per area (pss.m)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_i !: Sea-Ice Bulk salinity (g/kg)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sv_i !: Sea-Ice Bulk salinity * volume per area (g/kg.m)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (s)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (s)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bv_i !: brine volume
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ibr !: brine volume
!! Variables summed over all categories, or associated to all the ice in a single grid cell
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: st_i !: Total ice salinity content (pss.m)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: st_i !: Total ice salinity content (g/kg.m)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content (J/m2)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories (K)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_s !: mean snw temperature over all categories (K)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bvm_i !: brine volume averaged over all categories
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sm_i !: mean sea ice salinity averaged over all categories (pss)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vm_ibr !: brine volume averaged over all categories
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sm_i !: mean sea ice salinity averaged over all categories (g/kg)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_su !: mean surface temperature over all categories (K)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_i !: mean ice thickness over all categories (m)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_s !: mean snow thickness over all categories (m)
@@ -374,7 +379,8 @@ MODULE ice
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow enthalpy [J/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice enthalpy [J/m2]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sz_i !: ice salinity [PSS]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sz_i !: ice salinity [g/kg]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: szv_i !: ice salinity content [g/kg]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip !: melt pond concentration
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip !: melt pond volume per grid cell area [m]
@@ -392,7 +398,7 @@ MODULE ice
! meltwater arrays to save for melt ponds (mv - could be grouped in a single meltwater volume array)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dh_i_sum_2d !: surface melt (2d arrays for ponds) [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dh_s_mlt_2d !: snow surf melt (2d arrays for ponds) [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dh_s_sum_2d !: snow surf melt (2d arrays for ponds) [m]
!!----------------------------------------------------------------------
!! * Global variables at before time step
@@ -401,7 +407,7 @@ MODULE ice
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip_b, v_il_b !: ponds and lids volumes
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_b, sv_i_b !:
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s_b !: snow heat content
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b !: ice temperatures
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b, szv_i_b !: ice temperatures and salt
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice_b, v_ice_b !: ice velocity
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i_b !: ice concentration (total)
@@ -478,16 +484,15 @@ CONTAINS
ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , STAT=ierr(ii) )
ii = ii + 1
- ALLOCATE( h_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , &
- & v_s (jpi,jpj,jpl) , h_s (jpi,jpj,jpl) , &
- & s_i (jpi,jpj,jpl) , sv_i(jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , oa_i (jpi,jpj,jpl) , &
- & a_ip (jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl), &
- & v_il (jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , &
- & t_su (jpi,jpj,jpl) , t_s (jpi,jpj,nlay_s,jpl) , t_i(jpi,jpj,nlay_i,jpl) , sz_i(jpi,jpj,nlay_i,jpl) , &
+ ALLOCATE( h_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , v_s(jpi,jpj,jpl) , &
+ & h_s (jpi,jpj,jpl) , s_i (jpi,jpj,jpl) , sv_i(jpi,jpj,jpl) , o_i(jpi,jpj,jpl) , oa_i(jpi,jpj,jpl) , &
+ & h_ip (jpi,jpj,jpl) , a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , &
+ & h_il (jpi,jpj,jpl) , v_il(jpi,jpj,jpl) , t_su(jpi,jpj,jpl) , &
+ & t_s (jpi,jpj,nlay_s,jpl) , t_i(jpi,jpj,nlay_i,jpl) , sz_i(jpi,jpj,nlay_i,jpl) , &
& ato_i(jpi,jpj) , STAT = ierr(ii) )
ii = ii + 1
- ALLOCATE( e_s(jpi,jpj,nlay_s,jpl) , e_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) )
+ ALLOCATE( e_s(jpi,jpj,nlay_s,jpl) , e_i(jpi,jpj,nlay_i,jpl) , szv_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) )
! * Before values of global variables
ii = ii + 1
@@ -515,14 +520,14 @@ CONTAINS
! -------------------- !
! * Ice global state variables
ii = ii + 1
- ALLOCATE( bv_i(A2D(0),jpl) , a_ip_frac(A2D(0),jpl) , a_ip_eff(A2D(0),jpl) , STAT=ierr(ii) )
+ ALLOCATE( v_ibr(A2D(0),jpl) , a_ip_frac(A2D(0),jpl) , a_ip_eff(A2D(0),jpl) , STAT=ierr(ii) )
! * Before values of global variables
ii = ii + 1
ALLOCATE( at_i_b(A2D(0)) , h_i_b (A2D(0),jpl) , a_i_b(A2D(0),jpl) , v_i_b(A2D(0),jpl) , &
& v_s_b (A2D(0),jpl) , h_s_b (A2D(0),jpl) , &
- & v_ip_b(A2D(0),jpl) , v_il_b(A2D(0),jpl) , &
- & sv_i_b(A2D(0),jpl) , e_i_b (A2D(0),nlay_i,jpl) , e_s_b(A2D(0),nlay_s,jpl) , STAT=ierr(ii) )
+ & v_ip_b(A2D(0),jpl) , v_il_b(A2D(0),jpl) , sv_i_b(A2D(0),jpl) , &
+ & e_i_b (A2D(0),nlay_i,jpl) , e_s_b(A2D(0),nlay_s,jpl) , szv_i_b (A2D(0),nlay_i,jpl) , STAT=ierr(ii) )
! * fluxes
ii = ii + 1
@@ -548,14 +553,14 @@ CONTAINS
! * mean and total
ii = ii + 1
- ALLOCATE( t_bo (A2D(0)) , st_i (A2D(0)) , et_i(A2D(0)) , et_s (A2D(0)) , hm_i (A2D(0)) , &
- & hm_ip(A2D(0)) , hm_il(A2D(0)) , tm_i(A2D(0)) , tm_s (A2D(0)) , &
- & sm_i (A2D(0)) , hm_s (A2D(0)) , om_i(A2D(0)) , bvm_i(A2D(0)) , &
+ ALLOCATE( t_bo (A2D(0)) , st_i (A2D(0)) , et_i(A2D(0)) , et_s (A2D(0)) , hm_i (A2D(0)) , &
+ & hm_ip(A2D(0)) , hm_il(A2D(0)) , tm_i(A2D(0)) , tm_s (A2D(0)) , &
+ & sm_i (A2D(0)) , hm_s (A2D(0)) , om_i(A2D(0)) , vm_ibr(A2D(0)) , &
& tm_su(A2D(0)) , STAT=ierr(ii) )
! * others
ii = ii + 1
- ALLOCATE( tau_icebfr(A2D(0)) , dh_i_sum_2d(A2D(0),jpl) , dh_s_mlt_2d(A2D(0),jpl) , STAT=ierr(ii) )
+ ALLOCATE( tau_icebfr(A2D(0)) , dh_i_sum_2d(A2D(0),jpl) , dh_s_sum_2d(A2D(0),jpl) , STAT=ierr(ii) )
ii = 1
ALLOCATE( ht_i_new (A2D(0)) , fraz_frac (A2D(0)) , STAT=ierr(ii) )
diff --git a/src/ICE/ice1d.F90 b/src/ICE/ice1d.F90
index a0afce7e48e2f62ed193087c2c4f508f91de5dd7..351cad6968031f31f805e445b9f1f846a259654d 100644
--- a/src/ICE/ice1d.F90
+++ b/src/ICE/ice1d.F90
@@ -10,7 +10,7 @@ MODULE ice1D
!!----------------------------------------------------------------------
!! 'key_si3' SI3 sea-ice model
!!----------------------------------------------------------------------
- USE ice , ONLY : nlay_i, nlay_s, jpl ! number of ice/snow layers and categories
+ USE ice , ONLY : nlay_i, nlay_s, jpl, ln_zdf_chkcvg, ln_sal_chk ! number of ice/snow layers and categories
!
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
@@ -113,10 +113,10 @@ MODULE ice1D
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_bom !: Ice bottom ablation [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_bog !: Ice bottom accretion [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_sub !: Ice surface sublimation [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_mlt !: Snow melt [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_sum !: Snow surface melt [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_itm !: Snow internal melt [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_snowice !: Snow ice formation [m of ice]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_1d !: Ice bulk salinity [ppt]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_new !: Salinity of new ice at the bottom
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: v_i_1d !:
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: v_s_1d !:
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sv_i_1d !:
@@ -131,6 +131,7 @@ MODULE ice1D
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_s_1d !: corresponding to the 2D var t_s
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_i_1d !: corresponding to the 2D var t_i
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sz_i_1d !: profiled ice salinity
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: szv_i_1d !: profiled ice salinity content
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e_i_1d !: Ice enthalpy per unit volume
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e_s_1d !: Snow enthalpy per unit volume
@@ -146,6 +147,13 @@ MODULE ice1D
! convergence check
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tice_cvgerr_1d !: convergence of ice/snow temp (dT) [K]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tice_cvgstp_1d !: convergence of ice/snow temp (subtimestep) [-]
+
+ ! sanity checks for salinity
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_drain_dserr_1d, s_flush_dserr_1d
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_drain_dserr_1d, t_flush_dserr_1d
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_drain_serr_1d , s_flush_serr_1d
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_drain_serr_1d , t_flush_serr_1d
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cfl_drain_1d , cfl_flush_1d
!
!!----------------------
!! * 2D Module variables
@@ -167,6 +175,7 @@ MODULE ice1D
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_i_2d
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_s_2d
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: szv_i_2d
!!----------------------------------------------------------------------
!! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -180,7 +189,7 @@ CONTAINS
!! *** ROUTINE ice1D_alloc ***
!!---------------------------------------------------------------------!
INTEGER :: ice1D_alloc ! return value
- INTEGER :: ierr(12), ii
+ INTEGER :: ierr(15), ii
!!---------------------------------------------------------------------!
ierr(:) = 0
ii = 0
@@ -193,7 +202,7 @@ CONTAINS
& s_i_1d (jpij) , sv_i_1d(jpij) , o_i_1d (jpij) , oa_i_1d (jpij) , &
& a_ip_1d (jpij) , v_ip_1d(jpij) , h_ip_1d (jpij) , &
& v_il_1d (jpij) , h_il_1d(jpij) , &
- & t_su_1d (jpij) , t_s_1d (jpij,nlay_s) , t_i_1d (jpij,nlay_i), sz_i_1d(jpij,nlay_i) , &
+ & t_su_1d (jpij) , t_s_1d (jpij,nlay_s) , t_i_1d (jpij,nlay_i), sz_i_1d(jpij,nlay_i) , szv_i_1d(jpij,nlay_i) , &
& ato_i_1d(jpij) , STAT=ierr(ii) )
ii = ii + 1
ALLOCATE( e_i_1d(jpij,nlay_i) , e_s_1d(jpij,nlay_s) , STAT=ierr(ii) )
@@ -233,15 +242,13 @@ CONTAINS
! * thermo tickness change
ii = ii + 1
- ALLOCATE( dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm (jpij) , dh_i_bom(jpij) , dh_i_bog(jpij) , &
- & dh_i_sub(jpij) , dh_s_mlt(jpij) , dh_snowice(jpij) , STAT=ierr(ii) )
+ ALLOCATE( dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm(jpij) , dh_i_bom (jpij) , dh_i_bog(jpij) , &
+ & dh_i_sub(jpij) , dh_s_sum(jpij) , dh_s_itm(jpij) , dh_snowice(jpij) , STAT=ierr(ii) )
! * other
ii = ii + 1
- ALLOCATE( at_i_1d(jpij) , rn_amax_1d(jpij) , t_si_1d(jpij) , t_bo_1d (jpij) , &
- & s_i_new(jpij) , sst_1d (jpij) , sss_1d (jpij) , frq_m_1d(jpij) , STAT=ierr(ii) )
- ii = ii + 1
- ALLOCATE( tice_cvgerr_1d(jpij) , tice_cvgstp_1d(jpij) , STAT=ierr(ii) )
+ ALLOCATE( at_i_1d(jpij) , rn_amax_1d(jpij) , t_si_1d (jpij) , t_bo_1d (jpij) , &
+ & sst_1d (jpij) , sss_1d (jpij) , frq_m_1d(jpij) , STAT=ierr(ii) )
!
! * 2d arrays
ii = ii + 1
@@ -252,8 +259,22 @@ CONTAINS
!
! * 3d arrays
ii = ii + 1
- ALLOCATE( e_i_2d(jpij,nlay_i,jpl) , e_s_2d(jpij,nlay_s,jpl) , STAT=ierr(ii) )
+ ALLOCATE( e_i_2d(jpij,nlay_i,jpl) , e_s_2d(jpij,nlay_s,jpl) , szv_i_2d(jpij,nlay_i,jpl) , STAT=ierr(ii) )
+ ! * checks
+ IF( ln_zdf_chkcvg ) THEN
+ ii = ii + 1
+ ALLOCATE( tice_cvgerr_1d (jpij) , tice_cvgstp_1d (jpij) , STAT=ierr(ii) )
+ ENDIF
+ IF( ln_sal_chk ) THEN
+ ii = ii + 1
+ ALLOCATE( s_drain_dserr_1d(jpij), s_flush_dserr_1d(jpij), &
+ & s_drain_serr_1d (jpij), s_flush_serr_1d (jpij), cfl_drain_1d(jpij), cfl_flush_1d(jpij), STAT=ierr(ii) )
+ ii = ii + 1
+ ALLOCATE( t_drain_dserr_1d(jpij,nlay_i), t_flush_dserr_1d(jpij,nlay_i), &
+ & t_drain_serr_1d (jpij,nlay_i), t_flush_serr_1d (jpij,nlay_i), STAT=ierr(ii) )
+ ENDIF
+
ice1D_alloc = MAXVAL( ierr(:) )
IF( ice1D_alloc /= 0 ) CALL ctl_stop( 'STOP', 'ice1D_alloc: failed to allocate arrays.' )
!
diff --git a/src/ICE/icecor.F90 b/src/ICE/icecor.F90
index d208956073a61380341c2e2c43dfd49d49d5f946..d164e472f807c629c39641436f5e89fe25204e72 100644
--- a/src/ICE/icecor.F90
+++ b/src/ICE/icecor.F90
@@ -20,6 +20,7 @@ MODULE icecor
USE iceitd ! sea-ice: rebining
USE icevar ! sea-ice: operations
USE icectl ! sea-ice: control prints
+ USE sbc_oce, ONLY : sss_m
!
USE in_out_manager ! I/O manager
USE iom ! I/O manager library
@@ -51,8 +52,8 @@ CONTAINS
INTEGER, INTENT(in) :: kt ! number of iteration
INTEGER, INTENT(in) :: kn ! 1 = after dyn ; 2 = after thermo
!
- INTEGER :: ji, jj, jl ! dummy loop indices
- REAL(wp) :: zsal, zzc
+ INTEGER :: ji, jj, jk, jl ! dummy loop indices
+ REAL(wp) :: zsal
!!----------------------------------------------------------------------
! controls
IF( ln_timing ) CALL timing_start('icecor') ! timing
@@ -88,17 +89,27 @@ CONTAINS
IF( jpl > 1 ) CALL ice_itd_reb( kt )
!
! !-----------------------------------------------------
- IF ( nn_icesal == 2 ) THEN ! salinity must stay in bounds [Simin,Simax] !
- ! !-----------------------------------------------------
- zzc = rhoi * r1_Dt_ice
+ ! ! salinity must stay in bounds [Simin,Simax] !
+ ! !-----------------------------------------------------
+ IF ( nn_icesal == 2 ) THEN
DO jl = 1, jpl
DO_2D( 0, 0, 0, 0 )
zsal = sv_i(ji,jj,jl)
- sv_i(ji,jj,jl) = MIN( MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl) )
+ sv_i(ji,jj,jl) = MIN( MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_sinew*sss_m(ji,jj)*v_i(ji,jj,jl) )
IF( kn /= 0 ) & ! no ice-ocean exchanges if kn=0 (for bdy for instance) otherwise conservation diags will fail
- & sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc ! associated salt flux
+ & sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * rhoi * r1_Dt_ice ! associated salt flux
END_2D
END DO
+ ELSEIF ( nn_icesal == 4 ) THEN
+ DO jl = 1, jpl
+ DO_3D( 0, 0, 0, 0, 1, nlay_i )
+ zsal = szv_i(ji,jj,jk,jl)
+ szv_i(ji,jj,jk,jl) = MIN( MAX( szv_i(ji,jj,jk,jl) , rn_simin * v_i(ji,jj,jl) * r1_nlay_i ) , &
+ & rn_sinew*sss_m(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i )
+ IF( kn /= 0 ) & ! no ice-ocean exchanges if kn=0 (for bdy for instance) otherwise conservation diags will fail
+ & sfx_res(ji,jj) = sfx_res(ji,jj) - ( szv_i(ji,jj,jk,jl) - zsal ) * rhoi * r1_Dt_ice ! associated salt flux
+ END_3D
+ END DO
ENDIF
!
IF( kn /= 0 ) THEN ! no zapsmall if kn=0 (for bdy for instance) because we do not want ice-ocean exchanges (wfx,sfx,hfx)
diff --git a/src/ICE/icectl.F90 b/src/ICE/icectl.F90
index a235e05626a3fbf91f8f58d664fd4ee1e268c396..67f7b5e27ce1e51f84205c11ae085a6b35c87982 100644
--- a/src/ICE/icectl.F90
+++ b/src/ICE/icectl.F90
@@ -89,21 +89,26 @@ CONTAINS
REAL(wp), DIMENSION(A2D(0),jpl,8) :: ztmp4
REAL(wp), DIMENSION(10) :: zchk3
REAL(wp), DIMENSION(8) :: zchk4
+ REAL(wp), DIMENSION(A2D(0),jpl) :: zsv_i
!!-------------------------------------------------------------------
+ IF( nn_icesal == 4 ) THEN
+ zsv_i(:,:,:) = SUM( szv_i(A2D(0),:,:), dim=3 )
+ ELSE
+ zsv_i(:,:,:) = sv_i(A2D(0),:)
+ ENDIF
!
DO_2D( 0, 0, 0, 0 )
! -- quantities -- !
- ztmp3(ji,jj,1) = SUM( v_i(ji,jj,:) * rhoi + v_s(ji,jj,:) * rhos + &
- & ( v_ip(ji,jj,:) + v_il(ji,jj,:) ) * rhow ) * e1e2t(ji,jj) ! volume
- ztmp3(ji,jj,2) = SUM( sv_i(ji,jj,:) * rhoi ) * e1e2t(ji,jj) ! salt
- ztmp3(ji,jj,3) = ( SUM( SUM( e_i(ji,jj,:,:), dim=2 ) ) + & ! heat
- & SUM( SUM( e_s(ji,jj,:,:), dim=2 ) ) ) * e1e2t(ji,jj)
+ ztmp3(ji,jj,1) = SUM( v_i (ji,jj,:) * rhoi + v_s (ji,jj,:) * rhos + &
+ & ( v_ip(ji,jj,:) + v_il(ji,jj,:) ) * rhow ) * e1e2t(ji,jj) ! mass
+ ztmp3(ji,jj,2) = SUM( zsv_i(ji,jj,:) ) * rhoi * e1e2t(ji,jj) ! salt
+ ztmp3(ji,jj,3) = ( SUM( SUM( e_i(ji,jj,:,:), dim=2 ) ) + SUM( SUM( e_s(ji,jj,:,:), dim=2 ) ) ) * e1e2t(ji,jj) ! heat
!
! -- fluxes -- !
ztmp3(ji,jj,4) = ( wfx_bog (ji,jj) + wfx_bom (ji,jj) + wfx_sum (ji,jj) + wfx_sni (ji,jj) & ! mass
& + wfx_opw (ji,jj) + wfx_res (ji,jj) + wfx_dyn (ji,jj) + wfx_lam (ji,jj) + wfx_pnd(ji,jj) &
& + wfx_snw_sni(ji,jj) + wfx_snw_sum(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sub(ji,jj) &
- & + wfx_ice_sub(ji,jj) + wfx_spr(ji,jj) ) * e1e2t(ji,jj)
+ & + wfx_ice_sub(ji,jj) + wfx_spr (ji,jj) ) * e1e2t(ji,jj)
ztmp3(ji,jj,5) = ( sfx_bri(ji,jj) + sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj) & ! salt
& + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) ) * e1e2t(ji,jj)
ztmp3(ji,jj,6) = ( hfx_sum(ji,jj) + hfx_bom(ji,jj) + hfx_bog(ji,jj) + hfx_dif(ji,jj) + hfx_opw(ji,jj) + hfx_snw(ji,jj) & ! heat
@@ -147,12 +152,12 @@ CONTAINS
! -- min diags -- !
DO jl = 1, jpl
DO_2D( 0, 0, 0, 0 )
- ztmp4(ji,jj,jl,1) = v_i(ji,jj,jl)
- ztmp4(ji,jj,jl,2) = v_s(ji,jj,jl)
- ztmp4(ji,jj,jl,3) = v_ip(ji,jj,jl)
- ztmp4(ji,jj,jl,4) = v_il(ji,jj,jl)
- ztmp4(ji,jj,jl,5) = a_i(ji,jj,jl)
- ztmp4(ji,jj,jl,6) = sv_i(ji,jj,jl)
+ ztmp4(ji,jj,jl,1) = v_i (ji,jj,jl)
+ ztmp4(ji,jj,jl,2) = v_s (ji,jj,jl)
+ ztmp4(ji,jj,jl,3) = v_ip (ji,jj,jl)
+ ztmp4(ji,jj,jl,4) = v_il (ji,jj,jl)
+ ztmp4(ji,jj,jl,5) = a_i (ji,jj,jl)
+ ztmp4(ji,jj,jl,6) = zsv_i(ji,jj,jl)
ztmp4(ji,jj,jl,7) = SUM( e_i(ji,jj,:,jl) )
ztmp4(ji,jj,jl,8) = SUM( e_s(ji,jj,:,jl) )
END_2D
@@ -208,6 +213,7 @@ CONTAINS
REAL(wp), DIMENSION(A2D(0),4) :: ztmp
REAL(wp), DIMENSION(4) :: zchk
!!-------------------------------------------------------------------
+
DO_2D( 0, 0, 0, 0 )
!
ztmp(ji,jj,1) = ( wfx_ice (ji,jj) + wfx_snw (ji,jj) + wfx_pnd (ji,jj) + wfx_spr(ji,jj) + wfx_sub(ji,jj) &
@@ -255,20 +261,26 @@ CONTAINS
LOGICAL :: ll_stop_s = .FALSE.
LOGICAL :: ll_stop_t = .FALSE.
CHARACTER(len=120) :: clnam ! filename for the output
+ REAL(wp), DIMENSION(A2D(0)) :: zsv_i
!!-------------------------------------------------------------------
+ IF( nn_icesal == 4 ) THEN
+ zsv_i(:,:) = SUM( SUM( szv_i(A2D(0),:,:), dim=4 ), dim=3 )
+ ELSE
+ zsv_i(:,:) = SUM( sv_i(A2D(0),:), dim=3 )
+ ENDIF
!
IF( icount == 0 ) THEN
DO_2D( 0, 0, 0, 0 )
pdiag_v(ji,jj) = SUM( v_i(ji,jj,:) * rhoi + v_s(ji,jj,:) * rhos + ( v_ip(ji,jj,:) + v_il(ji,jj,:) ) * rhow )
- pdiag_s(ji,jj) = SUM( sv_i(ji,jj,:) * rhoi )
+ pdiag_s(ji,jj) = zsv_i(ji,jj) * rhoi
pdiag_t(ji,jj) = SUM( SUM( e_i(ji,jj,:,:), dim=2 ) ) + SUM( SUM( e_s(ji,jj,:,:), dim=2 ) )
! mass flux
pdiag_fv(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) &
& + wfx_opw(ji,jj) + wfx_res(ji,jj) + wfx_dyn(ji,jj) + wfx_lam(ji,jj) + wfx_pnd (ji,jj) &
& + wfx_snw_sni(ji,jj) + wfx_snw_sum(ji,jj) + wfx_snw_dyn(ji,jj) &
- & + wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) + wfx_spr(ji,jj)
+ & + wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) + wfx_spr (ji,jj)
! salt flux
pdiag_fs(ji,jj) = sfx_bri(ji,jj) + sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) &
& + sfx_opw(ji,jj) + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj)
@@ -286,14 +298,14 @@ CONTAINS
& + ( wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) + wfx_opw(ji,jj) &
& + wfx_res(ji,jj) + wfx_dyn(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj) &
& + wfx_snw_sni(ji,jj) + wfx_snw_sum(ji,jj) + wfx_snw_dyn(ji,jj) &
- & + wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) + wfx_spr(ji,jj) ) &
+ & + wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) + wfx_spr (ji,jj) ) &
& - pdiag_fv(ji,jj)
END_2D
IF( MAXVAL( ABS(zdiag_mass) ) > rchk_m * rn_icechk_cel ) ll_stop_m = .TRUE.
!
! -- salt diag -- !
DO_2D( 0, 0, 0, 0 )
- zdiag_salt(ji,jj) = ( SUM( sv_i(ji,jj,:) * rhoi ) - pdiag_s(ji,jj) ) * r1_Dt_ice &
+ zdiag_salt(ji,jj) = ( zsv_i (ji,jj) * rhoi - pdiag_s(ji,jj) ) * r1_Dt_ice &
& + ( sfx_bri(ji,jj) + sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) &
& + sfx_opw(ji,jj) + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) ) &
& - pdiag_fs(ji,jj)
@@ -406,7 +418,14 @@ CONTAINS
REAL(wp) :: ztmelts ! ice layer melting point
CHARACTER (len=30), DIMENSION(20) :: cl_alname ! name of alert
INTEGER , DIMENSION(20) :: inb_alp ! number of alerts positive
+ REAL(wp), DIMENSION(A2D(0),jpl) :: zsv_i
!!-------------------------------------------------------------------
+ IF( nn_icesal == 4 ) THEN
+ zsv_i(:,:,:) = SUM( szv_i(A2D(0),:,:), dim=3 )
+ ELSE
+ zsv_i(:,:,:) = sv_i(A2D(0),:)
+ ENDIF
+ !
inb_alp(:) = 0
ialert_id = 0
@@ -416,8 +435,8 @@ CONTAINS
DO jl = 1, jpl
DO_2D( 0, 0, 0, 0 )
IF( v_i(ji,jj,jl) > epsi10 ) THEN
- IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN
- WRITE(numout,*) ' ALERTE : Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl)
+ IF( zsv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_sinew * sss_m(ji,jj) ) THEN
+ WRITE(numout,*) ' ALERTE : Very high salinity ',zsv_i(ji,jj,jl)/v_i(ji,jj,jl)
WRITE(numout,*) ' at i,j,l = ',ji,jj,jl
inb_alp(ialert_id) = inb_alp(ialert_id) + 1
ENDIF
@@ -431,8 +450,8 @@ CONTAINS
DO jl = 1, jpl
DO_2D( 0, 0, 0, 0 )
IF( v_i(ji,jj,jl) > epsi10 ) THEN
- IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN
- WRITE(numout,*) ' ALERTE : Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl)
+ IF( zsv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN
+ WRITE(numout,*) ' ALERTE : Very low salinity ',zsv_i(ji,jj,jl),v_i(ji,jj,jl)
WRITE(numout,*) ' at i,j,l = ',ji,jj,jl
inb_alp(ialert_id) = inb_alp(ialert_id) + 1
ENDIF
diff --git a/src/ICE/icedyn.F90 b/src/ICE/icedyn.F90
index 8ea874d6f968762021ab3a56812e14b0ad2b6b26..63450e697eb04cf402b5cef925d6a52f6d9a383f 100644
--- a/src/ICE/icedyn.F90
+++ b/src/ICE/icedyn.F90
@@ -186,7 +186,7 @@ CONTAINS
CALL lbc_lnk( 'icedyn', a_i , 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, &
& t_su, 'T', 1._wp, ldfull = .TRUE. )
ENDIF
- CALL lbc_lnk( 'icedyn', e_i, 'T', 1._wp, e_s, 'T', 1._wp, ldfull = .TRUE. )
+ CALL lbc_lnk( 'icedyn', e_i, 'T', 1._wp, e_s, 'T', 1._wp, szv_i, 'T', 1._wp, ldfull = .TRUE. )
! controls
IF( ln_timing ) CALL timing_stop ('ice_dyn')
diff --git a/src/ICE/icedyn_adv.F90 b/src/ICE/icedyn_adv.F90
index 6afabac00bcf4adc66c8cbd98cfb577df3151843..0f37084a857a643fe3c1dca768792aefc446483e 100644
--- a/src/ICE/icedyn_adv.F90
+++ b/src/ICE/icedyn_adv.F90
@@ -82,22 +82,26 @@ CONTAINS
CASE( np_advUMx ) ! ULTIMATE-MACHO scheme !
! !-----------------------!
CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice, h_i, h_s, h_ip, &
- & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i )
+ & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i, szv_i )
! !-----------------------!
CASE( np_advPRA ) ! PRATHER scheme !
! !-----------------------!
CALL ice_dyn_adv_pra( kt, u_ice, v_ice, h_i, h_s, h_ip, &
- & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i )
+ & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i, szv_i )
END SELECT
!------------
! diagnostics
!------------
- diag_trp_ei(:,:) = SUM(SUM( e_i (A2D(0),1:nlay_i,:) - e_i_b (A2D(0),1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice
- diag_trp_es(:,:) = SUM(SUM( e_s (A2D(0),1:nlay_s,:) - e_s_b (A2D(0),1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice
- diag_trp_sv(:,:) = SUM( sv_i(A2D(0),:) - sv_i_b(A2D(0),:) , dim=3 ) * r1_Dt_ice
- diag_trp_vi(:,:) = SUM( v_i (A2D(0),:) - v_i_b (A2D(0),:) , dim=3 ) * r1_Dt_ice
- diag_trp_vs(:,:) = SUM( v_s (A2D(0),:) - v_s_b (A2D(0),:) , dim=3 ) * r1_Dt_ice
+ diag_trp_ei(:,:) = SUM(SUM( e_i (A2D(0),:,:) - e_i_b (A2D(0),:,:), dim=4 ), dim=3 ) * r1_Dt_ice
+ diag_trp_es(:,:) = SUM(SUM( e_s (A2D(0),:,:) - e_s_b (A2D(0),:,:), dim=4 ), dim=3 ) * r1_Dt_ice
+ IF( nn_icesal == 4 ) THEN
+ diag_trp_sv(:,:) = SUM(SUM( szv_i(A2D(0),:,:) - szv_i_b(A2D(0),:,:), dim=4 ), dim=3 ) * r1_Dt_ice
+ ELSE
+ diag_trp_sv(:,:) = SUM( sv_i (A2D(0),:) - sv_i_b (A2D(0),:) , dim=3 ) * r1_Dt_ice
+ ENDIF
+ diag_trp_vi(:,:) = SUM( v_i (A2D(0),:) - v_i_b (A2D(0),:) , dim=3 ) * r1_Dt_ice
+ diag_trp_vs(:,:) = SUM( v_s (A2D(0),:) - v_s_b (A2D(0),:) , dim=3 ) * r1_Dt_ice
IF( iom_use('icemtrp') ) CALL iom_put( 'icemtrp' , diag_trp_vi * rhoi ) ! ice mass transport
IF( iom_use('snwmtrp') ) CALL iom_put( 'snwmtrp' , diag_trp_vs * rhos ) ! snw mass transport
IF( iom_use('salmtrp') ) CALL iom_put( 'salmtrp' , diag_trp_sv * rhoi * 1.e-03 ) ! salt mass transport (kg/m2/s)
diff --git a/src/ICE/icedyn_adv_pra.F90 b/src/ICE/icedyn_adv_pra.F90
index 7ad39b053816aeb5f6d3e879b0de8ee93e323ece..5a3ff037ca11ac514da4e07040c4c30b7bc3300a 100644
--- a/src/ICE/icedyn_adv_pra.F90
+++ b/src/ICE/icedyn_adv_pra.F90
@@ -41,6 +41,7 @@ MODULE icedyn_adv_pra
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxage, syage, sxxage, syyage, sxyage ! ice age
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxc0 , syc0 , sxxc0 , syyc0 , sxyc0 ! snow layers heat content
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxe , sye , sxxe , syye , sxye ! ice layers heat content
+ REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxsi , sysi , sxxsi , syysi , sxysi ! ice layers salt content
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxap , syap , sxxap , syyap , sxyap ! melt pond fraction
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxvp , syvp , sxxvp , syyvp , sxyvp ! melt pond volume
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxvl , syvl , sxxvl , syyvl , sxyvl ! melt pond lid volume
@@ -55,7 +56,7 @@ MODULE icedyn_adv_pra
CONTAINS
SUBROUTINE ice_dyn_adv_pra( kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip, &
- & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i )
+ & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i )
!!----------------------------------------------------------------------
!! ** routine ice_dyn_adv_pra **
!!
@@ -84,28 +85,36 @@ CONTAINS
REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_il ! melt pond lid thickness
REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content
REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pszv_i ! ice salt content
!
INTEGER :: ji, jj, jk, jl, jt, ihls ! dummy loop indices
INTEGER :: icycle ! number of sub-timestep for the advection
REAL(wp) :: zdt, z1_dt ! - -
REAL(wp) :: zati2
REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication
- REAL(wp), DIMENSION(jpi,jpj) :: zati1
+ REAL(wp), DIMENSION(A2D(0)) :: zati1
REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx
- REAL(wp), DIMENSION(jpi,jpj) :: zh_i, zh_s, zh_ip, zs_i, zhi_max, zhs_max, zhip_max, zsi_max
- REAL(wp), DIMENSION(jpi,jpj,nlay_i) :: ze_i, zei_max
+ REAL(wp), DIMENSION(jpi,jpj) :: zh_i, zh_s, zhi_max, zhs_max, zhip_max, zsi_max
+ REAL(wp), DIMENSION(jpi,jpj,nlay_i) :: ze_i, zei_max, zszi_max
REAL(wp), DIMENSION(jpi,jpj,nlay_s) :: ze_s, zes_max
REAL(wp), DIMENSION(jpi,jpj) :: zarea
- REAL(wp), DIMENSION(jpi,jpj) :: z0ice, z0snw, z0ai, z0smi, z0oi
- REAL(wp), DIMENSION(jpi,jpj) :: z0ap , z0vp, z0vl
+ REAL(wp), DIMENSION(jpi,jpj) :: z0ice, z0snw, z0ai, z0oi
REAL(wp), DIMENSION(jpi,jpj,nlay_s) :: z0es
REAL(wp), DIMENSION(jpi,jpj,nlay_i) :: z0ei
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z0ap , z0vp, z0vl, zh_ip
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z0smi, zs_i
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z0si , zsz_i
!! diagnostics
REAL(wp), DIMENSION(A2D(0)) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat
!!----------------------------------------------------------------------
!
IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme'
!
+ IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) ALLOCATE( z0ap(jpi,jpj), z0vp(jpi,jpj), z0vl(jpi,jpj), zh_ip(jpi,jpj) )
+ IF( nn_icesal == 4 ) THEN ; ALLOCATE( z0si (jpi,jpj,nlay_i), zsz_i(jpi,jpj,nlay_i) )
+ ELSE ; ALLOCATE( z0smi(jpi,jpj) , zs_i (jpi,jpj) )
+ ENDIF
+
! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- !
! Note: the advection split is applied at the next time-step in order to avoid blocking global comm.
! this should not affect too much the stability
@@ -128,38 +137,35 @@ CONTAINS
! --- transport --- !
zudy(:,:) = pu_ice(:,:) * e2u(:,:)
zvdx(:,:) = pv_ice(:,:) * e1v(:,:)
-
+
!---------------!
!== advection ==!
!---------------!
DO jt = 1, icycle
+ ! record at_i before advection (for open water)
+ zati1(:,:) = SUM( pa_i(A2D(0),:), dim=3 )
+
IF( icycle == 1 ) THEN ; ihls = 0 ! optimization
ELSE ; ihls = MAX( 0, nn_hls - jt )
ENDIF
!
- ! record at_i before advection (for open water)
- DO_2D( ihls, ihls, ihls, ihls )
- zati1(ji,jj) = SUM( pa_i(ji,jj,:) )
- END_2D
- !
! ! =================== !
! ! Start cat loop here !
! ! =================== !
DO jl = 1, jpl
! --- Record max of the surrounding 9-pts (for call Hbig) --- !
- ! thickness and salinity
+ ! thickness
zh_i (:,:) = ph_i (:,:,jl)
zh_s (:,:) = ph_s (:,:,jl)
- zh_ip(:,:) = ph_ip(:,:,jl)
- WHERE( pv_i(:,:,jl) >= epsi10 ) ; zs_i(:,:) = psv_i(:,:,jl) / pv_i(:,:,jl)
- ELSEWHERE ; zs_i(:,:) = 0._wp
- END WHERE
CALL icemax2D_pra( ihls, zh_i , zhi_max )
CALL icemax2D_pra( ihls, zh_s , zhs_max )
- CALL icemax2D_pra( ihls, zh_ip, zhip_max)
- CALL icemax2D_pra( ihls, zs_i , zsi_max )
+
+ IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
+ zh_ip(:,:) = ph_ip(:,:,jl)
+ CALL icemax2D_pra( ihls, zh_ip, zhip_max)
+ ENDIF
!
! enthalpies
DO jk = 1, nlay_i
@@ -174,41 +180,72 @@ CONTAINS
END DO
CALL icemax3D_pra( ihls, ze_i , zei_max )
CALL icemax3D_pra( ihls, ze_s , zes_max )
-
+ !
+ ! salt content
+ IF( nn_icesal == 4 ) THEN
+ !
+ DO jk = 1, nlay_i
+ WHERE( pv_i(:,:,jl) >= epsi10 ) ; zsz_i(:,:,jk) = pszv_i(:,:,jk,jl) / pv_i(:,:,jl)
+ ELSEWHERE ; zsz_i(:,:,jk) = 0._wp
+ END WHERE
+ END DO
+ CALL icemax3D_pra( ihls, zsz_i , zszi_max )
+ !
+ ELSE
+ !
+ WHERE( pv_i(:,:,jl) >= epsi10 ) ; zs_i(:,:) = psv_i(:,:,jl) / pv_i(:,:,jl)
+ ELSEWHERE ; zs_i(:,:) = 0._wp
+ END WHERE
+ CALL icemax2D_pra( ihls, zs_i , zsi_max )
+ !
+ ENDIF
+
! diagnostics
DO_2D( 0, 0, 0, 0 )
zdiag_adv_mass(ji,jj) = pv_i (ji,jj,jl) * rhoi + pv_s (ji,jj,jl) * rhos &
& + pv_ip(ji,jj,jl) * rhow + pv_il(ji,jj,jl) * rhow
- zdiag_adv_salt(ji,jj) = psv_i(ji,jj,jl) * rhoi
zdiag_adv_heat(ji,jj) = - SUM( pe_i(ji,jj,1:nlay_i,jl) ) - SUM( pe_s(ji,jj,1:nlay_s,jl) )
END_2D
+ IF( nn_icesal == 4 ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ zdiag_adv_salt(ji,jj) = SUM( pszv_i(ji,jj,1:nlay_i,jl) ) * rhoi
+ END_2D
+ ELSE
+ DO_2D( 0, 0, 0, 0 )
+ zdiag_adv_salt(ji,jj) = psv_i(ji,jj,jl) * rhoi
+ END_2D
+ ENDIF
!
! --- transported fields --- !
DO_2D( ihls+1, ihls+1, ihls+1, ihls+1 )
zarea(ji,jj) = e1e2t(ji,jj)
- z0snw(ji,jj) = pv_s (ji,jj,jl) * e1e2t(ji,jj) ! Snow volume
- z0ice(ji,jj) = pv_i (ji,jj,jl) * e1e2t(ji,jj) ! Ice volume
- z0ai (ji,jj) = pa_i (ji,jj,jl) * e1e2t(ji,jj) ! Ice area
- z0smi(ji,jj) = psv_i(ji,jj,jl) * e1e2t(ji,jj) ! Salt content
- z0oi (ji,jj) = poa_i(ji,jj,jl) * e1e2t(ji,jj) ! Age content
- DO jk = 1, nlay_s
- z0es(ji,jj,jk) = pe_s(ji,jj,jk,jl) * e1e2t(ji,jj) ! Snow heat content
- END DO
- DO jk = 1, nlay_i
- z0ei(ji,jj,jk) = pe_i(ji,jj,jk,jl) * e1e2t(ji,jj) ! Ice heat content
- END DO
+ z0snw(ji,jj) = pv_s (ji,jj,jl) * e1e2t(ji,jj) ! Snow volume
+ z0ice(ji,jj) = pv_i (ji,jj,jl) * e1e2t(ji,jj) ! Ice volume
+ z0ai (ji,jj) = pa_i (ji,jj,jl) * e1e2t(ji,jj) ! Ice area
+ z0oi (ji,jj) = poa_i(ji,jj,jl) * e1e2t(ji,jj) ! Age content
END_2D
+ DO_3D( ihls+1, ihls+1, ihls+1, ihls+1, 1, nlay_s )
+ z0es(ji,jj,jk) = pe_s(ji,jj,jk,jl) * e1e2t(ji,jj) ! Snow heat content
+ END_3D
+ DO_3D( ihls+1, ihls+1, ihls+1, ihls+1, 1, nlay_i )
+ z0ei(ji,jj,jk) = pe_i (ji,jj,jk,jl) * e1e2t(ji,jj) ! Ice heat content
+ END_3D
+ IF( nn_icesal == 4 ) THEN
+ DO_3D( ihls+1, ihls+1, ihls+1, ihls+1, 1, nlay_i )
+ z0si(ji,jj,jk) = pszv_i(ji,jj,jk,jl) * e1e2t(ji,jj) ! Ice salt content
+ END_3D
+ ELSE
+ DO_2D( ihls+1, ihls+1, ihls+1, ihls+1 )
+ z0smi(ji,jj) = psv_i(ji,jj,jl) * e1e2t(ji,jj)
+ END_2D
+ ENDIF
IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
DO_2D( ihls+1, ihls+1, ihls+1, ihls+1 )
- z0ap(ji,jj) = pa_ip(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond fraction
- z0vp(ji,jj) = pv_ip(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond volume
+ z0ap(ji,jj) = pa_ip(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond fraction
+ z0vp(ji,jj) = pv_ip(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond volume
+ z0vl(ji,jj) = pv_il(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond lid volume
END_2D
- IF ( ln_pnd_lids ) THEN
- DO_2D( ihls+1, ihls+1, ihls+1, ihls+1 )
- z0vl(ji,jj) = pv_il(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond lid volume
- END_2D
- ENDIF
ENDIF
!
! ----------------------- !
@@ -217,74 +254,102 @@ CONTAINS
! !--------------------------------------------!
IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==!
! !--------------------------------------------!
- CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume
+ ! ---------------------- !
+ ! == mandatory fields == !
+ ! ---------------------- !
+ CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume
CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice )
- CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume
+ CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume
CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn )
- CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity
- CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal )
- CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration
+ CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration
CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya )
- CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age
+ CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age
CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage )
!
- DO jk = 1, nlay_s !--- snow heat content
+ DO jk = 1, nlay_s !--- snow heat content
CALL adv_x( ihls, jl, zdt, zudy, 1._wp, zarea, z0es (:,:,jk) , sxc0(:,:,jk,:), &
& sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
CALL adv_y( ihls, jl, zdt, zvdx, 0._wp, zarea, z0es (:,:,jk) , sxc0(:,:,jk,:), &
& sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
END DO
- DO jk = 1, nlay_i !--- ice heat content
+ DO jk = 1, nlay_i !--- ice heat content
CALL adv_x( ihls, jl, zdt, zudy, 1._wp, zarea, z0ei(:,:,jk) , sxe(:,:,jk,:), &
& sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
CALL adv_y( ihls, jl, zdt, zvdx, 0._wp, zarea, z0ei(:,:,jk) , sxe(:,:,jk,:), &
& sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
END DO
+ ! --------------------- !
+ ! == optional fields == !
+ ! --------------------- !
+ IF( nn_icesal == 4 ) THEN
+ DO jk = 1, nlay_i !--- ice salt content
+ CALL adv_x( ihls, jl, zdt, zudy, 1._wp, zarea, z0si(:,:,jk) , sxsi (:,:,jk,:), &
+ & sxxsi(:,:,jk,:), sysi(:,:,jk,:), syysi(:,:,jk,:), sxysi(:,:,jk,:) )
+ CALL adv_y( ihls, jl, zdt, zvdx, 0._wp, zarea, z0si(:,:,jk) , sxsi (:,:,jk,:), &
+ & sxxsi(:,:,jk,:), sysi(:,:,jk,:), syysi(:,:,jk,:), sxysi(:,:,jk,:) )
+ END DO
+ ELSE
+ CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity
+ CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal )
+ ENDIF
!
IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
- CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction
+ CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction
CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )
- CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume
+ CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume
CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )
- IF ( ln_pnd_lids ) THEN
- CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume
- CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )
- ENDIF
+ CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume
+ CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )
ENDIF
! !--------------------------------------------!
ELSE !== even ice time step: adv_y then adv_x ==!
! !--------------------------------------------!
- CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume
+ ! ---------------------- !
+ ! == mandatory fields == !
+ ! ---------------------- !
+ CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume
CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice )
- CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume
+ CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume
CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn )
- CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity
- CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal )
- CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration
+ CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration
CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya )
- CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age
+ CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age
CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage )
- DO jk = 1, nlay_s !--- snow heat content
+ !
+ DO jk = 1, nlay_s !--- snow heat content
CALL adv_y( ihls, jl, zdt, zvdx, 1._wp, zarea, z0es (:,:,jk) , sxc0(:,:,jk,:), &
& sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
CALL adv_x( ihls, jl, zdt, zudy, 0._wp, zarea, z0es (:,:,jk) , sxc0(:,:,jk,:), &
& sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) )
END DO
- DO jk = 1, nlay_i !--- ice heat content
+ DO jk = 1, nlay_i !--- ice heat content
CALL adv_y( ihls, jl, zdt, zvdx, 1._wp, zarea, z0ei(:,:,jk) , sxe(:,:,jk,:), &
& sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
CALL adv_x( ihls, jl, zdt, zudy, 0._wp, zarea, z0ei(:,:,jk) , sxe(:,:,jk,:), &
& sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
END DO
+ ! --------------------- !
+ ! == optional fields == !
+ ! --------------------- !
+ IF( nn_icesal == 4 ) THEN
+ DO jk = 1, nlay_i !--- ice salt content
+ CALL adv_y( ihls, jl, zdt, zvdx, 1._wp, zarea, z0si(:,:,jk) , sxsi (:,:,jk,:), &
+ & sxxsi(:,:,jk,:), sysi(:,:,jk,:), syysi(:,:,jk,:), sxysi(:,:,jk,:) )
+ CALL adv_x( ihls, jl, zdt, zudy, 0._wp, zarea, z0si(:,:,jk) , sxsi (:,:,jk,:), &
+ & sxxsi(:,:,jk,:), sysi(:,:,jk,:), syysi(:,:,jk,:), sxysi(:,:,jk,:) )
+ END DO
+ ELSE
+ CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity
+ CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal )
+ ENDIF
+ !
IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
- CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction
+ CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction
CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )
- CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume
+ CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume
CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )
- IF ( ln_pnd_lids ) THEN
- CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume
- CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )
- ENDIF
+ CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume
+ CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )
ENDIF
!
ENDIF
@@ -293,43 +358,56 @@ CONTAINS
DO_2D( ihls, ihls, ihls, ihls )
pv_i (ji,jj,jl) = z0ice(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
pv_s (ji,jj,jl) = z0snw(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
- psv_i(ji,jj,jl) = z0smi(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
poa_i(ji,jj,jl) = z0oi (ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
pa_i (ji,jj,jl) = z0ai (ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
- DO jk = 1, nlay_s
- pe_s(ji,jj,jk,jl) = z0es(ji,jj,jk) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
- END DO
- DO jk = 1, nlay_i
- pe_i(ji,jj,jk,jl) = z0ei(ji,jj,jk) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
- END DO
END_2D
+ DO_3D( ihls, ihls, ihls, ihls, 1, nlay_s )
+ pe_s(ji,jj,jk,jl) = z0es(ji,jj,jk) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
+ END_3D
+ DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i )
+ pe_i(ji,jj,jk,jl) = z0ei(ji,jj,jk) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
+ END_3D
+ IF( nn_icesal == 4 ) THEN
+ DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i )
+ pszv_i(ji,jj,jk,jl) = z0si(ji,jj,jk) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
+ END_3D
+ ELSE
+ DO_2D( ihls, ihls, ihls, ihls )
+ psv_i(ji,jj,jl) = z0smi(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
+ END_2D
+ ENDIF
IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
DO_2D( ihls, ihls, ihls, ihls )
pa_ip(ji,jj,jl) = z0ap(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
pv_ip(ji,jj,jl) = z0vp(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
+ pv_il(ji,jj,jl) = z0vl(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
END_2D
- IF ( ln_pnd_lids ) THEN
- DO_2D( ihls, ihls, ihls, ihls )
- pv_il(ji,jj,jl) = z0vl(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1)
- END_2D
- ENDIF
ENDIF
-
+
! --- diagnostics --- !
DO_2D( 0, 0, 0, 0 )
diag_adv_mass(ji,jj) = diag_adv_mass(ji,jj) + ( pv_i (ji,jj,jl) * rhoi + pv_s (ji,jj,jl) * rhos &
& + pv_ip(ji,jj,jl) * rhow + pv_il(ji,jj,jl) * rhow &
& - zdiag_adv_mass(ji,jj) ) * z1_dt
- diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( psv_i(ji,jj,jl) * rhoi &
- & - zdiag_adv_salt(ji,jj) ) * z1_dt
diag_adv_heat(ji,jj) = diag_adv_heat(ji,jj) + ( -SUM( pe_i(ji,jj,1:nlay_i,jl) ) -SUM( pe_s(ji,jj,1:nlay_s,jl) ) &
& - zdiag_adv_heat(ji,jj) ) * z1_dt
END_2D
+ IF( nn_icesal == 4 ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( SUM( pszv_i(ji,jj,1:nlay_i,jl) ) * rhoi &
+ & - zdiag_adv_salt(ji,jj) ) * z1_dt
+ END_2D
+ ELSE
+ DO_2D( 0, 0, 0, 0 )
+ diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( psv_i(ji,jj,jl) * rhoi &
+ & - zdiag_adv_salt(ji,jj) ) * z1_dt
+ END_2D
+ ENDIF
! --- Make sure ice thickness is not too big --- !
! (because ice thickness can be too large where ice concentration is very small)
- CALL Hbig_pra( ihls, jl, zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, &
- & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i )
+ CALL Hbig_pra( ihls, jl, zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, zszi_max, &
+ & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i, pszv_i )
!
! --- Ensure snow load is not too big --- !
CALL Hsnow_pra( ihls, jl, zdt, pv_i, pv_s, pa_i, pa_ip, pe_s )
@@ -338,48 +416,68 @@ CONTAINS
! ! ================= !
! ! End cat loop here !
! ! ================= !
-
- ! derive open water from ice concentration
- DO_2D( ihls, ihls, ihls, ihls )
- zati2 = SUM( pa_i(ji,jj,:) )
- pato_i(ji,jj) = pato_i(ji,jj) - ( zati2 - zati1(ji,jj) ) & !--- open water
- & - ( ( zudy(ji,jj) - zudy(ji-1,jj) ) & ! add () for NP repro
- & + ( zvdx(ji,jj) - zvdx(ji,jj-1) ) ) * r1_e1e2t(ji,jj) * zdt
- END_2D
-
+ !
! --- Ensure non-negative fields --- !
! Remove negative values (conservation is ensured)
! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20)
- CALL ice_var_zapneg( ihls, zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i )
+ CALL ice_var_zapneg( ihls, zdt, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i )
+ !
+ ! derive open water from ice concentration
+ DO_2D( 0, 0, 0, 0 )
+ zati2 = SUM( pa_i(ji,jj,:) )
+ pato_i(ji,jj) = MAX( 0._wp, pato_i(ji,jj) - ( zati2 - zati1(ji,jj) ) &
+ & - ( ( zudy(ji,jj) - zudy(ji-1,jj) ) & ! ad () for NP repro
+ & + ( zvdx(ji,jj) - zvdx(ji,jj-1) ) ) * r1_e1e2t(ji,jj) * zdt )
+ END_2D
+ ! note: no need of lbc_lnk for open water (never used in the halos)
!
! --- Lateral boundary conditions --- !
! caution: for gradients (sx and sy) the sign changes
! plus, one needs ldfull=T to deal with the NorthFold
IF( ihls == 0 .AND. jt /= icycle ) THEN ! comm. on all fields if ihls=0 and we are only at the 1st iteration (jt=1) over 2 (icycle=2)
!
- CALL lbc_lnk( 'icedyn_adv_pra', pv_i , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp & ! ice volume
- & , sxxice, 'T', 1._wp, syyice, 'T', 1._wp, sxyice, 'T', 1._wp &
- & , pv_s , 'T', 1._wp, sxsn , 'T', -1._wp, sysn , 'T', -1._wp & ! snw volume
- & , sxxsn , 'T', 1._wp, syysn , 'T', 1._wp, sxysn , 'T', 1._wp &
- & , psv_i , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp & ! ice salinity
- & , sxxsal, 'T', 1._wp, syysal, 'T', 1._wp, sxysal, 'T', 1._wp &
- & , pa_i , 'T', 1._wp, sxa , 'T', -1._wp, sya , 'T', -1._wp & ! ice concentration
- & , sxxa , 'T', 1._wp, syya , 'T', 1._wp, sxya , 'T', 1._wp &
- & , poa_i , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age
- & , sxxage, 'T', 1._wp, syyage, 'T', 1._wp, sxyage, 'T', 1._wp, ldfull = .TRUE. )
- CALL lbc_lnk( 'icedyn_adv_pra', pe_s , 'T', 1._wp, sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy
- & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp &
- & , pe_i , 'T', 1._wp, sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy
- & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp, ldfull = .TRUE. )
IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
- CALL lbc_lnk( 'icedyn_adv_pra', pa_ip, 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp & ! melt pond fraction
- & , sxxap, 'T', 1._wp, syyap, 'T', 1._wp, sxyap, 'T', 1._wp &
- & , pv_ip, 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp & ! melt pond volume
- & , sxxvp, 'T', 1._wp, syyvp, 'T', 1._wp, sxyvp, 'T', 1._wp &
- & , pv_il, 'T', 1._wp, sxvl , 'T', -1._wp, syvl , 'T', -1._wp & ! melt pond lid volume
- & , sxxvl, 'T', 1._wp, syyvl, 'T', 1._wp, sxyvl, 'T', 1._wp, ldfull = .TRUE. )
+ CALL lbc_lnk( 'icedyn_adv_pra', pv_i , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp & ! ice volume
+ & , sxxice, 'T', 1._wp, syyice, 'T', 1._wp, sxyice, 'T', 1._wp &
+ & , pv_s , 'T', 1._wp, sxsn , 'T', -1._wp, sysn , 'T', -1._wp & ! snw volume
+ & , sxxsn , 'T', 1._wp, syysn , 'T', 1._wp, sxysn , 'T', 1._wp &
+ & , psv_i , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp & ! ice salinity
+ & , sxxsal, 'T', 1._wp, syysal, 'T', 1._wp, sxysal, 'T', 1._wp &
+ & , pa_i , 'T', 1._wp, sxa , 'T', -1._wp, sya , 'T', -1._wp & ! ice concentration
+ & , sxxa , 'T', 1._wp, syya , 'T', 1._wp, sxya , 'T', 1._wp &
+ & , poa_i , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age
+ & , sxxage, 'T', 1._wp, syyage, 'T', 1._wp, sxyage, 'T', 1._wp &
+ & , pa_ip , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp & ! melt pond fraction
+ & , sxxap , 'T', 1._wp, syyap , 'T', 1._wp, sxyap , 'T', 1._wp &
+ & , pv_ip , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp & ! melt pond volume
+ & , sxxvp , 'T', 1._wp, syyvp , 'T', 1._wp, sxyvp , 'T', 1._wp &
+ & , pv_il , 'T', 1._wp, sxvl , 'T', -1._wp, syvl , 'T', -1._wp & ! melt pond lid volume
+ & , sxxvl , 'T', 1._wp, syyvl , 'T', 1._wp, sxyvl, 'T', 1._wp, ldfull = .TRUE. )
+ ELSE
+ CALL lbc_lnk( 'icedyn_adv_pra', pv_i , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp & ! ice volume
+ & , sxxice, 'T', 1._wp, syyice, 'T', 1._wp, sxyice, 'T', 1._wp &
+ & , pv_s , 'T', 1._wp, sxsn , 'T', -1._wp, sysn , 'T', -1._wp & ! snw volume
+ & , sxxsn , 'T', 1._wp, syysn , 'T', 1._wp, sxysn , 'T', 1._wp &
+ & , psv_i , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp & ! ice salinity
+ & , sxxsal, 'T', 1._wp, syysal, 'T', 1._wp, sxysal, 'T', 1._wp &
+ & , pa_i , 'T', 1._wp, sxa , 'T', -1._wp, sya , 'T', -1._wp & ! ice concentration
+ & , sxxa , 'T', 1._wp, syya , 'T', 1._wp, sxya , 'T', 1._wp &
+ & , poa_i , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age
+ & , sxxage, 'T', 1._wp, syyage, 'T', 1._wp, sxyage, 'T', 1._wp, ldfull = .TRUE. )
+ ENDIF
+ IF( nn_icesal == 4 ) THEN
+ CALL lbc_lnk( 'icedyn_adv_pra', pe_s , 'T', 1._wp, sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy
+ & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp &
+ & , pe_i , 'T', 1._wp, sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy
+ & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp &
+ & , pszv_i, 'T', 1._wp, sxsi , 'T', -1._wp, sysi , 'T', -1._wp & ! ice salt content
+ & , sxxsi , 'T', 1._wp, syysi , 'T', 1._wp, sxysi , 'T', 1._wp, ldfull = .TRUE. )
+ ELSE
+ CALL lbc_lnk( 'icedyn_adv_pra', pe_s , 'T', 1._wp, sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy
+ & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp &
+ & , pe_i , 'T', 1._wp, sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy
+ & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp, ldfull = .TRUE. )
ENDIF
- CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T', 1.0_wp, ldfull = .TRUE. )
!
ELSEIF( jt == icycle ) THEN ! comm. on the moments at the end of advection
! ! comm. on the other fields are gathered in icedyn.F90
@@ -412,17 +510,34 @@ CONTAINS
& , sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age
& , sxxage, 'T', 1._wp, syyage, 'T', 1._wp, sxyage, 'T', 1._wp, ldfull = .TRUE. )
ENDIF
- CALL lbc_lnk( 'icedyn_adv_pra', sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy
- & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp &
- & , sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy
- & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp, ldfull = .TRUE. )
+ IF( nn_icesal == 4 ) THEN
+ CALL lbc_lnk( 'icedyn_adv_pra', sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy
+ & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp &
+ & , sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy
+ & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp &
+ & , sxsi , 'T', -1._wp, sysi , 'T', -1._wp & ! ice salt content
+ & , sxxsi , 'T', 1._wp, syysi , 'T', 1._wp, sxysi , 'T', 1._wp, ldfull = .TRUE. )
+ ELSE
+ CALL lbc_lnk( 'icedyn_adv_pra', sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy
+ & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp &
+ & , sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy
+ & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp, ldfull = .TRUE. )
+ ENDIF
!
ENDIF
!
END DO ! jt
!
+ !
IF( lrst_ice ) CALL adv_pra_rst( 'WRITE', kt ) !* write Prather fields in the restart file
!
+ !
+ ! --- Deallocate arrays --- !
+ IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) DEALLOCATE( z0ap , z0vp, z0vl, zh_ip )
+ IF( nn_icesal == 4 ) THEN ; DEALLOCATE( z0si , zsz_i )
+ ELSE ; DEALLOCATE( z0smi, zs_i )
+ ENDIF
+ !
END SUBROUTINE ice_dyn_adv_pra
@@ -446,6 +561,7 @@ CONTAINS
!!
INTEGER :: ji, jj ! dummy loop indices
INTEGER :: ji0, jj0 ! dummy loop indices
+ REAL(wp) :: z1_3
REAL(wp) :: zs1max, zslpmax ! local scalars
REAL(wp) :: zs1new, zalf , zalf2, zalf3 ! - -
REAL(wp) :: zs2new, z1malf, z1malf2, z1malf3 ! - -
@@ -460,6 +576,7 @@ CONTAINS
ji0 = 1 + ihls
jj0 = NINT(pcrh) + ihls
!
+ z1_3 = 1._wp / 3._wp
! Limitation of moments.
DO_2D( ji0, ji0, jj0, jj0 )
!
@@ -480,7 +597,7 @@ CONTAINS
IF( zslpmax > 0._wp ) THEN
zs1max = 1.5_wp * zslpmax
zs1new = MIN( zs1max, MAX( -zs1max, zpsx ) )
- zs2new = MIN( 2._wp * zslpmax - 0.3334_wp * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, zpsxx ) )
+ zs2new = MIN( 2._wp * zslpmax - z1_3 * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, zpsxx ) )
!
zpsx = zs1new * tmask(ji,jj,1)
zpsxx = zs2new * tmask(ji,jj,1)
@@ -506,7 +623,7 @@ CONTAINS
zalf3 = zalf2 * zalf
z1malf2 = z1malf * z1malf
z1malf3 = z1malf2 * z1malf
-
+ !
zfm (ji,jj) = zalf * zpsm
zf0 (ji,jj) = zalf * ( zps0 + z1malf * ( zpsx + (z1malf - zalf) * zpsxx ) )
zfx (ji,jj) = zalf2 * ( zpsx + 3._wp * z1malf * zpsxx )
@@ -514,6 +631,7 @@ CONTAINS
zfy (ji,jj) = zalf * ( zpsy + z1malf * zpsxy )
zfyy(ji,jj) = zalf * zpsyy
zfxy(ji,jj) = zalf2 * zpsxy
+ !
! ! Readjust moments remaining in the box.
zpsm = zpsm - zfm (ji,jj)
zps0 = zps0 - zf0 (ji,jj)
@@ -666,6 +784,7 @@ CONTAINS
!!
INTEGER :: ji, jj ! dummy loop indices
INTEGER :: ji0, jj0 ! dummy loop indices
+ REAL(wp) :: z1_3
REAL(wp) :: zs1max, zslpmax ! local scalars
REAL(wp) :: zs1new, zalf , zalf2, zalf3 ! - -
REAL(wp) :: zs2new, z1malf, z1malf2, z1malf3 ! - -
@@ -680,6 +799,7 @@ CONTAINS
ji0 = NINT(pcrh) + ihls
jj0 = 1 + ihls
!
+ z1_3 = 1._wp / 3._wp
! Limitation of moments.
DO_2D( ji0, ji0, jj0, jj0 )
!
@@ -698,9 +818,9 @@ CONTAINS
zps0 = zslpmax
!
IF( zslpmax > 0._wp ) THEN
- zs1max = 1.5_wp * zslpmax
- zs1new = MIN( zs1max, MAX( -zs1max, zpsy ) )
- zs2new = MIN( 2._wp * zslpmax - 0.3334_wp * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, zpsyy ) )
+ zs1max = 1.5_wp * zslpmax
+ zs1new = MIN( zs1max, MAX( -zs1max, zpsy ) )
+ zs2new = MIN( 2._wp * zslpmax - z1_3 * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, zpsyy ) )
!
zpsx = zpsx * tmask(ji,jj,1)
zpsxx = zpsxx * tmask(ji,jj,1)
@@ -727,18 +847,18 @@ CONTAINS
z1malf2 = z1malf * z1malf
z1malf3 = z1malf2 * z1malf
!
- zfm (ji,jj) = zalf * zpsm
- zf0 (ji,jj) = zalf * ( zps0 + z1malf * ( zpsy + (z1malf - zalf) * zpsyy ) )
- zfy (ji,jj) = zalf2 * ( zpsy + 3._wp * z1malf * zpsyy )
- zfyy(ji,jj) = zalf3 * zpsyy
- zfx (ji,jj) = zalf * ( zpsx + z1malf * zpsxy )
- zfxx(ji,jj) = zalf * zpsxx
- zfxy(ji,jj) = zalf2 * zpsxy
+ zfm (ji,jj) = zalf * zpsm
+ zf0 (ji,jj) = zalf * ( zps0 + z1malf * ( zpsy + (z1malf - zalf) * zpsyy ) )
+ zfy (ji,jj) = zalf2 * ( zpsy + 3._wp * z1malf * zpsyy )
+ zfyy(ji,jj) = zalf3 * zpsyy
+ zfx (ji,jj) = zalf * ( zpsx + z1malf * zpsxy )
+ zfxx(ji,jj) = zalf * zpsxx
+ zfxy(ji,jj) = zalf2 * zpsxy
!
! ! Readjust moments remaining in the box.
zpsm = zpsm - zfm (ji,jj)
zps0 = zps0 - zf0 (ji,jj)
- zpsy = z1malf2 * ( zpsy -3._wp * zalf * zpsyy )
+ zpsy = z1malf2 * ( zpsy - 3._wp * zalf * zpsyy )
zpsyy = z1malf3 * zpsyy
zpsx = zpsx - zfx (ji,jj)
zpsxx = zpsxx - zfxx(ji,jj)
@@ -868,8 +988,8 @@ CONTAINS
END SUBROUTINE adv_y
- SUBROUTINE Hbig_pra( ihls, jcat, pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, &
- & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i )
+ SUBROUTINE Hbig_pra( ihls, jcat, pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, pszi_max, &
+ & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i, pszv_i )
!!-------------------------------------------------------------------
!! *** ROUTINE Hbig_pra ***
!!
@@ -888,10 +1008,11 @@ CONTAINS
REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
REAL(wp), DIMENSION(:,:) , INTENT(in ) :: phi_max, phs_max, phip_max, psi_max ! max ice thick from surrounding 9-pts
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pes_max
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pei_max
+ REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pei_max, pszi_max
REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i
REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s
REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pszv_i
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra
@@ -938,18 +1059,36 @@ CONTAINS
pv_s(ji,jj,jcat) = pa_i(ji,jj,jcat) * phs_max(ji,jj)
ENDIF
!
- ! ! -- check s_i -- !
- ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean
- zsi = psv_i(ji,jj,jcat) / pv_i(ji,jj,jcat)
- IF( zsi > psi_max(ji,jj) .AND. pa_i(ji,jj,jcat) < 0.15 ) THEN
- zfra = psi_max(ji,jj) / zsi
- zsfx_res(ji,jj) = zsfx_res(ji,jj) + psv_i(ji,jj,jcat) * ( 1._wp - zfra ) * rhoi * z1_dt
- psv_i(ji,jj,jcat) = psv_i(ji,jj,jcat) * zfra
- ENDIF
- !
ENDIF
END_2D
!
+ ! ! -- check s_i -- !
+ IF( nn_icesal == 4 ) THEN
+ DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i )
+ IF ( pv_i(ji,jj,jcat) > 0._wp ) THEN
+ ! if szv_i/v_i is larger than the surrounding 9 pts => put the salt excess in the ocean
+ zsi = pszv_i(ji,jj,jk,jcat) / pv_i(ji,jj,jcat)
+ IF( zsi > pszi_max(ji,jj,jk) .AND. pa_i(ji,jj,jcat) < 0.15 ) THEN
+ zfra = pszi_max(ji,jj,jk) / zsi
+ zsfx_res(ji,jj) = zsfx_res(ji,jj) + pszv_i(ji,jj,jk,jcat) * ( 1._wp - zfra ) * rhoi * z1_dt
+ pszv_i(ji,jj,jk,jcat) = pszv_i(ji,jj,jk,jcat) * zfra
+ ENDIF
+ ENDIF
+ END_3D
+ ELSE
+ DO_2D( ihls, ihls, ihls, ihls )
+ IF ( pv_i(ji,jj,jcat) > 0._wp ) THEN
+ ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean
+ zsi = psv_i(ji,jj,jcat) / pv_i(ji,jj,jcat)
+ IF( zsi > psi_max(ji,jj) .AND. pa_i(ji,jj,jcat) < 0.15 ) THEN
+ zfra = psi_max(ji,jj) / zsi
+ zsfx_res(ji,jj) = zsfx_res(ji,jj) + psv_i(ji,jj,jcat) * ( 1._wp - zfra ) * rhoi * z1_dt
+ psv_i(ji,jj,jcat) = psv_i(ji,jj,jcat) * zfra
+ ENDIF
+ !
+ ENDIF
+ END_2D
+ ENDIF
! ! -- check e_i/v_i -- !
DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i )
IF ( pv_i(ji,jj,jcat) > 0._wp ) THEN
@@ -1054,28 +1193,52 @@ CONTAINS
!!
!! ** Purpose : allocate and initialize arrays for Prather advection
!!-------------------------------------------------------------------
- INTEGER :: ierr
+ INTEGER :: ierr(4), ii, ierr_max
!!-------------------------------------------------------------------
!
+ ierr(:) = 0
+ ii = 0
! !* allocate prather fields
- ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , &
- & sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) , &
- & sxa (jpi,jpj,jpl) , sya (jpi,jpj,jpl) , sxxa (jpi,jpj,jpl) , syya (jpi,jpj,jpl) , sxya (jpi,jpj,jpl) , &
- & sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) , &
- & sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) , &
- & sxap (jpi,jpj,jpl) , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) , &
- & sxvp (jpi,jpj,jpl) , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) , &
- & sxvl (jpi,jpj,jpl) , syvl (jpi,jpj,jpl) , sxxvl (jpi,jpj,jpl) , syyvl (jpi,jpj,jpl) , sxyvl (jpi,jpj,jpl) , &
- !
+ ! ---------------------- !
+ ! == mandatory fields == !
+ ! ---------------------- !
+ ii = ii + 1
+ ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , &
+ & sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) , &
+ & sxa (jpi,jpj,jpl) , sya (jpi,jpj,jpl) , sxxa (jpi,jpj,jpl) , syya (jpi,jpj,jpl) , sxya (jpi,jpj,jpl) , &
+ & sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) , &
& sxc0 (jpi,jpj,nlay_s,jpl) , syc0 (jpi,jpj,nlay_s,jpl) , sxxc0(jpi,jpj,nlay_s,jpl) , &
& syyc0(jpi,jpj,nlay_s,jpl) , sxyc0(jpi,jpj,nlay_s,jpl) , &
- !
& sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe (jpi,jpj,nlay_i,jpl) , &
& syye (jpi,jpj,nlay_i,jpl) , sxye (jpi,jpj,nlay_i,jpl) , &
- & STAT = ierr )
+ & STAT = ierr(ii) )
+ !
+ ! --------------------- !
+ ! == optional fields == !
+ ! --------------------- !
+ ii = ii + 1 ! sxsal etc must be allocated for conveniency
+ ALLOCATE( sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) , &
+ & STAT = ierr(ii) )
+ !
+ ii = ii + 1
+ IF( nn_icesal == 4 ) THEN
+ ALLOCATE( sxsi (jpi,jpj,nlay_i,jpl) , sysi (jpi,jpj,nlay_i,jpl) , sxxsi(jpi,jpj,nlay_i,jpl) , &
+ & syysi(jpi,jpj,nlay_i,jpl) , sxysi(jpi,jpj,nlay_i,jpl) , &
+ & STAT = ierr(ii) )
+ ENDIF
!
- CALL mpp_sum( 'icedyn_adv_pra', ierr )
- IF( ierr /= 0 ) CALL ctl_stop('STOP', 'adv_pra_init : unable to allocate ice arrays for Prather advection scheme')
+ ii = ii + 1
+ IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
+ ALLOCATE( sxap (jpi,jpj,jpl) , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) , &
+ & sxvp (jpi,jpj,jpl) , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) , &
+ & sxvl (jpi,jpj,jpl) , syvl (jpi,jpj,jpl) , sxxvl (jpi,jpj,jpl) , syyvl (jpi,jpj,jpl) , sxyvl (jpi,jpj,jpl) , &
+ & STAT = ierr(ii) )
+ ENDIF
+ !
+ ierr_max = MAXVAL( ierr(:) )
+ !
+ CALL mpp_sum( 'icedyn_adv_pra', ierr_max )
+ IF( ierr_max /= 0 ) CALL ctl_stop('STOP', 'adv_pra_init : unable to allocate ice arrays for Prather advection scheme')
!
CALL adv_pra_rst( 'READ' ) !* read or initialize all required files
!
@@ -1111,6 +1274,9 @@ CONTAINS
!
IF( id1 > 0 ) THEN !** Read the restart file **!
!
+ ! ---------------------- !
+ ! == mandatory fields == !
+ ! ---------------------- !
! ! ice thickness
CALL iom_get( numrir, jpdom_auto, 'sxice' , sxice , psgn = -1._wp )
CALL iom_get( numrir, jpdom_auto, 'syice' , syice , psgn = -1._wp )
@@ -1129,12 +1295,6 @@ CONTAINS
CALL iom_get( numrir, jpdom_auto, 'sxxa' , sxxa )
CALL iom_get( numrir, jpdom_auto, 'syya' , syya )
CALL iom_get( numrir, jpdom_auto, 'sxya' , sxya )
- ! ! ice salinity
- CALL iom_get( numrir, jpdom_auto, 'sxsal' , sxsal , psgn = -1._wp )
- CALL iom_get( numrir, jpdom_auto, 'sysal' , sysal , psgn = -1._wp )
- CALL iom_get( numrir, jpdom_auto, 'sxxsal', sxxsal )
- CALL iom_get( numrir, jpdom_auto, 'syysal', syysal )
- CALL iom_get( numrir, jpdom_auto, 'sxysal', sxysal )
! ! ice age
CALL iom_get( numrir, jpdom_auto, 'sxage' , sxage , psgn = -1._wp )
CALL iom_get( numrir, jpdom_auto, 'syage' , syage , psgn = -1._wp )
@@ -1149,11 +1309,11 @@ CONTAINS
znam = 'syc0'//'_l'//zchar1
CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; syc0 (:,:,jk,:) = z3d(:,:,:)
znam = 'sxxc0'//'_l'//zchar1
- CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxc0(:,:,jk,:) = z3d(:,:,:)
+ CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxc0(:,:,jk,:) = z3d(:,:,:)
znam = 'syyc0'//'_l'//zchar1
- CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syyc0(:,:,jk,:) = z3d(:,:,:)
+ CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syyc0(:,:,jk,:) = z3d(:,:,:)
znam = 'sxyc0'//'_l'//zchar1
- CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxyc0(:,:,jk,:) = z3d(:,:,:)
+ CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxyc0(:,:,jk,:) = z3d(:,:,:)
END DO
! ! ice layers heat content
DO jk = 1, nlay_i
@@ -1163,39 +1323,73 @@ CONTAINS
znam = 'sye'//'_l'//zchar1
CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sye (:,:,jk,:) = z3d(:,:,:)
znam = 'sxxe'//'_l'//zchar1
- CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxe(:,:,jk,:) = z3d(:,:,:)
+ CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxe(:,:,jk,:) = z3d(:,:,:)
znam = 'syye'//'_l'//zchar1
- CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syye(:,:,jk,:) = z3d(:,:,:)
+ CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syye(:,:,jk,:) = z3d(:,:,:)
znam = 'sxye'//'_l'//zchar1
- CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxye(:,:,jk,:) = z3d(:,:,:)
+ CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxye(:,:,jk,:) = z3d(:,:,:)
END DO
!
- IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN ! melt pond fraction
+ ! --------------------- !
+ ! == optional fields == !
+ ! --------------------- !
+ ! ! ice salinity
+ IF( iom_varid( numrir, 'sxsal', ldstop = .FALSE. ) > 0 ) THEN
+ CALL iom_get( numrir, jpdom_auto, 'sxsal' , sxsal , psgn = -1._wp )
+ CALL iom_get( numrir, jpdom_auto, 'sysal' , sysal , psgn = -1._wp )
+ CALL iom_get( numrir, jpdom_auto, 'sxxsal', sxxsal )
+ CALL iom_get( numrir, jpdom_auto, 'syysal', syysal )
+ CALL iom_get( numrir, jpdom_auto, 'sxysal', sxysal )
+ ELSE
+ sxsal = 0._wp ; sysal = 0._wp ; sxxsal = 0._wp ; syysal = 0._wp ; sxysal = 0._wp
+ ENDIF
+ ! ! ice layers salt content
+ IF( nn_icesal == 4 ) THEN
+ IF( iom_varid( numrir, 'sxsi_l01' , ldstop = .FALSE. ) > 0 ) THEN
+ DO jk = 1, nlay_i
+ WRITE(zchar1,'(I2.2)') jk
+ znam = 'sxsi'//'_l'//zchar1
+ CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sxsi (:,:,jk,:) = z3d(:,:,:)
+ znam = 'sysi'//'_l'//zchar1
+ CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sysi (:,:,jk,:) = z3d(:,:,:)
+ znam = 'sxxsi'//'_l'//zchar1
+ CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxsi(:,:,jk,:) = z3d(:,:,:)
+ znam = 'syysi'//'_l'//zchar1
+ CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syysi(:,:,jk,:) = z3d(:,:,:)
+ znam = 'sxysi'//'_l'//zchar1
+ CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxysi(:,:,jk,:) = z3d(:,:,:)
+ END DO
+ ELSE
+ sxsi = 0._wp ; sysi = 0._wp ; sxxsi = 0._wp ; syysi = 0._wp ; sxysi = 0._wp
+ ENDIF
+ ENDIF
+ !
+ IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN ! melt pond fraction
IF( iom_varid( numrir, 'sxap', ldstop = .FALSE. ) > 0 ) THEN
CALL iom_get( numrir, jpdom_auto, 'sxap' , sxap , psgn = -1._wp )
CALL iom_get( numrir, jpdom_auto, 'syap' , syap , psgn = -1._wp )
CALL iom_get( numrir, jpdom_auto, 'sxxap', sxxap )
CALL iom_get( numrir, jpdom_auto, 'syyap', syyap )
CALL iom_get( numrir, jpdom_auto, 'sxyap', sxyap )
- ! ! melt pond volume
+ ! ! melt pond volume
CALL iom_get( numrir, jpdom_auto, 'sxvp' , sxvp , psgn = -1._wp )
CALL iom_get( numrir, jpdom_auto, 'syvp' , syvp , psgn = -1._wp )
CALL iom_get( numrir, jpdom_auto, 'sxxvp', sxxvp )
CALL iom_get( numrir, jpdom_auto, 'syyvp', syyvp )
CALL iom_get( numrir, jpdom_auto, 'sxyvp', sxyvp )
ELSE
- sxap = 0._wp ; syap = 0._wp ; sxxap = 0._wp ; syyap = 0._wp ; sxyap = 0._wp ! melt pond fraction
- sxvp = 0._wp ; syvp = 0._wp ; sxxvp = 0._wp ; syyvp = 0._wp ; sxyvp = 0._wp ! melt pond volume
+ sxap = 0._wp ; syap = 0._wp ; sxxap = 0._wp ; syyap = 0._wp ; sxyap = 0._wp
+ sxvp = 0._wp ; syvp = 0._wp ; sxxvp = 0._wp ; syyvp = 0._wp ; sxyvp = 0._wp
ENDIF
- !
- IF( iom_varid( numrir, 'sxvl', ldstop = .FALSE. ) > 0 ) THEN ! melt pond lid volume
+ ! ! melt pond lid volume
+ IF( iom_varid( numrir, 'sxvl', ldstop = .FALSE. ) > 0 ) THEN
CALL iom_get( numrir, jpdom_auto, 'sxvl' , sxvl , psgn = -1._wp )
CALL iom_get( numrir, jpdom_auto, 'syvl' , syvl , psgn = -1._wp )
CALL iom_get( numrir, jpdom_auto, 'sxxvl', sxxvl )
CALL iom_get( numrir, jpdom_auto, 'syyvl', syyvl )
CALL iom_get( numrir, jpdom_auto, 'sxyvl', sxyvl )
ELSE
- sxvl = 0._wp ; syvl = 0._wp ; sxxvl = 0._wp ; syyvl = 0._wp ; sxyvl = 0._wp ! melt pond lid volume
+ sxvl = 0._wp ; syvl = 0._wp ; sxxvl = 0._wp ; syyvl = 0._wp ; sxyvl = 0._wp
ENDIF
ENDIF
!
@@ -1206,10 +1400,14 @@ CONTAINS
sxice = 0._wp ; syice = 0._wp ; sxxice = 0._wp ; syyice = 0._wp ; sxyice = 0._wp ! ice thickness
sxsn = 0._wp ; sysn = 0._wp ; sxxsn = 0._wp ; syysn = 0._wp ; sxysn = 0._wp ! snow thickness
sxa = 0._wp ; sya = 0._wp ; sxxa = 0._wp ; syya = 0._wp ; sxya = 0._wp ! ice concentration
- sxsal = 0._wp ; sysal = 0._wp ; sxxsal = 0._wp ; syysal = 0._wp ; sxysal = 0._wp ! ice salinity
sxage = 0._wp ; syage = 0._wp ; sxxage = 0._wp ; syyage = 0._wp ; sxyage = 0._wp ! ice age
sxc0 = 0._wp ; syc0 = 0._wp ; sxxc0 = 0._wp ; syyc0 = 0._wp ; sxyc0 = 0._wp ! snow layers heat content
sxe = 0._wp ; sye = 0._wp ; sxxe = 0._wp ; syye = 0._wp ; sxye = 0._wp ! ice layers heat content
+ !
+ sxsal = 0._wp ; sysal = 0._wp ; sxxsal = 0._wp ; syysal = 0._wp ; sxysal = 0._wp ! ice salinity
+ IF( nn_icesal == 4 ) THEN
+ sxsi = 0._wp ; sysi = 0._wp ; sxxsi = 0._wp ; syysi = 0._wp ; sxysi = 0._wp ! ice layers salt content
+ ENDIF
IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
sxap = 0._wp ; syap = 0._wp ; sxxap = 0._wp ; syyap = 0._wp ; sxyap = 0._wp ! melt pond fraction
sxvp = 0._wp ; syvp = 0._wp ; sxxvp = 0._wp ; syyvp = 0._wp ; sxyvp = 0._wp ! melt pond volume
@@ -1227,6 +1425,9 @@ CONTAINS
! In case Prather scheme is used for advection, write second order moments
! ------------------------------------------------------------------------
!
+ ! ---------------------- !
+ ! == mandatory fields == !
+ ! ---------------------- !
! ! ice thickness
CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice )
CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice )
@@ -1245,12 +1446,6 @@ CONTAINS
CALL iom_rstput( iter, nitrst, numriw, 'sxxa' , sxxa )
CALL iom_rstput( iter, nitrst, numriw, 'syya' , syya )
CALL iom_rstput( iter, nitrst, numriw, 'sxya' , sxya )
- ! ! ice salinity
- CALL iom_rstput( iter, nitrst, numriw, 'sxsal' , sxsal )
- CALL iom_rstput( iter, nitrst, numriw, 'sysal' , sysal )
- CALL iom_rstput( iter, nitrst, numriw, 'sxxsal', sxxsal )
- CALL iom_rstput( iter, nitrst, numriw, 'syysal', syysal )
- CALL iom_rstput( iter, nitrst, numriw, 'sxysal', sxysal )
! ! ice age
CALL iom_rstput( iter, nitrst, numriw, 'sxage' , sxage )
CALL iom_rstput( iter, nitrst, numriw, 'syage' , syage )
@@ -1286,7 +1481,38 @@ CONTAINS
CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
END DO
!
- IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN ! melt pond fraction
+ ! --------------------- !
+ ! == optional fields == !
+ ! --------------------- !
+ !
+ IF( nn_icesal == 4 ) THEN
+ ! ! ice layers salt content
+ DO jk = 1, nlay_i
+ WRITE(zchar1,'(I2.2)') jk
+ znam = 'sxsi'//'_l'//zchar1 ; z3d(:,:,:) = sxsi (:,:,jk,:)
+ CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
+ znam = 'sysi'//'_l'//zchar1 ; z3d(:,:,:) = sysi (:,:,jk,:)
+ CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
+ znam = 'sxxsi'//'_l'//zchar1 ; z3d(:,:,:) = sxxsi(:,:,jk,:)
+ CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
+ znam = 'syysi'//'_l'//zchar1 ; z3d(:,:,:) = syysi(:,:,jk,:)
+ CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
+ znam = 'sxysi'//'_l'//zchar1 ; z3d(:,:,:) = sxysi(:,:,jk,:)
+ CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
+ END DO
+ !
+ ELSE
+ ! ! ice salinity
+ CALL iom_rstput( iter, nitrst, numriw, 'sxsal' , sxsal )
+ CALL iom_rstput( iter, nitrst, numriw, 'sysal' , sysal )
+ CALL iom_rstput( iter, nitrst, numriw, 'sxxsal', sxxsal )
+ CALL iom_rstput( iter, nitrst, numriw, 'syysal', syysal )
+ CALL iom_rstput( iter, nitrst, numriw, 'sxysal', sxysal )
+ !
+ ENDIF
+ !
+ IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
+ ! ! melt pond fraction
CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap )
CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap )
CALL iom_rstput( iter, nitrst, numriw, 'sxxap', sxxap )
@@ -1298,14 +1524,13 @@ CONTAINS
CALL iom_rstput( iter, nitrst, numriw, 'sxxvp', sxxvp )
CALL iom_rstput( iter, nitrst, numriw, 'syyvp', syyvp )
CALL iom_rstput( iter, nitrst, numriw, 'sxyvp', sxyvp )
+ ! ! melt pond lid volume
+ CALL iom_rstput( iter, nitrst, numriw, 'sxvl' , sxvl )
+ CALL iom_rstput( iter, nitrst, numriw, 'syvl' , syvl )
+ CALL iom_rstput( iter, nitrst, numriw, 'sxxvl', sxxvl )
+ CALL iom_rstput( iter, nitrst, numriw, 'syyvl', syyvl )
+ CALL iom_rstput( iter, nitrst, numriw, 'sxyvl', sxyvl )
!
- IF ( ln_pnd_lids ) THEN ! melt pond lid volume
- CALL iom_rstput( iter, nitrst, numriw, 'sxvl' , sxvl )
- CALL iom_rstput( iter, nitrst, numriw, 'syvl' , syvl )
- CALL iom_rstput( iter, nitrst, numriw, 'sxxvl', sxxvl )
- CALL iom_rstput( iter, nitrst, numriw, 'syyvl', syyvl )
- CALL iom_rstput( iter, nitrst, numriw, 'sxyvl', sxyvl )
- ENDIF
ENDIF
!
ENDIF
diff --git a/src/ICE/icedyn_adv_umx.F90 b/src/ICE/icedyn_adv_umx.F90
index 755c002cb80be72346220f854dc0c99ce8d5d8ae..4fe7d9a06326a88691f5a0293abb440e26fb1272 100644
--- a/src/ICE/icedyn_adv_umx.F90
+++ b/src/ICE/icedyn_adv_umx.F90
@@ -59,7 +59,7 @@ MODULE icedyn_adv_umx
CONTAINS
SUBROUTINE ice_dyn_adv_umx( kn_umx, kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip, &
- & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i )
+ & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i )
!!----------------------------------------------------------------------
!! *** ROUTINE ice_dyn_adv_umx ***
!!
@@ -87,39 +87,59 @@ CONTAINS
REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_il ! melt pond lid volume
REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content
REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pszv_i ! ice salt content
!
- INTEGER :: ji, jj, jk, jl, jt ! dummy loop indices
+ INTEGER :: ji, jj, jk, jl, jm, jt ! dummy loop indices
+ INTEGER :: ndim ! number of variables to advect
INTEGER :: icycle ! number of sub-timestep for the advection
- REAL(wp) :: zamsk ! 1 if advection of concentration, 0 if advection of other tracers
REAL(wp) :: zdt, z1_dt, zvi_cen
REAL(wp) :: zati2
REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication
REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box
- REAL(wp), DIMENSION(jpi,jpj) :: zati1
+ REAL(wp), DIMENSION(A2D(0)) :: zati1
REAL(wp), DIMENSION(jpi,jpj,jpl) :: zu_cat, zv_cat
REAL(wp), DIMENSION(jpi,jpj,jpl) :: zua_ho, zva_ho, zua_ups, zva_ups
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai , z1_aip, zhvar
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max, zs_i, zsi_max
- REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: ze_i, zei_max
- REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: ze_s, zes_max
+ REAL(wp), DIMENSION(jpi,jpj,jpl) :: zuap_ho, zvap_ho, zuap_ups, zvap_ups
+ REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai
!
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs
+ REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: ze_i
+ REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: ze_s
+ REAL(wp), DIMENSION(A2D(0),jpl) :: zhi_max, zhs_max, zhip_max, zsi_max
+ REAL(wp), DIMENSION(A2D(0),nlay_i,jpl) :: zei_max, zszi_max
+ REAL(wp), DIMENSION(A2D(0),nlay_s,jpl) :: zes_max
+ !
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z1_aip
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zs_i
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zsz_i
+ !
+ REAL(wp), ALLOCATABLE, DIMENSION(:) :: zamsk ! 1 if advection of concentration, 0 if advection of other tracers
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zvar, zhvar
+ !
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs
!! diagnostics
- REAL(wp), DIMENSION(A2D(0)) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat
+ REAL(wp), DIMENSION(A2D(0)) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat
!!----------------------------------------------------------------------
- !
+ !
IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_umx: Ultimate-Macho advection scheme'
!
+ ndim = nlay_s + 2*nlay_i + 5 ! max number of tracers to advect at the same time
+ !
+ ! --- Allocate arrays --- !
+ ALLOCATE( zvar(jpi,jpj,jpl,ndim), zhvar(jpi,jpj,jpl,ndim), zamsk(ndim) )
+ IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) ALLOCATE( z1_aip(jpi,jpj,jpl) )
+ IF( nn_icesal == 4 ) THEN ; ALLOCATE( zsz_i (jpi,jpj,nlay_i,jpl) )
+ ELSE ; ALLOCATE( zs_i (jpi,jpj,jpl) )
+ ENDIF
+ IF( np_advS == 3 ) ALLOCATE( zuv_ho(jpi,jpj,jpl), zvv_ho(jpi,jpj,jpl), zuv_ups(jpi,jpj,jpl), zvv_ups(jpi,jpj,jpl), &
+ & z1_vi (jpi,jpj,jpl), z1_vs (jpi,jpj,jpl) )
+ !
+ !
! --- Record max of the surrounding 9-pts (for call Hbig) --- !
- ! thickness and salinity
- WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:)
- ELSEWHERE ; zs_i(:,:,:) = 0._wp
- END WHERE
+ !
+ ! thickness
CALL icemax3D_umx( ph_i , zhi_max )
CALL icemax3D_umx( ph_s , zhs_max )
- CALL icemax3D_umx( ph_ip, zhip_max)
- CALL icemax3D_umx( zs_i , zsi_max )
- CALL lbc_lnk( 'icedyn_adv_umx', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp )
+ IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) CALL icemax3D_umx( ph_ip, zhip_max)
!
! enthalpies
DO jk = 1, nlay_i
@@ -134,7 +154,21 @@ CONTAINS
END DO
CALL icemax4D_umx( ze_i , zei_max )
CALL icemax4D_umx( ze_s , zes_max )
- CALL lbc_lnk( 'icedyn_adv_umx', zei_max, 'T', 1._wp, zes_max, 'T', 1._wp )
+ !
+ ! salt content
+ IF( nn_icesal == 4 ) THEN
+ DO jk = 1, nlay_i
+ WHERE( pv_i(:,:,:) >= epsi10 ) ; zsz_i(:,:,jk,:) = pszv_i(:,:,jk,:) / pv_i(:,:,:)
+ ELSEWHERE ; zsz_i(:,:,jk,:) = 0._wp
+ END WHERE
+ END DO
+ CALL icemax4D_umx( zsz_i , zszi_max )
+ ELSE
+ WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:)
+ ELSEWHERE ; zs_i(:,:,:) = 0._wp
+ END WHERE
+ CALL icemax3D_umx( zs_i , zsi_max )
+ ENDIF
!
!
! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- !
@@ -167,17 +201,15 @@ CONTAINS
END DO
!
! --- define velocity for advection: u*grad(H) --- !
- DO_2D( nn_hls-1, nn_hls, nn_hls, nn_hls )
+ DO_2D( 1, 2, 2, 2 )
IF ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN ; zcu_box(ji,jj) = 0._wp
ELSEIF( pu_ice(ji,jj) > 0._wp ) THEN ; zcu_box(ji,jj) = pu_ice(ji-1,jj)
- ELSE ; zcu_box(ji,jj) = pu_ice(ji ,jj)
- ENDIF
+ ELSE ; zcu_box(ji,jj) = pu_ice(ji ,jj) ; ENDIF
END_2D
- DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls )
+ DO_2D( 2, 2, 1, 2 )
IF ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN ; zcv_box(ji,jj) = 0._wp
ELSEIF( pv_ice(ji,jj) > 0._wp ) THEN ; zcv_box(ji,jj) = pv_ice(ji,jj-1)
- ELSE ; zcv_box(ji,jj) = pv_ice(ji,jj )
- ENDIF
+ ELSE ; zcv_box(ji,jj) = pv_ice(ji,jj ) ; ENDIF
END_2D
!---------------!
@@ -185,28 +217,27 @@ CONTAINS
!---------------!
DO jt = 1, icycle
- ! record at_i before advection (for open water)
- zati1(:,:) = SUM( pa_i(:,:,:), dim=3 )
-
! inverse of A and Ap
WHERE( pa_i(:,:,:) >= epsi20 ) ; z1_ai(:,:,:) = 1._wp / pa_i(:,:,:)
ELSEWHERE ; z1_ai(:,:,:) = 0.
END WHERE
- WHERE( pa_ip(:,:,:) >= epsi20 ) ; z1_aip(:,:,:) = 1._wp / pa_ip(:,:,:)
- ELSEWHERE ; z1_aip(:,:,:) = 0.
- END WHERE
+ IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
+ WHERE( pa_ip(:,:,:) >= epsi20 ) ; z1_aip(:,:,:) = 1._wp / pa_ip(:,:,:)
+ ELSEWHERE ; z1_aip(:,:,:) = 0.
+ END WHERE
+ ENDIF
!
! setup a mask where advection will be upstream
IF( ll_neg ) THEN
IF( .NOT. ALLOCATED(imsk_small) ) ALLOCATE( imsk_small(jpi,jpj,jpl) )
IF( .NOT. ALLOCATED(jmsk_small) ) ALLOCATE( jmsk_small(jpi,jpj,jpl) )
DO jl = 1, jpl
- DO_2D( 1, 0, nn_hls, nn_hls )
+ DO_2D( 2, 1, 2, 2 )
zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) )
IF( zvi_cen < epsi06) THEN ; imsk_small(ji,jj,jl) = 0
ELSE ; imsk_small(ji,jj,jl) = 1 ; ENDIF
END_2D
- DO_2D( nn_hls, nn_hls, 1, 0 )
+ DO_2D( 2, 2, 2, 1 )
zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) )
IF( zvi_cen < epsi06) THEN ; jmsk_small(ji,jj,jl) = 0
ELSE ; jmsk_small(ji,jj,jl) = 1 ; ENDIF
@@ -218,83 +249,168 @@ CONTAINS
DO_2D( 0, 0, 0, 0 )
zdiag_adv_mass(ji,jj) = SUM( pv_i (ji,jj,:) ) * rhoi + SUM( pv_s (ji,jj,:) ) * rhos &
& + SUM( pv_ip(ji,jj,:) ) * rhow + SUM( pv_il(ji,jj,:) ) * rhow
- zdiag_adv_salt(ji,jj) = SUM( psv_i(ji,jj,:) ) * rhoi
zdiag_adv_heat(ji,jj) = - SUM( SUM( pe_i(ji,jj,1:nlay_i,:), dim=2 ) ) - SUM( SUM( pe_s(ji,jj,1:nlay_s,:), dim=2 ) )
END_2D
+ IF( nn_icesal == 4 ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ zdiag_adv_salt(ji,jj) = SUM( SUM( pszv_i(ji,jj,:,:), dim=2 ) ) * rhoi
+ END_2D
+ ELSE
+ DO_2D( 0, 0, 0, 0 )
+ zdiag_adv_salt(ji,jj) = SUM( psv_i(ji,jj,:) ) * rhoi
+ END_2D
+ ENDIF
+ !
+ ! record at_i before advection (for open water)
+ zati1(:,:) = SUM( pa_i(A2D(0),:), dim=3 )
!
! ----------------------- !
! ==> start advection <== !
! ----------------------- !
!
+ zamsk(1) = 1._wp
+ !
!== Ice area ==!
- zamsk = 1._wp
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zu_cat , zv_cat , zcu_box, zcv_box, &
- & pa_i, pa_i, zua_ups, zva_ups, zua_ho , zva_ho )
+ zvar(:,:,:,1) = pa_i(:,:,:)
+ CALL adv_umx( zamsk(1:1), kn_umx, jt, kt, zdt, zudy, zvdx, zu_cat , zv_cat , zcu_box, zcv_box, &
+ & zvar(:,:,:,1:1), zvar(:,:,:,1:1), zua_ups, zva_ups, zua_ho, zva_ho )
+ pa_i(:,:,:) = zvar(:,:,:,1)
+
+ !== Ice age ==!
+ zvar(:,:,:,1) = poa_i(:,:,:)
+ CALL adv_umx( zamsk(1:1), kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, &
+ & zvar(:,:,:,1:1), zvar(:,:,:,1:1) )
+ poa_i(:,:,:) = zvar(:,:,:,1)
+
+ !== melt ponds area ==!
+ IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
+ zvar(:,:,:,1) = pa_ip(:,:,:)
+ CALL adv_umx( zamsk(1:1), kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat , zv_cat , zcu_box, zcv_box, &
+ & zvar(:,:,:,1:1), zvar(:,:,:,1:1), zuap_ups, zvap_ups, zuap_ho, zvap_ho )
+ pa_ip(:,:,:) = zvar(:,:,:,1)
+ ENDIF
!
! ! --------------------------------- !
IF( np_advS == 1 ) THEN ! -- advection form: -div( uVS ) -- !
! ! --------------------------------- !
- zamsk = 0._wp
+
!== Ice volume ==!
- zhvar(:,:,:) = pv_i(:,:,:) * z1_ai(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, &
- & zhvar, pv_i, zua_ups, zva_ups )
+ jm = 1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pv_i(:,:,:)
+ zhvar(:,:,:,jm) = pv_i(:,:,:) * z1_ai(:,:,:)
!== Snw volume ==!
- zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, &
- & zhvar, pv_s, zua_ups, zva_ups )
- !
- zamsk = 1._wp
- !== Salt content ==!
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, &
- & psv_i, psv_i )
+ jm = jm+1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pv_s(:,:,:)
+ zhvar(:,:,:,jm) = pv_s(:,:,:) * z1_ai(:,:,:)
!== Ice heat content ==!
DO jk = 1, nlay_i
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, &
- & pe_i(:,:,jk,:), pe_i(:,:,jk,:) )
- END DO
+ jm = jm+1 ; zamsk(jm) = 1._wp
+ zvar (:,:,:,jm) = pe_i(:,:,jk,:)
+ zhvar(:,:,:,jm) = pe_i(:,:,jk,:)
+ ENDDO
!== Snw heat content ==!
DO jk = 1, nlay_s
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, &
- & pe_s(:,:,jk,:), pe_s(:,:,jk,:) )
- END DO
+ jm = jm+1 ; zamsk(jm) = 1._wp
+ zvar (:,:,:,jm) = pe_s(:,:,jk,:)
+ zhvar(:,:,:,jm) = pe_s(:,:,jk,:)
+ ENDDO
+ !== Ice salt content ==!
+ IF( nn_icesal == 4 ) THEN
+ DO jk = 1, nlay_i
+ jm = jm+1 ; zamsk(jm) = 1._wp
+ zvar (:,:,:,jm) = pszv_i(:,:,jk,:)
+ zhvar(:,:,:,jm) = pszv_i(:,:,jk,:)
+ ENDDO
+ ELSE
+ jm = jm+1 ; zamsk(jm) = 1._wp
+ zvar (:,:,:,jm) = psv_i(:,:,:)
+ zhvar(:,:,:,jm) = psv_i(:,:,:)
+ ENDIF
+
+ !== advection ==!
+ CALL adv_umx( zamsk(1:jm), kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, &
+ & zhvar(:,:,:,1:jm), zvar(:,:,:,1:jm), zua_ups, zva_ups )
+ !
+
+ !== Recover quantities ==!
+ jm = 1 ; pv_i (:,:,:) = zvar (:,:,:,jm)
+ jm = jm+1 ; pv_s (:,:,:) = zvar (:,:,:,jm)
+ DO jk = 1, nlay_i
+ jm = jm+1 ; pe_i (:,:,jk,:) = zvar (:,:,:,jm)
+ ENDDO
+ DO jk = 1, nlay_s
+ jm = jm+1 ; pe_s (:,:,jk,:) = zvar (:,:,:,jm)
+ ENDDO
+ IF( nn_icesal == 4 ) THEN
+ DO jk = 1, nlay_i
+ jm = jm+1 ; pszv_i(:,:,jk,:) = zvar (:,:,:,jm)
+ ENDDO
+ ELSE
+ jm = jm+1 ; psv_i (:,:,:) = zvar (:,:,:,jm)
+ ENDIF
+
!
! ! ------------------------------------------ !
ELSEIF( np_advS == 2 ) THEN ! -- advection form: -div( uA * uHS / u ) -- !
! ! ------------------------------------------ !
- zamsk = 0._wp
+
!== Ice volume ==!
- zhvar(:,:,:) = pv_i(:,:,:) * z1_ai(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, &
- & zhvar, pv_i, zua_ups, zva_ups )
+ jm = 1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pv_i(:,:,:)
+ zhvar(:,:,:,jm) = pv_i(:,:,:) * z1_ai(:,:,:)
!== Snw volume ==!
- zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, &
- & zhvar, pv_s, zua_ups, zva_ups )
- !== Salt content ==!
- zhvar(:,:,:) = psv_i(:,:,:) * z1_ai(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, &
- & zhvar, psv_i, zua_ups, zva_ups )
+ jm = jm+1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pv_s(:,:,:)
+ zhvar(:,:,:,jm) = pv_s(:,:,:) * z1_ai(:,:,:)
!== Ice heat content ==!
DO jk = 1, nlay_i
- zhvar(:,:,:) = pe_i(:,:,jk,:) * z1_ai(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho, zva_ho, zcu_box, zcv_box, &
- & zhvar, pe_i(:,:,jk,:), zua_ups, zva_ups )
- END DO
+ jm = jm+1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pe_i(:,:,jk,:)
+ zhvar(:,:,:,jm) = pe_i(:,:,jk,:) * z1_ai(:,:,:)
+ ENDDO
!== Snw heat content ==!
DO jk = 1, nlay_s
- zhvar(:,:,:) = pe_s(:,:,jk,:) * z1_ai(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho, zva_ho, zcu_box, zcv_box, &
- & zhvar, pe_s(:,:,jk,:), zua_ups, zva_ups )
- END DO
+ jm = jm+1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pe_s(:,:,jk,:)
+ zhvar(:,:,:,jm) = pe_s(:,:,jk,:) * z1_ai(:,:,:)
+ ENDDO
+ !== Ice salt content ==!
+ IF( nn_icesal == 4 ) THEN
+ DO jk = 1, nlay_i
+ jm = jm+1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pszv_i(:,:,jk,:)
+ zhvar(:,:,:,jm) = pszv_i(:,:,jk,:) * z1_ai(:,:,:)
+ ENDDO
+ ELSE
+ jm = jm+1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = psv_i(:,:,:)
+ zhvar(:,:,:,jm) = psv_i(:,:,:) * z1_ai(:,:,:)
+ ENDIF
+
+ !== advection ==!
+ CALL adv_umx( zamsk(1:jm), kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, &
+ & zhvar(:,:,:,1:jm), zvar(:,:,:,1:jm), zua_ups, zva_ups )
!
+ !== Recover quantities ==!
+ jm = 1 ; pv_i (:,:,:) = zvar (:,:,:,jm)
+ jm = jm+1 ; pv_s (:,:,:) = zvar (:,:,:,jm)
+ DO jk = 1, nlay_i
+ jm = jm+1 ; pe_i (:,:,jk,:) = zvar (:,:,:,jm)
+ ENDDO
+ DO jk = 1, nlay_s
+ jm = jm+1 ; pe_s (:,:,jk,:) = zvar (:,:,:,jm)
+ ENDDO
+ IF( nn_icesal == 4 ) THEN
+ DO jk = 1, nlay_i
+ jm = jm+1 ; pszv_i(:,:,jk,:) = zvar (:,:,:,jm)
+ ENDDO
+ ELSE
+ jm = jm+1 ; psv_i (:,:,:) = zvar (:,:,:,jm)
+ ENDIF
+
! ! ----------------------------------------- !
ELSEIF( np_advS == 3 ) THEN ! -- advection form: -div( uV * uS / u ) -- !
! ! ----------------------------------------- !
- zamsk = 0._wp
- !
- ALLOCATE( zuv_ho (jpi,jpj,jpl), zvv_ho (jpi,jpj,jpl), &
- & zuv_ups(jpi,jpj,jpl), zvv_ups(jpi,jpj,jpl), z1_vi(jpi,jpj,jpl), z1_vs(jpi,jpj,jpl) )
!
! inverse of Vi
WHERE( pv_i(:,:,:) >= epsi20 ) ; z1_vi(:,:,:) = 1._wp / pv_i(:,:,:)
@@ -308,98 +424,142 @@ CONTAINS
! It is important to first calculate the ice fields and then the snow fields (because we use the same arrays)
!
!== Ice volume ==!
+ jm = 1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pv_i(:,:,:)
+ zhvar(:,:,:,jm) = pv_i(:,:,:) * z1_ai(:,:,:)
zuv_ups = zua_ups
zvv_ups = zva_ups
- zhvar(:,:,:) = pv_i(:,:,:) * z1_ai(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, &
- & zhvar, pv_i, zuv_ups, zvv_ups, zuv_ho , zvv_ho )
- !== Salt content ==!
- zhvar(:,:,:) = psv_i(:,:,:) * z1_vi(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zuv_ho , zvv_ho , zcu_box, zcv_box, &
- & zhvar, psv_i, zuv_ups, zvv_ups )
+ CALL adv_umx( zamsk(1:1), kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, &
+ & zhvar(:,:,:,1:1), zvar(:,:,:,1:1), zuv_ups, zvv_ups, zuv_ho, zvv_ho )
!== Ice heat content ==!
DO jk = 1, nlay_i
- zhvar(:,:,:) = pe_i(:,:,jk,:) * z1_vi(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zuv_ho, zvv_ho, zcu_box, zcv_box, &
- & zhvar, pe_i(:,:,jk,:), zuv_ups, zvv_ups )
- END DO
- !== Snow volume ==!
+ jm = jm+1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pe_i(:,:,jk,:)
+ zhvar(:,:,:,jm) = pe_i(:,:,jk,:) * z1_vi(:,:,:)
+ ENDDO
+ !== Ice salt content ==!
+ IF( nn_icesal == 4 ) THEN
+ DO jk = 1, nlay_i
+ jm = jm+1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pszv_i(:,:,jk,:)
+ zhvar(:,:,:,jm) = pszv_i(:,:,jk,:) * z1_vi(:,:,:)
+ ENDDO
+ ELSE
+ jm = jm+1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = psv_i(:,:,:)
+ zhvar(:,:,:,jm) = psv_i(:,:,:) * z1_vi(:,:,:)
+ ENDIF
+ CALL adv_umx( zamsk(2:jm), kn_umx, jt, kt, zdt, zudy, zvdx, zuv_ho, zvv_ho, zcu_box, zcv_box, &
+ & zhvar(:,:,:,2:jm), zvar(:,:,:,2:jm), zuv_ups, zvv_ups )
+ !
+ !== Recover quantities ==!
+ jm = 1 ; pv_i (:,:,:) = zvar (:,:,:,jm)
+ DO jk = 1, nlay_i
+ jm = jm+1 ; pe_i (:,:,jk,:) = zvar (:,:,:,jm)
+ ENDDO
+ IF( nn_icesal == 4 ) THEN
+ DO jk = 1, nlay_i
+ jm = jm+1 ; pszv_i(:,:,jk,:) = zvar (:,:,:,jm)
+ ENDDO
+ ELSE
+ jm = jm+1 ; psv_i (:,:,:) = zvar (:,:,:,jm)
+ ENDIF
+
+ !== Snw volume ==!
+ jm = 1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pv_s(:,:,:)
+ zhvar(:,:,:,jm) = pv_s(:,:,:) * z1_ai(:,:,:)
zuv_ups = zua_ups
zvv_ups = zva_ups
- zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, &
- & zhvar, pv_s, zuv_ups, zvv_ups, zuv_ho , zvv_ho )
+ CALL adv_umx( zamsk(1:1), kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, &
+ & zhvar(:,:,:,1:1), zvar(:,:,:,1:1), zuv_ups, zvv_ups, zuv_ho , zvv_ho )
!== Snw heat content ==!
DO jk = 1, nlay_s
- zhvar(:,:,:) = pe_s(:,:,jk,:) * z1_vs(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zuv_ho, zvv_ho, zcu_box, zcv_box, &
- & zhvar, pe_s(:,:,jk,:), zuv_ups, zvv_ups )
- END DO
+ jm = jm+1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pe_s(:,:,jk,:)
+ zhvar(:,:,:,jm) = pe_s(:,:,jk,:) * z1_vs(:,:,:)
+ ENDDO
+ CALL adv_umx( zamsk(2:jm), kn_umx, jt, kt, zdt, zudy, zvdx, zuv_ho, zvv_ho, zcu_box, zcv_box, &
+ & zhvar(:,:,:,2:jm), zvar(:,:,:,2:jm), zuv_ups, zvv_ups )
+ !
+ !== Recover quantities ==!
+ jm = 1 ; pv_s (:,:,:) = zvar (:,:,:,jm)
+ DO jk = 1, nlay_s
+ jm = jm+1 ; pe_s (:,:,jk,:) = zvar (:,:,:,jm)
+ ENDDO
!
- DEALLOCATE( zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs )
!
ENDIF
!
- !== Ice age ==!
- zamsk = 1._wp
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, &
- & poa_i, poa_i )
!
!== melt ponds ==!
IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
- ! concentration
- zamsk = 1._wp
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat , zv_cat , zcu_box, zcv_box, &
- & pa_ip, pa_ip, zua_ups, zva_ups, zua_ho , zva_ho )
- ! volume
- zamsk = 0._wp
- zhvar(:,:,:) = pv_ip(:,:,:) * z1_aip(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, &
- & zhvar, pv_ip, zua_ups, zva_ups )
- ! lid
- IF ( ln_pnd_lids ) THEN
- zamsk = 0._wp
- zhvar(:,:,:) = pv_il(:,:,:) * z1_aip(:,:,:)
- CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, &
- & zhvar, pv_il, zua_ups, zva_ups )
- ENDIF
- ENDIF
- !== Open water area ==!
- DO_2D( 0, 0, 0, 0 )
- zati2 = SUM( pa_i(ji,jj,:) )
- pato_i(ji,jj) = pato_i(ji,jj) - ( zati2 - zati1(ji,jj) ) &
- & - ( ( zudy(ji,jj) - zudy(ji-1,jj) ) & ! ad () for NP repro
- & + ( zvdx(ji,jj) - zvdx(ji,jj-1) ) ) * r1_e1e2t(ji,jj) * zdt
- END_2D
+ !== pond volume ==!
+ jm = 1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pv_ip(:,:,:)
+ zhvar(:,:,:,jm) = pv_ip(:,:,:) * z1_aip(:,:,:)
+ !== lid volume ==!
+ jm = jm+1 ; zamsk(jm) = 0._wp
+ zvar (:,:,:,jm) = pv_il(:,:,:)
+ zhvar(:,:,:,jm) = pv_il(:,:,:) * z1_aip(:,:,:)
+ !
+ !== advection ==!
+ CALL adv_umx( zamsk(1:jm), kn_umx, jt, kt, zdt, zudy, zvdx, zuap_ho, zvap_ho, zcu_box, zcv_box, &
+ & zhvar(:,:,:,1:jm), zvar(:,:,:,1:jm), zuap_ups, zvap_ups )
+ !== Recover quantities ==!
+ jm = 1 ; pv_ip (:,:,:) = zvar (:,:,:,jm)
+ jm = jm+1 ; pv_il (:,:,:) = zvar (:,:,:,jm)
+ ENDIF
+
! --- diagnostics --- !
DO_2D( 0, 0, 0, 0 )
diag_adv_mass(ji,jj) = diag_adv_mass(ji,jj) + ( SUM( pv_i (ji,jj,:) ) * rhoi + SUM( pv_s (ji,jj,:) ) * rhos &
& + SUM( pv_ip(ji,jj,:) ) * rhow + SUM( pv_il(ji,jj,:) ) * rhow &
& - zdiag_adv_mass(ji,jj) ) * z1_dt
- diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( SUM( psv_i(ji,jj,:) ) * rhoi &
- & - zdiag_adv_salt(ji,jj) ) * z1_dt
diag_adv_heat(ji,jj) = diag_adv_heat(ji,jj) + ( - SUM(SUM( pe_i(ji,jj,1:nlay_i,:) , dim=2 ) ) &
& - SUM(SUM( pe_s(ji,jj,1:nlay_s,:) , dim=2 ) ) &
& - zdiag_adv_heat(ji,jj) ) * z1_dt
END_2D
+ IF( nn_icesal == 4 ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( SUM( SUM( pszv_i(ji,jj,:,:), dim=2 ) ) * rhoi &
+ & - zdiag_adv_salt(ji,jj) ) * z1_dt
+ END_2D
+ ELSE
+ DO_2D( 0, 0, 0, 0 )
+ diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( SUM( psv_i(ji,jj,:) ) * rhoi &
+ & - zdiag_adv_salt(ji,jj) ) * z1_dt
+ END_2D
+ ENDIF
! --- Ensure non-negative fields and in-bound thicknesses --- !
! Remove negative values (conservation is ensured)
! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20)
- CALL ice_var_zapneg( 0, zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i )
+ CALL ice_var_zapneg( 0, zdt, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i )
!
! --- Make sure ice thickness is not too big --- !
! (because ice thickness can be too large where ice concentration is very small)
- CALL Hbig_umx( zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, &
- & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i )
+ CALL Hbig_umx( zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, zszi_max, &
+ & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i, pszv_i )
!
! --- Ensure snow load is not too big --- !
CALL Hsnow_umx( zdt, pv_i, pv_s, pa_i, pa_ip, pe_s )
!
+ !
+ !== open water area ==!
+ DO_2D( 0, 0, 0, 0 )
+ zati2 = SUM( pa_i(ji,jj,:) )
+ pato_i(ji,jj) = MAX( 0._wp, pato_i(ji,jj) - ( zati2 - zati1(ji,jj) ) & ! derive open water from ice concentration
+ & - ( ( zudy(ji,jj) - zudy(ji-1,jj) ) & ! ad () for NP repro
+ & + ( zvdx(ji,jj) - zvdx(ji,jj-1) ) ) * r1_e1e2t(ji,jj) * zdt )
+ END_2D
+ ! note: no need of lbc_lnk for open water (never used in the halos)
+ !
! --- Lateral boundary conditions --- !
- IF( jt /= icycle ) THEN ! only if we have 2 cycles and we are at the 1st one
+ IF( jt <= (icycle-1) ) THEN ! only if we have 2 cycles and we are at the 1st one
+ !
IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
CALL lbc_lnk( 'icedyn_adv_umx', pa_i , 'T', 1._wp, pv_i , 'T', 1._wp, pv_s , 'T', 1._wp, &
& psv_i, 'T', 1._wp, poa_i, 'T', 1._wp, &
@@ -408,13 +568,25 @@ CONTAINS
CALL lbc_lnk( 'icedyn_adv_umx', pa_i , 'T', 1._wp, pv_i , 'T', 1._wp, pv_s , 'T', 1._wp, &
& psv_i, 'T', 1._wp, poa_i, 'T', 1._wp )
ENDIF
- CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp, pe_s, 'T', 1._wp )
- CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T', 1._wp )
+ IF( nn_icesal == 4 ) THEN
+ CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp, pe_s, 'T', 1._wp, pszv_i, 'T', 1._wp )
+ ELSE
+ CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp, pe_s, 'T', 1._wp )
+ ENDIF
+ !
ENDIF
!
- !
END DO
!
+ !
+ ! --- Deallocate arrays --- !
+ DEALLOCATE( zvar, zhvar, zamsk )
+ IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) DEALLOCATE( z1_aip )
+ IF( nn_icesal == 4 ) THEN ; DEALLOCATE( zsz_i )
+ ELSE ; DEALLOCATE( zs_i )
+ ENDIF
+ IF( np_advS == 3 ) DEALLOCATE( zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs )
+ !
END SUBROUTINE ice_dyn_adv_umx
@@ -460,7 +632,7 @@ CONTAINS
!! Therefore, after advection we limit the thickness to the largest value of the 9-points around (only if ice
!! concentration is small). We also limit S and T.
!!----------------------------------------------------------------------
- REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0)
+ REAL(wp), DIMENSION(:) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0)
INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2)
INTEGER , INTENT(in ) :: jt ! number of sub-iteration
INTEGER , INTENT(in ) :: kt ! number of iteration
@@ -468,107 +640,141 @@ CONTAINS
REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pu , pv ! 2 ice velocity components => u*e2
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: puc , pvc ! 2 ice velocity components => u*e2 or u*a*e2u
REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pubox, pvbox ! upstream velocity
- REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pt ! tracer field
- REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: ptc ! tracer content field
+ REAL(wp), DIMENSION(:,:,:,:) , INTENT(inout) :: pt ! tracer field
+ REAL(wp), DIMENSION(:,:,:,:) , INTENT(inout) :: ptc ! tracer content field
REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(inout), OPTIONAL :: pua_ups, pva_ups ! upstream u*a fluxes
REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out), OPTIONAL :: pua_ho, pva_ho ! high order u*a fluxes
!
- INTEGER :: ji, jj, jl ! dummy loop indices
+ INTEGER :: ji, jj, jl, jm ! dummy loop indices
+ INTEGER :: ndim ! number of variables to advect
REAL(wp) :: ztra ! local scalar
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: zfu_ho , zfv_ho , zpt
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: zfu_ups, zfv_ups, zt_ups
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zfu_ho , zfv_ho
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zfu_ups, zfv_ups, zt_ups
!!----------------------------------------------------------------------
!
+ ndim = SIZE( ptc, dim=4 )
+ !
+ ALLOCATE( zfu_ho (jpi,jpj,jpl,ndim), zfv_ho (jpi,jpj,jpl,ndim), &
+ & zfu_ups(jpi,jpj,jpl,ndim), zfv_ups(jpi,jpj,jpl,ndim), zt_ups(jpi,jpj,jpl,ndim) )
+ !
! Upstream (_ups) fluxes
! -----------------------
- CALL upstream( pamsk, jt, kt, pdt, pt, pu, pv, zt_ups, zfu_ups, zfv_ups )
-
+ DO jm = 1, ndim
+ CALL upstream( pamsk(jm), jt, kt, pdt, pt(:,:,:,jm), pu(:,:), pv(:,:), & ! <<= in
+ & zt_ups(:,:,:,jm), zfu_ups(:,:,:,jm), zfv_ups(:,:,:,jm) ) ! =>> out ( gives zt_ups(1,1,1,1), zfu_ups(2,1,1,1) & zfv_ups(1,1,2,1) )
+ ENDDO
+ !
! High order (_ho) fluxes
! -----------------------
SELECT CASE( kn_umx )
!
CASE ( 20 ) !== centered second order ==!
- !
- CALL cen2( pamsk, jt, kt, pdt, pt, pu, pv, zt_ups, zfu_ups, zfv_ups, zfu_ho, zfv_ho )
- !
+ DO jm = 1, ndim
+ CALL cen2( pamsk(jm), jt, kt, pdt, pt(:,:,:,jm), pu(:,:), pv(:,:), & ! <<= in
+ & zfu_ups(:,:,:,jm), zfv_ups(:,:,:,jm), & ! <<= in (upstream)
+ & zfu_ho (:,:,:,jm), zfv_ho (:,:,:,jm) ) ! =>> out (high order) ( gives zfu_ho(2,1,1,1) & zfv_ho(1,1,2,1) )
+ ENDDO
CASE ( 1:5 ) !== 1st to 5th order ULTIMATE-MACHO scheme ==!
- !
- CALL macho( pamsk, kn_umx, jt, kt, pdt, pt, pu, pv, pubox, pvbox, zt_ups, zfu_ups, zfv_ups, zfu_ho, zfv_ho )
- !
+ CALL macho( pamsk(:), kn_umx, jt, kt, pdt, pt(:,:,:,:), pu(:,:), pv(:,:), pubox(:,:), pvbox(:,:), & ! <<= in
+ & zfu_ups(:,:,:,:), zfv_ups(:,:,:,:), & ! <<= in (upstream)
+ & zfu_ho (:,:,:,:), zfv_ho (:,:,:,:) ) ! =>> out (high order) ( gives zfu_ho(2,1,1,1) & zfv_ho(1,1,2,1) )
END SELECT
!
+ ! Flux limiter
+ ! ------------
+ IF( np_limiter == 1 ) THEN
+ CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T', 1.0_wp ) ! nonosc needs zt_ups over the whole domain
+ DO jm = 1, ndim
+ CALL nonosc_ice( pamsk(jm), pdt, pu, pv, pt(:,:,:,jm), zt_ups(:,:,:,jm), zfu_ups(:,:,:,jm), zfv_ups(:,:,:,jm), &
+ & zfu_ho (:,:,:,jm), zfv_ho (:,:,:,jm) ) ! gives zfu_ho(1,0,0,0) & zfv_ho(0,0,1,0)
+ ENDDO
+ !
+ ENDIF
! --ho --ho
! new fluxes = u*H * u*a / u
! ----------------------------
- IF( pamsk == 0._wp ) THEN
- DO jl = 1, jpl
- DO_2D( 1, 0, 0, 0 )
- IF( ABS( pu(ji,jj) ) > epsi10 ) THEN
- zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc (ji,jj,jl) / pu(ji,jj)
- zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj)
- ELSE
- zfu_ho (ji,jj,jl) = 0._wp
- zfu_ups(ji,jj,jl) = 0._wp
- ENDIF
- !
- END_2D
- DO_2D( 0, 0, 1, 0 )
- IF( ABS( pv(ji,jj) ) > epsi10 ) THEN
- zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc (ji,jj,jl) / pv(ji,jj)
- zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj)
- ELSE
- zfv_ho (ji,jj,jl) = 0._wp
- zfv_ups(ji,jj,jl) = 0._wp
- ENDIF
- END_2D
- END DO
-
- ! the new "volume" fluxes must also be "flux corrected"
- ! thus we calculate the upstream solution and apply a limiter again
- DO jl = 1, jpl
- DO_2D( 0, 0, 0, 0 )
- ztra = - ( ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) ) & ! add () for NP repro
- & + ( zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) ) )
- !
- zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)
- END_2D
- END DO
- CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T', 1.0_wp )
- !
- IF ( np_limiter == 1 ) THEN
- CALL nonosc_ice( 1._wp, pdt, pu, pv, ptc, zt_ups, zfu_ups, zfv_ups, zfu_ho, zfv_ho )
- ELSEIF( np_limiter == 2 .OR. np_limiter == 3 ) THEN
- CALL limiter_x( pdt, pu, ptc, zfu_ups, zfu_ho )
- CALL limiter_y( pdt, pv, ptc, zfv_ups, zfv_ho )
+ DO jm = 1, ndim
+ IF( pamsk(jm) == 0._wp ) THEN
+
+ DO jl = 1, jpl
+ DO_2D( 1, 0, 0, 0 )
+ IF( ABS( pu(ji,jj) ) > epsi10 ) THEN ; zfu_ho(ji,jj,jl,jm) = zfu_ho(ji,jj,jl,jm) * puc(ji,jj,jl) / pu(ji,jj)
+ ELSE ; zfu_ho(ji,jj,jl,jm) = 0._wp ; ENDIF
+ END_2D
+ DO_2D( 0, 0, 1, 0 )
+ IF( ABS( pv(ji,jj) ) > epsi10 ) THEN ; zfv_ho(ji,jj,jl,jm) = zfv_ho(ji,jj,jl,jm) * pvc(ji,jj,jl) / pv(ji,jj)
+ ELSE ; zfv_ho(ji,jj,jl,jm) = 0._wp ; ENDIF
+ END_2D
+ DO_2D( 2, 1, 1, 1 )
+ IF( ABS( pu(ji,jj) ) > epsi10 ) THEN ; zfu_ups(ji,jj,jl,jm) = zfu_ups(ji,jj,jl,jm) * pua_ups(ji,jj,jl) / pu(ji,jj)
+ ELSE ; zfu_ups(ji,jj,jl,jm) = 0._wp ; ENDIF
+ END_2D
+ DO_2D( 1, 1, 2, 1 )
+ IF( ABS( pv(ji,jj) ) > epsi10 ) THEN ; zfv_ups(ji,jj,jl,jm) = zfv_ups(ji,jj,jl,jm) * pva_ups(ji,jj,jl) / pv(ji,jj)
+ ELSE ; zfv_ups(ji,jj,jl,jm) = 0._wp ; ENDIF
+ END_2D
+
+ ! the new "volume" fluxes must also be "flux corrected" => we calculate the upstream solution and apply a limiter again
+ DO_2D( 0, 0, 0, 0 )
+ ztra = - ( ( zfu_ups(ji,jj,jl,jm) - zfu_ups(ji-1,jj,jl,jm) ) & ! add () for NP repro
+ & + ( zfv_ups(ji,jj,jl,jm) - zfv_ups(ji,jj-1,jl,jm) ) )
+ !
+ zt_ups(ji,jj,jl,jm) = ( ptc(ji,jj,jl,jm) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)
+ END_2D
+ END DO
ENDIF
- !
- ENDIF
+ ENDDO
+ ! lbc needed for nonosc
+ IF( MINVAL( pamsk(:) ) == 0._wp .AND. np_limiter == 1 ) &
+ & CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T', 1.0_wp, zfu_ho, 'U', -1.0_wp, zfv_ho, 'V', -1.0_wp )
+ ! flux limiter
+ DO jm = 1, ndim
+ IF( pamsk(jm) == 0._wp ) THEN
+ IF ( np_limiter == 1 ) THEN
+ CALL nonosc_ice( 1._wp, pdt, pu, pv, ptc(:,:,:,jm), zt_ups (:,:,:,jm), zfu_ups(:,:,:,jm), zfv_ups(:,:,:,jm), &
+ & zfu_ho (:,:,:,jm), zfv_ho (:,:,:,jm) ) ! gives zfu_ho(1,0,0,0) & zfv_ho(0,0,1,0)
+ ELSEIF( np_limiter == 2 .OR. np_limiter == 3 ) THEN
+ CALL limiter_x( pdt, pu, ptc(:,:,:,jm), zfu_ups(:,:,:,jm), zfu_ho(:,:,:,jm) )
+ CALL limiter_y( pdt, pv, ptc(:,:,:,jm), zfv_ups(:,:,:,jm), zfv_ho(:,:,:,jm) )
+
+ ENDIF
+ ENDIF
+ ENDDO
+ !
! --ho --ups
! in case of advection of A: output u*a and u*a
! -----------------------------------------------
IF( PRESENT( pua_ho ) ) THEN
DO jl = 1, jpl
DO_2D( 1, 0, 0, 0 )
- pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl)
- pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl)
+ pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl,1)
END_2D
DO_2D( 0, 0, 1, 0 )
- pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl)
- pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl)
+ pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl,1)
+ END_2D
+ DO_2D( 2, 1, 1, 1 )
+ pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl,1)
+ END_2D
+ DO_2D( 1, 1, 2, 1 )
+ pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl,1)
END_2D
END DO
ENDIF
!
! final trend with corrected fluxes
! ---------------------------------
- DO jl = 1, jpl
- DO_2D( 0, 0, 0, 0 )
- ztra = - ( ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) ) & ! add () for NP repro
- & + ( zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) ) )
- !
- ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)
- END_2D
- END DO
+ DO jm = 1, ndim
+ DO jl = 1, jpl
+ DO_2D( 0, 0, 0, 0 )
+ ztra = - ( ( zfu_ho(ji,jj,jl,jm) - zfu_ho(ji-1,jj,jl,jm) ) & ! add () for NP repro
+ & + ( zfv_ho(ji,jj,jl,jm) - zfv_ho(ji,jj-1,jl,jm) ) )
+ !
+ ptc(ji,jj,jl,jm) = ( ptc(ji,jj,jl,jm) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)
+ END_2D
+ END DO
+ ENDDO
+ !
+ DEALLOCATE( zfu_ho, zfv_ho, zfu_ups, zfv_ups, zt_ups )
!
END SUBROUTINE adv_umx
@@ -590,13 +796,13 @@ CONTAINS
!
INTEGER :: ji, jj, jl ! dummy loop indices
REAL(wp) :: ztra ! local scalar
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: zpt
+ REAL(wp), DIMENSION(jpi,jpj) :: zpt
!!----------------------------------------------------------------------
IF( .NOT. ll_upsxy ) THEN !** no alternate directions **!
!
DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+ DO_2D( 2, 1, 2, 1 )
pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl)
pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl)
END_2D
@@ -607,46 +813,38 @@ CONTAINS
IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==!
!
DO jl = 1, jpl !-- flux in x-direction
- DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls )
+ DO_2D( 2, 1, 2, 2 )
pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl)
END_2D
- END DO
- !
- DO jl = 1, jpl !-- first guess of tracer from u-flux
- DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls )
+ ! !-- first guess of tracer from u-flux
+ DO_2D( 1, 1, 2, 2 )
ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) ) &
& + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk)
!
- zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+ zpt(ji,jj) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
END_2D
- END DO
- !
- DO jl = 1, jpl !-- flux in y-direction
- DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 )
- pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl)
+ ! !-- flux in y-direction
+ DO_2D( 1, 1, 2, 1 )
+ pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1)
END_2D
END DO
!
ELSE !== even ice time step: adv_y then adv_x ==!
!
DO jl = 1, jpl !-- flux in y-direction
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 )
+ DO_2D( 2, 2, 2, 1 )
pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl)
END_2D
- END DO
- !
- DO jl = 1, jpl !-- first guess of tracer from v-flux
- DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 )
+ ! !-- first guess of tracer from v-flux
+ DO_2D( 2, 2, 1, 1 )
ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) ) &
& + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk)
!
- zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+ zpt(ji,jj) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
END_2D
- END DO
- !
- DO jl = 1, jpl !-- flux in x-direction
- DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 )
- pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl)
+ ! !-- flux in x-direction
+ DO_2D( 2, 1, 1, 1 )
+ pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj)
END_2D
END DO
!
@@ -655,7 +853,7 @@ CONTAINS
ENDIF
!
DO jl = 1, jpl !-- after tracer with upstream scheme
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 1, 1, 1, 1 )
ztra = - ( ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj ,jl) ) & ! add () for NP repro
& + ( pfv_ups(ji,jj,jl) - pfv_ups(ji ,jj-1,jl) ) ) &
& + ( ( pu (ji,jj ) - pu (ji-1,jj ) ) &
@@ -668,7 +866,7 @@ CONTAINS
END SUBROUTINE upstream
- SUBROUTINE cen2( pamsk, jt, kt, pdt, pt, pu, pv, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )
+ SUBROUTINE cen2( pamsk, jt, kt, pdt, pt, pu, pv, pfu_ups, pfv_ups, pfu_ho, pfv_ho )
!!---------------------------------------------------------------------
!! *** ROUTINE cen2 ***
!!
@@ -681,29 +879,26 @@ CONTAINS
REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt ! tracer fields
REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pu, pv ! 2 ice velocity components
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt_ups ! upstream guess of tracer
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pfu_ups, pfv_ups ! upstream fluxes
REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfu_ho, pfv_ho ! high order fluxes
!
INTEGER :: ji, jj, jl ! dummy loop indices
REAL(wp) :: ztra ! local scalar
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: zpt
+ REAL(wp), DIMENSION(jpi,jpj) :: zpt
!!----------------------------------------------------------------------
!
IF( .NOT.ll_hoxy ) THEN !** no alternate directions **!
!
DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls )
+ DO_2D( 2, 1, 2, 2 )
pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj ,jl) )
END_2D
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 )
+ DO_2D( 2, 2, 2, 1 )
pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji ,jj+1,jl) )
END_2D
END DO
!
- IF ( np_limiter == 1 ) THEN
- CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )
- ELSEIF( np_limiter == 2 .OR. np_limiter == 3 ) THEN
+ IF( np_limiter == 2 .OR. np_limiter == 3 ) THEN
CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )
CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )
ENDIF
@@ -713,24 +908,23 @@ CONTAINS
IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==!
!
DO jl = 1, jpl !-- flux in x-direction
- DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls )
+ DO_2D( 2, 1, 2, 2 )
pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) )
END_2D
END DO
IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )
DO jl = 1, jpl !-- first guess of tracer from u-flux
- DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls )
+ DO_2D( 1, 1, 2, 2 )
ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) ) &
& + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk)
!
- zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+ zpt(ji,jj) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
END_2D
- END DO
- DO jl = 1, jpl !-- flux in y-direction
- DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 )
- pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) )
+ ! !-- flux in y-direction
+ DO_2D( 1, 1, 2, 1 )
+ pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj) + zpt(ji,jj+1) )
END_2D
END DO
IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )
@@ -738,37 +932,36 @@ CONTAINS
ELSE !== even ice time step: adv_y then adv_x ==!
!
DO jl = 1, jpl !-- flux in y-direction
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 )
+ DO_2D( 2, 2, 2, 1 )
pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) )
END_2D
END DO
IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )
!
DO jl = 1, jpl !-- first guess of tracer from v-flux
- DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 )
+ DO_2D( 2, 2, 1, 1 )
ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) ) &
& + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk)
!
- zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
+ zpt(ji,jj) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1)
END_2D
- END DO
- !
- DO jl = 1, jpl !-- flux in x-direction
- DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 )
- pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) )
+ !
+ ! !-- flux in x-direction
+ DO_2D( 2, 1, 1, 1 )
+ pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj) + zpt(ji+1,jj) )
END_2D
END DO
IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )
ENDIF
- IF( np_limiter == 1 ) CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )
ENDIF
-
+ !
+ !
END SUBROUTINE cen2
- SUBROUTINE macho( pamsk, kn_umx, jt, kt, pdt, pt, pu, pv, pubox, pvbox, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )
+ SUBROUTINE macho( pamsk, kn_umx, jt, kt, pdt, pt, pu, pv, pubox, pvbox, pfu_ups, pfv_ups, pfu_ho, pfv_ho )
!!---------------------------------------------------------------------
!! *** ROUTINE macho ***
!!
@@ -778,76 +971,95 @@ CONTAINS
!!
!! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74.
!!----------------------------------------------------------------------
- REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0)
- INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2)
- INTEGER , INTENT(in ) :: jt ! number of sub-iteration
- INTEGER , INTENT(in ) :: kt ! number of iteration
- REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt ! tracer fields
- REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pu, pv ! 2 ice velocity components
- REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pubox, pvbox ! upstream velocity
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt_ups ! upstream guess of tracer
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pfu_ups, pfv_ups ! upstream fluxes
- REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfu_ho, pfv_ho ! high order fluxes
+ REAL(wp), DIMENSION(:) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0)
+ INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2)
+ INTEGER , INTENT(in ) :: jt ! number of sub-iteration
+ INTEGER , INTENT(in ) :: kt ! number of iteration
+ REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! tracer fields
+ REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pu, pv ! 2 ice velocity components
+ REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pubox, pvbox ! upstream velocity
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pfu_ups, pfv_ups ! upstream fluxes
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pfu_ho, pfv_ho ! high order fluxes (only out)
!
- INTEGER :: ji, jj, jl ! dummy loop indices
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: zt_u, zt_v, zpt
+ INTEGER :: ji, jj, jl, jm ! dummy loop indices
+ INTEGER :: ndim ! number of variables to advect
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zt_u, zt_v, zpt
!!----------------------------------------------------------------------
+ ndim = SIZE( pt, dim=4 )
+ !
+ ALLOCATE( zt_u(jpi,jpj,jpl,ndim), zt_v(jpi,jpj,jpl,ndim), zpt(jpi,jpj,jpl,ndim) )
+
!
IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==!
!
! !-- ultimate interpolation of pt at u-point --!
- CALL ultimate_x( nn_hls, pamsk, kn_umx, pdt, pt, pu, zt_u, pfu_ho )
+ CALL ultimate_x( 2, pamsk, kn_umx, pdt, pt, pu, zt_u, pfu_ho )
+ !
! !-- limiter in x --!
- IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )
+ DO jm = 1, ndim
+ IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt(:,:,:,jm), pfu_ups(:,:,:,jm), pfu_ho(:,:,:,jm) )
+ END DO
! !-- advective form update in zpt --!
- DO jl = 1, jpl
- DO_2D( 0, 0, nn_hls, nn_hls )
- zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pubox(ji,jj ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t (ji,jj) &
- & + pt (ji,jj,jl) * ( pu (ji,jj ) - pu (ji-1,jj ) ) * r1_e1e2t(ji,jj) &
- & * pamsk &
- & ) * pdt ) * tmask(ji,jj,1)
- END_2D
+ DO jm = 1, ndim
+ DO jl = 1, jpl
+ DO_2D( 1, 1, 2, 2 )
+ zpt(ji,jj,jl,jm) = (pt(ji,jj,jl,jm) - ( pubox(ji,jj ) * ( zt_u(ji,jj,jl,jm) - zt_u(ji-1,jj,jl,jm) ) &
+ & * r1_e1t(ji,jj) &
+ & + pt(ji,jj,jl,jm) * ( pu (ji,jj) - pu (ji-1,jj) ) * pamsk(jm) &
+ & * r1_e1e2t(ji,jj) &
+ & ) * pdt) * tmask(ji,jj,1)
+ END_2D
+ END DO
END DO
- !
! !-- ultimate interpolation of pt at v-point --!
IF( ll_hoxy ) THEN
- CALL ultimate_y( 0, pamsk, kn_umx, pdt, zpt, pv, zt_v, pfv_ho )
+ CALL ultimate_y( 1, pamsk, kn_umx, pdt, zpt, pv, zt_v, pfv_ho )
ELSE
- CALL ultimate_y( 0, pamsk, kn_umx, pdt, pt , pv, zt_v, pfv_ho )
+ CALL ultimate_y( 1, pamsk, kn_umx, pdt, pt, pv, zt_v, pfv_ho )
ENDIF
! !-- limiter in y --!
- IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )
+ DO jm = 1, ndim
+ IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt(:,:,:,jm), pfv_ups(:,:,:,jm), pfv_ho(:,:,:,jm) )
+ END DO
!
!
ELSE !== even ice time step: adv_y then adv_x ==!
!
! !-- ultimate interpolation of pt at v-point --!
- CALL ultimate_y( nn_hls, pamsk, kn_umx, pdt, pt, pv, zt_v, pfv_ho )
+ CALL ultimate_y( 2, pamsk, kn_umx, pdt, pt, pv, zt_v, pfv_ho )
+ !
! !-- limiter in y --!
- IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )
+ DO jm = 1, ndim
+ IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt(:,:,:,jm), pfv_ups(:,:,:,jm), pfv_ho(:,:,:,jm) )
+ END DO
! !-- advective form update in zpt --!
- DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls, 0, 0 )
- zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pvbox(ji,jj ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t (ji,jj) &
- & + pt (ji,jj,jl) * ( pv (ji,jj ) - pv (ji,jj-1 ) ) * r1_e1e2t(ji,jj) &
- & * pamsk &
- & ) * pdt ) * tmask(ji,jj,1)
- END_2D
+ DO jm = 1, ndim
+ DO jl = 1, jpl
+ DO_2D( 2, 2, 1, 1 )
+ zpt(ji,jj,jl,jm) = (pt(ji,jj,jl,jm) - ( pvbox(ji,jj ) * ( zt_v(ji,jj,jl,jm) - zt_v(ji,jj-1,jl,jm) ) &
+ & * r1_e2t(ji,jj) &
+ & + pt(ji,jj,jl,jm) * ( pv (ji,jj) - pv (ji,jj-1) ) * pamsk(jm) &
+ & * r1_e1e2t(ji,jj) &
+ & ) * pdt) * tmask(ji,jj,1)
+ END_2D
+ END DO
END DO
- !
! !-- ultimate interpolation of pt at u-point --!
IF( ll_hoxy ) THEN
- CALL ultimate_x( 0, pamsk, kn_umx, pdt, zpt, pu, zt_u, pfu_ho )
+ CALL ultimate_x( 1, pamsk, kn_umx, pdt, zpt, pu, zt_u, pfu_ho )
ELSE
- CALL ultimate_x( 0, pamsk, kn_umx, pdt, pt , pu, zt_u, pfu_ho )
+ CALL ultimate_x( 1, pamsk, kn_umx, pdt, pt, pu, zt_u, pfu_ho )
ENDIF
! !-- limiter in x --!
- IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )
+ DO jm = 1, ndim
+ IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt(:,:,:,jm), pfu_ups(:,:,:,jm), pfu_ho(:,:,:,jm) )
+ END DO
!
ENDIF
+
+ DEALLOCATE( zt_u, zt_v, zpt )
- IF( np_limiter == 1 ) CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )
!
END SUBROUTINE macho
@@ -862,148 +1074,149 @@ CONTAINS
!!
!! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74.
!!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kloop ! either 0 or nn_hls depending on the order of the call
- REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0)
- INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2)
- REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
- REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pu ! ice i-velocity component
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt ! tracer fields
- REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pt_u ! tracer at u-point
- REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfu_ho ! high order flux
- !
- INTEGER :: ji, jj, jl ! dummy loop indices
+ INTEGER , INTENT(in ) :: kloop ! either 0 or nn_hls depending on the order of the call
+ REAL(wp), DIMENSION(:) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0)
+ INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2)
+ REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
+ REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pu ! ice i-velocity component
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! tracer fields
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pt_u ! tracer at u-point (only out)
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pfu_ho ! high order flux (only out)
+ !
+ INTEGER :: ji, jj, jl, jm ! dummy loop indices
+ INTEGER :: ndim ! number of variables to advect
REAL(wp) :: zcu, zdx2, zdx4 ! - -
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztu1, ztu2, ztu3, ztu4
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztu1, ztu2, ztu3, ztu4
!!----------------------------------------------------------------------
+ ndim = SIZE( pt, dim=4 )
!
- ! !-- Laplacian in i-direction --!
- DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls-1, kloop, kloop ) ! First derivative (gradient)
- ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
- END_2D
- DO_2D( nn_hls-1, nn_hls-1, kloop, kloop ) ! Second derivative (Laplacian)
- ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj)
- END_2D
-!!$ DO jj = 2, jpjm1 ! First derivative (gradient)
-!!$ DO ji = 1, jpim1
-!!$ ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
-!!$ END DO
-!!$ ! ! Second derivative (Laplacian)
-!!$ DO ji = 2, jpim1
-!!$ ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj)
-!!$ END DO
-!!$ END DO
- END DO
- !
- ! !-- BiLaplacian in i-direction --!
- DO jl = 1, jpl
- DO_2D( 1, 0, kloop, kloop ) ! Third derivative
- ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
- END_2D
- DO_2D( 0, 0, kloop, kloop ) ! Fourth derivative
- ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj)
- END_2D
-!!$ DO jj = 2, jpjm1 ! Third derivative
-!!$ DO ji = 1, jpim1
-!!$ ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
-!!$ END DO
-!!$ ! ! Fourth derivative
-!!$ DO ji = 2, jpim1
-!!$ ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj)
-!!$ END DO
-!!$ END DO
- END DO
+ ALLOCATE( ztu1(jpi,jpj,jpl,ndim), ztu2(jpi,jpj,jpl,ndim), ztu3(jpi,jpj,jpl,ndim), ztu4(jpi,jpj,jpl,ndim) )
!
+ DO jm = 1, ndim
+ ! !-- Laplacian in i-direction --!
+ IF( kn_umx >= 3 ) THEN
+ DO jl = 1, jpl
+ DO_2D( 2, 1, kloop, kloop ) ! First derivative (gradient)
+ ztu1(ji,jj,jl,jm) = ( pt(ji+1,jj,jl,jm) - pt(ji,jj,jl,jm) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
+ END_2D
+ DO_2D( 1, 1, kloop, kloop ) ! Second derivative (Laplacian)
+ ztu2(ji,jj,jl,jm) = ( ztu1(ji,jj,jl,jm) - ztu1(ji-1,jj,jl,jm) ) * r1_e1t(ji,jj)
+ END_2D
+ END DO
+ ENDIF
+ ! !-- BiLaplacian in i-direction --!
+ IF( kn_umx == 5 ) THEN
+ DO jl = 1, jpl
+ DO_2D( 1, 0, kloop, kloop ) ! Third derivative
+ ztu3(ji,jj,jl,jm) = ( ztu2(ji+1,jj,jl,jm) - ztu2(ji,jj,jl,jm) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
+ END_2D
+ DO_2D( 0, 0, kloop, kloop ) ! Fourth derivative
+ ztu4(ji,jj,jl,jm) = ( ztu3(ji,jj,jl,jm) - ztu3(ji-1,jj,jl,jm) ) * r1_e1t(ji,jj)
+ END_2D
+ END DO
+ ENDIF
+ !
+ ENDDO
+ ! lbc only needed for some orders
+ IF ( kn_umx == 3 .OR. kn_umx == 4 ) THEN ; CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp )
+ ELSEIF( kn_umx == 5 ) THEN ; CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp, ztu4, 'T', 1.0_wp )
+ ENDIF
!
- SELECT CASE (kn_umx )
!
- CASE( 1 ) !== 1st order central TIM ==! (Eq. 21)
+ DO jm = 1, ndim
!
- DO jl = 1, jpl
- DO_2D( 1, 0, kloop, kloop )
- pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt(ji+1,jj,jl) + pt(ji,jj,jl) ) &
- & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
- END_2D
- END DO
- !
- CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23)
- !
- DO jl = 1, jpl
- DO_2D( 1, 0, kloop, kloop )
- zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
- pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt(ji+1,jj,jl) + pt(ji,jj,jl) ) &
- & - zcu * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
- END_2D
- END DO
- !
- CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24)
- !
- DO jl = 1, jpl
- DO_2D( 1, 0, kloop, kloop )
- zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
- zdx2 = e1u(ji,jj) * e1u(ji,jj)
-!!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj)
- pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) ) &
- & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) &
- & + r1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) ) &
- & - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) )
- END_2D
- END DO
- !
- CASE( 4 ) !== 4th order central TIM ==! (Eq. 27)
- !
- DO jl = 1, jpl
- DO_2D( 1, 0, kloop, kloop )
- zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
- zdx2 = e1u(ji,jj) * e1u(ji,jj)
-!!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj)
- pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) ) &
- & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) &
- & + r1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) ) &
- & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) )
- END_2D
- END DO
- !
- CASE( 5 ) !== 5th order central TIM ==! (Eq. 29)
+ SELECT CASE ( kn_umx )
+ !
+ CASE( 1 ) !== 1st order central TIM ==! (Eq. 21)
+ !
+ DO jl = 1, jpl
+ DO_2D( 2, 1, kloop, kloop )
+ pt_u(ji,jj,jl,jm) = 0.5_wp * umask(ji,jj,1) * ( ( pt(ji+1,jj,jl,jm) + pt(ji,jj,jl,jm) ) &
+ & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl,jm) - pt(ji,jj,jl,jm) ) )
+ END_2D
+ END DO
+ !
+ CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23)
+ !
+ DO jl = 1, jpl
+ DO_2D( 2, 1, kloop, kloop )
+ zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+ pt_u(ji,jj,jl,jm) = 0.5_wp * umask(ji,jj,1) * ( ( pt(ji+1,jj,jl,jm) + pt(ji,jj,jl,jm) ) &
+ & - zcu * ( pt(ji+1,jj,jl,jm) - pt(ji,jj,jl,jm) ) )
+ END_2D
+ END DO
+ !
+ CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24)
+ !
+ DO jl = 1, jpl
+ DO_2D( 2, 1, kloop, kloop )
+ zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+ zdx2 = e1u(ji,jj) * e1u(ji,jj)
+ !!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj)
+ pt_u(ji,jj,jl,jm) = 0.5_wp * umask(ji,jj,1) * ( ( ( pt (ji+1,jj,jl,jm) + pt (ji,jj,jl,jm) ) &
+ & - zcu * ( pt (ji+1,jj,jl,jm) - pt (ji,jj,jl,jm) ) ) &
+ & + r1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ( ztu2(ji+1,jj,jl,jm) + ztu2(ji,jj,jl,jm) ) &
+ & - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl,jm) - ztu2(ji,jj,jl,jm) ) ) )
+ END_2D
+ END DO
+ !
+ CASE( 4 ) !== 4th order central TIM ==! (Eq. 27)
+ !
+ DO jl = 1, jpl
+ DO_2D( 2, 1, kloop, kloop )
+ zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+ zdx2 = e1u(ji,jj) * e1u(ji,jj)
+ !!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj)
+ pt_u(ji,jj,jl,jm) = 0.5_wp * umask(ji,jj,1) * ( ( ( pt (ji+1,jj,jl,jm) + pt (ji,jj,jl,jm) ) &
+ & - zcu * ( pt (ji+1,jj,jl,jm) - pt (ji,jj,jl,jm) ) ) &
+ & + r1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ( ztu2(ji+1,jj,jl,jm) + ztu2(ji,jj,jl,jm) ) &
+ & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl,jm) - ztu2(ji,jj,jl,jm) ) ) )
+ END_2D
+ END DO
+ !
+ CASE( 5 ) !== 5th order central TIM ==! (Eq. 29)
+ !
+ DO jl = 1, jpl
+ DO_2D( 2, 1, kloop, kloop )
+ zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+ zdx2 = e1u(ji,jj) * e1u(ji,jj)
+ !!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj)
+ zdx4 = zdx2 * zdx2
+ pt_u(ji,jj,jl,jm) = 0.5_wp * umask(ji,jj,1) * ( ( ( pt (ji+1,jj,jl,jm) + pt (ji,jj,jl,jm) ) &
+ & - zcu * ( pt (ji+1,jj,jl,jm) - pt (ji,jj,jl,jm) ) ) &
+ & + r1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ( ztu2(ji+1,jj,jl,jm) + ztu2(ji,jj,jl,jm) ) &
+ & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl,jm) - ztu2(ji,jj,jl,jm) ) ) &
+ & + r1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ((ztu4(ji+1,jj,jl,jm) + ztu4(ji,jj,jl,jm) ) &
+ & - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl,jm) - ztu4(ji,jj,jl,jm) ) ) )
+ END_2D
+ END DO
+ !
+ END SELECT
!
- CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp )
!
+ ! if pt at u-point is negative then use the upstream value
+ ! this should not be necessary if a proper sea-ice mask is set in Ultimate
+ ! to degrade the order of the scheme when necessary (for ex. at the ice edge)
+ IF( ll_neg ) THEN
+ DO jl = 1, jpl
+ DO_2D( 2, 1, kloop, kloop )
+ IF( pt_u(ji,jj,jl,jm) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk(jm) == 0. ) ) THEN
+ pt_u(ji,jj,jl,jm) = 0.5_wp * umask(ji,jj,1) * ( ( pt(ji+1,jj,jl,jm) + pt(ji,jj,jl,jm) ) &
+ & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl,jm) - pt(ji,jj,jl,jm) ) )
+ ENDIF
+ END_2D
+ END DO
+ ENDIF
+ ! !-- High order flux in i-direction --!
DO jl = 1, jpl
- DO_2D( 1, 0, kloop, kloop )
- zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
- zdx2 = e1u(ji,jj) * e1u(ji,jj)
-!!rachid zdx2 = e1u(ji,jj) * e1t(ji,jj)
- zdx4 = zdx2 * zdx2
- pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( ( pt (ji+1,jj,jl) + pt (ji,jj,jl) ) &
- & - zcu * ( pt (ji+1,jj,jl) - pt (ji,jj,jl) ) ) &
- & + r1_6 * zdx2 * ( zcu*zcu - 1._wp ) * ( ( ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl) ) &
- & - 0.5_wp * zcu * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) &
- & + r1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ((ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl) ) &
- & - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) )
+ DO_2D( 2, 1, 1, 1 )
+ pfu_ho(ji,jj,jl,jm) = pu(ji,jj) * pt_u(ji,jj,jl,jm)
END_2D
END DO
!
- END SELECT
- !
- ! if pt at u-point is negative then use the upstream value
- ! this should not be necessary if a proper sea-ice mask is set in Ultimate
- ! to degrade the order of the scheme when necessary (for ex. at the ice edge)
- IF( ll_neg ) THEN
- DO jl = 1, jpl
- DO_2D( 1, 0, kloop, kloop )
- IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN
- pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( ( pt(ji+1,jj,jl) + pt(ji,jj,jl) ) &
- & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
- ENDIF
- END_2D
- END DO
- ENDIF
- ! !-- High order flux in i-direction --!
- DO jl = 1, jpl
- DO_2D( 1, 0, 0, 0 )
- pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl)
- END_2D
- END DO
+ ENDDO
+
+ DEALLOCATE( ztu1, ztu2, ztu3, ztu4 )
!
END SUBROUTINE ultimate_x
@@ -1018,126 +1231,143 @@ CONTAINS
!!
!! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74.
!!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kloop ! either 0 or nn_hls depending on the order of the call
- REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0)
- INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2)
- REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
- REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pv ! ice j-velocity component
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt ! tracer fields
- REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pt_v ! tracer at v-point
- REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfv_ho ! high order flux
- !
- INTEGER :: ji, jj, jl ! dummy loop indices
+ INTEGER , INTENT(in ) :: kloop ! either 0 or nn_hls depending on the order of the call
+ REAL(wp), DIMENSION(:) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0)
+ INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2)
+ REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
+ REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pv ! ice j-velocity component
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! tracer fields
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pt_v ! tracer at v-point (only out)
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pfv_ho ! high order flux (only out)
+ !
+ INTEGER :: ji, jj, jl, jm ! dummy loop indices
+ INTEGER :: ndim ! number of variables to advect
REAL(wp) :: zcv, zdy2, zdy4 ! - -
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztv1, ztv2, ztv3, ztv4
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztv1, ztv2, ztv3, ztv4
!!----------------------------------------------------------------------
+ ndim = SIZE( pt, dim=4 )
!
- ! !-- Laplacian in j-direction --!
- DO jl = 1, jpl
- DO_2D( kloop, kloop, nn_hls, nn_hls-1 ) ! First derivative (gradient)
- ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
- END_2D
- DO_2D( kloop, kloop, nn_hls-1, nn_hls-1 ) ! Second derivative (Laplacian)
- ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj)
- END_2D
- END DO
+ ALLOCATE( ztv1(jpi,jpj,jpl,ndim), ztv2(jpi,jpj,jpl,ndim), ztv3(jpi,jpj,jpl,ndim), ztv4(jpi,jpj,jpl,ndim) )
!
- ! !-- BiLaplacian in j-direction --!
- DO jl = 1, jpl
- DO_2D( kloop, kloop, 1, 0 ) ! Third derivative
- ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
- END_2D
- DO_2D( kloop, kloop, 0, 0 ) ! Fourth derivative
- ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj)
- END_2D
- END DO
+ DO jm = 1, ndim
+ ! !-- Laplacian in j-direction --!
+ IF( kn_umx >= 3 ) THEN
+ DO jl = 1, jpl
+ DO_2D( kloop, kloop, 2, 1 ) ! First derivative (gradient)
+ ztv1(ji,jj,jl,jm) = ( pt(ji,jj+1,jl,jm) - pt(ji,jj,jl,jm) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
+ END_2D
+ DO_2D( kloop, kloop, 1, 1 ) ! Second derivative (Laplacian)
+ ztv2(ji,jj,jl,jm) = ( ztv1(ji,jj,jl,jm) - ztv1(ji,jj-1,jl,jm) ) * r1_e2t(ji,jj)
+ END_2D
+ END DO
+ ENDIF
+ ! !-- BiLaplacian in j-direction --!
+ IF( kn_umx == 5 ) THEN
+ DO jl = 1, jpl
+ DO_2D( kloop, kloop, 1, 0 ) ! Third derivative
+ ztv3(ji,jj,jl,jm) = ( ztv2(ji,jj+1,jl,jm) - ztv2(ji,jj,jl,jm) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
+ END_2D
+ DO_2D( kloop, kloop, 0, 0 ) ! Fourth derivative
+ ztv4(ji,jj,jl,jm) = ( ztv3(ji,jj,jl,jm) - ztv3(ji,jj-1,jl,jm) ) * r1_e2t(ji,jj)
+ END_2D
+ END DO
+ ENDIF
+ !
+ ENDDO
+ ! lbc only needed for some orders
+ IF ( kn_umx == 3 .OR. kn_umx == 4 ) THEN ; CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1.0_wp )
+ ELSEIF( kn_umx == 5 ) THEN ; CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1.0_wp, ztv4, 'T', 1.0_wp )
+ ENDIF
!
!
- SELECT CASE (kn_umx )
- !
- CASE( 1 ) !== 1st order central TIM ==! (Eq. 21)
- DO jl = 1, jpl
- DO_2D( kloop, kloop, 1, 0 )
- pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) &
- & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
- END_2D
- END DO
- !
- CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23)
- DO jl = 1, jpl
- DO_2D( kloop, kloop, 1, 0 )
- zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
- pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) &
- & - zcv * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
- END_2D
- END DO
- !
- CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24)
- DO jl = 1, jpl
- DO_2D( kloop, kloop, 1, 0 )
- zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
- zdy2 = e2v(ji,jj) * e2v(ji,jj)
-!!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj)
- pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) ) &
- & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) &
- & + r1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) ) &
- & - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) )
- END_2D
- END DO
- !
- CASE( 4 ) !== 4th order central TIM ==! (Eq. 27)
- DO jl = 1, jpl
- DO_2D( kloop, kloop, 1, 0 )
- zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
- zdy2 = e2v(ji,jj) * e2v(ji,jj)
-!!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj)
- pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) ) &
- & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) &
- & + r1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) ) &
- & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) )
- END_2D
- END DO
- !
- CASE( 5 ) !== 5th order central TIM ==! (Eq. 29)
- !
- CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1.0_wp )
+ DO jm = 1, ndim
+ SELECT CASE ( kn_umx )
+ !
+ CASE( 1 ) !== 1st order central TIM ==! (Eq. 21)
+ DO jl = 1, jpl
+ DO_2D( kloop, kloop, 2, 1 )
+ pt_v(ji,jj,jl,jm) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl,jm) + pt(ji,jj,jl,jm) ) &
+ & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl,jm) - pt(ji,jj,jl,jm) ) )
+ END_2D
+ END DO
+ !
+ CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23)
+ DO jl = 1, jpl
+ DO_2D( kloop, kloop, 2, 1 )
+ zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+ pt_v(ji,jj,jl,jm) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl,jm) + pt(ji,jj,jl,jm) ) &
+ & - zcv * ( pt(ji,jj+1,jl,jm) - pt(ji,jj,jl,jm) ) )
+ END_2D
+ END DO
+ !
+ CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24)
+ DO jl = 1, jpl
+ DO_2D( kloop, kloop, 2, 1 )
+ zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+ zdy2 = e2v(ji,jj) * e2v(ji,jj)
+ !!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj)
+ pt_v(ji,jj,jl,jm) = 0.5_wp * vmask(ji,jj,1) * ( ( ( pt (ji,jj+1,jl,jm) + pt (ji,jj,jl,jm) ) &
+ & - zcv * ( pt (ji,jj+1,jl,jm) - pt (ji,jj,jl,jm) ) ) &
+ & + r1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ( ztv2(ji,jj+1,jl,jm) + ztv2(ji,jj,jl,jm) ) &
+ & - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl,jm) - ztv2(ji,jj,jl,jm) ) ) )
+ END_2D
+ END DO
+ !
+ CASE( 4 ) !== 4th order central TIM ==! (Eq. 27)
+ DO jl = 1, jpl
+ DO_2D( kloop, kloop, 2, 1 )
+ zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+ zdy2 = e2v(ji,jj) * e2v(ji,jj)
+ !!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj)
+ pt_v(ji,jj,jl,jm) = 0.5_wp * vmask(ji,jj,1) * ( ( ( pt (ji,jj+1,jl,jm) + pt (ji,jj,jl,jm) ) &
+ & - zcv * ( pt (ji,jj+1,jl,jm) - pt (ji,jj,jl,jm) ) ) &
+ & + r1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ( ztv2(ji,jj+1,jl,jm) + ztv2(ji,jj,jl,jm) ) &
+ & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl,jm) - ztv2(ji,jj,jl,jm) ) ) )
+ END_2D
+ END DO
+ !
+ CASE( 5 ) !== 5th order central TIM ==! (Eq. 29)
+ !
+ DO jl = 1, jpl
+ DO_2D( kloop, kloop, 2, 1 )
+ zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+ zdy2 = e2v(ji,jj) * e2v(ji,jj)
+ !!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj)
+ zdy4 = zdy2 * zdy2
+ pt_v(ji,jj,jl,jm) = 0.5_wp * vmask(ji,jj,1) * ( ( ( pt (ji,jj+1,jl,jm) + pt (ji,jj,jl,jm) ) &
+ & - zcv * ( pt (ji,jj+1,jl,jm) - pt (ji,jj,jl,jm) ) ) &
+ & + r1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ( ztv2(ji,jj+1,jl,jm) + ztv2(ji,jj,jl,jm) ) &
+ & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl,jm) - ztv2(ji,jj,jl,jm) ) ) &
+ & + r1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ((ztv4(ji,jj+1,jl,jm) + ztv4(ji,jj,jl,jm) ) &
+ & - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl,jm) - ztv4(ji,jj,jl,jm) ) ) )
+ END_2D
+ END DO
+ !
+ END SELECT
!
+ ! if pt at v-point is negative then use the upstream value
+ ! this should not be necessary if a proper sea-ice mask is set in Ultimate
+ ! to degrade the order of the scheme when necessary (for ex. at the ice edge)
+ IF( ll_neg ) THEN
+ DO jl = 1, jpl
+ DO_2D( kloop, kloop, 2, 1 )
+ IF( pt_v(ji,jj,jl,jm) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk(jm) == 0. ) ) THEN
+ pt_v(ji,jj,jl,jm) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl,jm) + pt(ji,jj,jl,jm) ) &
+ & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl,jm) - pt(ji,jj,jl,jm) ) )
+ ENDIF
+ END_2D
+ END DO
+ ENDIF
+ ! !-- High order flux in j-direction --!
DO jl = 1, jpl
- DO_2D( kloop, kloop, 1, 0 )
- zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
- zdy2 = e2v(ji,jj) * e2v(ji,jj)
-!!rachid zdy2 = e2v(ji,jj) * e2t(ji,jj)
- zdy4 = zdy2 * zdy2
- pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( ( pt (ji,jj+1,jl) + pt (ji,jj,jl) ) &
- & - zcv * ( pt (ji,jj+1,jl) - pt (ji,jj,jl) ) ) &
- & + r1_6 * zdy2 * ( zcv*zcv - 1._wp ) * ( ( ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl) ) &
- & - 0.5_wp * zcv * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) &
- & + r1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ((ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl) ) &
- & - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) )
+ DO_2D( 1, 1, 2, 1 )
+ pfv_ho(ji,jj,jl,jm) = pv(ji,jj) * pt_v(ji,jj,jl,jm)
END_2D
END DO
!
- END SELECT
+ ENDDO
!
- ! if pt at v-point is negative then use the upstream value
- ! this should not be necessary if a proper sea-ice mask is set in Ultimate
- ! to degrade the order of the scheme when necessary (for ex. at the ice edge)
- IF( ll_neg ) THEN
- DO jl = 1, jpl
- DO_2D( kloop, kloop, 1, 0 )
- IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN
- pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) &
- & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) )
- ENDIF
- END_2D
- END DO
- ENDIF
- ! !-- High order flux in j-direction --!
- DO jl = 1, jpl
- DO_2D( 0, 0, 1, 0 )
- pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl)
- END_2D
- END DO
+ DEALLOCATE( ztv1, ztv2, ztv3, ztv4 )
!
END SUBROUTINE ultimate_y
@@ -1153,31 +1383,32 @@ CONTAINS
!!----------------------------------------------------------------------
REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0)
REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
- REAL(wp), DIMENSION (:,: ), INTENT(in ) :: pu ! ice i-velocity => u*e2
- REAL(wp), DIMENSION (:,: ), INTENT(in ) :: pv ! ice j-velocity => v*e1
+ REAL(wp), DIMENSION (:,:) , INTENT(in ) :: pu ! ice i-velocity => u*e2
+ REAL(wp), DIMENSION (:,:) , INTENT(in ) :: pv ! ice j-velocity => v*e1
REAL(wp), DIMENSION (:,:,:), INTENT(in ) :: pt, pt_ups ! before field & upstream guess of after field
REAL(wp), DIMENSION (:,:,:), INTENT(in ) :: pfv_ups, pfu_ups ! upstream flux
REAL(wp), DIMENSION (:,:,:), INTENT(inout) :: pfv_ho, pfu_ho ! monotonic flux
!
- INTEGER :: ji, jj, jl ! dummy loop indices
+ INTEGER :: ji, jj, jl ! dummy loop indices
REAL(wp) :: zpos, zneg, zbig, zup, zdo, z1_dt ! local scalars
REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zcoef, zzt ! - -
- REAL(wp), DIMENSION(jpi,jpj ) :: zbup, zbdo
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: zbetup, zbetdo, zti_ups, ztj_ups
+ REAL(wp), DIMENSION(jpi,jpj) :: zbup, zbdo
+ REAL(wp), DIMENSION(jpi,jpj,jpl) :: zbetup, zbetdo
!!----------------------------------------------------------------------
zbig = 1.e+20_wp ! works ok with simple/double precison
+ !
! antidiffusive flux : high order minus low order
! --------------------------------------------------
DO jl = 1, jpl
- DO_2D( 1, 0, 0, 0 )
+ DO_2D( 2, 1, 1, 1 )
pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)
END_2D
- DO_2D( 0, 0, 1, 0 )
+ DO_2D( 1, 1, 2, 1 )
pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)
END_2D
END DO
-
+
! extreme case where pfu_ho has to be zero
! ----------------------------------------
! pfu_ho
@@ -1186,23 +1417,15 @@ CONTAINS
! | | | * |
! | | | | *
! t_ups : i-1 i i+1 i+2
- IF( ll_prelim ) THEN
-
- DO jl = 1, jpl
- DO_2D( 0, 0, 0, 0 )
- zti_ups(ji,jj,jl)= pt_ups(ji+1,jj ,jl)
- ztj_ups(ji,jj,jl)= pt_ups(ji ,jj+1,jl)
- END_2D
- END DO
- CALL lbc_lnk( 'icedyn_adv_umx', zti_ups, 'T', 1.0_wp, ztj_ups, 'T', 1.0_wp )
-
+ IF( ll_prelim ) THEN
+
DO jl = 1, jpl
DO_2D( 0, 0, 0, 0 )
IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND. &
& pfv_ho(ji,jj,jl) * ( pt_ups(ji ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN
!
- IF( pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND. &
- & pfv_ho(ji,jj,jl) * ( ztj_ups(ji ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN
+ IF( pfu_ho(ji,jj,jl) * ( pt_ups(ji+2,jj ,jl) - pt_ups(ji+1,jj ,jl) ) <= 0._wp .AND. &
+ & pfv_ho(ji,jj,jl) * ( pt_ups(ji ,jj+2,jl) - pt_ups(ji ,jj+1,jl) ) <= 0._wp ) THEN
pfu_ho(ji,jj,jl)=0._wp
pfv_ho(ji,jj,jl)=0._wp
ENDIF
@@ -1217,16 +1440,17 @@ CONTAINS
END_2D
END DO
CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp, pfv_ho, 'V', -1.0_wp ) ! lateral boundary cond.
-
+
ENDIF
! Search local extrema
! --------------------
! max/min of pt & pt_ups with large negative/positive value (-/+zbig) outside ice cover
z1_dt = 1._wp / pdt
- DO jl = 1, jpl
- DO_2D( 1, 1, 1, 1 )
+ DO jl = 1, jpl
+
+ DO_2D( 2, 2, 2, 2 )
IF ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN
zbup(ji,jj) = -zbig
zbdo(ji,jj) = zbig
@@ -1241,8 +1465,8 @@ CONTAINS
zbdo(ji,jj) = MIN( pt(ji,jj,jl) , pt_ups(ji,jj,jl) )
ENDIF
END_2D
-
- DO_2D( 0, 0, 0, 0 )
+
+ DO_2D( 1, 1, 1, 1 )
!
zup = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) ) ! search max/min in neighbourhood
zdo = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) )
@@ -1272,9 +1496,7 @@ CONTAINS
IF( zdo == zbig ) zbetdo(ji,jj,jl) = 0._wp ! zbig
!
END_2D
- END DO
- CALL lbc_lnk( 'icedyn_adv_umx', zbetup, 'T', 1.0_wp, zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign)
-
+ END DO
! monotonic flux in the y direction
! ---------------------------------
@@ -1289,7 +1511,7 @@ CONTAINS
pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) * zcoef + pfu_ups(ji,jj,jl)
!
END_2D
-
+
DO_2D( 0, 0, 1, 0 )
zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) )
zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) )
@@ -1300,9 +1522,10 @@ CONTAINS
pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) * zcoef + pfv_ups(ji,jj,jl)
!
END_2D
-
+
END DO
!
+
END SUBROUTINE nonosc_ice
@@ -1320,22 +1543,22 @@ CONTAINS
!
REAL(wp) :: Cr, Rjm, Rj, Rjp, uCFL, zpsi, zh3, zlimiter, Rr
INTEGER :: ji, jj, jl ! dummy loop indices
- REAL(wp), DIMENSION (jpi,jpj,jpl) :: zslpx ! tracer slopes
+ REAL(wp), DIMENSION (jpi,jpj) :: zslpx ! tracer slopes
!!----------------------------------------------------------------------
!
- DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls-1, 0, 0 )
- zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1)
- END_2D
- END DO
DO jl = 1, jpl
- DO_2D( nn_hls-1, 0, 0, 0 )
+
+ DO_2D( 2, 1, 0, 0 )
+ zslpx(ji,jj) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1)
+ END_2D
+
+ DO_2D( 1, 0, 0, 0 )
uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj)
- Rjm = zslpx(ji-1,jj,jl)
- Rj = zslpx(ji ,jj,jl)
- Rjp = zslpx(ji+1,jj,jl)
+ Rjm = zslpx(ji-1,jj)
+ Rj = zslpx(ji ,jj)
+ Rjp = zslpx(ji+1,jj)
IF( np_limiter == 3 ) THEN
@@ -1409,22 +1632,22 @@ CONTAINS
!
REAL(wp) :: Cr, Rjm, Rj, Rjp, vCFL, zpsi, zh3, zlimiter, Rr
INTEGER :: ji, jj, jl ! dummy loop indices
- REAL(wp), DIMENSION (jpi,jpj,jpl) :: zslpy ! tracer slopes
+ REAL(wp), DIMENSION (jpi,jpj) :: zslpy ! tracer slopes
!!----------------------------------------------------------------------
!
+
DO jl = 1, jpl
- DO_2D( 0, 0, nn_hls, nn_hls-1 )
- zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1)
+
+ DO_2D( 0, 0, 2, 1 )
+ zslpy(ji,jj) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1)
END_2D
- END DO
- DO jl = 1, jpl
- DO_2D( 0, 0, nn_hls-1, 0 )
+ DO_2D( 0, 0, 1, 0 )
vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj)
- Rjm = zslpy(ji,jj-1,jl)
- Rj = zslpy(ji,jj ,jl)
- Rjp = zslpy(ji,jj+1,jl)
+ Rjm = zslpy(ji,jj-1)
+ Rj = zslpy(ji,jj )
+ Rjp = zslpy(ji,jj+1)
IF( np_limiter == 3 ) THEN
@@ -1485,8 +1708,8 @@ CONTAINS
END SUBROUTINE limiter_y
- SUBROUTINE Hbig_umx( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, &
- & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i )
+ SUBROUTINE Hbig_umx( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, pszi_max, &
+ & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i, pszv_i )
!!-------------------------------------------------------------------
!! *** ROUTINE Hbig_umx ***
!!
@@ -1500,13 +1723,13 @@ CONTAINS
!!
!! ** input : Max thickness of the surrounding 9-points
!!-------------------------------------------------------------------
- REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: phi_max, phs_max, phip_max, psi_max ! max ice thick from surrounding 9-pts
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pes_max
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pei_max
- REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i
- REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s
- REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i
+ REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
+ REAL(wp), DIMENSION(A2D(0),jpl) , INTENT(in ) :: phi_max, phs_max, phip_max, psi_max ! max ice thick from surrounding 9-pts
+ REAL(wp), DIMENSION(A2D(0),nlay_s,jpl), INTENT(in ) :: pes_max
+ REAL(wp), DIMENSION(A2D(0),nlay_i,jpl), INTENT(in ) :: pei_max, pszi_max
+ REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i
+ REAL(wp), DIMENSION(:,:,:,:) , INTENT(inout) :: pe_s
+ REAL(wp), DIMENSION(:,:,:,:) , INTENT(inout) :: pe_i, pszv_i
!
INTEGER :: ji, jj, jk, jl ! dummy loop indices
REAL(wp) :: z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra
@@ -1547,19 +1770,42 @@ CONTAINS
pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl)
ENDIF
!
- ! ! -- check s_i -- !
- ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean
- zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl)
- IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
- zfra = psi_max(ji,jj,jl) / zsi
- sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt
- psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra
- ENDIF
- !
ENDIF
END_2D
END DO
!
+ ! ! -- check s_i -- !
+ IF( nn_icesal == 4 ) THEN
+ DO jl = 1, jpl
+ DO_3D( 0, 0, 0, 0, 1, nlay_i )
+ IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+ ! if szv_i/v_i is larger than the surrounding 9 pts => put the salt excess in the ocean
+ zsi = pszv_i(ji,jj,jk,jl) / pv_i(ji,jj,jl)
+ IF( zsi > pszi_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+ zfra = pszi_max(ji,jj,jk,jl) / zsi
+ sfx_res(ji,jj) = sfx_res(ji,jj) + pszv_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * rhoi * z1_dt
+ pszv_i(ji,jj,jk,jl) = pszv_i(ji,jj,jk,jl) * zfra
+ ENDIF
+ ENDIF
+ END_3D
+ END DO
+ ELSE
+ DO jl = 1, jpl
+ DO_2D( 0, 0, 0, 0 )
+ IF ( pv_i(ji,jj,jl) > 0._wp ) THEN
+ ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean
+ zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl)
+ IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN
+ zfra = psi_max(ji,jj,jl) / zsi
+ sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt
+ psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra
+ ENDIF
+ !
+ ENDIF
+ END_2D
+ END DO
+ ENDIF
+ !
! ! -- check e_i/v_i -- !
DO jl = 1, jpl
DO_3D( 0, 0, 0, 0, 1, nlay_i )
@@ -1648,8 +1894,8 @@ CONTAINS
!! *** ROUTINE icemax3D_umx ***
!! ** Purpose : compute the max of the 9 points around
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pice ! input
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pmax ! output
+ REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pice ! input
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(out) :: pmax ! output
!
REAL(wp), DIMENSION(Nis0:Nie0) :: zmax1, zmax2
REAL(wp) :: zmax3
@@ -1688,9 +1934,15 @@ CONTAINS
!
REAL(wp), DIMENSION(Nis0:Nie0) :: zmax1, zmax2
REAL(wp) :: zmax3
- INTEGER :: jlay, ji, jj, jk, jl ! dummy loop indices
+ INTEGER :: ihls, jlay, ji, jj, jk, jl ! dummy loop indices
!!----------------------------------------------------------------------
jlay = SIZE( pice , 3 ) ! size of input arrays
+
+ ! pmax is A2D(0), so it needs to be shifted by nn_hls in the loops below
+ IF( SIZE( pmax , 1 ) == jpi ) THEN ; ihls = 0
+ ELSE ; ihls = nn_hls
+ ENDIF
+
! basic version: get the max of epsi20 + 9 neighbours
!!$ DO jl = 1, jpl
!!$ DO jk = 1, jlay
@@ -1710,7 +1962,7 @@ CONTAINS
END DO
DO_2D( 0, 0, 0, 0 )
zmax3 = MAX( epsi20, pice(ji,jj+1,jk,jl), pice(ji-1,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) )
- pmax(ji,jj,jk,jl) = MAX( epsi20, zmax1(ji), zmax2(ji), zmax3 )
+ pmax(ji-ihls,jj-ihls,jk,jl) = MAX( epsi20, zmax1(ji), zmax2(ji), zmax3 )
zmax1(ji) = zmax2(ji)
zmax2(ji) = zmax3
END_2D
diff --git a/src/ICE/icedyn_rdgrft.F90 b/src/ICE/icedyn_rdgrft.F90
index ad7d1de81c22ea810c7dc50eb8257aa2b7da1db2..ffd5c0fcf49689414a267f7abb7af79175acbd5e 100644
--- a/src/ICE/icedyn_rdgrft.F90
+++ b/src/ICE/icedyn_rdgrft.F90
@@ -278,7 +278,7 @@ CONTAINS
CALL ice_dyn_1d2d( 2 ) ! --- Move to 2D arrays --- !
ENDIF
- ! clem: those fields must be updated on the halos: ato_i, a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, v_il, e_i, e_s
+ ! clem: those fields must be updated on the halos: ato_i, a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, v_il, e_i, e_s, szv_i
! clem: I think we can comment this line but I am not sure it does not change results
!!$ CALL ice_var_agg( 1 )
@@ -561,10 +561,10 @@ CONTAINS
REAL(wp) :: expL, expR ! exponentials involving hL, hR
REAL(wp) :: vsw ! vol of water trapped into ridges
REAL(wp) :: afrdg, afrft ! fraction of category area ridged/rafted
- REAL(wp) :: airdg1, oirdg1, aprdg1, virdg1, sirdg1
- REAL(wp) :: airft1, oirft1, aprft1
- REAL(wp), DIMENSION(jpij) :: airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg ! area etc of new ridges
- REAL(wp), DIMENSION(jpij) :: airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft ! area etc of rafted ice
+ REAL(wp) :: airdg1, airft1
+ REAL(wp), DIMENSION(jpij) :: airdg2, oirdg, aprdg, virdg, vsrdg, vprdg, vlrdg ! area etc of new ridges
+ REAL(wp), DIMENSION(jpij) :: airft2, oirft, aprft, virft, vsrft, vprft, vlrft ! area etc of rafted ice
+ REAL(wp), DIMENSION(jpij,nlay_i) :: sirdg, sirft
!
REAL(wp) :: ersw ! enthalpy of water trapped into ridges
REAL(wp) :: zswitch, fvol ! new ridge volume going to jl2
@@ -590,7 +590,7 @@ CONTAINS
! 2) compute categories in which ice is removed (jl1)
!----------------------------------------------------
- IF( nn_icesal /= 2 ) THEN
+ IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN
CALL tab_3d_2d( npti, nptidx(1:npti), s_i_2d(1:npti,:), s_i(:,:,:) )
ENDIF
@@ -628,42 +628,38 @@ CONTAINS
ersw = -rhoi * vsw * rcp * sst_1d(ji) ! clem: if sst>0, then ersw <0 (is that possible?)
! volume etc of ridging / rafting ice and new ridges (vi, vs, sm, oi, es, ei)
- virdg1 = v_i_2d (ji,jl1) * afrdg
- virdg2(ji) = v_i_2d (ji,jl1) * afrdg + vsw
- vsrdg(ji) = v_s_2d (ji,jl1) * afrdg
- sirdg1 = sv_i_2d(ji,jl1) * afrdg
- sirdg2(ji) = sv_i_2d(ji,jl1) * afrdg + vsw * sss_1d(ji)
- oirdg1 = oa_i_2d(ji,jl1) * afrdg
- oirdg2(ji) = oa_i_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1)
-
- virft(ji) = v_i_2d (ji,jl1) * afrft
- vsrft(ji) = v_s_2d (ji,jl1) * afrft
- sirft(ji) = sv_i_2d(ji,jl1) * afrft
- oirft1 = oa_i_2d(ji,jl1) * afrft
- oirft2(ji) = oa_i_2d(ji,jl1) * afrft * hi_hrft
+ virdg(ji) = v_i_2d (ji,jl1) * afrdg + vsw
+ vsrdg(ji) = v_s_2d (ji,jl1) * afrdg
+ oirdg(ji) = oa_i_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1)
+
+ virft(ji) = v_i_2d (ji,jl1) * afrft
+ vsrft(ji) = v_s_2d (ji,jl1) * afrft
+ oirft(ji) = oa_i_2d(ji,jl1) * afrft * hi_hrft
IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
- aprdg1 = a_ip_2d(ji,jl1) * afrdg
- aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1)
- vprdg (ji) = v_ip_2d(ji,jl1) * afrdg
- aprft1 = a_ip_2d(ji,jl1) * afrft
- aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft
- vprft (ji) = v_ip_2d(ji,jl1) * afrft
+ aprdg(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1)
+ vprdg(ji) = v_ip_2d(ji,jl1) * afrdg
+ aprft(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft
+ vprft(ji) = v_ip_2d(ji,jl1) * afrft
IF ( ln_pnd_lids ) THEN
- vlrdg (ji) = v_il_2d(ji,jl1) * afrdg
- vlrft (ji) = v_il_2d(ji,jl1) * afrft
+ vlrdg(ji) = v_il_2d(ji,jl1) * afrdg
+ vlrft(ji) = v_il_2d(ji,jl1) * afrft
ENDIF
ENDIF
- DO jk = 1, nlay_s
- esrdg(ji,jk) = e_s_2d (ji,jk,jl1) * afrdg
- esrft(ji,jk) = e_s_2d (ji,jk,jl1) * afrft
- END DO
- DO jk = 1, nlay_i
- eirdg(ji,jk) = e_i_2d (ji,jk,jl1) * afrdg + ersw * r1_nlay_i
- eirft(ji,jk) = e_i_2d (ji,jk,jl1) * afrft
- END DO
-
+ esrdg(ji,:) = e_s_2d (ji,:,jl1) * afrdg
+ esrft(ji,:) = e_s_2d (ji,:,jl1) * afrft
+ eirdg(ji,:) = e_i_2d (ji,:,jl1) * afrdg + ersw * r1_nlay_i
+ eirft(ji,:) = e_i_2d (ji,:,jl1) * afrft
+
+ IF( nn_icesal == 4 ) THEN
+ sirdg(ji,:) = szv_i_2d(ji,:,jl1) * afrdg + vsw * sss_1d(ji) * r1_nlay_i
+ sirft(ji,:) = szv_i_2d(ji,:,jl1) * afrft
+ ELSE
+ sirdg(ji,1) = sv_i_2d (ji, jl1) * afrdg + vsw * sss_1d(ji)
+ sirft(ji,1) = sv_i_2d (ji, jl1) * afrft
+ ENDIF
+
! Ice-ocean exchanges associated with ice porosity
wfx_dyn_1d(ji) = wfx_dyn_1d(ji) - vsw * rhoi * r1_Dt_ice ! increase in ice volume due to seawater frozen in voids
sfx_dyn_1d(ji) = sfx_dyn_1d(ji) - vsw * sss_1d(ji) * rhoi * r1_Dt_ice
@@ -679,32 +675,30 @@ CONTAINS
END DO
! virtual salt flux to keep salinity constant
- IF( nn_icesal /= 2 ) THEN
- sirdg2(ji) = sirdg2(ji) - ( sss_1d(ji) - s_i_2d(ji,jl1) ) * vsw ! ridge salinity = s_i
+ IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN
+ sirdg(ji,1) = sirdg(ji,1) - ( sss_1d(ji) - s_i_2d(ji,jl1) ) * vsw ! ridge salinity = s_i
sfx_bri_1d(ji) = sfx_bri_1d(ji) + ( sss_1d(ji) - s_i_2d(ji,jl1) ) * vsw * rhoi * r1_Dt_ice ! put back sss_m into the ocean
! ! and get s_i from the ocean
ENDIF
! Remove area, volume of new ridge to each category jl1
!------------------------------------------------------
- a_i_2d (ji,jl1) = a_i_2d (ji,jl1) - airdg1 - airft1
- v_i_2d (ji,jl1) = v_i_2d (ji,jl1) - virdg1 - virft(ji)
- v_s_2d (ji,jl1) = v_s_2d (ji,jl1) - vsrdg(ji) - vsrft(ji)
- sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1 - sirft(ji)
- oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1 - oirft1
+ a_i_2d (ji,jl1) = a_i_2d (ji,jl1) - airdg1 - airft1
+ v_i_2d (ji,jl1) = v_i_2d (ji,jl1) * ( 1._wp - afrdg - afrft )
+ v_s_2d (ji,jl1) = v_s_2d (ji,jl1) * ( 1._wp - afrdg - afrft )
+ oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) * ( 1._wp - afrdg - afrft )
IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
- a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1 - aprft1
- v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji)
- IF ( ln_pnd_lids ) THEN
- v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - vlrdg(ji) - vlrft(ji)
- ENDIF
+ a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) * ( 1._wp - afrdg - afrft )
+ v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) * ( 1._wp - afrdg - afrft )
+ IF ( ln_pnd_lids ) v_il_2d(ji,jl1) = v_il_2d(ji,jl1) * ( 1._wp - afrdg - afrft )
+ ENDIF
+ !
+ e_s_2d(ji,:,jl1) = e_s_2d(ji,:,jl1) * ( 1._wp - afrdg - afrft )
+ e_i_2d(ji,:,jl1) = e_i_2d(ji,:,jl1) * ( 1._wp - afrdg - afrft )
+ !
+ IF( nn_icesal == 4 ) THEN ; szv_i_2d(ji,:,jl1) = szv_i_2d(ji,:,jl1) * ( 1._wp - afrdg - afrft )
+ ELSE ; sv_i_2d (ji, jl1) = sv_i_2d (ji, jl1) * ( 1._wp - afrdg - afrft )
ENDIF
- DO jk = 1, nlay_s
- e_s_2d(ji,jk,jl1) = e_s_2d(ji,jk,jl1) * ( 1._wp - afrdg - afrft )
- END DO
- DO jk = 1, nlay_i
- e_i_2d(ji,jk,jl1) = e_i_2d(ji,jk,jl1) * ( 1._wp - afrdg - afrft )
- END DO
ENDIF
@@ -784,30 +778,24 @@ CONTAINS
!
! Add area, volume of new ridge to category jl2
!----------------------------------------------
- a_i_2d (ji,jl2) = a_i_2d (ji,jl2) + ( airdg2(ji) * farea + airft2(ji) * zswitch )
- oa_i_2d(ji,jl2) = oa_i_2d(ji,jl2) + ( oirdg2(ji) * farea + oirft2(ji) * zswitch )
- v_i_2d (ji,jl2) = v_i_2d (ji,jl2) + ( virdg2(ji) * fvol + virft (ji) * zswitch )
- sv_i_2d(ji,jl2) = sv_i_2d(ji,jl2) + ( sirdg2(ji) * fvol + sirft (ji) * zswitch )
- v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol + &
- & vsrft (ji) * rn_fsnwrft * zswitch )
+ a_i_2d (ji,jl2) = a_i_2d (ji,jl2) + ( airdg2(ji) * farea + airft2(ji) * zswitch )
+ oa_i_2d(ji,jl2) = oa_i_2d(ji,jl2) + ( oirdg (ji) * farea + oirft (ji) * zswitch )
+ v_i_2d (ji,jl2) = v_i_2d (ji,jl2) + ( virdg (ji) * fvol + virft (ji) * zswitch )
+ v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol + vsrft (ji) * rn_fsnwrft * zswitch )
IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
- v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + ( vprdg (ji) * rn_fpndrdg * fvol &
- & + vprft (ji) * rn_fpndrft * zswitch )
- a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + ( aprdg2(ji) * rn_fpndrdg * farea &
- & + aprft2(ji) * rn_fpndrft * zswitch )
+ v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + ( vprdg(ji) * rn_fpndrdg * fvol + vprft(ji) * rn_fpndrft * zswitch )
+ a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + ( aprdg(ji) * rn_fpndrdg * farea + aprft(ji) * rn_fpndrft * zswitch )
IF ( ln_pnd_lids ) THEN
- v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + ( vlrdg(ji) * rn_fpndrdg * fvol &
- & + vlrft(ji) * rn_fpndrft * zswitch )
+ v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + ( vlrdg(ji) * rn_fpndrdg * fvol + vlrft(ji) * rn_fpndrft * zswitch )
ENDIF
ENDIF
- DO jk = 1, nlay_s
- e_s_2d(ji,jk,jl2) = e_s_2d(ji,jk,jl2) + ( esrdg(ji,jk) * rn_fsnwrdg * fvol + &
- & esrft(ji,jk) * rn_fsnwrft * zswitch )
- END DO
- DO jk = 1, nlay_i
- e_i_2d(ji,jk,jl2) = e_i_2d(ji,jk,jl2) + eirdg(ji,jk) * fvol + eirft(ji,jk) * zswitch
- END DO
-
+ e_s_2d(ji,:,jl2) = e_s_2d(ji,:,jl2) + ( esrdg(ji,:) * rn_fsnwrdg * fvol + esrft(ji,:) * rn_fsnwrft * zswitch )
+ e_i_2d(ji,:,jl2) = e_i_2d(ji,:,jl2) + ( eirdg(ji,:) * fvol + eirft(ji,:) * zswitch )
+ IF( nn_icesal == 4 ) THEN
+ szv_i_2d(ji,:,jl2) = szv_i_2d(ji,:,jl2) + ( sirdg(ji,:) * fvol + sirft(ji,:) * zswitch )
+ ELSE
+ sv_i_2d (ji, jl2) = sv_i_2d (ji, jl2) + ( sirdg(ji,1) * fvol + sirft(ji,1) * zswitch )
+ ENDIF
ENDIF
END DO
@@ -819,7 +807,7 @@ CONTAINS
! roundoff errors
!----------------
! In case ridging/rafting lead to very small negative values (sometimes it happens)
- CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, e_s_2d, e_i_2d )
+ CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, e_s_2d, e_i_2d, szv_i_2d )
!
END SUBROUTINE rdgrft_shift
@@ -999,14 +987,15 @@ CONTAINS
!!CALL tab_2d_1d( npti, nptidx(1:npti), ato_i_1d(1:npti), ato_i(:,:) )
!!CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d(1:npti,:), a_i(:,:,:) )
!!CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,:), v_i (:,:,:) )
- CALL tab_3d_2d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s (:,:,:) )
- CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d(1:npti,:) , sv_i(:,:,:) )
- CALL tab_3d_2d( npti, nptidx(1:npti), oa_i_2d(1:npti,:) , oa_i(:,:,:) )
- CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,:) , a_ip(:,:,:) )
- CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,:) , v_ip(:,:,:) )
- CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,:) , v_il(:,:,:) )
- CALL tab_4d_3d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s )
- CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_3d_2d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s (:,:,:) )
+ CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i(:,:,:) )
+ CALL tab_3d_2d( npti, nptidx(1:npti), oa_i_2d (1:npti,:) , oa_i(:,:,:) )
+ CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d (1:npti,:) , a_ip(:,:,:) )
+ CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d (1:npti,:) , v_ip(:,:,:) )
+ CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d (1:npti,:) , v_il(:,:,:) )
+ CALL tab_4d_3d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s )
+ CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_4d_3d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i )
CALL tab_2d_1d( npti, nptidx(1:npti), sfx_dyn_1d (1:npti), sfx_dyn (:,:) )
CALL tab_2d_1d( npti, nptidx(1:npti), sfx_bri_1d (1:npti), sfx_bri (:,:) )
CALL tab_2d_1d( npti, nptidx(1:npti), wfx_dyn_1d (1:npti), wfx_dyn (:,:) )
@@ -1018,16 +1007,17 @@ CONTAINS
CASE( 2 ) !== from 1D to 2D ==!
! !---------------------!
CALL tab_1d_2d( npti, nptidx(1:npti), ato_i_1d(1:npti) , ato_i(:,:) )
- CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i (:,:,:) )
- CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i (:,:,:) )
- CALL tab_2d_3d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s (:,:,:) )
- CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d(1:npti,:) , sv_i(:,:,:) )
- CALL tab_2d_3d( npti, nptidx(1:npti), oa_i_2d(1:npti,:) , oa_i(:,:,:) )
- CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,:) , a_ip(:,:,:) )
- CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,:) , v_ip(:,:,:) )
- CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,:) , v_il(:,:,:) )
- CALL tab_3d_4d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s )
- CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i (:,:,:) )
+ CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i (:,:,:) )
+ CALL tab_2d_3d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s (:,:,:) )
+ CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i(:,:,:) )
+ CALL tab_2d_3d( npti, nptidx(1:npti), oa_i_2d (1:npti,:) , oa_i(:,:,:) )
+ CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d (1:npti,:) , a_ip(:,:,:) )
+ CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d (1:npti,:) , v_ip(:,:,:) )
+ CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d (1:npti,:) , v_il(:,:,:) )
+ CALL tab_3d_4d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s )
+ CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_3d_4d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i )
CALL tab_1d_2d( npti, nptidx(1:npti), sfx_dyn_1d (1:npti), sfx_dyn (:,:) )
CALL tab_1d_2d( npti, nptidx(1:npti), sfx_bri_1d (1:npti), sfx_bri (:,:) )
CALL tab_1d_2d( npti, nptidx(1:npti), wfx_dyn_1d (1:npti), wfx_dyn (:,:) )
diff --git a/src/ICE/icedyn_rhg_eap.F90 b/src/ICE/icedyn_rhg_eap.F90
index 18f923ee460333f89acda1cb3b6f2ff291262e55..1363541b8bbad19743d73972101294dc5388ae01 100644
--- a/src/ICE/icedyn_rhg_eap.F90
+++ b/src/ICE/icedyn_rhg_eap.F90
@@ -228,8 +228,8 @@ CONTAINS
fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
! Lateral boundary conditions on velocity (modify fimask)
IF( fimask(ji,jj) == 0._wp ) THEN
- fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), &
- & vmask(ji,jj,1), vmask(ji+1,jj,1) ) )
+ fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji ,jj+1,1), &
+ & vmask(ji,jj,1), vmask(ji+1,jj ,1) ) )
ENDIF
END_2D
ENDIF
@@ -286,31 +286,28 @@ CONTAINS
zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zm1 = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) ) ! Ice/snow mass at U-V points
-!!$ zm1 = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) ) ! clem: this should replace the above
- zmf (ji,jj) = zm1 * ff_t(ji,jj) ! Coriolis at T points (m*f)
- zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin ) ! dt/m at T points (for alpha and beta coefficients)
+ zm1 = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) ) ! Ice/snow mass at U-V points
+ zmf (ji,jj) = zm1 * ff_t(ji,jj) ! Coriolis at T points (m*f)
+ zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin ) ! dt/m at T points (for alpha and beta coefficients)
END_2D
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
! ice fraction at U-V points
- zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
- zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+ zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj)*e1e2t(ji,jj) + at_i(ji+1,jj )*e1e2t(ji+1,jj ) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+ zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj)*e1e2t(ji,jj) + at_i(ji ,jj+1)*e1e2t(ji ,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
! Ice/snow mass at U-V points
- zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) )
-!!$ zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) + rhow * (vt_ip(ji ,jj ) + vt_il(ji ,jj )) ) ! clem: this should replace the above
- zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) )
-!!$ zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) + rhow * (vt_ip(ji+1,jj ) + vt_il(ji+1,jj )) ) ! clem: this should replace the above
- zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) )
-!!$ zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) + rhow * (vt_ip(ji ,jj+1) + vt_il(ji ,jj+1)) ) ! clem: this should replace the above
- zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
- zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+ zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) + rhow * (vt_ip(ji ,jj ) + vt_il(ji ,jj )) )
+ zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) + rhow * (vt_ip(ji+1,jj ) + vt_il(ji+1,jj )) )
+ zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) + rhow * (vt_ip(ji ,jj+1) + vt_il(ji ,jj+1)) )
+ !
+ zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj ) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+ zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji ,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
! Ocean currents at U-V point, warning: add () for the North Pole reproducibility
- v_oceU(ji,jj) = 0.25_wp * ( ( v_oce(ji,jj) + v_oce(ji,jj-1) ) + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) ) * umask(ji,jj,1)
- u_oceV(ji,jj) = 0.25_wp * ( ( u_oce(ji,jj) + u_oce(ji-1,jj) ) + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) ) * vmask(ji,jj,1)
+ v_oceU(ji,jj) = 0.25_wp * ( (v_oce(ji,jj) + v_oce(ji ,jj-1)) + (v_oce(ji+1,jj ) + v_oce(ji+1,jj-1)) ) * umask(ji,jj,1)
+ u_oceV(ji,jj) = 0.25_wp * ( (u_oce(ji,jj) + u_oce(ji-1,jj )) + (u_oce(ji ,jj+1) + u_oce(ji-1,jj+1)) ) * vmask(ji,jj,1)
! m/dt
zmU_t(ji,jj) = zmassU * z1_dtevp
@@ -345,8 +342,8 @@ CONTAINS
IF( ln_landfast_L16 ) THEN !-- Lemieux 2016
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
! ice thickness at U-V points
- zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
- zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+ zvU = 0.5_wp * ( vt_i(ji,jj)*e1e2t(ji,jj) + vt_i(ji+1,jj )*e1e2t(ji+1,jj ) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+ zvV = 0.5_wp * ( vt_i(ji,jj)*e1e2t(ji,jj) + vt_i(ji ,jj+1)*e1e2t(ji ,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
! ice-bottom stress at U points
zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0
ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )
diff --git a/src/ICE/icedyn_rhg_evp.F90 b/src/ICE/icedyn_rhg_evp.F90
index 200e2b2e4164874b2bf29fb6d33aa3fcd584012f..44d8c8e11363e57da0fa8fad4a6661fc1eabffb7 100644
--- a/src/ICE/icedyn_rhg_evp.F90
+++ b/src/ICE/icedyn_rhg_evp.F90
@@ -86,8 +86,7 @@ CONTAINS
!! (ji-1,jj-1) (ji,jj-1)
!!
!! ** Inputs : - wind forcing (stress), oceanic currents
- !! ice total volume (vt_i) per unit area
- !! snow total volume (vt_s) per unit area
+ !! ice, snow and ponds total volume (vt_i, vt_s, vt_ip, vt_il) per unit area
!!
!! ** Action : - compute u_ice, v_ice : the components of the
!! sea-ice velocity vector
@@ -218,8 +217,8 @@ CONTAINS
fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
! Lateral boundary conditions on velocity (modify fimask)
IF( fimask(ji,jj) == 0._wp ) THEN
- fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), &
- & vmask(ji,jj,1), vmask(ji+1,jj,1) ) )
+ fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji ,jj+1,1), &
+ & vmask(ji,jj,1), vmask(ji+1,jj ,1) ) )
ENDIF
END_2D
ENDIF
@@ -270,32 +269,29 @@ CONTAINS
zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zm1 = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) ) ! Ice/snow mass at U-V points
-!!$ zm1 = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) ) ! clem: this should replace the above
- zmf (ji,jj) = zm1 * ff_t(ji,jj) ! Coriolis at T points (m*f)
- zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin ) ! dt/m at T points (for alpha and beta coefficients)
+ zm1 = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) ) ! Ice/snow mass at U-V points
+ zmf (ji,jj) = zm1 * ff_t(ji,jj) ! Coriolis at T points (m*f)
+ zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin ) ! dt/m at T points (for alpha and beta coefficients)
END_2D
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
! ice fraction at U-V points
- zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
- zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+ zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj)*e1e2t(ji,jj) + at_i(ji+1,jj )*e1e2t(ji+1,jj ) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+ zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj)*e1e2t(ji,jj) + at_i(ji ,jj+1)*e1e2t(ji ,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
! Ice/snow mass at U-V points
- zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) )
-!!$ zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) + rhow * (vt_ip(ji ,jj ) + vt_il(ji ,jj )) ) ! clem: this should replace the above
- zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) )
-!!$ zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) + rhow * (vt_ip(ji+1,jj ) + vt_il(ji+1,jj )) ) ! clem: this should replace the above
- zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) )
-!!$ zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) + rhow * (vt_ip(ji ,jj+1) + vt_il(ji ,jj+1)) ) ! clem: this should replace the above
- zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
- zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+ zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) + rhow * (vt_ip(ji ,jj ) + vt_il(ji ,jj )) )
+ zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) + rhow * (vt_ip(ji+1,jj ) + vt_il(ji+1,jj )) )
+ zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) + rhow * (vt_ip(ji ,jj+1) + vt_il(ji ,jj+1)) )
+ !
+ zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj ) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+ zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji ,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
! Ocean currents at U-V points
! (brackets added to fix the order of floating point operations for the North Pole reproducibility)
- v_oceU(ji,jj) = 0.25_wp * ( (v_oce(ji,jj) + v_oce(ji,jj-1)) + (v_oce(ji+1,jj) + v_oce(ji+1,jj-1)) ) * umask(ji,jj,1)
- u_oceV(ji,jj) = 0.25_wp * ( (u_oce(ji,jj) + u_oce(ji-1,jj)) + (u_oce(ji,jj+1) + u_oce(ji-1,jj+1)) ) * vmask(ji,jj,1)
+ v_oceU(ji,jj) = 0.25_wp * ( (v_oce(ji,jj) + v_oce(ji ,jj-1)) + (v_oce(ji+1,jj ) + v_oce(ji+1,jj-1)) ) * umask(ji,jj,1)
+ u_oceV(ji,jj) = 0.25_wp * ( (u_oce(ji,jj) + u_oce(ji-1,jj )) + (u_oce(ji ,jj+1) + u_oce(ji-1,jj+1)) ) * vmask(ji,jj,1)
! m/dt
zmU_t(ji,jj) = zmassU * z1_dtevp
@@ -332,8 +328,8 @@ CONTAINS
IF( ln_landfast_L16 ) THEN !-- Lemieux 2016
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
! ice thickness at U-V points
- zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
- zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+ zvU = 0.5_wp * ( vt_i(ji,jj)*e1e2t(ji,jj) + vt_i(ji+1,jj )*e1e2t(ji+1,jj ) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+ zvV = 0.5_wp * ( vt_i(ji,jj)*e1e2t(ji,jj) + vt_i(ji ,jj+1)*e1e2t(ji ,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
! ice-bottom stress at U points
zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0
ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )
diff --git a/src/ICE/icedyn_rhg_vp.F90 b/src/ICE/icedyn_rhg_vp.F90
index 81e636c94cb2f2aa859823483b90591d3b938bda..b6373fa9cb8371e1ee5c66cbef406ffb49ff0743 100644
--- a/src/ICE/icedyn_rhg_vp.F90
+++ b/src/ICE/icedyn_rhg_vp.F90
@@ -308,8 +308,8 @@ CONTAINS
zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zmt(ji,jj) = rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) ! Snow and ice mass at T-point
- zmf(ji,jj) = zmt(ji,jj) * ff_t(ji,jj) ! Coriolis factor at T points (m*f)
+ zmt(ji,jj) = rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) ! Snow and ice mass at T-point
+ zmf(ji,jj) = zmt(ji,jj) * ff_t(ji,jj) ! Coriolis factor at T points (m*f)
END_2D
DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls )
diff --git a/src/ICE/iceistate.F90 b/src/ICE/iceistate.F90
index dfba3873bfadde6c3c11c8de860642bdcc5d361b..9f72fda344be71d66bac77f23a2e6e47e282d671 100644
--- a/src/ICE/iceistate.F90
+++ b/src/ICE/iceistate.F90
@@ -109,15 +109,13 @@ CONTAINS
!
INTEGER :: ji, jj, jk, jl ! dummy loop indices
REAL(wp) :: ztmelts, zsshadj, area
- INTEGER , DIMENSION(4) :: itest
- REAL(wp), DIMENSION(jpi,jpj) :: zswitch ! ice indicator
- REAL(wp), DIMENSION(A2D(0)) :: zmsk ! ice indicator
- REAL(wp), DIMENSION(A2D(0)) :: zht_i_ini, zat_i_ini, ztm_s_ini !data from namelist or nc file
- REAL(wp), DIMENSION(A2D(0)) :: zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file
- REAL(wp), DIMENSION(A2D(0)) :: zapnd_ini, zhpnd_ini, zhlid_ini !data from namelist or nc file
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d !temporary arrays
- !!
- REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d
+ INTEGER , DIMENSION(4) :: itest
+ REAL(wp), DIMENSION(jpi,jpj) :: ztfrz ! freezing temperature (degC)
+ REAL(wp), DIMENSION(jpi,jpj) :: zswitch ! ice indicator
+ REAL(wp), DIMENSION(jpi,jpj) :: zmsk ! ice indicator
+ REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, ztm_s_ini !data from namelist or nc file
+ REAL(wp), DIMENSION(jpi,jpj) :: zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file
+ REAL(wp), DIMENSION(jpi,jpj) :: zapnd_ini, zhpnd_ini, zhlid_ini !data from namelist or nc file
!--------------------------------------------------------------------
IF(lwp) WRITE(numout,*)
@@ -132,8 +130,8 @@ CONTAINS
CALL eos_fzp( sss_m(:,:), t_bo(:,:), kbnd=0 )
t_bo(:,:) = ( t_bo(:,:) + rt0 ) * smask0(:,:)
!
+ ! == reduced arrays == !
DO jl = 1, jpl
- ! == reduced arrays == !
DO_2D( 0, 0, 0, 0 )
!
cnd_ice(ji,jj,jl) = 0._wp ! conductivity at the ice top
@@ -144,19 +142,27 @@ CONTAINS
a_ip_eff(ji,jj,jl) = 0._wp ! melt pond effective fraction
END_2D
!
- ! == full arrays == !
+ ENDDO
+
+ ! == full arrays == !
+ DO jl = 1, jpl
+ !
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i )
+ ! heat
+ e_i(ji,jj,jk,jl) = 0._wp
+ t_i(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) ! ice temp
+ ! salt
+ szv_i(ji,jj,jk,jl) = 0._wp
+ sz_i (ji,jj,jk,jl) = rn_simin * tmask(ji,jj,1)
+ END_3D
+
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s )
+ ! heat
+ e_s(ji,jj,jk,jl) = 0._wp
+ t_s(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) ! snw temp
+ END_3D
+ !
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- !
- ! heat contents
- DO jk = 1, nlay_i
- e_i(ji,jj,jk,jl) = 0._wp
- t_i(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) ! ice temp
- ENDDO
- DO jk = 1, nlay_s
- e_s(ji,jj,jk,jl) = 0._wp
- t_s(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) ! snw temp
- ENDDO
- !
! general fields
a_i (ji,jj,jl) = 0._wp
v_i (ji,jj,jl) = 0._wp
@@ -197,30 +203,30 @@ CONTAINS
! !---------------!
IF( nn_iceini_file == 1 )THEN ! Read a file !
! !---------------!
- WHERE( ff_t(A2D(0)) >= 0._wp ) ; zmsk(:,:) = 1._wp
- ELSEWHERE ; zmsk(:,:) = 0._wp
+ WHERE( ff_t(:,:) >= 0._wp ) ; zmsk(:,:) = 1._wp
+ ELSEWHERE ; zmsk(:,:) = 0._wp
END WHERE
!
CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step
!
! -- mandatory fields -- !
- zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * smask0(:,:)
- zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * smask0(:,:)
- zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * smask0(:,:)
+ zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1)
+ zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1)
+ zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1)
! -- optional fields -- !
! if fields do not exist then set them to the values present in the namelist (except for temperatures)
!
! ice salinity
IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) &
- & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zmsk + rn_smi_ini_s * (1._wp - zmsk) ) * smask0(:,:)
+ & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zmsk + rn_smi_ini_s * (1._wp - zmsk) ) * tmask(:,:,1)
!
! temperatures
IF ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. &
& TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN
- si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zmsk + rn_tmi_ini_s * (1._wp - zmsk) ) * smask0(:,:)
- si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zmsk + rn_tsu_ini_s * (1._wp - zmsk) ) * smask0(:,:)
- si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zmsk + rn_tms_ini_s * (1._wp - zmsk) ) * smask0(:,:)
+ si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zmsk + rn_tmi_ini_s * (1._wp - zmsk) ) * tmask(:,:,1)
+ si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zmsk + rn_tsu_ini_s * (1._wp - zmsk) ) * tmask(:,:,1)
+ si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zmsk + rn_tms_ini_s * (1._wp - zmsk) ) * tmask(:,:,1)
ENDIF
IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) & ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2
& si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 )
@@ -237,35 +243,36 @@ CONTAINS
!
! pond concentration
IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) &
- & si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zmsk + rn_apd_ini_s * (1._wp - zmsk) ) * smask0(:,:) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc.
+ & si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zmsk + rn_apd_ini_s * (1._wp - zmsk) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc.
& * si(jp_ati)%fnow(:,:,1)
!
! pond depth
IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) &
- & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zmsk + rn_hpd_ini_s * (1._wp - zmsk) ) * smask0(:,:)
+ & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zmsk + rn_hpd_ini_s * (1._wp - zmsk) ) * tmask(:,:,1)
!
! pond lid depth
IF( TRIM(si(jp_hld)%clrootname) == 'NOT USED' ) &
- & si(jp_hld)%fnow(:,:,1) = ( rn_hld_ini_n * zmsk + rn_hld_ini_s * (1._wp - zmsk) ) * smask0(:,:)
+ & si(jp_hld)%fnow(:,:,1) = ( rn_hld_ini_n * zmsk + rn_hld_ini_s * (1._wp - zmsk) ) * tmask(:,:,1)
!
- zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * smask0(:,:)
- ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * smask0(:,:)
- zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * smask0(:,:)
- ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * smask0(:,:)
- zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * smask0(:,:)
- zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * smask0(:,:)
- zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) * smask0(:,:)
+ zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1)
+ ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1)
+ zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1)
+ ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1)
+ zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1)
+ zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1)
+ zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) * tmask(:,:,1)
!
! !---------------!
ELSE ! Read namelist !
! !---------------!
! no ice if (sst - Tfreez) >= thresold
- WHERE( ( sst_m(A2D(0)) - (t_bo(:,:) - rt0) ) * smask0(:,:) >= rn_thres_sst ) ; zmsk(:,:) = 0._wp
- ELSEWHERE ; zmsk(:,:) = smask0(:,:)
+ CALL eos_fzp( sss_m(:,:), ztfrz(:,:), kbnd=nn_hls )
+ WHERE( ( sst_m(:,:) - ztfrz(:,:) ) * tmask(:,:,1) >= rn_thres_sst ) ; zmsk(:,:) = 0._wp
+ ELSEWHERE ; zmsk(:,:) = tmask(:,:,1)
END WHERE
!
! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
- WHERE( ff_t(A2D(0)) >= 0._wp )
+ WHERE( ff_t(:,:) >= 0._wp )
zht_i_ini(:,:) = rn_hti_ini_n * zmsk(:,:)
zht_s_ini(:,:) = rn_hts_ini_n * zmsk(:,:)
zat_i_ini(:,:) = rn_ati_ini_n * zmsk(:,:)
@@ -305,64 +312,25 @@ CONTAINS
!----------------!
! 3) fill fields !
!----------------!
- ! select ice covered grid points
- npti = 0 ; nptidx(:) = 0
- DO_2D( 0, 0, 0, 0 )
- IF ( zht_i_ini(ji,jj) > 0._wp ) THEN
- npti = npti + 1
- nptidx(npti) = (jj - 1) * jpi + ji
- ENDIF
- END_2D
-
- ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj)
- CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti) , zht_i_ini )
- CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti) , zht_s_ini )
- CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti) , zat_i_ini )
- CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini )
- CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini )
- CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti) , zt_su_ini )
- CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti) , zsm_i_ini )
- CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti) , zapnd_ini )
- CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti) , zhpnd_ini )
- CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d(1:npti) , zhlid_ini )
-
- ! allocate temporary arrays
- ALLOCATE( zhi_2d (npti,jpl), zhs_2d (npti,jpl), zai_2d (npti,jpl), &
- & zti_2d (npti,jpl), zts_2d (npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), &
- & zaip_2d(npti,jpl), zhip_2d(npti,jpl), zhil_2d(npti,jpl) )
-
! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl)
- CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), &
- & zhi_2d , zhs_2d , zai_2d , &
- & t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), &
- & s_i_1d(1:npti) , a_ip_1d(1:npti) , h_ip_1d(1:npti), h_il_1d(1:npti), &
- & zti_2d , zts_2d , ztsu_2d , &
- & zsi_2d , zaip_2d , zhip_2d , zhil_2d )
-
- ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl)
+ DO jj = 1, jpj
+ CALL ice_var_itd( zht_i_ini(:,jj) , zht_s_ini(:,jj) , zat_i_ini(:,jj) , & ! <<= in
+ & h_i (:,jj,:) , h_s (:,jj,:) , a_i (:,jj,:) , & ! =>> out
+ & ztm_i_ini(:,jj) , ztm_s_ini(:,jj) , zt_su_ini(:,jj) , zsm_i_ini(:,jj) , & ! <<= in
+ & zapnd_ini(:,jj) , zhpnd_ini(:,jj) , zhlid_ini(:,jj) , & ! <<= in
+ & t_i (:,jj,1,:) , t_s (:,jj,1,:) , t_su (:,jj,:) , s_i(:,jj,:) , & ! =>> out
+ & a_ip (:,jj,:) , h_ip (:,jj,:) , h_il (:,jj,:) ) ! =>> out
+ ENDDO
DO jl = 1, jpl
- zti_3d(:,:,jl) = rt0 * tmask(:,:,1)
- zts_3d(:,:,jl) = rt0 * tmask(:,:,1)
- END DO
- CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d , h_i )
- CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d , h_s )
- CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d , a_i )
- CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d , zti_3d )
- CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d , zts_3d )
- CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d , t_su )
- CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d , s_i )
- CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d , a_ip )
- CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d , h_ip )
- CALL tab_2d_3d( npti, nptidx(1:npti), zhil_2d , h_il )
-
- ! deallocate temporary arrays
- DEALLOCATE( zhi_2d, zhs_2d, zai_2d , &
- & zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d )
-
- ! this call is needed because of the calculations above that are done only in the interior
- CALL lbc_lnk( 'iceistate', a_i , 'T', 1._wp, h_i , 'T', 1._wp, h_s , 'T', 1._wp, &
- & zti_3d, 'T', 1._wp, zts_3d, 'T', 1._wp, t_su, 'T', 1._wp, &
- & s_i , 'T', 1._wp, a_ip , 'T', 1._wp, h_ip, 'T', 1._wp, h_il, 'T', 1._wp )
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nlay_s )
+ t_s(ji,jj,jk,jl) = t_s(ji,jj,1,jl)
+ END_3D
+ ENDDO
+ DO jl = 1, jpl
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nlay_i )
+ t_i(ji,jj,jk,jl) = t_i(ji,jj,1,jl)
+ END_3D
+ ENDDO
! switch for the following
WHERE( SUM(a_i(:,:,:),dim=3) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1)
@@ -370,18 +338,23 @@ CONTAINS
END WHERE
! calculate extensive and intensive variables
+ DO jl = 1, jpl
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ s_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_sinew * sss_m(ji,jj) )
+ END_2D
+ END DO
CALL ice_var_salprof ! for sz_i
+
DO jl = 1, jpl
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl)
v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl)
- sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl)
+ sv_i(ji,jj,jl) = s_i(ji,jj,jl) * v_i(ji,jj,jl)
END_2D
END DO
!
DO jl = 1, jpl
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s )
- t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl)
e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * &
& rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus )
END_3D
@@ -389,7 +362,9 @@ CONTAINS
!
DO jl = 1, jpl
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i )
- t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)
+ ! salt
+ szv_i(ji,jj,jk,jl) = sz_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
+ ! heat
ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K
e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * &
& rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + &
@@ -543,8 +518,8 @@ CONTAINS
ENDIF
!
DO ifpr = 1, jpfldi
- ALLOCATE( si(ifpr)%fnow(A2D(0),1) )
- IF( slf_i(ifpr)%ln_tint ) ALLOCATE( si(ifpr)%fdta(A2D(0),1,2) )
+ ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) )
+ IF( slf_i(ifpr)%ln_tint ) ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) )
END DO
!
! fill si with slf_i and control print
diff --git a/src/ICE/iceitd.F90 b/src/ICE/iceitd.F90
index 796c0bf03dfa2bea8254d26994a17c0fb252c11a..bef5ab878917b6ca3786733f20f9bb4849cfb40f 100644
--- a/src/ICE/iceitd.F90
+++ b/src/ICE/iceitd.F90
@@ -400,18 +400,19 @@ CONTAINS
REAL(wp), DIMENSION(jpij,jpl) :: zaTsfn ! - -
!!------------------------------------------------------------------
- CALL tab_3d_2d( npti, nptidx(1:npti), h_i_2d (1:npti,:) , h_i )
- CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i )
- CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i )
- CALL tab_3d_2d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s )
- CALL tab_3d_2d( npti, nptidx(1:npti), oa_i_2d(1:npti,:) , oa_i )
- CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d(1:npti,:) , sv_i )
- CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,:) , a_ip )
- CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,:) , v_ip )
- CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,:) , v_il )
- CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,:) , t_su )
- CALL tab_4d_3d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s )
- CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_3d_2d( npti, nptidx(1:npti), h_i_2d (1:npti,:) , h_i )
+ CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i )
+ CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i )
+ CALL tab_3d_2d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s )
+ CALL tab_3d_2d( npti, nptidx(1:npti), oa_i_2d (1:npti,:) , oa_i )
+ CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i )
+ CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d (1:npti,:) , a_ip )
+ CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d (1:npti,:) , v_ip )
+ CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d (1:npti,:) , v_il )
+ CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d (1:npti,:) , t_su )
+ CALL tab_4d_3d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s )
+ CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_4d_3d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i )
! to correct roundoff errors on a_i
CALL tab_2d_1d( npti, nptidx(1:npti), rn_amax_1d(1:npti), rn_amax_2d )
@@ -459,10 +460,6 @@ CONTAINS
oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - ztrans
oa_i_2d(ji,jl2) = oa_i_2d(ji,jl2) + ztrans
!
- ztrans = sv_i_2d(ji,jl1) * zworkv ! Ice salinity
- sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - ztrans
- sv_i_2d(ji,jl2) = sv_i_2d(ji,jl2) + ztrans
- !
ztrans = zaTsfn(ji,jl1) * zworka ! Surface temperature
zaTsfn(ji,jl1) = zaTsfn(ji,jl1) - ztrans
zaTsfn(ji,jl2) = zaTsfn(ji,jl2) + ztrans
@@ -493,6 +490,18 @@ CONTAINS
e_i_2d(ji,jk,jl1) = e_i_2d(ji,jk,jl1) - ztrans
e_i_2d(ji,jk,jl2) = e_i_2d(ji,jk,jl2) + ztrans
ENDDO
+ ! ! Ice salinity
+ IF( nn_icesal == 4 ) THEN
+ DO jk = 1, nlay_i
+ ztrans = szv_i_2d(ji,jk,jl1) * zworkv
+ szv_i_2d(ji,jk,jl1) = szv_i_2d(ji,jk,jl1) - ztrans
+ szv_i_2d(ji,jk,jl2) = szv_i_2d(ji,jk,jl2) + ztrans
+ ENDDO
+ ELSE
+ ztrans = sv_i_2d(ji,jl1) * zworkv
+ sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - ztrans
+ sv_i_2d(ji,jl2) = sv_i_2d(ji,jl2) + ztrans
+ ENDIF
!
ENDIF ! jl1 >0
END DO
@@ -504,7 +513,7 @@ CONTAINS
!-------------------
! clem: The transfer between one category to another can lead to very small negative values (-1.e-20)
! because of truncation error ( i.e. 1. - 1. /= 0 )
- CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, e_s_2d, e_i_2d )
+ CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, e_s_2d, e_i_2d, szv_i_2d )
! at_i must be <= rn_amax
ztmp(1:npti) = SUM( a_i_2d(1:npti,:), dim=2 )
@@ -528,18 +537,19 @@ CONTAINS
t_su_2d(1:npti,:) = rt0
END WHERE
!
- CALL tab_2d_3d( npti, nptidx(1:npti), h_i_2d (1:npti,:) , h_i )
- CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i )
- CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i )
- CALL tab_2d_3d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s )
- CALL tab_2d_3d( npti, nptidx(1:npti), oa_i_2d(1:npti,:) , oa_i )
- CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d(1:npti,:) , sv_i )
- CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,:) , a_ip )
- CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,:) , v_ip )
- CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,:) , v_il )
- CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,:) , t_su )
- CALL tab_3d_4d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s )
- CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_2d_3d( npti, nptidx(1:npti), h_i_2d (1:npti,:) , h_i )
+ CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i )
+ CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i )
+ CALL tab_2d_3d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s )
+ CALL tab_2d_3d( npti, nptidx(1:npti), oa_i_2d (1:npti,:) , oa_i )
+ CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i )
+ CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d (1:npti,:) , a_ip )
+ CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d (1:npti,:) , v_ip )
+ CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d (1:npti,:) , v_il )
+ CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d (1:npti,:) , t_su )
+ CALL tab_3d_4d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s )
+ CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_3d_4d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i )
!
END SUBROUTINE itd_shiftice
diff --git a/src/ICE/icerst.F90 b/src/ICE/icerst.F90
index 5fb37070f6213f17a94c3d95129d1653ec40aacb..29c451d2e0d48ac00e035f171ae8add0d5f4c745 100644
--- a/src/ICE/icerst.F90
+++ b/src/ICE/icerst.F90
@@ -145,7 +145,6 @@ CONTAINS
! Prognostic variables
CALL iom_rstput( iter, nitrst, numriw, 'v_i' , v_i )
CALL iom_rstput( iter, nitrst, numriw, 'v_s' , v_s )
- CALL iom_rstput( iter, nitrst, numriw, 'sv_i' , sv_i )
CALL iom_rstput( iter, nitrst, numriw, 'a_i' , a_i )
CALL iom_rstput( iter, nitrst, numriw, 't_su' , t_su )
CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice )
@@ -168,6 +167,16 @@ CONTAINS
z3d(:,:,:) = e_i(:,:,jk,:)
CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
END DO
+ ! Ice salt content
+ CALL iom_rstput( iter, nitrst, numriw, 'sv_i' , sv_i )
+ !
+ DO jk = 1, nlay_i
+ WRITE(zchar1,'(I2.2)') jk
+ znam = 'szv_i'//'_l'//zchar1
+ z3d(:,:,:) = szv_i(:,:,jk,:)
+ CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
+ END DO
+ !
! fields needed for Met Office (Jules) coupling
IF( ln_cpl ) THEN
CALL iom_rstput( iter, nitrst, numriw, 'cnd_ice', cnd_ice )
@@ -200,7 +209,7 @@ CONTAINS
INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
INTEGER :: jk
LOGICAL :: llok
- INTEGER :: id0, id1, id2, id3, id4, id5 ! local integer
+ INTEGER :: id0, id1, id2, id3, id4, id5, id6 ! local integer
CHARACTER(len=25) :: znam
CHARACTER(len=2) :: zchar, zchar1
REAL(wp) :: zfice, ziter
@@ -312,6 +321,21 @@ CONTAINS
t1_ice (:,:,:) = rt0
ENDIF
ENDIF
+ ! Ice salt content
+ id6 = iom_varid( numrir, 'szv_i_l01' , ldstop = .FALSE. )
+ IF( id6 > 0 ) THEN ! fields exist
+ DO jk = 1, nlay_i
+ WRITE(zchar1,'(I2.2)') jk
+ znam = 'szv_i'//'_l'//zchar1
+ CALL iom_get( numrir, jpdom_auto, znam , z3d )
+ szv_i(:,:,jk,:) = z3d(:,:,:)
+ END DO
+ ELSE ! start from rest
+ IF(lwp) WRITE(numout,*) ' ==>> previous run without ice salt content per layer output then set it to bulk value'
+ DO jk = 1, nlay_i
+ szv_i(:,:,jk,:) = sv_i(:,:,:) * r1_nlay_i
+ ENDDO
+ ENDIF
IF(.NOT.lrxios) CALL iom_delay_rst( 'READ', 'ICE', numrir ) ! read only ice delayed global communication variables
! ! ---------------------------------- !
diff --git a/src/ICE/icestp.F90 b/src/ICE/icestp.F90
index 5b4074175d55d544f6c3a0586dba864af8552bda..1103a1125f8103d7effbacd444a7c3f988756b7d 100644
--- a/src/ICE/icestp.F90
+++ b/src/ICE/icestp.F90
@@ -261,13 +261,12 @@ CONTAINS
CALL Agrif_Declare_Var_ice ! " " " " " Sea ice
#endif
!
- ! ! Allocate the ice arrays (sbc_ice already allocated in sbc_init)
+ ! ! Allocate the 2D ice arrays (sbc_ice already allocated in sbc_init)
ierr = ice_alloc () ! ice variables
ierr = ierr + sbc_ice_alloc () ! surface boundary conditions
- ierr = ierr + ice1D_alloc () ! thermodynamics
!
CALL mpp_sum( 'icestp', ierr )
- IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays')
+ IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ice_init : unable to allocate 2D ice arrays')
!
! ! set max concentration in both hemispheres
WHERE( gphit(:,:) > 0._wp ) ; rn_amax_2d(:,:) = rn_amax_n ! NH
@@ -309,6 +308,12 @@ CONTAINS
IF(lrxios) CALL iom_context_finalize( cr_icerst_cxt )
ENDIF
!
+ ! ! Allocate the 1D ice arrays
+ ierr = ice1D_alloc () ! thermodynamics
+ !
+ CALL mpp_sum( 'icestp', ierr )
+ IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ice_init : unable to allocate 1D ice arrays')
+ !
END SUBROUTINE ice_init
@@ -398,8 +403,9 @@ CONTAINS
h_i_b(ji,jj,jl) = 0._wp
h_s_b(ji,jj,jl) = 0._wp
ENDIF
- e_s_b (ji,jj,:,jl) = e_s (ji,jj,:,jl) ! snow thermal energy
- e_i_b (ji,jj,:,jl) = e_i (ji,jj,:,jl) ! ice thermal energy
+ e_s_b (ji,jj,:,jl) = e_s (ji,jj,:,jl) ! snow thermal energy
+ e_i_b (ji,jj,:,jl) = e_i (ji,jj,:,jl) ! ice thermal energy
+ szv_i_b(ji,jj,:,jl) = szv_i(ji,jj,:,jl) ! ice salt content
END_2D
ENDDO
! total concentration
@@ -482,7 +488,7 @@ CONTAINS
qml_ice (ji,jj,jl) = 0._wp ! surface melt heat flux
! Melt pond surface melt diagnostics (mv - more efficient: grouped into one water volume flux)
dh_i_sum_2d(ji,jj,jl) = 0._wp
- dh_s_mlt_2d(ji,jj,jl) = 0._wp
+ dh_s_sum_2d(ji,jj,jl) = 0._wp
END_2D
ENDDO
@@ -505,17 +511,26 @@ CONTAINS
!
DO_2D( 0, 0, 0, 0 )
diag_heat(ji,jj) = diag_heat(ji,jj) &
- & - SUM(SUM( e_i (ji,jj,1:nlay_i,:) - e_i_b (ji,jj,1:nlay_i,:), dim=2 ) ) * r1_Dt_ice &
- & - SUM(SUM( e_s (ji,jj,1:nlay_s,:) - e_s_b (ji,jj,1:nlay_s,:), dim=2 ) ) * r1_Dt_ice
- diag_sice(ji,jj) = diag_sice(ji,jj) &
- & + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * r1_Dt_ice * rhoi
+ & - SUM(SUM( e_i (ji,jj,1:nlay_i,:) - e_i_b (ji,jj,1:nlay_i,:), dim=2 ) ) * r1_Dt_ice &
+ & - SUM(SUM( e_s (ji,jj,1:nlay_s,:) - e_s_b (ji,jj,1:nlay_s,:), dim=2 ) ) * r1_Dt_ice
diag_vice(ji,jj) = diag_vice(ji,jj) &
- & + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * r1_Dt_ice * rhoi
+ & + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * r1_Dt_ice * rhoi
diag_vsnw(ji,jj) = diag_vsnw(ji,jj) &
- & + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * r1_Dt_ice * rhos
+ & + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * r1_Dt_ice * rhos
diag_vpnd(ji,jj) = diag_vpnd(ji,jj) &
- & + SUM( v_ip(ji,jj,:)+v_il(ji,jj,:) - v_ip_b(ji,jj,:)-v_il_b(ji,jj,:) ) * r1_Dt_ice * rhow
+ & + SUM( v_ip(ji,jj,:)+v_il(ji,jj,:) - v_ip_b(ji,jj,:)-v_il_b(ji,jj,:) ) * r1_Dt_ice * rhow
END_2D
+ IF( nn_icesal == 4 ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ diag_sice(ji,jj) = diag_sice(ji,jj) &
+ & + SUM(SUM( szv_i(ji,jj,:,:) - szv_i_b(ji,jj,:,:) , dim=2 ) ) * r1_Dt_ice * rhoi
+ END_2D
+ ELSE
+ DO_2D( 0, 0, 0, 0 )
+ diag_sice(ji,jj) = diag_sice(ji,jj) &
+ & + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * r1_Dt_ice * rhoi
+ END_2D
+ ENDIF
!
IF( kn == 2 ) CALL iom_put ( 'hfxdhc' , diag_heat ) ! output of heat trend
!
diff --git a/src/ICE/icethd.F90 b/src/ICE/icethd.F90
index 8408ab9891c9e055cb94a327629ef66a588e2461..739167a1661b5bb670e63a757e4af58c40e771ec 100644
--- a/src/ICE/icethd.F90
+++ b/src/ICE/icethd.F90
@@ -48,6 +48,10 @@ MODULE icethd
!! for convergence tests
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztice_cvgerr, ztice_cvgstp
+ !! for sanity checks in drainage and flushing
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zcfl_flush, zcfl_drain
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zs_flush_dserr, zs_drain_dserr, zs_flush_serr, zs_drain_serr
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zt_flush_dserr, zt_drain_dserr, zt_flush_serr, zt_drain_serr
!! * Substitutions
# include "do_loop_substitute.h90"
@@ -79,9 +83,10 @@ CONTAINS
!! - call ice_thd_rem for remapping thickness distribution
!! - call ice_thd_do for ice growth in leads
!!-------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! number of iteration
+ INTEGER, INTENT(in) :: kt ! number of iteration
!
- INTEGER :: ji, jj, jk, jl ! dummy loop indices
+ INTEGER :: ji, jj, jk, jl ! dummy loop indices
+ REAL(wp) :: zmiss
!!-------------------------------------------------------------------
! controls
@@ -101,11 +106,29 @@ CONTAINS
ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp
ENDIF
!
- CALL ice_thd_frazil !--- frazil ice: collection thickness (ht_i_new) & fraction of frazil (fraz_frac)
+ ! sanity checks for salt flushing and drainage
+ IF( ln_sal_chk ) THEN
+ CALL iom_miss_val( 'icetemp', zmiss ) ! get missing value from xml
+ !
+ ALLOCATE( zcfl_flush(A2D(0),jpl), zcfl_drain(A2D(0),jpl) )
+ !
+ ALLOCATE( zs_flush_dserr(A2D(0),jpl), zs_drain_dserr(A2D(0),jpl), &
+ & zs_flush_serr (A2D(0),jpl), zs_drain_serr (A2D(0),jpl) )
+ !
+ ALLOCATE( zt_flush_dserr(A2D(0),nlay_i,jpl), zt_drain_dserr(A2D(0),nlay_i,jpl), &
+ & zt_flush_serr (A2D(0),nlay_i,jpl), zt_drain_serr (A2D(0),nlay_i,jpl) )
+ !
+ zcfl_flush = 0._wp ; zcfl_drain = 0._wp
+ zs_flush_dserr = zmiss ; zs_drain_dserr = zmiss ; zs_flush_serr = zmiss ; zs_drain_serr = zmiss
+ zt_flush_dserr = zmiss ; zt_drain_dserr = zmiss ; zt_flush_serr = zmiss ; zt_drain_serr = zmiss
+ ENDIF
!
!-------------------------------------------------------------------------------------------!
! Thermodynamic computation (only on grid points covered by ice) => loop over ice categories
!-------------------------------------------------------------------------------------------!
+ !
+ CALL ice_thd_frazil !--- frazil ice: collection thickness (ht_i_new) & fraction of frazil (fraz_frac)
+ !
DO jl = 1, jpl
! select ice covered grid points
@@ -122,17 +145,18 @@ CONTAINS
CALL ice_thd_1d2d( jl, 1 ) ! --- Move to 1D arrays --- !
! ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- !
!
- s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here)
- dh_i_sum (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm (1:npti) = 0._wp
+ dh_s_tot (1:npti) = 0._wp ! --- some init --- ! (important to have them here)
+ dh_i_sum (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm(1:npti) = 0._wp
dh_i_sub (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp
- dh_snowice(1:npti) = 0._wp ; dh_s_mlt(1:npti) = 0._wp
+ dh_snowice(1:npti) = 0._wp ; dh_s_sum(1:npti) = 0._wp ; dh_s_itm(1:npti) = 0._wp
!
CALL ice_thd_zdf ! --- Ice-Snow temperature --- !
!
- IF( ln_icedH ) THEN ! --- Growing/Melting --- !
- CALL ice_thd_dh
- ENDIF
- CALL ice_thd_sal( ln_icedS ) ! --- Ice salinity --- !
+ IF( ln_icedH ) CALL ice_thd_dh ! --- Growing/Melting --- !
+ !
+ CALL ice_thd_temp ! --- Temperature update --- !
+ !
+ CALL ice_thd_sal ! --- Ice salinity --- !
!
CALL ice_thd_temp ! --- Temperature update --- !
!
@@ -164,7 +188,7 @@ CONTAINS
! ! --- LBC for the halos --- !
CALL lbc_lnk( 'icethd', a_i , 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, &
& t_su, 'T', 1._wp, a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp )
- CALL lbc_lnk( 'icethd', e_i , 'T', 1._wp, e_s , 'T', 1._wp )
+ CALL lbc_lnk( 'icethd', e_i , 'T', 1._wp, e_s , 'T', 1._wp, szv_i , 'T', 1._wp )
!
at_i(:,:) = SUM( a_i, dim=3 )
DO_2D( 0, 0, 0, 0 ) ! --- Ice velocity corrections
@@ -183,6 +207,22 @@ CONTAINS
CALL iom_put( 'tice_cvgstp', ztice_cvgstp ) ; DEALLOCATE( ztice_cvgstp )
ENDIF
!
+ ! sanity checks for salt drainage and flushing
+ IF( ln_sal_chk ) THEN
+ CALL iom_put( 'sice_flush_dserr', zs_flush_dserr ) ; DEALLOCATE( zs_flush_dserr )
+ CALL iom_put( 'sice_drain_dserr', zs_drain_dserr ) ; DEALLOCATE( zs_drain_dserr )
+ CALL iom_put( 'tice_flush_dserr', zt_flush_dserr ) ; DEALLOCATE( zt_flush_dserr )
+ CALL iom_put( 'tice_drain_dserr', zt_drain_dserr ) ; DEALLOCATE( zt_drain_dserr )
+ !
+ CALL iom_put( 'sice_flush_serr', zs_flush_serr ) ; DEALLOCATE( zs_flush_serr )
+ CALL iom_put( 'sice_drain_serr', zs_drain_serr ) ; DEALLOCATE( zs_drain_serr )
+ CALL iom_put( 'tice_flush_serr', zt_flush_serr ) ; DEALLOCATE( zt_flush_serr )
+ CALL iom_put( 'tice_drain_serr', zt_drain_serr ) ; DEALLOCATE( zt_drain_serr )
+ !
+ CALL iom_put( 'cfl_flush', zcfl_flush ) ; DEALLOCATE( zcfl_flush )
+ CALL iom_put( 'cfl_drain', zcfl_drain ) ; DEALLOCATE( zcfl_drain )
+ ENDIF
+
! controls
IF( ln_icectl ) CALL ice_prt (kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ') ! prints
IF( sn_cfctl%l_prtctl ) &
@@ -280,9 +320,9 @@ CONTAINS
CALL tab_2d_1d( npti, nptidx(1:npti), e_s_1d(1:npti,jk), e_s(:,:,jk,kl) )
END DO
DO jk = 1, nlay_i
- CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,kl) )
- CALL tab_2d_1d( npti, nptidx(1:npti), e_i_1d (1:npti,jk), e_i (:,:,jk,kl) )
- CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl) )
+ CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,kl) )
+ CALL tab_2d_1d( npti, nptidx(1:npti), e_i_1d (1:npti,jk), e_i (:,:,jk,kl) )
+ CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d (1:npti,jk), sz_i (:,:,jk,kl) )
END DO
!
CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d (1:npti), qprec_ice )
@@ -375,11 +415,13 @@ CONTAINS
END DO
!
! Change thickness to volume (replaces routine ice_var_eqv2glo)
- v_i_1d (1:npti) = h_i_1d (1:npti) * a_i_1d (1:npti)
- v_s_1d (1:npti) = h_s_1d (1:npti) * a_i_1d (1:npti)
- sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti)
- oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti)
-
+ v_i_1d (1:npti) = h_i_1d (1:npti) * a_i_1d (1:npti)
+ v_s_1d (1:npti) = h_s_1d (1:npti) * a_i_1d (1:npti)
+ sv_i_1d (1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti)
+ oa_i_1d (1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti)
+ DO jk = 1, nlay_i
+ szv_i_1d(1:npti,jk) = sz_i_1d(1:npti,jk) * v_i_1d (1:npti) * r1_nlay_i
+ ENDDO
CALL tab_1d_2d( npti, nptidx(1:npti), at_i_1d(1:npti), at_i )
CALL tab_1d_2d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i (:,:,kl) )
CALL tab_1d_2d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i (:,:,kl) )
@@ -391,9 +433,10 @@ CONTAINS
CALL tab_1d_2d( npti, nptidx(1:npti), e_s_1d(1:npti,jk), e_s(:,:,jk,kl) )
END DO
DO jk = 1, nlay_i
- CALL tab_1d_2d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,kl) )
- CALL tab_1d_2d( npti, nptidx(1:npti), e_i_1d (1:npti,jk), e_i (:,:,jk,kl) )
- CALL tab_1d_2d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), e_i_1d (1:npti,jk), e_i (:,:,jk,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), sz_i_1d (1:npti,jk), sz_i (:,:,jk,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), szv_i_1d(1:npti,jk), szv_i(:,:,jk,kl) )
END DO
!
CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni )
@@ -439,7 +482,7 @@ CONTAINS
CALL tab_1d_2d( npti, nptidx(1:npti), t1_ice_1d (1:npti), t1_ice (:,:,kl) )
! Melt ponds
CALL tab_1d_2d( npti, nptidx(1:npti), dh_i_sum (1:npti) , dh_i_sum_2d(:,:,kl) )
- CALL tab_1d_2d( npti, nptidx(1:npti), dh_s_mlt (1:npti) , dh_s_mlt_2d(:,:,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), dh_s_sum (1:npti) , dh_s_sum_2d(:,:,kl) )
! SIMIP diagnostics
CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d (1:npti), t_si (:,:,kl) )
CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_bot_1d(1:npti), qcn_ice_bot(:,:,kl) )
@@ -455,6 +498,21 @@ CONTAINS
CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgerr_1d(1:npti), ztice_cvgerr(:,:,kl) )
CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgstp_1d(1:npti), ztice_cvgstp(:,:,kl) )
ENDIF
+ ! sanity check for salt scheme
+ IF( ln_sal_chk ) THEN
+ CALL tab_1d_2d( npti, nptidx(1:npti), s_flush_dserr_1d(1:npti), zs_flush_dserr(:,:,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), s_drain_dserr_1d(1:npti), zs_drain_dserr(:,:,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), s_flush_serr_1d (1:npti), zs_flush_serr (:,:,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), s_drain_serr_1d (1:npti), zs_drain_serr (:,:,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), cfl_flush_1d(1:npti), zcfl_flush(:,:,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), cfl_drain_1d(1:npti), zcfl_drain(:,:,kl) )
+ DO jk = 1, nlay_i
+ CALL tab_1d_2d( npti, nptidx(1:npti), t_flush_dserr_1d(1:npti,jk), zt_flush_dserr(:,:,jk,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), t_drain_dserr_1d(1:npti,jk), zt_drain_dserr(:,:,jk,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), t_flush_serr_1d (1:npti,jk), zt_flush_serr (:,:,jk,kl) )
+ CALL tab_1d_2d( npti, nptidx(1:npti), t_drain_serr_1d (1:npti,jk), zt_drain_serr (:,:,jk,kl) )
+ END DO
+ ENDIF
!
END SELECT
!
@@ -475,7 +533,7 @@ CONTAINS
!!-------------------------------------------------------------------
INTEGER :: ios ! Local integer output status for namelist read
!!
- NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS, ln_leadhfx
+ NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_leadhfx
!!-------------------------------------------------------------------
!
READ ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901)
@@ -492,7 +550,6 @@ CONTAINS
WRITE(numout,*) ' activate ice thick change from top/bot (T) or not (F) ln_icedH = ', ln_icedH
WRITE(numout,*) ' activate lateral melting (T) or not (F) ln_icedA = ', ln_icedA
WRITE(numout,*) ' activate ice growth in open-water (T) or not (F) ln_icedO = ', ln_icedO
- WRITE(numout,*) ' activate gravity drainage and flushing (T) or not (F) ln_icedS = ', ln_icedS
WRITE(numout,*) ' heat in the leads is used to melt sea-ice before warming the ocean ln_leadhfx = ', ln_leadhfx
ENDIF
!
diff --git a/src/ICE/icethd_da.F90 b/src/ICE/icethd_da.F90
index 69896c5112d7cfe1e56b3bc6d1de986fdb9f1455..47e83f26f74f8c90adfbc370a765b99668f2526c 100644
--- a/src/ICE/icethd_da.F90
+++ b/src/ICE/icethd_da.F90
@@ -113,11 +113,17 @@ CONTAINS
REAL(wp), PARAMETER :: zcs = 0.66_wp
REAL(wp), PARAMETER :: zm1 = 3.e-6_wp
REAL(wp), PARAMETER :: zm2 = 1.36_wp
+ REAL(wp), DIMENSION(nlay_i) :: zs_i ! ice salinity
!!---------------------------------------------------------------------
!
zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) )
!
DO ji = 1, npti
+ !
+ IF( nn_icesal == 4 ) THEN ; zs_i(:) = sz_i_1d(ji,:) ! use layer salinity if nn_icesal=4
+ ELSE ; zs_i(:) = s_i_1d (ji) ! bulk salinity otherwise (for conservation purpose)
+ ENDIF
+ !
! --- Calculate reduction of total sea ice concentration --- !
zdfloe = rn_dmin * ( zastar / ( zastar - at_i_1d(ji) ) )**rn_beta ! Mean floe caliper diameter [m]
!
@@ -134,7 +140,7 @@ CONTAINS
zda = MIN( a_i_1d(ji), zda_tot * a_i_1d(ji) / at_i_1d(ji) )
! Contribution to salt flux
- sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoi * h_i_1d(ji) * zda * s_i_1d(ji) * r1_Dt_ice
+ sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoi * zda * r1_Dt_ice * h_i_1d(ji) * r1_nlay_i * SUM( zs_i(:) )
! Contribution to heat flux into the ocean [W.m-2], (<0)
hfx_thd_1d(ji) = hfx_thd_1d(ji) - zda * r1_Dt_ice * ( h_i_1d(ji) * r1_nlay_i * SUM( e_i_1d(ji,1:nlay_i) ) &
diff --git a/src/ICE/icethd_dh.F90 b/src/ICE/icethd_dh.F90
index 5264b7566aef2a99676495afece415a797844e41..bfc110cf78a5b34a498f2b6c587a71b12399048a 100644
--- a/src/ICE/icethd_dh.F90
+++ b/src/ICE/icethd_dh.F90
@@ -63,45 +63,41 @@ CONTAINS
!! Vancoppenolle et al.,2009, Ocean Modelling
!!------------------------------------------------------------------
INTEGER :: ji, jk ! dummy loop indices
- INTEGER :: iter ! local integer
-
+ !
REAL(wp) :: ztmelts ! local scalar
REAL(wp) :: zdum
- REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment
- REAL(wp) :: zgrr ! bottom growth rate
REAL(wp) :: zt_i_new ! bottom formation temperature
REAL(wp) :: z1_rho ! 1/(rhos+rho0-rhoi)
-
+ !
REAL(wp) :: zQm ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean
REAL(wp) :: zEi ! specific enthalpy of sea ice (J/kg)
REAL(wp) :: zEw ! specific enthalpy of exchanged water (J/kg)
REAL(wp) :: zdE ! specific enthalpy difference (J/kg)
REAL(wp) :: zfmdt ! exchange mass flux x time step (J/m2), >0 towards the ocean
-
+ REAL(wp) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2)
+ REAL(wp) :: zdeltah, zs_i_new, zds, zs_sni
+ REAL(wp) :: zswitch_sal
+ !
REAL(wp), DIMENSION(jpij) :: zq_top ! heat for surface ablation (J.m-2)
REAL(wp), DIMENSION(jpij) :: zq_bot ! heat for bottom ablation (J.m-2)
REAL(wp), DIMENSION(jpij) :: zq_rema ! remaining heat at the end of the routine (J.m-2)
REAL(wp), DIMENSION(jpij) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2)
- REAL(wp) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2)
- REAL(wp) :: zdeltah
REAL(wp), DIMENSION(jpij) :: zsnw ! distribution of snow after wind blowing
-
+ !
INTEGER , DIMENSION(nlay_i) :: icount ! number of layers vanishing by melting
+ REAL(wp), DIMENSION(nlay_i) :: zs_i ! ice salinity
REAL(wp), DIMENSION(0:nlay_i+1) :: zh_i ! ice layer thickness (m)
REAL(wp), DIMENSION(0:nlay_s ) :: zh_s ! snw layer thickness (m)
REAL(wp), DIMENSION(0:nlay_s ) :: ze_s ! snw layer enthalpy (J.m-3)
REAL(wp), DIMENSION(0:nlay_i+1) :: zh_i_old ! old thickness
REAL(wp), DIMENSION(0:nlay_i+1) :: ze_i_old ! old enthalpy
-
- REAL(wp) :: zswitch_sal
-
- INTEGER :: num_iter_max ! Heat conservation
+ REAL(wp), DIMENSION(0:nlay_i+1) :: zs_i_old ! old salt content
!!------------------------------------------------------------------
! Discriminate between time varying salinity and constant
SELECT CASE( nn_icesal ) ! varying salinity or not
CASE( 1 , 3 ) ; zswitch_sal = 0._wp ! prescribed salinity profile
- CASE( 2 ) ; zswitch_sal = 1._wp ! varying salinity profile
+ CASE( 2 , 4 ) ; zswitch_sal = 1._wp ! varying salinity profile
END SELECT
!
! ! ============================================== !
@@ -136,20 +132,22 @@ CONTAINS
! for snw-ice formation
z1_rho = 1._wp / ( rhos+rho0-rhoi )
!
- ! number of iterations for new sea ice
- IF( nn_icesal == 2 ) THEN ; num_iter_max = 5 ! salinity varying in time
- ELSE ; num_iter_max = 1
- ENDIF
! ! ==================== !
! ! Start main loop here !
! ! ==================== !
DO ji = 1, npti
-
+ !
+ IF( nn_icesal == 4 ) THEN ; zs_i(:) = sz_i_1d(ji,:) ! use layer salinity if nn_icesal=4
+ ELSE ; zs_i(:) = s_i_1d (ji) ! bulk salinity otherwise (for conservation purpose)
+ ENDIF
+ !
! initialize ice layer thicknesses and enthalpies
+ zs_i_old(0:nlay_i+1) = 0._wp
ze_i_old(0:nlay_i+1) = 0._wp
zh_i_old(0:nlay_i+1) = 0._wp
zh_i (0:nlay_i+1) = 0._wp
DO jk = 1, nlay_i
+ zs_i_old(jk) = h_i_1d(ji) * r1_nlay_i * zs_i (jk)
ze_i_old(jk) = h_i_1d(ji) * r1_nlay_i * e_i_1d(ji,jk)
zh_i_old(jk) = h_i_1d(ji) * r1_nlay_i
zh_i (jk) = h_i_1d(ji) * r1_nlay_i
@@ -175,7 +173,7 @@ CONTAINS
hfx_res_1d (ji) = hfx_res_1d (ji) - ze_s(jk) * zh_s(jk) * a_i_1d(ji) * r1_Dt_ice ! heat flux to the ocean [W.m-2], < 0
wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos * zh_s(jk) * a_i_1d(ji) * r1_Dt_ice ! mass flux
! updates
- dh_s_mlt(ji) = dh_s_mlt(ji) - zh_s(jk)
+ dh_s_itm(ji) = dh_s_itm(ji) - zh_s(jk)
h_s_1d (ji) = MAX( 0._wp, h_s_1d (ji) - zh_s(jk) )
zh_s (jk) = 0._wp
ze_s (jk) = 0._wp
@@ -209,7 +207,7 @@ CONTAINS
wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos * zdum * a_i_1d(ji) * r1_Dt_ice ! snow melting only = water into the ocean
! updates available heat + thickness
- dh_s_mlt(ji) = dh_s_mlt(ji) + zdum
+ dh_s_sum(ji) = dh_s_sum(ji) + zdum
zq_top (ji) = MAX( 0._wp , zq_top (ji) + zdum * ze_s(jk) )
h_s_1d (ji) = MAX( 0._wp , h_s_1d (ji) + zdum )
zh_s (jk) = MAX( 0._wp , zh_s (jk) + zdum )
@@ -260,11 +258,11 @@ CONTAINS
!
dh_i_itm(ji) = dh_i_itm(ji) + zdum ! Cumulate internal melting
!
- hfx_res_1d(ji) = hfx_res_1d(ji) + zEi * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0
- ! ice enthalpy zEi is "sent" to the ocean
- wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux
- sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux
- ! using s_i_1d and not sz_i_1d(jk) is ok
+ hfx_res_1d(ji) = hfx_res_1d(ji) + zEi * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0
+ ! ice enthalpy zEi is "sent" to the ocean
+ wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux
+ sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * zs_i(jk) * a_i_1d(ji) * r1_Dt_ice ! Salt flux
+ !
ELSE !-- Surface melting
zEi = - e_i_1d(ji,jk) * r1_rhoi ! Specific enthalpy of layer k [J/kg, <0]
@@ -285,17 +283,18 @@ CONTAINS
zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0]
- hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0
- hfx_sum_1d(ji) = hfx_sum_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux used in this process [W.m-2], > 0
- wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux
- sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0
- ! using s_i_1d and not sz_i_1d(jk) is ok)
+ hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0
+ hfx_sum_1d(ji) = hfx_sum_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux used in this process [W.m-2], > 0
+ wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux
+ sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * zdum * zs_i(jk) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0
+ !
END IF
! update thickness
zh_i (jk) = MAX( 0._wp, zh_i (jk) + zdum )
h_i_1d(ji) = MAX( 0._wp, h_i_1d(ji) + zdum )
!
- ! update heat content (J.m-2) and layer thickness
+ ! update heat content (J.m-2), salt content and layer thickness
+ zs_i_old(jk) = zs_i_old(jk) + zdum * zs_i(jk)
ze_i_old(jk) = ze_i_old(jk) + zdum * e_i_1d(ji,jk)
zh_i_old(jk) = zh_i_old(jk) + zdum
!
@@ -304,19 +303,20 @@ CONTAINS
! ---------------
zdum = MAX( - zh_i(jk) , - zevap_rema * r1_rhoi )
!
- hfx_sub_1d(ji) = hfx_sub_1d(ji) + e_i_1d(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0
- wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux > 0
- sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0
- ! clem: flux is sent to the ocean for simplicity
- ! but salt should remain in the ice except
- ! if all ice is melted. => must be corrected
+ hfx_sub_1d(ji) = hfx_sub_1d(ji) + e_i_1d(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0
+ wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux > 0
+ sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoi * zdum * zs_i(jk) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0
+ ! clem: flux is sent to the ocean for simplicity
+ ! but salt should remain in the ice except
+ ! if all ice is melted. => must be corrected
! update remaining mass flux and thickness
zevap_rema = zevap_rema + zdum * rhoi
zh_i (jk) = MAX( 0._wp, zh_i (jk) + zdum )
h_i_1d(ji) = MAX( 0._wp, h_i_1d(ji) + zdum )
dh_i_sub(ji) = dh_i_sub(ji) + zdum
- ! update heat content (J.m-2) and layer thickness
+ ! update heat content (J.m-2), salt content and layer thickness
+ zs_i_old(jk) = zs_i_old(jk) + zdum * zs_i(jk)
ze_i_old(jk) = ze_i_old(jk) + zdum * e_i_1d(ji,jk)
zh_i_old(jk) = zh_i_old(jk) + zdum
@@ -338,53 +338,40 @@ CONTAINS
! between the inner conductive flux (qcn_ice_bot), from the open water heat flux
! (fhld) and the sensible ice-ocean flux (qsb_ice_bot).
! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice
-
- ! If salinity varies in time, an iterative procedure is required, because
- ! the involved quantities are inter-dependent.
- ! Basal growth (dh_i_bog) depends upon new ice specific enthalpy (zEi),
- ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bog)
- ! -> need for an iterative procedure, which converges quickly
-
+ !
+ zs_i_new = 0._wp
+ !
IF( zf_tt(ji) < 0._wp ) THEN
- DO iter = 1, num_iter_max ! iterations
-
- ! New bottom ice salinity (Cox & Weeks, JGR88 )
- zgrr = MIN( 1.0e-3_wp, MAX ( dh_i_bog(ji) * r1_Dt_ice , epsi10 ) )
- !
- IF ( zgrr < 2.0e-8_wp ) THEN ; zfracs = 0.12_wp
- ELSEIF( zgrr >= 3.6e-7_wp ) THEN ; zfracs = MIN( 0.26_wp / ( 0.26_wp + 0.74_wp * EXP(-724300._wp*zgrr) ) , 0.5_wp )
- ELSE ; zfracs = MIN( 0.8925_wp + 0.0568_wp * LOG(100._wp*zgrr), 0.5_wp )
- ENDIF
-
- s_i_new(ji) = zswitch_sal * zfracs * sss_1d(ji) + ( 1. - zswitch_sal ) * s_i_1d(ji) ! New ice salinity
-
- ztmelts = - rTmlt * s_i_new(ji) ! New ice melting point (C)
-
- zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
-
- zEi = rcpi * ( zt_i_new - (ztmelts+rt0) ) & ! Specific enthalpy of forming ice (J/kg, <0)
- & - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts
-
- zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0)
-
- zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0)
- dh_i_bog(ji) = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) )
+ zs_i_new = zswitch_sal * rn_sinew * sss_1d(ji) + ( 1. - zswitch_sal ) * zs_i(1) ! New ice salinity
+
+ ztmelts = - rTmlt * zs_i_new ! New ice melting point (C)
+
+ zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
+
+ zEi = rcpi * ( zt_i_new - (ztmelts+rt0) ) & ! Specific enthalpy of forming ice (J/kg, <0)
+ & - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts
+
+ zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0)
+
+ zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0)
+
+ dh_i_bog(ji) = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) )
- END DO
! Contribution to Energy and Salt Fluxes
- zfmdt = - rhoi * dh_i_bog(ji) ! Mass flux x time step (kg/m2, < 0)
+ zfmdt = - rhoi * dh_i_bog(ji) ! Mass flux x time step (kg/m2, < 0)
- hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], >0
- hfx_bog_1d(ji) = hfx_bog_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux used in this process [W.m-2], <0
- wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * a_i_1d(ji) * r1_Dt_ice ! Mass flux, <0
- sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * s_i_new(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux, <0
+ hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], >0
+ hfx_bog_1d(ji) = hfx_bog_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux used in this process [W.m-2], <0
+ wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * a_i_1d(ji) * r1_Dt_ice ! Mass flux, <0
+ sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * zs_i_new * a_i_1d(ji) * r1_Dt_ice ! Salt flux, <0
! update thickness
zh_i(nlay_i+1) = zh_i(nlay_i+1) + dh_i_bog(ji)
h_i_1d(ji) = h_i_1d(ji) + dh_i_bog(ji)
- ! update heat content (J.m-2) and layer thickness
+ ! update heat content (J.m-2), salt content and layer thickness
+ zs_i_old(nlay_i+1) = zs_i_old(nlay_i+1) + dh_i_bog(ji) * zs_i_new
ze_i_old(nlay_i+1) = ze_i_old(nlay_i+1) + dh_i_bog(ji) * (-zEi * rhoi)
zh_i_old(nlay_i+1) = zh_i_old(nlay_i+1) + dh_i_bog(ji)
@@ -408,11 +395,11 @@ CONTAINS
!
zfmdt = - zdum * rhoi ! Mass flux x time step > 0
!
- hfx_res_1d(ji) = hfx_res_1d(ji) + zEi * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0
- ! ice enthalpy zEi is "sent" to the ocean
- wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux
- sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux
- ! using s_i_1d and not sz_i_1d(jk) is ok
+ hfx_res_1d(ji) = hfx_res_1d(ji) + zEi * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0
+ ! ice enthalpy zEi is "sent" to the ocean
+ wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux
+ sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * zs_i(jk) * a_i_1d(ji) * r1_Dt_ice ! Salt flux
+ !
ELSE !-- Basal melting
zEi = - e_i_1d(ji,jk) * r1_rhoi ! Specific enthalpy of melting ice (J/kg, <0)
@@ -433,17 +420,18 @@ CONTAINS
zQm = zfmdt * zEw ! Heat exchanged with ocean
- hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0
- hfx_bom_1d(ji) = hfx_bom_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat used in this process [W.m-2], >0
- wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux
- sfx_bom_1d(ji) = sfx_bom_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux
- ! using s_i_1d and not sz_i_1d(jk) is ok
+ hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0
+ hfx_bom_1d(ji) = hfx_bom_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat used in this process [W.m-2], >0
+ wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux
+ sfx_bom_1d(ji) = sfx_bom_1d(ji) - rhoi * zdum * zs_i(jk) * a_i_1d(ji) * r1_Dt_ice ! Salt flux
+ !
ENDIF
! update thickness
zh_i (jk) = MAX( 0._wp, zh_i (jk) + zdum )
h_i_1d(ji) = MAX( 0._wp, h_i_1d(ji) + zdum )
!
- ! update heat content (J.m-2) and layer thickness
+ ! update heat content (J.m-2), salt content and layer thickness
+ zs_i_old(jk) = zs_i_old(jk) + zdum * zs_i(jk)
ze_i_old(jk) = ze_i_old(jk) + zdum * e_i_1d(ji,jk)
zh_i_old(jk) = zh_i_old(jk) + zdum
ENDIF
@@ -504,9 +492,9 @@ CONTAINS
sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Salt flux
! Case constant salinity in time: virtual salt flux to keep salinity constant
- IF( nn_icesal /= 2 ) THEN
- sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d(ji) * zfmdt * a_i_1d(ji) * r1_Dt_ice & ! put back sss_m into the ocean
- & - s_i_1d(ji) * dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice ! and get rn_icesal from the ocean
+ IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN
+ sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d(ji) * zfmdt * a_i_1d(ji) * r1_Dt_ice & ! put back sss_m into the ocean
+ & - zs_i(1) * dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice ! and get rn_icesal from the ocean
ENDIF
! Mass flux: All snow is thrown in the ocean, and seawater is taken to replace the volume
@@ -517,7 +505,8 @@ CONTAINS
zh_i(0) = zh_i(0) + dh_snowice(ji)
zdeltah = dh_snowice(ji)
- ! update heat content (J.m-2) and layer thickness
+ ! update heat content (J.m-2), salt content and layer thickness
+ zs_i_old(0) = zs_i_old(0) - zfmdt * sss_1d(ji) * r1_rhoi ! clem: s(0) could be > rn_sinew*sss
zh_i_old(0) = zh_i_old(0) + dh_snowice(ji)
ze_i_old(0) = ze_i_old(0) + zfmdt * zEw ! 1st part (sea water enthalpy)
@@ -534,12 +523,12 @@ CONTAINS
!!$ ! --- Update snow diags --- !
!!$ !!clem: this is wrong. dh_s_tot is not used anyway
!!$ DO ji = 1, npti
-!!$ dh_s_tot(ji) = dh_s_tot(ji) + dh_s_mlt(ji) + zdeltah + zdh_s_sub(ji) - dh_snowice(ji)
+!!$ dh_s_tot(ji) = dh_s_tot(ji) + dh_s_sum(ji) + zdeltah + zdh_s_sub(ji) - dh_snowice(ji)
!!$ END DO
!
! Remapping of snw enthalpy on a regular grid
!--------------------------------------------
- e_s_1d(ji,:) = snw_ent( zh_s(:), ze_s(:) )
+ e_s_1d(ji,:) = snw_ent( zh_s, ze_s )
! recalculate t_s_1d from e_s_1d
IF( h_s_1d(ji) > 0._wp ) THEN
@@ -552,10 +541,18 @@ CONTAINS
END DO
ENDIF
- ! Remapping of ice enthalpy on a regular grid
- !--------------------------------------------
- e_i_1d(ji,:) = ice_ent1( zh_i_old(:), ze_i_old(:) )
-
+ ! Remapping of ice enthalpy/salt on a regular grid
+ !-------------------------------------------------
+ CALL ice_var_vremap( zh_i_old, ze_i_old, e_i_1d (ji,:) )
+ IF( nn_icesal == 4 ) CALL ice_var_vremap( zh_i_old, zs_i_old, sz_i_1d(ji,:) )
+ IF( nn_icesal == 2 ) THEN ! Update ice salinity from snow-ice and bottom growth
+ zs_sni = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi ! salinity of snow ice
+ zds = ( zs_sni - s_i_1d(ji) ) * dh_snowice(ji) / MAX( epsi10, h_i_1d(ji) ) ! snow-ice
+ zds = zds + ( zs_i_new - s_i_1d(ji) ) * dh_i_bog (ji) / MAX( epsi10, h_i_1d(ji) ) ! bottom growth
+ !
+ s_i_1d(ji) = s_i_1d(ji) + zds
+ ENDIF
+
END DO ! npti
! ! ================== !
! ! End main loop here !
@@ -573,7 +570,6 @@ CONTAINS
FUNCTION snw_ent( ph_old, pe_old )
!!-------------------------------------------------------------------
!! *** ROUTINE snw_ent ***
- !!
!! ** Purpose :
!! This routine computes new vertical grids in the snow,
!! and consistently redistributes temperatures.
@@ -650,92 +646,6 @@ CONTAINS
END FUNCTION snw_ent
-
- FUNCTION ice_ent1( ph_old, pe_old )
- !!-------------------------------------------------------------------
- !! *** ROUTINE ice_ent1 ***
- !!
- !! ** Purpose :
- !! This routine computes new vertical grids in the ice,
- !! and consistently redistributes temperatures.
- !! Redistribution is made so as to ensure to energy conservation
- !!
- !!
- !! ** Method : linear conservative remapping
- !!
- !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses
- !! 2) linear remapping on the new layers
- !!
- !! ------------ cum0(0) ------------- cum1(0)
- !! NEW -------------
- !! ------------ cum0(1) ==> -------------
- !! ... -------------
- !! ------------ -------------
- !! ------------ cum0(nlay_i+2) ------------- cum1(nlay_i)
- !!
- !!
- !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005
- !!-------------------------------------------------------------------
- REAL(wp), DIMENSION(0:nlay_i+1), INTENT(in) :: ph_old, pe_old ! old tickness and enthlapy
- REAL(wp), DIMENSION(1:nlay_i) :: ice_ent1 ! new enthlapies (J.m-3, remapped)
- !
- INTEGER :: ji ! dummy loop indices
- INTEGER :: jk0, jk1 ! old/new layer indices
- !
- REAL(wp), DIMENSION(0:nlay_i+2) :: zeh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces
- REAL(wp), DIMENSION(0:nlay_i) :: zeh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces
- REAL(wp) :: zhnew ! new layers thicknesses
- !!-------------------------------------------------------------------
-
- !--------------------------------------------------------------------------
- ! 1) Cumulative integral of old enthalpy * thickness and layers interfaces
- !--------------------------------------------------------------------------
- zeh_cum0(0) = 0._wp
- zh_cum0 (0) = 0._wp
- DO jk0 = 1, nlay_i+2
- zeh_cum0(jk0) = zeh_cum0(jk0-1) + pe_old(jk0-1)
- zh_cum0 (jk0) = zh_cum0 (jk0-1) + ph_old(jk0-1)
- END DO
-
- !------------------------------------
- ! 2) Interpolation on the new layers
- !------------------------------------
- ! new layer thickesses
- zhnew = SUM( ph_old(0:nlay_i+1) ) * r1_nlay_i
-
- ! new layers interfaces
- zh_cum1(0) = 0._wp
- DO jk1 = 1, nlay_i
- zh_cum1(jk1) = zh_cum1(jk1-1) + zhnew
- END DO
-
- zeh_cum1(0:nlay_i) = 0._wp
- ! new cumulative q*h => linear interpolation
- DO jk0 = 1, nlay_i+2
- DO jk1 = 1, nlay_i-1
- IF( zh_cum1(jk1) <= zh_cum0(jk0) .AND. zh_cum1(jk1) > zh_cum0(jk0-1) ) THEN
- zeh_cum1(jk1) = ( zeh_cum0(jk0-1) * ( zh_cum0(jk0) - zh_cum1(jk1 ) ) + &
- & zeh_cum0(jk0 ) * ( zh_cum1(jk1) - zh_cum0(jk0-1) ) ) &
- & / ( zh_cum0(jk0) - zh_cum0(jk0-1) )
- ENDIF
- END DO
- END DO
- ! to ensure that total heat content is strictly conserved, set:
- zeh_cum1(nlay_i) = zeh_cum0(nlay_i+2)
-
- ! new enthalpies
- DO jk1 = 1, nlay_i
- ice_ent1(jk1) = MAX( 0._wp, zeh_cum1(jk1) - zeh_cum1(jk1-1) ) / MAX( zhnew, epsi20 ) ! max for roundoff error
- END DO
-
- ! --- diag error on heat remapping --- !
- ! comment: if input h_old and eh_old are already multiplied by a_i (as in icethd_do),
- ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0
- ! hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice * &
- ! & ( SUM( pe_new(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_old(ji,0:nlay_i+1) ) )
-
-
- END FUNCTION ice_ent1
#else
!!----------------------------------------------------------------------
diff --git a/src/ICE/icethd_do.F90 b/src/ICE/icethd_do.F90
index 90e0cee2bfb606cab3ddbe26d7184071ccee394c..4ed314350a6bb2ad0616747a382df193e40fd6ec 100644
--- a/src/ICE/icethd_do.F90
+++ b/src/ICE/icethd_do.F90
@@ -95,7 +95,7 @@ CONTAINS
REAL(wp), DIMENSION(jpij) :: zh_newice ! thickness of accreted ice
REAL(wp), DIMENSION(jpij) :: zfraz_frac_1d ! relative ice / frazil velocity (1D vector)
!
- REAL(wp), DIMENSION(0:nlay_i+1) :: zh_i_old, ze_i_old
+ REAL(wp), DIMENSION(0:nlay_i+1) :: zh_i_old, ze_i_old, zs_i_old
!!-----------------------------------------------------------------------!
IF( ln_icediachk ) CALL ice_cons_hsm( 0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft )
@@ -119,11 +119,12 @@ CONTAINS
! Move from 2-D to 1-D vectors
IF ( npti > 0 ) THEN
- CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti) , at_i )
- CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,:), a_i (:,:,:) )
- CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,:), v_i (:,:,:) )
- CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d(1:npti,:), sv_i(:,:,:) )
- CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d (1:npti) , at_i )
+ CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i (:,:,:) )
+ CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i (:,:,:) )
+ CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i(:,:,:) )
+ CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_4d_3d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i )
CALL tab_2d_1d( npti, nptidx(1:npti), qlead_1d (1:npti), qlead )
CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d (1:npti), t_bo )
CALL tab_2d_1d( npti, nptidx(1:npti), sfx_opw_1d (1:npti), sfx_opw )
@@ -136,13 +137,15 @@ CONTAINS
CALL tab_2d_1d( npti, nptidx(1:npti), rn_amax_1d(1:npti), rn_amax_2d )
CALL tab_2d_1d( npti, nptidx(1:npti), sss_1d (1:npti), sss_m )
- ! Convert units for ice internal energy
+ ! Convert units for ice internal energy and salt content
DO jl = 1, jpl
DO jk = 1, nlay_i
WHERE( v_i_2d(1:npti,jl) > 0._wp )
- e_i_2d(1:npti,jk,jl) = e_i_2d(1:npti,jk,jl) / v_i_2d(1:npti,jl) * REAL( nlay_i )
+ e_i_2d (1:npti,jk,jl) = e_i_2d (1:npti,jk,jl) / v_i_2d(1:npti,jl) * REAL( nlay_i )
+ szv_i_2d(1:npti,jk,jl) = szv_i_2d(1:npti,jk,jl) / v_i_2d(1:npti,jl) * REAL( nlay_i )
ELSEWHERE
- e_i_2d(1:npti,jk,jl) = 0._wp
+ e_i_2d (1:npti,jk,jl) = 0._wp
+ szv_i_2d(1:npti,jk,jl) = 0._wp
END WHERE
END DO
END DO
@@ -151,10 +154,8 @@ CONTAINS
SELECT CASE ( nn_icesal )
CASE ( 1 ) ! Sice = constant
zs_newice(1:npti) = rn_icesal
- CASE ( 2 ) ! Sice = F(z,t) [Vancoppenolle et al (2005)]
- DO ji = 1, npti
- zs_newice(ji) = MIN( 4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_1d(ji) )
- END DO
+ CASE ( 2 , 4 ) ! Sice = F(z,t) [Griewank and Notz 2013 ; Rees Jones and Worster 2014]
+ zs_newice(1:npti) = rn_sinew * sss_1d(1:npti)
CASE ( 3 ) ! Sice = F(z) [multiyear ice]
zs_newice(1:npti) = 2.3
END SELECT
@@ -243,9 +244,11 @@ CONTAINS
! Heat content
jl = jcat ! categroy in which new ice is put
IF( za_b(jl) > 0._wp ) THEN
- e_i_2d(ji,:,jl) = ( ze_newice * zv_newice + e_i_2d(ji,:,jl) * zv_b(jl) ) / MAX( v_i_2d(ji,jl), epsi20 )
+ e_i_2d (ji,:,jl) = ( ze_newice * zv_newice + e_i_2d (ji,:,jl) * zv_b(jl) ) / MAX( v_i_2d(ji,jl), epsi20 )
+ szv_i_2d(ji,:,jl) = ( zs_newice(ji) * zv_newice + szv_i_2d(ji,:,jl) * zv_b(jl) ) / MAX( v_i_2d(ji,jl), epsi20 )
ELSE
- e_i_2d(ji,:,jl) = ze_newice
+ e_i_2d (ji,:,jl) = ze_newice
+ szv_i_2d(ji,:,jl) = zs_newice(ji)
ENDIF
! --- bottom ice growth + ice enthalpy remapping --- !
@@ -254,9 +257,11 @@ CONTAINS
! for remapping
zh_i_old(0:nlay_i+1) = 0._wp
ze_i_old(0:nlay_i+1) = 0._wp
+ zs_i_old(0:nlay_i+1) = 0._wp
DO jk = 1, nlay_i
- zh_i_old(jk) = v_i_2d(ji,jl) * r1_nlay_i
- ze_i_old(jk) = e_i_2d(ji,jk,jl) * v_i_2d(ji,jl) * r1_nlay_i
+ zh_i_old(jk) = v_i_2d(ji,jl) * r1_nlay_i
+ ze_i_old(jk) = e_i_2d (ji,jk,jl) * v_i_2d(ji,jl) * r1_nlay_i
+ zs_i_old(jk) = szv_i_2d(ji,jk,jl) * v_i_2d(ji,jl) * r1_nlay_i
END DO
! new volumes including lateral/bottom accretion + residual
@@ -269,13 +274,16 @@ CONTAINS
v_i_2d(ji,jl) = v_i_2d(ji,jl) + zv_newfra
! for remapping
zh_i_old(nlay_i+1) = zv_newfra
- ze_i_old(nlay_i+1) = ze_newice * zv_newfra
+ ze_i_old(nlay_i+1) = ze_newice * zv_newfra
+ zs_i_old(nlay_i+1) = zs_newice(ji) * zv_newfra
- ! --- Update salinity --- !
+ ! --- Update bulk salinity --- !
sv_i_2d(ji,jl) = sv_i_2d(ji,jl) + zs_newice(ji) * ( v_i_2d(ji,jl) - zv_b(jl) )
-
- ! --- Ice enthalpy remapping --- !
- e_i_2d(ji,:,jl) = ice_ent2( zh_i_old(:), ze_i_old(:) )
+
+ ! --- Ice enthalpy and salt remapping --- !
+ CALL ice_var_vremap( zh_i_old, ze_i_old, e_i_2d (ji,:,jl) )
+ IF( nn_icesal == 4 ) CALL ice_var_vremap( zh_i_old, zs_i_old, szv_i_2d(ji,:,jl) )
+ !
END DO
END DO ! npti
@@ -283,18 +291,20 @@ CONTAINS
! ! End main loop here !
! ! ================== !
!
- ! Change units for e_i
+ ! Change units for e_i/szv_i
DO jl = 1, jpl
DO jk = 1, nlay_i
- e_i_2d(1:npti,jk,jl) = e_i_2d(1:npti,jk,jl) * v_i_2d(1:npti,jl) * r1_nlay_i
+ e_i_2d (1:npti,jk,jl) = e_i_2d (1:npti,jk,jl) * v_i_2d(1:npti,jl) * r1_nlay_i
+ szv_i_2d(1:npti,jk,jl) = szv_i_2d(1:npti,jk,jl) * v_i_2d(1:npti,jl) * r1_nlay_i
END DO
END DO
! Move 2D vectors to 1D vectors
- CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:), a_i (:,:,:) )
- CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:), v_i (:,:,:) )
- CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d(1:npti,:), sv_i(:,:,:) )
- CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i (:,:,:) )
+ CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i (:,:,:) )
+ CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i(:,:,:) )
+ CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i )
+ CALL tab_3d_4d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i )
CALL tab_1d_2d( npti, nptidx(1:npti), sfx_opw_1d(1:npti), sfx_opw )
CALL tab_1d_2d( npti, nptidx(1:npti), wfx_opw_1d(1:npti), wfx_opw )
CALL tab_1d_2d( npti, nptidx(1:npti), hfx_thd_1d(1:npti), hfx_thd )
@@ -402,93 +412,6 @@ CONTAINS
ENDIF
END SUBROUTINE ice_thd_frazil
- FUNCTION ice_ent2( ph_old, pe_old )
- !!-------------------------------------------------------------------
- !! *** ROUTINE ice_ent2 ***
- !!
- !! ** Purpose :
- !! This routine computes new vertical grids in the ice,
- !! and consistently redistributes temperatures.
- !! Redistribution is made so as to ensure to energy conservation
- !!
- !!
- !! ** Method : linear conservative remapping
- !!
- !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses
- !! 2) linear remapping on the new layers
- !!
- !! ------------ cum0(0) ------------- cum1(0)
- !! NEW -------------
- !! ------------ cum0(1) ==> -------------
- !! ... -------------
- !! ------------ -------------
- !! ------------ cum0(nlay_i+2) ------------- cum1(nlay_i)
- !!
- !!
- !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005
- !!-------------------------------------------------------------------
- REAL(wp), DIMENSION(0:nlay_i+1), INTENT(in) :: ph_old, pe_old ! old tickness and enthlapy
- REAL(wp), DIMENSION(1:nlay_i) :: ice_ent2 ! new enthlapies (J.m-3, remapped)
- !
- INTEGER :: ji ! dummy loop indices
- INTEGER :: jk0, jk1 ! old/new layer indices
- !
- REAL(wp), DIMENSION(0:nlay_i+2) :: zeh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces
- REAL(wp), DIMENSION(0:nlay_i) :: zeh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces
- REAL(wp) :: zhnew ! new layers thicknesses
- !!-------------------------------------------------------------------
-
- !--------------------------------------------------------------------------
- ! 1) Cumulative integral of old enthalpy * thickness and layers interfaces
- !--------------------------------------------------------------------------
- zeh_cum0(0) = 0._wp
- zh_cum0 (0) = 0._wp
- DO jk0 = 1, nlay_i+2
- zeh_cum0(jk0) = zeh_cum0(jk0-1) + pe_old(jk0-1)
- zh_cum0 (jk0) = zh_cum0 (jk0-1) + ph_old(jk0-1)
- END DO
-
- !------------------------------------
- ! 2) Interpolation on the new layers
- !------------------------------------
- ! new layer thickesses
- zhnew = SUM( ph_old(0:nlay_i+1) ) * r1_nlay_i
-
- ! new layers interfaces
- zh_cum1(0) = 0._wp
- DO jk1 = 1, nlay_i
- zh_cum1(jk1) = zh_cum1(jk1-1) + zhnew
- END DO
-
- zeh_cum1(0:nlay_i) = 0._wp
- ! new cumulative q*h => linear interpolation
- DO jk0 = 1, nlay_i+2
- DO jk1 = 1, nlay_i-1
- IF( zh_cum1(jk1) <= zh_cum0(jk0) .AND. zh_cum1(jk1) > zh_cum0(jk0-1) ) THEN
- zeh_cum1(jk1) = ( zeh_cum0(jk0-1) * ( zh_cum0(jk0) - zh_cum1(jk1 ) ) + &
- & zeh_cum0(jk0 ) * ( zh_cum1(jk1) - zh_cum0(jk0-1) ) ) &
- & / ( zh_cum0(jk0) - zh_cum0(jk0-1) )
- ENDIF
- END DO
- END DO
- ! to ensure that total heat content is strictly conserved, set:
- zeh_cum1(nlay_i) = zeh_cum0(nlay_i+2)
-
- ! new enthalpies
- DO jk1 = 1, nlay_i
- ice_ent2(jk1) = MAX( 0._wp, zeh_cum1(jk1) - zeh_cum1(jk1-1) ) / MAX( zhnew, epsi20 ) ! max for roundoff error
- END DO
-
- ! --- diag error on heat remapping --- !
- ! comment: if input h_old and eh_old are already multiplied by a_i (as in icethd_do),
- ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0
- ! hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice * &
- ! & ( SUM( pe_new(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_old(ji,0:nlay_i+1) ) )
-
-
- END FUNCTION ice_ent2
-
-
SUBROUTINE ice_thd_do_init
!!-----------------------------------------------------------------------
!! *** ROUTINE ice_thd_do_init ***
diff --git a/src/ICE/icethd_pnd.F90 b/src/ICE/icethd_pnd.F90
index 8f5b63df6fafe2d57bee60219d80aa32321082f9..81d55238139dc0bdb01a4dd5ce5961c6e6e0757d 100644
--- a/src/ICE/icethd_pnd.F90
+++ b/src/ICE/icethd_pnd.F90
@@ -310,7 +310,7 @@ CONTAINS
CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il(:,:,jl) )
CALL tab_2d_1d( npti, nptidx(1:npti), dh_i_sum(1:npti), dh_i_sum_2d(:,:,jl) )
- CALL tab_2d_1d( npti, nptidx(1:npti), dh_s_mlt(1:npti), dh_s_mlt_2d(:,:,jl) )
+ CALL tab_2d_1d( npti, nptidx(1:npti), dh_s_sum(1:npti), dh_s_sum_2d(:,:,jl) )
DO jk = 1, nlay_i
CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,jl) )
@@ -341,7 +341,7 @@ CONTAINS
!------------------!
!
!--- available meltwater for melt ponding (zdv_avail) ---!
- zdv_avail = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) ! > 0
+ zdv_avail = -( dh_i_sum(ji)*rhoi + dh_s_sum(ji)*rhos ) * z1_rhow * a_i_1d(ji) ! > 0
zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) ! = ( 1 - r ) = fraction of melt water that is not flushed
zdv_mlt = MAX( 0._wp, zfr_mlt * zdv_avail ) ! max for roundoff errors?
!
@@ -596,7 +596,7 @@ CONTAINS
IF ( a_i(ji,jj,jl) > epsi10 ) THEN
!--- Available and contributing meltwater for melt ponding ---!
- zv_mlt = - ( dh_i_sum_2d(ji,jj,jl) * rhoi + dh_s_mlt_2d(ji,jj,jl) * rhos ) & ! available volume of surface melt water per grid area
+ zv_mlt = - ( dh_i_sum_2d(ji,jj,jl) * rhoi + dh_s_sum_2d(ji,jj,jl) * rhos ) & ! available volume of surface melt water per grid area
& * z1_rhow * a_i(ji,jj,jl)
! MV -> could move this directly in ice_thd_dh and get an array (ji,jj,jl) for surface melt water volume per grid area
zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i(ji,jj) ! fraction of surface meltwater going to ponds
diff --git a/src/ICE/icethd_sal.F90 b/src/ICE/icethd_sal.F90
index 11ca64e3e16cee1e36be5fd640635274ffd7fdf2..bb6e726cb7725f122f03abbe2e382e613988eb5d 100644
--- a/src/ICE/icethd_sal.F90
+++ b/src/ICE/icethd_sal.F90
@@ -23,6 +23,7 @@ MODULE icethd_sal
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
USE lib_fortran ! fortran utilities (glob_sum + no signed zero)
+ USE iom ! I/O manager library
IMPLICIT NONE
PRIVATE
@@ -35,7 +36,20 @@ MODULE icethd_sal
REAL(wp) :: rn_time_gd ! restoring time constant for gravity drainage (= 20 days) [s]
REAL(wp) :: rn_sal_fl ! restoring salinity for flushing [PSU]
REAL(wp) :: rn_time_fl ! restoring time constant for gravity drainage (= 10 days) [s]
-
+ INTEGER :: nn_sal_scheme ! convection scheme
+ LOGICAL :: ln_flushing ! activate flushing
+ LOGICAL :: ln_drainage ! activate gravity drainage
+ INTEGER :: nn_drainage ! number of subcycles for gravity drainage
+ INTEGER :: nn_flushing ! number of subcycles for flushing
+ REAL(wp) :: rn_flushrate ! rate of flushing (fraction of melt water used for flushing)
+ REAL(wp) :: rn_alpha_CW ! Brine flow for CW1988
+ REAL(wp) :: rn_alpha_RJW ! Brine flow for RJW2014
+ REAL(wp) :: rn_alpha_GN ! Brine flow for GN2013 (kg/m3/s)
+ REAL(wp) :: rn_Rc_RJW ! critical Rayleigh number for RJW
+ REAL(wp) :: rn_Rc_GN ! for GN
+ REAL(wp) :: rn_sal_himin ! min ice thickness for gravity drainage and flushing calculation
+ REAL(wp) :: rn_vbrc ! critical brines volume above which flushing can occur
+
!!----------------------------------------------------------------------
!! NEMO/ICE 4.0 , NEMO Consortium (2018)
!! $Id: icethd_sal.F90 13472 2020-09-16 13:05:19Z smasson $
@@ -43,71 +57,193 @@ MODULE icethd_sal
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE ice_thd_sal( ld_sal )
+ SUBROUTINE ice_thd_sal
!!-------------------------------------------------------------------
!! *** ROUTINE ice_thd_sal ***
!!
!! ** Purpose : computes new salinities in the ice
!!
- !! ** Method : 3 possibilities
+ !! ** Method : 4 possibilities
!! -> nn_icesal = 1 -> Sice = cst [ice salinity constant in both time & space]
!! -> nn_icesal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005]
!! -> nn_icesal = 3 -> Sice = S(z) [multiyear ice]
+ !! -> nn_icesal = 4 -> Sice = S(z,t) [Gravity Drainage and Flushing parameterizations]
+ !!
+ !! ** Case 4 details :
+ !!
+ !! For both gravity drainage and flushing, brines are calculated depending on ice temperature (liquidus formulation):
+ !! Sbr = - T / mu [linear liquidus] ( nn_liquidus == 1 )
+ !! Sbr = -18.7 * T - 0.519 * T2 - 0.00535 * T3 [VC2019] ( nn_liquidus == 2 )
+ !! Sbr = -17.6 * T - 0.389 * T2 - 0.00362 * T3 [Weast] ( nn_liquidus == 3 )
+ !!
+ !! ****************
+ !! Gravity Drainage
+ !! ****************
+ !!
+ !! we want to solve this equation:
+ !! ==============================
+ !! dS/dt = -w dSbr/dz
+ !!
+ !! with S = sea ice salinity
+ !! Sbr = brine salinity
+ !! w = upwelling Darcy velocity of the return flow (i.e. vertical velocity of the brines, positive downward => >0)
+ !!
+ !! discrete form is solved using upward scheme (such as in CICE):
+ !! (S(t+dt)-S(t))/dt = -w(k) * (Sbr(k+1)-Sbr(k))/dz
+ !!
+ !! 3 schemes are proposed based on the paper from Thomas et al. (2020):
+ !! ======================
+ !! 0 | ----------------------------------- surface
+ !! |
+ !! | ----------------------------------- zc
+ !! z |
+ !! | Ra > Rac => brine convection
+ !! |
+ !! h | ------------------------------------ bottom
+ !! v
+ !!
+ !! Ra = cp_br * g * beta * (Sbr(z) - Sw) * perm * (h-z) / (cnd_br*visc) [RWJ2014 formulation]
+ !!
+ !! with Ra : Rayleigh number
+ !! cp_br : brine heat capacity (J/m3/K)
+ !! g : gravity (m/s2)
+ !! beta : saline density coefficient (g/kg)-1
+ !! cnd_br : brine thermal conductivity (W/m/K)
+ !! visc : brine kinematic viscosity (m2/s)
+ !! Sw : ocean salinity (g/kg)
+ !! zc : critical depth below which convection occurs (m)
+ !! h : total ice thickness (m)
+ !! perm : effective permeability (m2)
+ !! = 3.e-8 * (S/Sbr)^3 [SI3] ( np_perm_for == 0 )
+ !! = 1.995e-8 * (S/Sbr)^3.1 [Freitag] ( np_perm_for == 1 )
+ !! = 1.0e-8 * (S/Sbr)^3. [RJW2014] ( np_perm_for == 2 )
+ !!
+ !! 1) === Reese Jones & Worster 2014 (refer to as RJW2014) ===
+ !!
+ !! w(z) = - alpha_rjw * cnd_br / cp_br * max(Ra(z)-Rac) * (z-zc)/(h-zc)^2
+ !! with alpha_rjw : intensity parameter
+ !!
+ !! 2) === Griewank & Notz 2013 (refer to as GN2013) ===
+ !!
+ !! w(k) = - alpha_gn/rho * sum( (Ra(kk)-Rac) * dz(kk), [from kk=1 to k] )
+ !! with rho : brine density (kg/m3)
+ !! alpha_gn : intensity parameter (kg/m3/s)
+ !!
+ !! 3) === Cox and Weeks 1988 (refer to as CW1988) ===
+ !!
+ !! w(k) = - alpha_cw * 0.0589_wp * MAX( 0._wp, zv_br(z)/rn_vbrc - 1._wp )
+ !! with alpha_cw : intensity parameter
+ !! rn_vbrc : critical brines volume (for permeability)
+ !!
+ !! ********
+ !! Flushing
+ !! ********
+ !!
+ !! we want to solve this equation:
+ !! ==============================
+ !! dS/dt = -w dSbr/dz
+ !!
+ !! with Sbr = brine salinity
+ !! w = upwelling velocity (i.e. vertical velocity of the brines, negative upward => < 0)
+ !!
+ !! w = Fmass / rhob if v_br > v_brc (= 5%)
+ !! = 0 otherwise
+ !!
+ !! with Fmass = -Flush * rhoi * dh / dt : mass flux (kg/m2/s, >0 since dh<0)
+ !! rhob = rhow * ( 1 + c*Sbr ) : brine density
+ !! v_br = S / Sbr : brine volume fraction
+ !! rhoi : ice density
+ !! rhow : fresh water density (kg/m3)
+ !! c : empirical coef (0.8e-3 ‰-1)
+ !! tuning parameters:
+ !! Flush : fraction of melt water allowed to percolate thru the ice (30%)
+ !! v_brc : critical brine volume above which there is flushing (5%)
+ !!
+ !! discrete form is solved using upward scheme (such as in CICE):
+ !! (S(t+dt)-S(t))/dt = -w(k) * (Sbr(k-1)-Sbr(k))/dz
+ !!
+ !!
+ !! ** References
+ !! Thomas, M., Vancoppenolle, M., France, J. L., Sturges, W. T., Bakker, D. C. E., Kaiser, J., & von Glasow, R. (2020).
+ !! Tracer measurements in growing sea ice support convective gravity drainage parameterizations.
+ ! Journal of Geophysical Research: Oceans, 125, e2019JC015791. https://doi.org/10. 1029/2019JC015791
!!---------------------------------------------------------------------
- LOGICAL, INTENT(in) :: ld_sal ! gravity drainage and flushing or not
- !
- INTEGER :: ji ! dummy loop indices
- REAL(wp) :: zs_sni, zds ! local scalars
+ INTEGER :: ji, jk, jk1, jk2 ! dummy loop indices
REAL(wp) :: z1_time_gd, z1_time_fl
+ !
+ ! for gravity drainage and flushing
+ INTEGER :: iter
+ REAL(wp) :: zh_i, z1_h_i, zhmelt, zc, zcfl, zperm, ztmp, zdt
+ REAL(wp), DIMENSION(nlay_i) :: z_mid
+ REAL(wp), DIMENSION(nlay_i+1) :: z_edge
+ REAL(wp), DIMENSION(nlay_i) :: zds, zperm_eff, zv_br, zRa, zRae, zw_br
+ REAL(wp), DIMENSION(0:nlay_i+1) :: zs_br
+ !
+ ! permeability
+ REAL(wp), PARAMETER :: np_perm_eff = 2 ! 1 = vertical minimum
+ ! 2 = harmonic mean
+ REAL(wp), PARAMETER :: np_perm_for = 1 ! 0 = SI3
+ ! 1 = Freitag 99
+ ! 2 = RJW 2014
+ ! Rayleigh
+ REAL(wp), PARAMETER :: zcp_br = 4.e6 ! heat capacity of brine (J/m3)
+ REAL(wp), PARAMETER :: zbeta = 7.5e-4 ! saline density coefficient (g/kg)-1
+ REAL(wp), PARAMETER :: zcnd_br = 0.523 ! thermal conductivity of brine W/m/K
+ REAL(wp), PARAMETER :: zvisc = 1.8e-6 ! Kinematic viscosity of brine
+ ! GN scheme constant
+ REAL(wp), PARAMETER :: zrhob_GN = 1020. ! Brine density (kg/m3)
+ !
+ ! for sanity checks
+ REAL(wp) :: zmiss, zs_min, zds_max, zcfl_max
!!---------------------------------------------------------------------
-
+ !
+ ! sanity check
+ IF( ln_sal_chk) CALL iom_miss_val( 'icetemp', zmiss ) ! get missing value from xml
+ !
SELECT CASE ( nn_icesal )
!
! !---------------------------------------------!
CASE( 2 ) ! time varying salinity with linear profile !
! !---------------------------------------------!
- z1_time_gd = rDt_ice / rn_time_gd
- z1_time_fl = rDt_ice / rn_time_fl
- !
+ IF( ln_drainage ) THEN ; z1_time_gd = rDt_ice / rn_time_gd
+ ELSE ; z1_time_gd = 0._wp
+ ENDIF
+ IF( ln_flushing ) THEN ; z1_time_fl = rDt_ice / rn_time_fl
+ ELSE ; z1_time_fl = 0._wp
+ ENDIF
+ !
DO ji = 1, npti
!
- IF( h_i_1d(ji) > 0._wp ) THEN
- !
- ! --- Update ice salinity from snow-ice and bottom growth --- !
- zs_sni = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi ! salinity of snow ice
- zds = ( zs_sni - s_i_1d(ji) ) * dh_snowice(ji) / h_i_1d(ji) ! snow-ice
- zds = zds + ( s_i_new(ji) - s_i_1d(ji) ) * dh_i_bog (ji) / h_i_1d(ji) ! bottom growth
- ! update salinity (nb: salt flux already included in icethd_dh)
- s_i_1d(ji) = s_i_1d(ji) + zds
+ IF( h_i_1d(ji) > rn_sal_himin ) THEN
!
! --- Update ice salinity from brine drainage and flushing --- !
- IF( ld_sal ) THEN
- IF( t_su_1d(ji) >= rt0 ) THEN ! flushing (summer time)
- zds = - MAX( s_i_1d(ji) - rn_sal_fl , 0._wp ) * z1_time_fl
- ELSEIF( t_su_1d(ji) <= t_bo_1d(ji) ) THEN ! gravity drainage
- zds = - MAX( s_i_1d(ji) - rn_sal_gd , 0._wp ) * z1_time_gd
- ELSE
- zds = 0._wp
- ENDIF
- ! update salinity
- s_i_1d(ji) = s_i_1d(ji) + zds
- ! salt flux
- sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds * r1_Dt_ice
+ IF( t_su_1d(ji) >= rt0 ) THEN ! flushing (summer time)
+ zds(1) = - MAX( s_i_1d(ji) - rn_sal_fl , 0._wp ) * z1_time_fl
+ ELSEIF( t_su_1d(ji) <= t_bo_1d(ji) ) THEN ! gravity drainage
+ zds(1) = - MAX( s_i_1d(ji) - rn_sal_gd , 0._wp ) * z1_time_gd
+ ELSE
+ zds(1) = 0._wp
ENDIF
- !
- ! --- salinity must stay inbounds --- !
- zds = MAX( 0._wp, rn_simin - s_i_1d(ji) ) ! > 0 if s_i < simin
- zds = zds + MIN( 0._wp, rn_simax - s_i_1d(ji) ) ! < 0 if s_i > simax
! update salinity
- s_i_1d(ji) = s_i_1d(ji) + zds
+ s_i_1d(ji) = s_i_1d(ji) + zds(1)
! salt flux
- sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds * r1_Dt_ice
+ sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds(1) * r1_Dt_ice
+ !
+ ! --- salinity must stay inbounds --- !
+ IF( ln_drainage .OR. ln_flushing ) THEN
+ zds(1) = MAX( 0._wp, rn_simin - s_i_1d(ji) ) ! > 0 if s_i < simin
+ zds(1) = zds(1) + MIN( 0._wp, rn_sinew*sss_1d(ji) - s_i_1d(ji) ) ! < 0 if s_i > simax
+ ! update salinity
+ s_i_1d(ji) = s_i_1d(ji) + zds(1)
+ ! salt flux
+ sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds(1) * r1_Dt_ice
+ ENDIF
!
ENDIF
!
END DO
!
- ! Salinity profile
+ ! Salinity profile (gives sz_i)
CALL ice_var_salprof1d
!
! !----------------------------------------!
@@ -115,11 +251,294 @@ CONTAINS
! !----------------------------------------!
CALL ice_var_salprof1d
!
+ ! !--------------------------------!
+ CASE( 4 ) ! Gravity Drainage and Flushing !
+ ! !--------------------------------!
+
+ ! Initialization
+ ! ==============
+ DO jk = 1, nlay_i
+ z_mid(jk) = ( REAL( jk ) - 0.5_wp ) * r1_nlay_i
+ END DO
+ DO jk = 1, nlay_i+1
+ z_edge(jk) = ( REAL( jk ) - 1._wp ) * r1_nlay_i
+ END DO
+
+ ! Gravity Drainage
+ ! ================
+ IF( ln_drainage ) THEN
+ !
+ zdt = rDt_ice / REAL( nn_drainage )
+ !
+ DO ji = 1, npti
+ ! ice thickness ( we do not want to do anything for salt when ice is thinner than the minimum allowed )
+ IF( h_i_1d(ji) >= rn_sal_himin ) THEN ; z1_h_i = 1._wp / ( h_i_1d(ji) * r1_nlay_i )
+ ELSE ; z1_h_i = 0._wp
+ ENDIF
+ !
+ ! surface melting (m)
+ zhmelt = dh_s_sum(ji) + dh_i_sum(ji) ! =0 if no melt, <0 otherwise
+ !
+ ! iteration to converge (usually 10 is ok)
+ zcfl_max = 0._wp
+ zds_max = 0._wp
+ zs_min = 0._wp
+ DO iter = 1, nn_drainage
+ !
+ CALL ice_brine( sss_1d(ji), t_i_1d(ji,:), sz_i_1d(ji,:), zs_br, zv_br )
+
+ IF( h_i_1d(ji) >= rn_sal_himin .AND. MAXVAL( zs_br(:) ) > sss_1d(ji) .AND. zhmelt >= 0._wp ) THEN
+ ! during melting season, salt flux can turn upward with these schemes
+ ! Effective permeability
+ ! ----------------------
+ IF( np_perm_eff == 1 ) THEN ! Minimum
+
+ DO jk = 1, nlay_i
+ IF ( np_perm_for == 0 ) THEN ; zperm_eff(jk) = 3.e-8_wp * ( MINVAL( zv_br(jk:nlay_i) ) )**3. ! SI3
+ ELSEIF( np_perm_for == 1 ) THEN ; zperm_eff(jk) = 1.995e-8_wp * ( MINVAL( zv_br(jk:nlay_i) ) )**3.1 ! Freitag
+ ELSEIF( np_perm_for == 2 ) THEN ; zperm_eff(jk) = 1.e-8_wp * ( MINVAL( zv_br(jk:nlay_i) ) )**3. ! Rees Jones and Worster
+ END IF ! -> this case leads to bizarre results
+ END DO
+
+ ELSEIF( np_perm_eff == 2 ) THEN ! Harmonic Mean
+
+ DO jk1 = 1, nlay_i
+ ztmp = 0._wp
+ DO jk2 = jk1, nlay_i
+ IF ( np_perm_for == 0 ) THEN ; zperm = 3.e-8_wp * zv_br(jk2)**3. ! SI3
+ ELSEIF( np_perm_for == 1 ) THEN ; zperm = 1.995e-8_wp * zv_br(jk2)**3.1 ! Freitag
+ ELSEIF( np_perm_for == 2 ) THEN ; zperm = 1.e-8_wp * zv_br(jk2)**3. ! Rees Jones and Worster
+ END IF
+ ztmp = ztmp + 1._wp / zperm
+ END DO
+ zperm_eff(jk1) = REAL( nlay_i - jk1 + 1 ) / ztmp
+ END DO
+
+ END IF
+
+ ! Rayleigh number
+ ! ---------------
+ ! Ra = cp_br * g * beta * (Sbr(z) - Sw) * perm * (h-z) / (cnd_br*visc) [RWJ2014 formulation]
+ DO jk = 1, nlay_i
+ zRa(jk) = zcp_br * grav * zbeta * MAX( 0., zs_br(jk) - sss_1d(ji)) * zperm_eff(jk) &
+ & * h_i_1d(ji) * ( 1._wp - z_mid(jk) ) / ( zcnd_br * zvisc )
+ END DO
+
+ ! Vertical velocity
+ ! -----------------
+ IF ( nn_sal_scheme == 1 ) THEN ! *** RJW 2014 ***
+ !
+ ! if Ra is everywhere < Rc : no convection => Rae =0
+ ! else : convection until zc => Rae /= 0
+ zc = 0._wp
+ ztmp = 0._wp
+ DO jk = nlay_i,1,-1
+ IF ( zRa(jk) >= rn_Rc_RJW ) THEN
+ ztmp = MAX( ztmp , zRa(jk) - rn_Rc_RJW )
+ zc = z_edge(jk)
+ END IF
+ zRae(jk) = ztmp
+ END DO
+
+ DO jk = 1, nlay_i
+ zw_br(jk) = - rn_alpha_RJW * zRae(jk) * ( zcnd_br / zcp_br ) * &
+ & ( z_mid(jk) - zc ) / ( h_i_1d(ji) * ( 1 - zc )**2 )
+ END DO
+
+ ELSEIF ( nn_sal_scheme == 2 ) THEN ! *** GN 2013 ***
+ DO jk = 1, nlay_i
+ zw_br(jk) = - rn_alpha_GN / zrhob_GN * SUM ( ( zRa(1:jk) - rn_Rc_GN ) * h_i_1d(ji) * r1_nlay_i )
+ END DO
+
+ ELSEIF ( nn_sal_scheme == 3 ) THEN ! *** CW 1988 ***
+ DO jk = 1, nlay_i
+ zw_br(jk) = - rn_alpha_CW * 0.0589_wp * MAX( 0._wp, zv_br(jk)/rn_vbrc - 1._wp )
+ END DO
+
+ END IF
+
+ ! Salinity
+ ! --------
+ ! upstream scheme as in CICE: ds = -w(k)*dt/dz * ( s_br(k+1) - s_br(k) ), w > 0 or < 0
+ DO jk = 1, nlay_i
+ !
+ zcfl = zw_br(jk) * zdt * z1_h_i
+ zds(jk) = - zcfl * ( zs_br(jk+1) - zs_br(jk) )
+ !
+ zcfl_max = MAX( zcfl_max, ABS(zcfl) )
+ zs_min = MIN( zs_min , sz_i_1d(ji,jk) + zds(jk) ) ! record what salinity would be without the trick below
+ ENDDO
+ IF( ln_sal_chk) zds_max = MAX( zds_max, MAX( 0._wp, SUM( zds(:) ) * r1_nlay_i )*REAL(nn_drainage) )
+
+ DO jk = 1, nlay_i
+ !
+ !!clem trick
+ zds(jk) = MAX( zds(jk), -sz_i_1d(ji,jk)+rn_simin )
+ !
+ ! new salinity
+ sz_i_1d(ji,jk) = sz_i_1d(ji,jk) + zds(jk)
+ !
+ ! salt flux
+ sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * r1_nlay_i * zds(jk) * r1_Dt_ice ! r1_Dt_ice is ok
+ !
+ END DO
+
+ ENDIF
+
+ END DO
+
+ ! sanity check
+ IF( ln_sal_chk) THEN
+ cfl_drain_1d(ji) = zcfl_max
+ IF( zds_max > 0._wp ) THEN ; s_drain_dserr_1d(ji) = zds_max ; t_drain_dserr_1d(ji,:) = t_i_1d(ji,:)-rt0
+ ELSE ; s_drain_dserr_1d(ji) = zmiss ; t_drain_dserr_1d(ji,:) = zmiss
+ ENDIF
+ IF( zs_min < 0._wp ) THEN ; s_drain_serr_1d(ji) = zs_min ; t_drain_serr_1d(ji,:) = t_i_1d(ji,:)-rt0
+ ELSE ; s_drain_serr_1d(ji) = zmiss ; t_drain_serr_1d(ji,:) = zmiss
+ ENDIF
+ ENDIF
+
+ ENDDO
+ ENDIF
+
+ ! Flushing
+ ! ========
+ IF( ln_flushing ) THEN
+
+ zdt = rDt_ice / REAL( nn_flushing )
+ !
+ DO ji = 1, npti
+ ! ice thickness ( we do not want to do anything for salt when ice is thinner than the minimum allowed )
+ IF( h_i_1d(ji) >= rn_sal_himin ) THEN ; z1_h_i = 1._wp / ( h_i_1d(ji) * r1_nlay_i )
+ ELSE ; z1_h_i = 0._wp
+ ENDIF
+ !
+ ! surface melting (m)
+ zhmelt = dh_s_sum(ji) + dh_i_sum(ji) ! =0 if no melt, <0 otherwise
+ !
+ ! iteration to converge (usually 1 is ok)
+ zcfl_max = 0._wp
+ zds_max = 0._wp
+ zs_min = 0._wp
+ DO iter = 1, nn_flushing
+ !
+ CALL ice_brine( sss_1d(ji), t_i_1d(ji,:), sz_i_1d(ji,:), zs_br, zv_br )
+ !
+ IF( zhmelt < 0._wp & ! Flushing if surface melting
+ !& .AND. t_i_1d(ji,1) >= t_i_1d(ji,nlay_i) & ! and surface temperature is warmer than bottom temperature
+ & .AND. MINVAL(zv_br(:)) >= rn_vbrc ) THEN ! and brine volume fraction exceeds a certain treshold
+ !
+ ! Vertical velocity
+ ! -----------------
+ DO jk = 1, nlay_i
+ zw_br(jk) = -rn_flushrate * ( dh_i_sum(ji)*rhoi + dh_s_sum(ji)*rhos ) &
+ & / ( rhow * ( 1._wp + 0.8e-3_wp * zs_br(jk) ) ) * r1_Dt_ice ! r1_Dt_ice is ok
+ ! can be replaced by rhow but in theory rhow should be rho_br = (rho0*(1+c*S_br)), with c = 0.8e-3
+ ENDDO
+
+ ! Salinity
+ ! --------
+ DO jk = 1, nlay_i
+ ! upstream scheme as in CICE: ds = -w*dt/dz * ( s_br(k) - s_br(k-1) ), w > 0
+ ! zcfl = w*dt/dz
+ zcfl = zw_br(jk) * zdt * z1_h_i
+ !
+ zcfl_max = MAX( zcfl_max, ABS(zcfl) )
+ !
+ zds(jk) = - zcfl * ( zs_br(jk) - zs_br(jk-1) )
+ !
+ zs_min = MIN( zs_min , sz_i_1d(ji,jk) + zds(jk) ) ! record what salinity would be without the trick below
+ !
+ ENDDO
+ IF( ln_sal_chk) zds_max = MAX( zds_max, MAX( 0._wp, SUM( zds(:) ) * r1_nlay_i )*REAL(nn_flushing) )
+
+ DO jk = 1, nlay_i
+!!$ zds(jk) = MIN( 0._wp, zds(jk) ) ! min to block flushing when temperature profile is not ok
+ !
+ ! new salinity
+ sz_i_1d(ji,jk) = sz_i_1d(ji,jk) + zds(jk)
+ !
+ ! salt flux
+ sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * r1_nlay_i * zds(jk) * r1_Dt_ice ! r1_Dt_ice is ok
+
+ ENDDO
+ ENDIF
+
+ END DO
+
+ ! sanity check
+ IF( ln_sal_chk) THEN
+ cfl_flush_1d(ji) = zcfl_max
+ IF( zds_max > 0._wp ) THEN ; s_flush_dserr_1d(ji) = zds_max ; t_flush_dserr_1d(ji,:) = t_i_1d(ji,:)-rt0
+ ELSE ; s_flush_dserr_1d(ji) = zmiss ; t_flush_dserr_1d(ji,:) = zmiss
+ ENDIF
+ IF( zs_min < 0._wp ) THEN ; s_flush_serr_1d(ji) = zs_min ; t_flush_serr_1d(ji,:) = t_i_1d(ji,:)-rt0
+ ELSE ; s_flush_serr_1d(ji) = zmiss ; t_flush_serr_1d(ji,:) = zmiss
+ ENDIF
+ ENDIF
+
+ ENDDO
+ ENDIF
+
+ ! --- salinity must stay inbounds --- !
+ IF( ln_drainage .OR. ln_flushing ) THEN
+ DO ji = 1, npti
+ DO jk = 1, nlay_i
+ zds(jk) = MAX( 0._wp, rn_simin - sz_i_1d(ji,jk) ) ! > 0 if s_i < simin
+ zds(jk) = zds(jk) + MIN( 0._wp, rn_sinew*sss_1d(ji) - sz_i_1d(ji,jk) ) ! < 0 if s_i > simax
+ ! update salinity
+ sz_i_1d(ji,jk) = sz_i_1d(ji,jk) + zds(jk)
+ ! salt flux
+ sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * r1_nlay_i * zds(jk) * r1_Dt_ice
+ END DO
+ ENDDO
+ ENDIF
+
END SELECT
!
END SUBROUTINE ice_thd_sal
+ SUBROUTINE ice_brine( zsss, pt_i, ps_i, ps_br, pv_br )
+ !!-------------------------------------------------------------------
+ !! *** ROUTINE ice_brine ***
+ !!
+ !! ** Purpose : computes brine volume fraction (%)
+ !! and salinity of the brine in sea ice
+ !!
+ !!-------------------------------------------------------------------
+ INTEGER :: ji, jk ! dummy loop indices
+ REAL(wp) :: zt1, zt2, zt3
+ REAL(wp), INTENT(in ) :: zsss
+ REAL(wp), DIMENSION(1:nlay_i) , INTENT(in ) :: pt_i, ps_i
+ REAL(wp), DIMENSION(0:nlay_i+1), INTENT( out) :: ps_br
+ REAL(wp), DIMENSION(1:nlay_i) , INTENT( out) :: pv_br
+ !!-------------------------------------------------------------------
+ !
+ ! brines
+ DO jk = 1, nlay_i
+ ! brine salinity
+ zt1 = pt_i(jk) - rt0
+ zt2 = zt1 * zt1
+ zt3 = zt2 * zt1
+ IF ( nn_liquidus == 1 ) THEN ; ps_br(jk) = - zt1 / rTmlt ! --- Linear liquidus
+ ELSEIF( nn_liquidus == 2 ) THEN ; ps_br(jk) = -18.7_wp * zt1 - 0.519_wp * zt2 - 0.00535_wp * zt3 ! --- 3rd order liquidus, VC19
+ ELSEIF( nn_liquidus == 3 ) THEN ; ps_br(jk) = -17.6_wp * zt1 - 0.389_wp * zt2 - 0.00362_wp * zt3 ! --- Weast 71 liquidus in RJW14
+ ENDIF
+ ! brine volume fraction
+ IF( zt1 < - epsi06 ) THEN
+ pv_br(jk) = ps_i(jk) / ps_br(jk)
+ ELSE
+ pv_br(jk) = 0._wp
+ ENDIF
+ ENDDO
+ ! brine salinity at the interfaces
+ ps_br(0) = 0._wp
+ ps_br(nlay_i+1) = zsss
+ !
+ END SUBROUTINE ice_brine
+
+
SUBROUTINE ice_thd_sal_init
!!-------------------------------------------------------------------
!! *** ROUTINE ice_thd_sal_init ***
@@ -133,8 +552,10 @@ CONTAINS
!!-------------------------------------------------------------------
INTEGER :: ios ! Local integer
!!
- NAMELIST/namthd_sal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, &
- & rn_sal_fl, rn_time_fl, rn_simax , rn_simin
+ NAMELIST/namthd_sal/ nn_icesal, ln_flushing, ln_drainage, rn_sinew, rn_simin, &
+ & rn_icesal, rn_sal_gd, rn_time_gd, rn_sal_fl, rn_time_fl, &
+ & rn_sal_himin, nn_liquidus, nn_drainage, nn_flushing, rn_flushrate, rn_vbrc, &
+ & nn_sal_scheme, rn_alpha_RJW, rn_Rc_RJW, rn_alpha_GN, rn_Rc_GN, rn_alpha_CW, ln_sal_chk
!!-------------------------------------------------------------------
!
READ ( numnam_ice_ref, namthd_sal, IOSTAT = ios, ERR = 901)
@@ -148,16 +569,36 @@ CONTAINS
WRITE(numout,*) 'ice_thd_sal_init : Ice parameters for salinity '
WRITE(numout,*) '~~~~~~~~~~~~~~~~'
WRITE(numout,*) ' Namelist namthd_sal:'
- WRITE(numout,*) ' switch for salinity nn_icesal = ', nn_icesal
- WRITE(numout,*) ' bulk salinity value if nn_icesal = 1 rn_icesal = ', rn_icesal
- WRITE(numout,*) ' restoring salinity for gravity drainage rn_sal_gd = ', rn_sal_gd
- WRITE(numout,*) ' restoring time for for gravity drainage rn_time_gd = ', rn_time_gd
- WRITE(numout,*) ' restoring salinity for flushing rn_sal_fl = ', rn_sal_fl
- WRITE(numout,*) ' restoring time for flushing rn_time_fl = ', rn_time_fl
- WRITE(numout,*) ' Maximum tolerated ice salinity rn_simax = ', rn_simax
- WRITE(numout,*) ' Minimum tolerated ice salinity rn_simin = ', rn_simin
+ WRITE(numout,*) ' switch for salinity nn_icesal = ', nn_icesal
+ WRITE(numout,*) ' activate flushing ln_flushing = ', ln_flushing
+ WRITE(numout,*) ' activate gravity drainage ln_drainage = ', ln_drainage
+ WRITE(numout,*) ' New ice salinity (fraction of sss) rn_sinew = ', rn_sinew
+ WRITE(numout,*) ' Minimum tolerated ice salinity rn_simin = ', rn_simin
+ ! -- nn_icesal=1 -- !
+ WRITE(numout,*) ' bulk salinity value if nn_icesal = 1 rn_icesal = ', rn_icesal
+ ! -- nn_icesal=2 -- !
+ WRITE(numout,*) ' restoring salinity for gravity drainage rn_sal_gd = ', rn_sal_gd
+ WRITE(numout,*) ' restoring time for for gravity drainage rn_time_gd = ', rn_time_gd
+ WRITE(numout,*) ' restoring salinity for flushing rn_sal_fl = ', rn_sal_fl
+ WRITE(numout,*) ' restoring time for flushing rn_time_fl = ', rn_time_fl
+ ! -- nn_icesal=4 -- !
+ WRITE(numout,*) ' min ice thickness for drainage and flushing rn_sal_himin = ', rn_sal_himin
+ WRITE(numout,*) ' liquidous formulation (1=linear, 2=VC2019, 3=Weast71) nn_liquidus = ', nn_liquidus
+ WRITE(numout,*) ' number of subcycles for gravity drainage nn_drainage = ', nn_drainage
+ WRITE(numout,*) ' number of subcycles for flushing nn_flushing = ', nn_flushing
+ WRITE(numout,*) ' fraction of melt water used for flushing rn_flushrate = ', rn_flushrate
+ WRITE(numout,*) ' critical brines volume above which flushing can occur rn_vbrc = ', rn_vbrc
+ WRITE(numout,*) ' convection scheme (1=RJW2014, 2=GN2013, 3=CW88) nn_sal_scheme = ', nn_sal_scheme
+ WRITE(numout,*) ' brine flow for RJW2014 scheme rn_alpha_RJW = ', rn_alpha_RJW
+ WRITE(numout,*) ' critical Rayleigh number for RJW2014 scheme rn_Rc_RJW = ', rn_Rc_RJW
+ WRITE(numout,*) ' brine flow for GN2013 scheme (kg/m3/s) rn_alpha_GN = ', rn_alpha_GN
+ WRITE(numout,*) ' critical Rayleigh number for GN2013 scheme rn_Rc_GN = ', rn_Rc_GN
+ WRITE(numout,*) ' brine flow for CW1988 scheme rn_alpha_CW = ', rn_alpha_CW
+ WRITE(numout,*) ' sanity checks (output diags) ln_sal_chk = ', ln_sal_chk
ENDIF
!
+ IF( nn_icesal /= 4 ) ln_sal_chk=.FALSE. ! option only valid for nn_icesal = 4
+ !
END SUBROUTINE ice_thd_sal_init
#else
diff --git a/src/ICE/icevar.F90 b/src/ICE/icevar.F90
index 03d1fd6d28e5c7f8f1c1a2047f03237a0f56ee1f..d247d63ea49bbd6c5ed7a83cbeef00e9d3288934 100644
--- a/src/ICE/icevar.F90
+++ b/src/ICE/icevar.F90
@@ -46,7 +46,7 @@ MODULE icevar
!! ice_var_zapsmall : remove very small area and volume
!! ice_var_zapneg : remove negative ice fields
!! ice_var_roundoff : remove negative values arising from roundoff erros
- !! ice_var_bv : brine volume
+ !! ice_var_brine : brine volume
!! ice_var_enthalpy : compute ice and snow enthalpies from temperature
!! ice_var_sshdyn : compute equivalent ssh in lead
!! ice_var_itd : convert N-cat to M-cat
@@ -68,14 +68,15 @@ MODULE icevar
PUBLIC ice_var_agg
PUBLIC ice_var_glo2eqv
- PUBLIC ice_var_eqv2glo
+!!$ PUBLIC ice_var_eqv2glo
PUBLIC ice_var_salprof
PUBLIC ice_var_salprof1d
PUBLIC ice_var_zapsmall
PUBLIC ice_var_zapneg
PUBLIC ice_var_roundoff
- PUBLIC ice_var_bv
+ PUBLIC ice_var_brine
PUBLIC ice_var_enthalpy
+ PUBLIC ice_var_vremap
PUBLIC ice_var_sshdyn
PUBLIC ice_var_itd
PUBLIC ice_var_snwfra
@@ -134,7 +135,6 @@ CONTAINS
END_2D
!
DO_2D( 0, 0, 0, 0 )
- st_i(ji,jj) = SUM( sv_i(ji,jj,:) )
et_s(ji,jj) = SUM( SUM( e_s (ji,jj,:,:), dim=2 ) )
et_i(ji,jj) = SUM( SUM( e_i (ji,jj,:,:), dim=2 ) )
!
@@ -146,6 +146,16 @@ CONTAINS
ENDIF
END_2D
!
+ IF( nn_icesal == 4 ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ st_i(ji,jj) = SUM( SUM( szv_i (ji,jj,:,:), dim=2 ) )
+ END_2D
+ ELSE
+ DO_2D( 0, 0, 0, 0 )
+ st_i(ji,jj) = SUM( sv_i(ji,jj,:) )
+ END_2D
+ ENDIF
+
! The following fields are calculated for diagnostics and outputs only
! ==> Do not use them for other purposes
IF( kn > 1 ) THEN
@@ -252,9 +262,9 @@ CONTAINS
INTEGER, INTENT( in ) :: kn ! =1 everything including ponds (necessary for init)
! ! =2 excluding ponds if ln_pnd=F
INTEGER :: ji, jj, jk, jl ! dummy loop indices
- REAL(wp) :: ze_i ! local scalars
+ REAL(wp) :: ze_i, zs_i ! local scalars
REAL(wp) :: ze_s, ztmelts, zbbb, zccc ! - -
- REAL(wp) :: zhmax, z1_hmax ! - -
+ REAL(wp) :: zhmax, z1_hmax ! - -
REAL(wp) :: zlay_i, zlay_s ! - -
REAL(wp), PARAMETER :: zhl_max = 0.015_wp ! pond lid thickness above which the ponds disappear from the albedo calculation
REAL(wp), PARAMETER :: zhl_min = 0.005_wp ! pond lid thickness below which the full pond area is used in the albedo calculation
@@ -294,14 +304,7 @@ CONTAINS
!
END_2D
ENDDO
- ! !--- salinity (with a minimum value imposed everywhere)
- IF( nn_icesal == 2 ) THEN
- WHERE( v_i(:,:,:) > epsi20 ) ; s_i(:,:,:) = MAX( rn_simin , MIN( rn_simax, sv_i(:,:,:) / v_i(:,:,:) ) )
- ELSEWHERE ; s_i(:,:,:) = rn_simin
- END WHERE
- ENDIF
- CALL ice_var_salprof ! salinity profile
-
+ !
IF( kn == 1 .OR. ln_pnd ) THEN
ALLOCATE( za_s_fra(A2D(0),jpl) )
!
@@ -334,6 +337,46 @@ CONTAINS
!
DEALLOCATE( za_s_fra )
ENDIF
+ !
+ !-------------------
+ ! Ice salinity (with a min value rn_simin and a max value rn_sinew*sss)
+ !-------------------
+ IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN
+ !
+ CALL ice_var_salprof ! salinity profile
+ !
+ ELSEIF( nn_icesal == 2 ) THEN
+ !
+ DO jl = 1, jpl
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ IF( v_i(ji,jj,jl) > epsi20 ) THEN
+!!clem test s_i(ji,jj,jl) = MAX( rn_simin , MIN( rn_sinew * sss_m(ji,jj), sv_i(ji,jj,jl) / v_i(ji,jj,jl) ) )
+ s_i(ji,jj,jl) = sv_i(ji,jj,jl) / v_i(ji,jj,jl)
+ ELSE
+ s_i(ji,jj,jl) = rn_simin
+ ENDIF
+ END_2D
+ ENDDO
+ CALL ice_var_salprof ! salinity profile
+ !
+ ELSEIF( nn_icesal == 4 ) THEN
+ !
+ s_i(:,:,:) = 0._wp
+ zlay_i = REAL( nlay_i , wp ) ! number of layers
+ DO jl = 1, jpl
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i )
+ IF ( v_i(ji,jj,jl) > epsi20 ) THEN !--- icy area
+ zs_i = szv_i(ji,jj,jk,jl) / ( v_i(ji,jj,jl) * r1_nlay_i )
+!!clem test sz_i(ji,jj,jk,jl) = MAX( rn_simin , MIN( rn_sinew * sss_m(ji,jj), zs_i ) )
+ sz_i(ji,jj,jk,jl) = zs_i
+ ELSE !--- no ice
+ sz_i(ji,jj,jk,jl) = rn_simin
+ ENDIF
+ s_i(ji,jj,jl) = s_i(ji,jj,jl) + sz_i(ji,jj,jk,jl) * r1_nlay_i
+ END_3D
+ END DO
+ !
+ ENDIF
!-------------------
! Ice temperature [K] (with a minimum value (rt0 - 100.))
@@ -383,27 +426,27 @@ CONTAINS
END SUBROUTINE ice_var_glo2eqv
- SUBROUTINE ice_var_eqv2glo
- !!-------------------------------------------------------------------
- !! *** ROUTINE ice_var_eqv2glo ***
- !!
- !! ** Purpose : computes global variables as function of
- !! equivalent variables, i.e. it turns VEQV into VGLO
- !!-------------------------------------------------------------------
- INTEGER :: ji, jj, jl ! dummy loop indices
- !!-------------------------------------------------------------------
- !
- DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- v_i (ji,jj,jl) = h_i (ji,jj,jl) * a_i (ji,jj,jl)
- v_s (ji,jj,jl) = h_s (ji,jj,jl) * a_i (ji,jj,jl)
- sv_i(ji,jj,jl) = s_i (ji,jj,jl) * v_i (ji,jj,jl)
- v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl)
- v_il(ji,jj,jl) = h_il(ji,jj,jl) * a_ip(ji,jj,jl)
- END_2D
- ENDDO
- !
- END SUBROUTINE ice_var_eqv2glo
+!!$ SUBROUTINE ice_var_eqv2glo
+!!$ !!-------------------------------------------------------------------
+!!$ !! *** ROUTINE ice_var_eqv2glo ***
+!!$ !!
+!!$ !! ** Purpose : computes global variables as function of
+!!$ !! equivalent variables, i.e. it turns VEQV into VGLO
+!!$ !!-------------------------------------------------------------------
+!!$ INTEGER :: ji, jj, jl ! dummy loop indices
+!!$ !!-------------------------------------------------------------------
+!!$ !
+!!$ DO jl = 1, jpl
+!!$ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+!!$ v_i (ji,jj,jl) = h_i (ji,jj,jl) * a_i (ji,jj,jl)
+!!$ v_s (ji,jj,jl) = h_s (ji,jj,jl) * a_i (ji,jj,jl)
+!!$ sv_i(ji,jj,jl) = s_i (ji,jj,jl) * v_i (ji,jj,jl)
+!!$ v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl)
+!!$ v_il(ji,jj,jl) = h_il(ji,jj,jl) * a_ip(ji,jj,jl)
+!!$ END_2D
+!!$ ENDDO
+!!$ !
+!!$ END SUBROUTINE ice_var_eqv2glo
SUBROUTINE ice_var_salprof
@@ -422,11 +465,9 @@ CONTAINS
!! ** References : Vancoppenolle et al., 2007
!!-------------------------------------------------------------------
INTEGER :: ji, jj, jk, jl ! dummy loop index
- REAL(wp) :: z1_dS
- REAL(wp) :: ztmp1, ztmp2, zs0, zs
- REAL(wp) :: z_slope_s, zalpha ! case 2 only
- REAL(wp), PARAMETER :: zsi0 = 3.5_wp
- REAL(wp), PARAMETER :: zsi1 = 4.5_wp
+ REAL(wp) :: z1_dS, ztmp1, ztmp2, zalpha
+ REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+ REAL(wp), PARAMETER :: zsi1 = 4.5_wp
!!-------------------------------------------------------------------
!!gm Question: Remove the option 3 ? How many years since it last use ?
@@ -440,27 +481,27 @@ CONTAINS
s_i (:,:,:) = rn_icesal
!
! !---------------------------------------------!
- CASE( 2 ) ! time varying salinity with linear profile !
+ CASE( 2 , 4 ) ! time varying salinity with linear profile !
! !---------------------------------------------!
z1_dS = 1._wp / ( zsi1 - zsi0 )
!
DO jl = 1, jpl
DO jk = 1, nlay_i
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- ! ! Slope of the linear profile
- IF( h_i(ji,jj,jl) > epsi20 ) THEN ; z_slope_s = 2._wp * s_i(ji,jj,jl) / h_i(ji,jj,jl)
- ELSE ; z_slope_s = 0._wp
+ !
+ IF ( s_i(ji,jj,jl) >= zsi1 ) THEN ; zalpha = 0._wp
+ ELSEIF( s_i(ji,jj,jl) <= zsi0 ) THEN ; zalpha = 1._wp
+ ELSE ; zalpha = ( zsi1 - s_i(ji,jj,jl) ) * z1_dS
ENDIF
!
- zalpha = MAX( 0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp ) )
- ! ! force a constant profile when SSS too low (Baltic Sea)
- IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) ) zalpha = 0._wp
+ IF( s_i(ji,jj,jl) >= ( 0.5_wp * rn_sinew * sss_m(ji,jj) ) ) zalpha = 0._wp ! force constant profile when SSS too low (Baltic Sea)
+ IF( s_i(ji,jj,jl) <= ( REAL( nlay_i , wp ) * rn_simin ) ) zalpha = 0._wp ! force constant profile when ice surface salinity too small
+ ! ! it depends on nlay_i which is not ideal
!
- ! Computation of the profile
- ! ! linear profile with 0 surface value
- zs0 = z_slope_s * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i
- zs = zalpha * zs0 + ( 1._wp - zalpha ) * s_i(ji,jj,jl) ! weighting the profile
- sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) )
+ ! linear profile with 0 surface value
+ sz_i(ji,jj,jk,jl) = zalpha * s_i(ji,jj,jl) * 2._wp * ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i &
+ & + ( 1._wp - zalpha ) * s_i(ji,jj,jl)
+ ! => mean(sz_i(jk)) = s_i
END_2D
ENDDO
ENDDO
@@ -499,12 +540,9 @@ CONTAINS
!! Works with 1d vectors and is used by thermodynamic modules
!!-------------------------------------------------------------------
INTEGER :: ji, jk ! dummy loop indices
- REAL(wp) :: ztmp1, ztmp2, z1_dS ! local scalars
- REAL(wp) :: zs, zs0 ! - -
- !
- REAL(wp) :: z_slope_s, zalpha !
- REAL(wp), PARAMETER :: zsi0 = 3.5_wp
- REAL(wp), PARAMETER :: zsi1 = 4.5_wp
+ REAL(wp) :: z1_dS, ztmp1, ztmp2, zalpha
+ REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+ REAL(wp), PARAMETER :: zsi1 = 4.5_wp
!!-------------------------------------------------------------------
!
SELECT CASE ( nn_icesal )
@@ -515,27 +553,26 @@ CONTAINS
sz_i_1d(1:npti,:) = rn_icesal
!
! !---------------------------------------------!
- CASE( 2 ) ! time varying salinity with linear profile !
+ CASE( 2 , 4 ) ! time varying salinity with linear profile !
! !---------------------------------------------!
z1_dS = 1._wp / ( zsi1 - zsi0 )
!
DO jk = 1, nlay_i
DO ji = 1, npti
- ! ! Slope of the linear profile
- IF( h_i_1d(ji) > epsi20 ) THEN ; z_slope_s = 2._wp * s_i_1d(ji) / h_i_1d(ji)
- ELSE ; z_slope_s = 0._wp
- ENDIF
!
- zalpha = MAX( 0._wp , MIN( ( zsi1 - s_i_1d(ji) ) * z1_dS , 1._wp ) )
- ! ! force a constant profile when SSS too low (Baltic Sea)
- IF( 2._wp * s_i_1d(ji) >= sss_1d(ji) ) zalpha = 0._wp
+ IF ( s_i_1d(ji) >= zsi1 ) THEN ; zalpha = 0._wp
+ ELSEIF( s_i_1d(ji) <= zsi0 ) THEN ; zalpha = 1._wp
+ ELSE ; zalpha = ( zsi1 - s_i_1d(ji) ) * z1_dS
+ ENDIF
!
+ IF( s_i_1d(ji) >= ( 0.5_wp * rn_sinew * sss_1d(ji) ) ) zalpha = 0._wp ! force constant profile when SSS too low (Baltic Sea)
+ IF( s_i_1d(ji) <= ( REAL( nlay_i , wp ) * rn_simin ) ) zalpha = 0._wp ! force constant profile when ice surface salinity too small
+ ! ! it depends on nlay_i which is not ideal
!
- ! Computation of the profile
- ! ! linear profile with 0 surface value
- zs0 = z_slope_s * ( REAL(jk,wp) - 0.5_wp ) * h_i_1d(ji) * r1_nlay_i
- zs = zalpha * zs0 + ( 1._wp - zalpha ) * s_i_1d(ji)
- sz_i_1d(ji,jk) = MIN( rn_simax , MAX( zs , rn_simin ) )
+ ! linear profile with 0 surface value
+ sz_i_1d(ji,jk) = zalpha * s_i_1d(ji) * 2._wp * ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i &
+ & + ( 1._wp - zalpha ) * s_i_1d(ji)
+ ! => mean(sz_i(jk)) = s_i
END DO
END DO
!
@@ -573,6 +610,38 @@ CONTAINS
ELSEWHERE ; h_i(A2D(0),:) = 0._wp
END WHERE
!
+ !-----------------------------------------------------------------
+ ! Zap ice volume, add salt to ocean
+ !-----------------------------------------------------------------
+ IF( nn_icesal == 4 ) THEN
+ DO jl = 1, jpl
+ DO_3D( 0, 0, 0, 0, 1, nlay_i )
+ !
+ zsmall = MIN( a_i(ji,jj,jl), v_i(ji,jj,jl), h_i(ji,jj,jl) )
+ !
+ IF( zsmall < epsi10 ) THEN
+ ! update exchanges with ocean
+ sfx_res(ji,jj) = sfx_res(ji,jj) + szv_i(ji,jj,jk,jl) * rhoi * r1_Dt_ice
+ szv_i(ji,jj,jk,jl) = 0._wp
+ sz_i (ji,jj,jk,jl) = rn_simin
+ ENDIF
+ END_3D
+ ENDDO
+ ELSE
+ DO jl = 1, jpl
+ DO_2D( 0, 0, 0, 0 )
+ !
+ zsmall = MIN( a_i(ji,jj,jl), v_i(ji,jj,jl), h_i(ji,jj,jl) )
+ !
+ IF( zsmall < epsi10 ) THEN
+ ! update exchanges with ocean
+ sfx_res(ji,jj) = sfx_res(ji,jj) + sv_i(ji,jj,jl) * rhoi * r1_Dt_ice
+ sv_i (ji,jj,jl) = 0._wp
+ ENDIF
+ END_2D
+ END DO
+ ENDIF
+
!-----------------------------------------------------------------
! Zap ice energy and use ocean heat to melt ice
!-----------------------------------------------------------------
@@ -605,7 +674,7 @@ CONTAINS
ENDDO
!
!-----------------------------------------------------------------
- ! zap ice and snow volume, add water and salt to ocean
+ ! zap ice and snow volume, add water to ocean
!-----------------------------------------------------------------
DO jl = 1, jpl
DO_2D( 0, 0, 0, 0 )
@@ -614,7 +683,6 @@ CONTAINS
!
IF( zsmall < epsi10 ) THEN
! update exchanges with ocean
- sfx_res(ji,jj) = sfx_res(ji,jj) + sv_i(ji,jj,jl) * rhoi * r1_Dt_ice
wfx_res(ji,jj) = wfx_res(ji,jj) + v_i (ji,jj,jl) * rhoi * r1_Dt_ice
wfx_res(ji,jj) = wfx_res(ji,jj) + v_s (ji,jj,jl) * rhos * r1_Dt_ice
wfx_res(ji,jj) = wfx_res(ji,jj) + ( v_ip(ji,jj,jl)+v_il(ji,jj,jl) ) * rhow * r1_Dt_ice
@@ -624,7 +692,6 @@ CONTAINS
v_s (ji,jj,jl) = 0._wp
t_su (ji,jj,jl) = sst_m(ji,jj) + rt0
oa_i (ji,jj,jl) = 0._wp
- sv_i (ji,jj,jl) = 0._wp
!
h_i (ji,jj,jl) = 0._wp
h_s (ji,jj,jl) = 0._wp
@@ -654,7 +721,7 @@ CONTAINS
END SUBROUTINE ice_var_zapsmall
- SUBROUTINE ice_var_zapneg( ihls, pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i )
+ SUBROUTINE ice_var_zapneg( ihls, pdt, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i )
!!-------------------------------------------------------------------
!! *** ROUTINE ice_var_zapneg ***
!!
@@ -662,7 +729,6 @@ CONTAINS
!!-------------------------------------------------------------------
INTEGER , INTENT(in ) :: ihls ! loop index
REAL(wp) , INTENT(in ) :: pdt ! tracer time-step
- REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pato_i ! open water area
REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i ! ice volume
REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_s ! snw volume
REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: psv_i ! salt content
@@ -673,6 +739,7 @@ CONTAINS
REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_il ! melt pond lid volume
REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content
REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pszv_i ! ice salt content
!
INTEGER :: ji, jj, jl, jk ! dummy loop indices
REAL(wp) :: z1_dt
@@ -690,30 +757,51 @@ CONTAINS
! make sure a_i=0 where v_i<=0
WHERE( pv_i(:,:,:) <= 0._wp ) pa_i(:,:,:) = 0._wp
+ !--------------------------------------
+ ! zap ice salt and send it to the ocean
+ !--------------------------------------
+ IF( nn_icesal == 4 ) THEN
+ DO jl = 1, jpl
+ DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i )
+ IF( pszv_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN
+ zsfx_res(ji,jj) = zsfx_res(ji,jj) + pszv_i(ji,jj,jk,jl) * rhoi * z1_dt
+ pszv_i(ji,jj,jk,jl) = 0._wp
+ ENDIF
+ END_3D
+ ENDDO
+ ELSE
+ DO jl = 1, jpl
+ DO_2D( ihls, ihls, ihls, ihls )
+ IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN
+ zsfx_res(ji,jj) = zsfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt
+ psv_i (ji,jj,jl) = 0._wp
+ ENDIF
+ END_2D
+ END DO
+ ENDIF
+ !
!----------------------------------------
! zap ice energy and send it to the ocean
!----------------------------------------
DO jl = 1, jpl
DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i )
- IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
+ IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN
zhfx_res(ji,jj) = zhfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0
pe_i(ji,jj,jk,jl) = 0._wp
ENDIF
END_3D
- ENDDO
- !
- DO jl = 1, jpl
+ !
DO_3D( ihls, ihls, ihls, ihls, 1, nlay_s )
- IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
+ IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_s(ji,jj,jl) <= 0._wp ) THEN
zhfx_res(ji,jj) = zhfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0
pe_s(ji,jj,jk,jl) = 0._wp
ENDIF
END_3D
ENDDO
!
- !-----------------------------------------------------
- ! zap ice and snow volume, add water and salt to ocean
- !-----------------------------------------------------
+ !--------------------------------------------
+ ! zap ice and snow volume, add water to ocean
+ !--------------------------------------------
DO jl = 1, jpl
DO_2D( ihls, ihls, ihls, ihls )
IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN
@@ -724,10 +812,6 @@ CONTAINS
zwfx_res(ji,jj) = zwfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt
pv_s (ji,jj,jl) = 0._wp
ENDIF
- IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN
- zsfx_res(ji,jj) = zsfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt
- psv_i (ji,jj,jl) = 0._wp
- ENDIF
IF( pv_ip(ji,jj,jl) < 0._wp .OR. pv_il(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN
zwfx_res(ji,jj) = zwfx_res(ji,jj) + pv_il(ji,jj,jl) * rhow * z1_dt
pv_il (ji,jj,jl) = 0._wp
@@ -746,7 +830,6 @@ CONTAINS
sfx_res(ji,jj) = sfx_res(ji,jj) + zsfx_res(ji,jj)
END_2D
!
- WHERE( pato_i(:,:) < 0._wp ) pato_i(:,:) = 0._wp
WHERE( poa_i (:,:,:) < 0._wp ) poa_i (:,:,:) = 0._wp
WHERE( pa_i (:,:,:) < 0._wp ) pa_i (:,:,:) = 0._wp
WHERE( pa_ip (:,:,:) < 0._wp ) pa_ip (:,:,:) = 0._wp
@@ -754,7 +837,7 @@ CONTAINS
END SUBROUTINE ice_var_zapneg
- SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i )
+ SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i )
!!-------------------------------------------------------------------
!! *** ROUTINE ice_var_roundoff ***
!!
@@ -770,59 +853,74 @@ CONTAINS
REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pv_il ! melt pond lid volume
REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_s ! snw heat content
REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_i ! ice heat content
+ REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pszv_i ! ice salt content
!!-------------------------------------------------------------------
WHERE( pa_i (1:npti,:) < 0._wp ) pa_i (1:npti,:) = 0._wp ! a_i must be >= 0
WHERE( pv_i (1:npti,:) < 0._wp ) pv_i (1:npti,:) = 0._wp ! v_i must be >= 0
WHERE( pv_s (1:npti,:) < 0._wp ) pv_s (1:npti,:) = 0._wp ! v_s must be >= 0
- WHERE( psv_i(1:npti,:) < 0._wp ) psv_i(1:npti,:) = 0._wp ! sv_i must be >= 0
WHERE( poa_i(1:npti,:) < 0._wp ) poa_i(1:npti,:) = 0._wp ! oa_i must be >= 0
WHERE( pe_i (1:npti,:,:) < 0._wp ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0
WHERE( pe_s (1:npti,:,:) < 0._wp ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0
IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
- WHERE( pa_ip(1:npti,:) < 0._wp ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0
- WHERE( pv_ip(1:npti,:) < 0._wp ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0
+ WHERE( pa_ip(1:npti,:) < 0._wp ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0
+ WHERE( pv_ip(1:npti,:) < 0._wp ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0
IF( ln_pnd_lids ) THEN
- WHERE( pv_il(1:npti,:) < 0._wp .AND. pv_il(1:npti,:) > -epsi10 ) pv_il(1:npti,:) = 0._wp ! v_il must be >= 0
+ WHERE( pv_il(1:npti,:) < 0._wp .AND. pv_il(1:npti,:) > -epsi10 ) pv_il(1:npti,:) = 0._wp ! v_il must be >= 0
ENDIF
ENDIF
+ IF( nn_icesal == 4 ) THEN
+ WHERE( pszv_i(1:npti,:,:) < 0._wp ) pszv_i(1:npti,:,:) = 0._wp ! szv_i must be >= 0
+ ELSE
+ WHERE( psv_i (1:npti,:) < 0._wp ) psv_i (1:npti,:) = 0._wp ! sv_i must be >= 0
+ ENDIF
!
END SUBROUTINE ice_var_roundoff
- SUBROUTINE ice_var_bv
+ SUBROUTINE ice_var_brine
!!-------------------------------------------------------------------
- !! *** ROUTINE ice_var_bv ***
+ !! *** ROUTINE ice_var_brine ***
!!
- !! ** Purpose : computes mean brine volume (%) in sea ice
+ !! ** Purpose : computes brine volume fraction (%)
+ !! and salinity of the brine in sea ice
!!
!! ** Method : e = - 0.054 * S (ppt) / T (C)
!!
!! References : Vancoppenolle et al., JGR, 2007
!!-------------------------------------------------------------------
INTEGER :: ji, jj, jk, jl ! dummy loop indices
+ REAL(wp) :: zt1, zt2, zt3, zs_br
!!-------------------------------------------------------------------
!
- bv_i (:,:,:) = 0._wp
+ v_ibr(:,:,:) = 0._wp
DO jl = 1, jpl
DO_3D( 0, 0, 0, 0, 1, nlay_i )
- IF( t_i(ji,jj,jk,jl) < rt0 - epsi10 ) THEN
- bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rTmlt * sz_i(ji,jj,jk,jl) * r1_nlay_i / ( t_i(ji,jj,jk,jl) - rt0 )
+ ! brine salinity
+ zt1 = t_i(ji,jj,jk,jl) - rt0
+ zt2 = zt1 * zt1
+ zt3 = zt2 * zt1
+ IF ( nn_liquidus == 1 ) THEN ; zs_br = - zt1 / rTmlt ! --- Linear liquidus
+ ELSEIF( nn_liquidus == 2 ) THEN ; zs_br = -18.7_wp * zt1 - 0.519_wp * zt2 - 0.00535_wp * zt3 ! --- 3rd order liquidus, VC19
+ ELSEIF( nn_liquidus == 3 ) THEN ; zs_br = -17.6_wp * zt1 - 0.389_wp * zt2 - 0.00362_wp * zt3 ! --- Weast 71 liquidus in RJW14
ENDIF
+ ! brine volume fraction
+ IF( zt1 < - epsi10 ) v_ibr(ji,jj,jl) = v_ibr(ji,jj,jl) + r1_nlay_i * sz_i(ji,jj,jk,jl) / zs_br
END_3D
ENDDO
!
+ ! mean brine volume fraction
DO_2D( 0, 0, 0, 0 )
IF( vt_i(ji,jj) > epsi20 ) THEN
- bvm_i(ji,jj) = SUM( bv_i(ji,jj,:) * v_i(ji,jj,:) ) / vt_i(ji,jj)
+ vm_ibr(ji,jj) = SUM( v_ibr(ji,jj,:) * v_i(ji,jj,:) ) / vt_i(ji,jj)
ELSE
- bvm_i(ji,jj) = 0._wp
+ vm_ibr(ji,jj) = 0._wp
ENDIF
END_2D
!
- END SUBROUTINE ice_var_bv
-
+ END SUBROUTINE ice_var_brine
+
SUBROUTINE ice_var_enthalpy
!!-------------------------------------------------------------------
!! *** ROUTINE ice_var_enthalpy ***
@@ -854,6 +952,84 @@ CONTAINS
!
END SUBROUTINE ice_var_enthalpy
+ SUBROUTINE ice_var_vremap( ph_old, pts_old, pts_i )
+ !!-------------------------------------------------------------------
+ !! *** ROUTINE ice_var_vremap ***
+ !!
+ !! ** Purpose :
+ !! This routine computes new vertical grids in the ice,
+ !! and consistently redistributes temperatures and salinities
+ !! Redistribution is made so as to ensure energy/salt conservation
+ !!
+ !!
+ !! ** Method : linear conservative remapping
+ !!
+ !! ** Steps : 1) cumulative integrals of old enthalpies/salinities/thicknesses
+ !! 2) linear remapping on the new layers
+ !!
+ !! ------------ cum0(0) ------------- cum1(0)
+ !! NEW -------------
+ !! ------------ cum0(1) ==> -------------
+ !! ... -------------
+ !! ------------ -------------
+ !! ------------ cum0(nlay_i+2) ------------- cum1(nlay_i)
+ !!
+ !!
+ !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005
+ !!-------------------------------------------------------------------
+ REAL(wp), DIMENSION(0:nlay_i+1), INTENT(in) :: ph_old, pts_old ! old tickness (m), enthlapy (J.m-2) or salt (m.g/kg)
+ REAL(wp), DIMENSION(1:nlay_i) , INTENT(inout) :: pts_i ! new enthlapies (J.m-3, remapped) or salt (g/kg)
+ !
+ INTEGER :: ji ! dummy loop indices
+ INTEGER :: jk0, jk1 ! old/new layer indices
+ !
+ REAL(wp), DIMENSION(0:nlay_i+2) :: zts_cum0, zh_cum0 ! old cumulative enthlapies/salinities and layers interfaces
+ REAL(wp), DIMENSION(0:nlay_i) :: zts_cum1, zh_cum1 ! new cumulative enthlapies/salinities and layers interfaces
+ REAL(wp) :: zhnew ! new layers thicknesses
+ !!-------------------------------------------------------------------
+
+ !-------------------------------------------------------------------------------
+ ! 1) Cumulative integral of old enthalpy/salt * thickness and layers interfaces
+ !-------------------------------------------------------------------------------
+ zts_cum0(0) = 0._wp
+ zh_cum0 (0) = 0._wp
+ DO jk0 = 1, nlay_i+2
+ zts_cum0(jk0) = zts_cum0(jk0-1) + pts_old(jk0-1)
+ zh_cum0 (jk0) = zh_cum0 (jk0-1) + ph_old(jk0-1)
+ END DO
+
+ !------------------------------------
+ ! 2) Interpolation on the new layers
+ !------------------------------------
+ ! new layer thickesses
+ zhnew = SUM( ph_old(0:nlay_i+1) ) * r1_nlay_i
+
+ ! new layers interfaces
+ zh_cum1(0) = 0._wp
+ DO jk1 = 1, nlay_i
+ zh_cum1(jk1) = zh_cum1(jk1-1) + zhnew
+ END DO
+
+ zts_cum1(0:nlay_i) = 0._wp
+ ! new cumulative q*h => linear interpolation
+ DO jk0 = 1, nlay_i+2
+ DO jk1 = 1, nlay_i-1
+ IF( zh_cum1(jk1) <= zh_cum0(jk0) .AND. zh_cum1(jk1) > zh_cum0(jk0-1) ) THEN
+ zts_cum1(jk1) = ( zts_cum0(jk0-1) * ( zh_cum0(jk0) - zh_cum1(jk1 ) ) + &
+ & zts_cum0(jk0 ) * ( zh_cum1(jk1) - zh_cum0(jk0-1) ) ) &
+ & / ( zh_cum0(jk0) - zh_cum0(jk0-1) )
+ ENDIF
+ END DO
+ END DO
+ ! to ensure that total heat/salt content is strictly conserved, set:
+ zts_cum1(nlay_i) = zts_cum0(nlay_i+2)
+
+ ! new enthalpies/salinities
+ DO jk1 = 1, nlay_i
+ pts_i(jk1) = MAX( 0._wp, zts_cum1(jk1) - zts_cum1(jk1-1) ) / MAX( zhnew, epsi20 ) ! max for roundoff error
+ END DO
+
+ END SUBROUTINE ice_var_vremap
FUNCTION ice_var_sshdyn(pssh, psnwice_mass, psnwice_mass_b)
!!---------------------------------------------------------------------
diff --git a/src/ICE/icewri.F90 b/src/ICE/icewri.F90
index d72fd7d807fd1174fd3b6c5a8506889531769dfd..2e66ee1d699925b019fdd01e4bc3bb9fc035a47e 100644
--- a/src/ICE/icewri.F90
+++ b/src/ICE/icewri.F90
@@ -51,11 +51,12 @@ CONTAINS
!
INTEGER :: ji, jj, jk, jl ! dummy loop indices
REAL(wp) :: z2da, z2db, zrho1, zrho2
- REAL(wp) :: zmiss_val ! missing value retrieved from xios
- REAL(wp), DIMENSION(A2D(0)) :: z2d ! 2D workspace
- REAL(wp), DIMENSION(A2D(0)) :: zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask
- REAL(wp), DIMENSION(A2D(0),jpl) :: zmsk00l, zmsksnl ! cat masks
- REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zfast, zalb, zmskalb ! 2D workspace
+ REAL(wp) :: zmiss ! missing value retrieved from xios
+ REAL(wp), DIMENSION(A2D(0)) :: z2d ! 2D workspace
+ REAL(wp), DIMENSION(A2D(0)) :: zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask
+ REAL(wp), DIMENSION(A2D(0),jpl) :: zmsk00c, zmsksnc ! categories masks
+ REAL(wp), DIMENSION(A2D(0),nlay_i,jpl) :: zmsk00l ! layers masks
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zfast, zalb, zmskalb ! 2D workspace
!
! Global ice diagnostics (SIMIP)
REAL(wp) :: zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh ! area, extent, volume
@@ -65,10 +66,10 @@ CONTAINS
IF( ln_timing ) CALL timing_start('icewri')
! get missing value from xml
- CALL iom_miss_val( 'icetemp', zmiss_val )
+ CALL iom_miss_val( 'icetemp', zmiss )
! brine volume
- IF( iom_use('icebrv') .OR. iom_use('icebrv_cat') ) CALL ice_var_bv
+ IF( iom_use('icebrv') .OR. iom_use('icebrv_cat') ) CALL ice_var_brine
! tresholds for outputs
DO_2D( 0, 0, 0, 0 )
@@ -87,13 +88,16 @@ CONTAINS
END_2D
DO jl = 1, jpl
DO_2D( 0, 0, 0, 0 )
- IF( a_i(ji,jj,jl) >= epsi06 ) THEN ; zmsk00l(ji,jj,jl) = 1._wp ! 1 if ice , 0 if no ice
- ELSE ; zmsk00l(ji,jj,jl) = 0._wp
+ IF( a_i(ji,jj,jl) >= epsi06 ) THEN ; zmsk00c(ji,jj,jl) = 1._wp ! 1 if ice , 0 if no ice
+ ELSE ; zmsk00c(ji,jj,jl) = 0._wp
ENDIF
- IF( v_s(ji,jj,jl) >= epsi06 ) THEN ; zmsksnl(ji,jj,jl) = 1._wp ! 1 if snow , 0 if no snow
- ELSE ; zmsksnl(ji,jj,jl) = 0._wp
+ IF( v_s(ji,jj,jl) >= epsi06 ) THEN ; zmsksnc(ji,jj,jl) = 1._wp ! 1 if snow , 0 if no snow
+ ELSE ; zmsksnc(ji,jj,jl) = 0._wp
ENDIF
END_2D
+ DO_3D( 0, 0, 0, 0, 1, nlay_i )
+ zmsk00l(ji,jj,jk,jl) = zmsk00c(ji,jj,jl)
+ END_3D
ENDDO
!-----------------
@@ -107,43 +111,43 @@ CONTAINS
CALL iom_put( 'icepres' , zmsk00 ) ! Ice presence (1 or 0)
!
! general fields
- IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i(A2D(0)) * rhoi * zmsk00 ) ! Ice mass per cell area
- IF( iom_use('snwmass' ) ) CALL iom_put( 'snwmass', vt_s(A2D(0)) * rhos * zmsksn ) ! Snow mass per cell area
- IF( iom_use('iceconc' ) ) CALL iom_put( 'iceconc', at_i(A2D(0)) * zmsk00 ) ! ice concentration
- IF( iom_use('icevolu' ) ) CALL iom_put( 'icevolu', vt_i(A2D(0)) * zmsk00 ) ! ice volume = mean ice thickness over the cell
- IF( iom_use('icethic' ) ) CALL iom_put( 'icethic', hm_i(:,:) * zmsk00 ) ! ice thickness
- IF( iom_use('snwthic' ) ) CALL iom_put( 'snwthic', hm_s(:,:) * zmsk00 ) ! snw thickness
- IF( iom_use('icebrv' ) ) CALL iom_put( 'icebrv' , bvm_i(:,:)* 100. * zmsk00 ) ! brine volume
- IF( iom_use('iceage' ) ) CALL iom_put( 'iceage' , om_i(:,:) / rday * zmsk15 + zmiss_val * ( 1._wp - zmsk15 ) ) ! ice age
- IF( iom_use('icehnew' ) ) CALL iom_put( 'icehnew', ht_i_new(:,:) ) ! new ice thickness formed in the leads
- IF( iom_use('snwvolu' ) ) CALL iom_put( 'snwvolu', vt_s(A2D(0)) * zmsksn ) ! snow volume
- IF( iom_use('icefrb' ) ) THEN ! Ice freeboard
+ IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i(A2D(0)) * rhoi * zmsk00 ) ! Ice mass per cell area
+ IF( iom_use('snwmass' ) ) CALL iom_put( 'snwmass', vt_s(A2D(0)) * rhos * zmsksn ) ! Snow mass per cell area
+ IF( iom_use('iceconc' ) ) CALL iom_put( 'iceconc', at_i(A2D(0)) * zmsk00 ) ! ice concentration
+ IF( iom_use('icevolu' ) ) CALL iom_put( 'icevolu', vt_i(A2D(0)) * zmsk00 ) ! ice volume = mean ice thickness over the cell
+ IF( iom_use('icethic' ) ) CALL iom_put( 'icethic', hm_i(:,:) * zmsk00 ) ! ice thickness
+ IF( iom_use('snwthic' ) ) CALL iom_put( 'snwthic', hm_s(:,:) * zmsk00 ) ! snw thickness
+ IF( iom_use('icebrv' ) ) CALL iom_put( 'icebrv' , vm_ibr(:,:)* 100. * zmsk00 ) ! brine volume
+ IF( iom_use('iceage' ) ) CALL iom_put( 'iceage' , om_i(:,:) / rday * zmsk15 + zmiss * ( 1._wp - zmsk15 ) ) ! ice age
+ IF( iom_use('icehnew' ) ) CALL iom_put( 'icehnew', ht_i_new(:,:) ) ! new ice thickness formed in the leads
+ IF( iom_use('snwvolu' ) ) CALL iom_put( 'snwvolu', vt_s(A2D(0)) * zmsksn ) ! snow volume
+ IF( iom_use('icefrb' ) ) THEN ! Ice freeboard
z2d(:,:) = zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:)
WHERE( z2d < 0._wp ) z2d = 0._wp
CALL iom_put( 'icefrb' , z2d * zmsk00 )
ENDIF
! melt ponds
- IF( iom_use('iceapnd' ) ) CALL iom_put( 'iceapnd', at_ip(A2D(0)) * zmsk00 ) ! melt pond total fraction
- IF( iom_use('icehpnd' ) ) CALL iom_put( 'icehpnd', hm_ip(:,:) * zmsk00 ) ! melt pond depth
- IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip(A2D(0)) * zmsk00 ) ! melt pond total volume per unit area
- IF( iom_use('icehlid' ) ) CALL iom_put( 'icehlid', hm_il(:,:) * zmsk00 ) ! melt pond lid depth
- IF( iom_use('icevlid' ) ) CALL iom_put( 'icevlid', vt_il(A2D(0)) * zmsk00 ) ! melt pond lid total volume per unit area
+ IF( iom_use('iceapnd' ) ) CALL iom_put( 'iceapnd', at_ip(A2D(0)) * zmsk00 ) ! melt pond total fraction
+ IF( iom_use('icehpnd' ) ) CALL iom_put( 'icehpnd', hm_ip(:,:) * zmsk00 ) ! melt pond depth
+ IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip(A2D(0)) * zmsk00 ) ! melt pond total volume per unit area
+ IF( iom_use('icehlid' ) ) CALL iom_put( 'icehlid', hm_il(:,:) * zmsk00 ) ! melt pond lid depth
+ IF( iom_use('icevlid' ) ) CALL iom_put( 'icevlid', vt_il(A2D(0)) * zmsk00 ) ! melt pond lid total volume per unit area
! salt
- IF( iom_use('icesalt' ) ) CALL iom_put( 'icesalt', sm_i(:,:) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity
- IF( iom_use('icesalm' ) ) CALL iom_put( 'icesalm', st_i(:,:) * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area
+ IF( iom_use('icesalt' ) ) CALL iom_put( 'icesalt', sm_i(:,:) * zmsk00 + zmiss * ( 1._wp - zmsk00 ) ) ! mean ice salinity
+ IF( iom_use('icesalm' ) ) CALL iom_put( 'icesalm', st_i(:,:) * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area
! heat
- IF( iom_use('icetemp' ) ) CALL iom_put( 'icetemp', ( tm_i (:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! ice mean temperature
- IF( iom_use('snwtemp' ) ) CALL iom_put( 'snwtemp', ( tm_s (:,:) - rt0 ) * zmsksn + zmiss_val * ( 1._wp - zmsksn ) ) ! snw mean temperature
- IF( iom_use('icettop' ) ) CALL iom_put( 'icettop', ( tm_su(:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice surface
- IF( iom_use('icetbot' ) ) CALL iom_put( 'icetbot', ( t_bo (:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice bottom
- IF( iom_use('icetsni' ) ) CALL iom_put( 'icetsni', ( tm_si(:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the snow-ice interface
- IF( iom_use('icehc' ) ) CALL iom_put( 'icehc' , -et_i (:,:) * zmsk00 ) ! ice heat content
- IF( iom_use('snwhc' ) ) CALL iom_put( 'snwhc' , -et_s (:,:) * zmsksn ) ! snow heat content
+ IF( iom_use('icetemp' ) ) CALL iom_put( 'icetemp', ( tm_i (:,:) - rt0 ) * zmsk00 + zmiss * ( 1._wp - zmsk00 ) ) ! ice mean temperature
+ IF( iom_use('snwtemp' ) ) CALL iom_put( 'snwtemp', ( tm_s (:,:) - rt0 ) * zmsksn + zmiss * ( 1._wp - zmsksn ) ) ! snw mean temperature
+ IF( iom_use('icettop' ) ) CALL iom_put( 'icettop', ( tm_su(:,:) - rt0 ) * zmsk00 + zmiss * ( 1._wp - zmsk00 ) ) ! temperature at the ice surface
+ IF( iom_use('icetbot' ) ) CALL iom_put( 'icetbot', ( t_bo (:,:) - rt0 ) * zmsk00 + zmiss * ( 1._wp - zmsk00 ) ) ! temperature at the ice bottom
+ IF( iom_use('icetsni' ) ) CALL iom_put( 'icetsni', ( tm_si(:,:) - rt0 ) * zmsk00 + zmiss * ( 1._wp - zmsk00 ) ) ! temperature at the snow-ice interface
+ IF( iom_use('icehc' ) ) CALL iom_put( 'icehc' , -et_i (:,:) * zmsk00 ) ! ice heat content
+ IF( iom_use('snwhc' ) ) CALL iom_put( 'snwhc' , -et_s (:,:) * zmsksn ) ! snow heat content
! momentum
- IF( iom_use('uice' ) ) CALL iom_put( 'uice' , u_ice(:,:) ) ! ice velocity u
- IF( iom_use('vice' ) ) CALL iom_put( 'vice' , v_ice(:,:) ) ! ice velocity v
+ IF( iom_use('uice' ) ) CALL iom_put( 'uice' , u_ice(:,:) ) ! ice velocity u
+ IF( iom_use('vice' ) ) CALL iom_put( 'vice' , v_ice(:,:) ) ! ice velocity v
!
- IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN ! module of ice velocity & fast ice
+ IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN ! module of ice velocity & fast ice
ALLOCATE( zfast(A2D(0)) )
DO_2D( 0, 0, 0, 0 )
z2da = u_ice(ji,jj) + u_ice(ji-1,jj)
@@ -152,14 +156,14 @@ CONTAINS
END_2D
CALL iom_put( 'icevel', z2d )
- WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp ! record presence of fast ice
+ WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp ! record presence of fast ice
ELSEWHERE ; zfast(:,:) = 0._wp
END WHERE
CALL iom_put( 'fasticepres', zfast )
DEALLOCATE( zfast )
ENDIF
!
- IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN ! ice albedo and surface albedo
+ IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN ! ice albedo and surface albedo
ALLOCATE( zalb(A2D(0)), zmskalb(A2D(0)) )
! ice albedo
WHERE( at_i_b(:,:) < 1.e-03 )
@@ -169,7 +173,7 @@ CONTAINS
zmskalb(:,:) = 1._wp
zalb (:,:) = SUM( alb_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) / at_i_b(:,:)
END WHERE
- CALL iom_put( 'icealb' , zalb * zmskalb + zmiss_val * ( 1._wp - zmskalb ) )
+ CALL iom_put( 'icealb' , zalb * zmskalb + zmiss * ( 1._wp - zmskalb ) )
! ice+ocean albedo
zalb(:,:) = SUM( alb_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b(:,:) )
CALL iom_put( 'albedo' , zalb )
@@ -177,55 +181,50 @@ CONTAINS
ENDIF
!
! --- category-dependent fields --- !
- IF( iom_use('icemask_cat' ) ) CALL iom_put( 'icemask_cat' , zmsk00l ) ! ice mask 0%
- IF( iom_use('iceconc_cat' ) ) CALL iom_put( 'iceconc_cat' , a_i(A2D(0),:) * zmsk00l ) ! area for categories
- IF( iom_use('icethic_cat' ) ) CALL iom_put( 'icethic_cat' , h_i(A2D(0),:) * zmsk00l + zmiss_val &
- & * ( 1._wp - zmsk00l ) ) ! thickness for categories
- IF( iom_use('snwthic_cat' ) ) CALL iom_put( 'snwthic_cat' , h_s(A2D(0),:) * zmsksnl + zmiss_val &
- & * ( 1._wp - zmsksnl ) ) ! snow depth for categories
- IF( iom_use('icesalt_cat' ) ) CALL iom_put( 'icesalt_cat' , s_i(A2D(0),:) * zmsk00l + zmiss_val &
- & * ( 1._wp - zmsk00l ) ) ! salinity for categories
- IF( iom_use('iceage_cat' ) ) CALL iom_put( 'iceage_cat' , o_i(A2D(0),:) / rday * zmsk00l + zmiss_val &
- & * ( 1._wp - zmsk00l ) ) ! ice age
- IF( iom_use('icetemp_cat' ) ) CALL iom_put( 'icetemp_cat' , ( SUM( t_i(A2D(0),:,:), dim=3 ) * r1_nlay_i - rt0 ) &
- & * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice temperature
- IF( iom_use('snwtemp_cat' ) ) CALL iom_put( 'snwtemp_cat' , ( SUM( t_s(A2D(0),:,:), dim=3 ) * r1_nlay_s - rt0 ) &
- & * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow temperature
- IF( iom_use('icettop_cat' ) ) CALL iom_put( 'icettop_cat' , ( t_su(A2D(0),:) - rt0 ) * zmsk00l + zmiss_val &
- & * ( 1._wp - zmsk00l ) ) ! surface temperature
- IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , bv_i(:,:,:) * 100. * zmsk00l + zmiss_val &
- & * ( 1._wp - zmsk00l ) ) ! brine volume
- IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip(A2D(0),:) * zmsk00l ) ! melt pond frac for categories
- IF( iom_use('icevpnd_cat' ) ) CALL iom_put( 'icevpnd_cat' , v_ip(A2D(0),:) * zmsk00l ) ! melt pond volume for categories
- IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip(A2D(0),:) * zmsk00l + zmiss_val &
- & * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories
- IF( iom_use('icehlid_cat' ) ) CALL iom_put( 'icehlid_cat' , h_il(A2D(0),:) * zmsk00l + zmiss_val &
- & * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories
- IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac(:,:,:) * zmsk00l ) ! melt pond frac per ice area for categories
- IF( iom_use('iceaepnd_cat') ) CALL iom_put( 'iceaepnd_cat', a_ip_eff(:,:,:) * zmsk00l ) ! melt pond effective frac for categories
- IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice(:,:,:) * zmsk00l + zmiss_val &
- & * ( 1._wp - zmsk00l ) ) ! ice albedo for categories
+ IF( iom_use('icemask_cat' ) ) CALL iom_put( 'icemask_cat' , zmsk00c ) ! ice mask 0%
+ IF( iom_use('iceconc_cat' ) ) CALL iom_put( 'iceconc_cat' , a_i(A2D(0),:) * zmsk00c ) ! area for categories
+ IF( iom_use('icethic_cat' ) ) CALL iom_put( 'icethic_cat' , h_i(A2D(0),:) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! thickness for categories
+ IF( iom_use('snwthic_cat' ) ) CALL iom_put( 'snwthic_cat' , h_s(A2D(0),:) * zmsksnc + zmiss * ( 1._wp - zmsksnc ) ) ! snow depth for categories
+ IF( iom_use('icesalt_cat' ) ) CALL iom_put( 'icesalt_cat' , s_i(A2D(0),:) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! salinity for categories
+ IF( iom_use('iceage_cat' ) ) CALL iom_put( 'iceage_cat' , o_i(A2D(0),:) / rday * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! ice age
+ IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , v_ibr(:,:,:) * 100. * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! brine volume
+ IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip(A2D(0),:) * zmsk00c ) ! melt pond frac for categories
+ IF( iom_use('icevpnd_cat' ) ) CALL iom_put( 'icevpnd_cat' , v_ip(A2D(0),:) * zmsk00c ) ! melt pond volume for categories
+ IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip(A2D(0),:) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! melt pond thickness for categories
+ IF( iom_use('icehlid_cat' ) ) CALL iom_put( 'icehlid_cat' , h_il(A2D(0),:) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! melt pond lid thickness for categories
+ IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac(:,:,:) * zmsk00c ) ! melt pond frac per ice area for categories
+ IF( iom_use('iceaepnd_cat') ) CALL iom_put( 'iceaepnd_cat', a_ip_eff(:,:,:) * zmsk00c ) ! melt pond effective frac for categories
+ IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice(:,:,:) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! ice albedo for categories
+ IF( iom_use('icettop_cat' ) ) CALL iom_put( 'icettop_cat' , (t_su(A2D(0),:)-rt0) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! surface temperature
+ IF( iom_use('icetemp_cat' ) ) CALL iom_put( 'icetemp_cat' , (SUM( t_i(A2D(0),:,:), dim=3 ) * r1_nlay_i - rt0) * zmsk00c &
+ & + zmiss * ( 1._wp - zmsk00c ) ) ! ice temperature
+ IF( iom_use('snwtemp_cat' ) ) CALL iom_put( 'snwtemp_cat' , (SUM( t_s(A2D(0),:,:), dim=3 ) * r1_nlay_s - rt0) * zmsksnc &
+ & + zmiss * ( 1._wp - zmsksnc ) ) ! snow temperature
+
+ ! --- layer-dependent fields --- !
+ IF( iom_use('icetemp_lay' ) ) CALL iom_put( 'icetemp_lay' , (t_i(A2D(0),:,:)-rt0) * zmsk00l + zmiss * ( 1._wp - zmsk00l ) ) ! ice temperature
+ IF( iom_use('icesalt_lay' ) ) CALL iom_put( 'icesalt_lay' , sz_i(A2D(0),:,:) * zmsk00l + zmiss * ( 1._wp - zmsk00l ) ) ! ice salinity
!------------------
! Add-ons for SIMIP
!------------------
! trends
IF( iom_use('dmithd') ) CALL iom_put( 'dmithd', - wfx_bog(:,:) - wfx_bom(:,:) - wfx_sum(:,:) - wfx_sni(:,:) &
- & - wfx_opw(:,:) - wfx_lam(:,:) - wfx_res(:,:) ) ! Sea-ice mass change from thermodynamics
- IF( iom_use('dmidyn') ) CALL iom_put( 'dmidyn', - wfx_dyn + rhoi * diag_trp_vi ) ! Sea-ice mass change from dynamics(kg/m2/s)
- IF( iom_use('dmiopw') ) CALL iom_put( 'dmiopw', - wfx_opw ) ! Sea-ice mass change through growth in open water
- IF( iom_use('dmibog') ) CALL iom_put( 'dmibog', - wfx_bog ) ! Sea-ice mass change through basal growth
- IF( iom_use('dmisni') ) CALL iom_put( 'dmisni', - wfx_sni ) ! Sea-ice mass change through snow-to-ice conversion
- IF( iom_use('dmisum') ) CALL iom_put( 'dmisum', - wfx_sum ) ! Sea-ice mass change through surface melting
- IF( iom_use('dmibom') ) CALL iom_put( 'dmibom', - wfx_bom ) ! Sea-ice mass change through bottom melting
- IF( iom_use('dmilam') ) CALL iom_put( 'dmilam', - wfx_lam ) ! Sea-ice mass change through lateral melting
- IF( iom_use('dmtsub') ) CALL iom_put( 'dmtsub', - wfx_sub ) ! Sea-ice mass change through evaporation and sublimation
- IF( iom_use('dmssub') ) CALL iom_put( 'dmssub', - wfx_snw_sub ) ! Snow mass change through sublimation
- IF( iom_use('dmisub') ) CALL iom_put( 'dmisub', - wfx_ice_sub ) ! Sea-ice mass change through sublimation
- IF( iom_use('dmsspr') ) CALL iom_put( 'dmsspr', - wfx_spr ) ! Snow mass change through snow fall
- IF( iom_use('dmsssi') ) CALL iom_put( 'dmsssi', wfx_sni*rhos*r1_rhoi ) ! Snow mass change through snow-to-ice conversion
- IF( iom_use('dmsmel') ) CALL iom_put( 'dmsmel', - wfx_snw_sum ) ! Snow mass change through melt
- IF( iom_use('dmsdyn') ) CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs ) ! Snow mass change through dynamics(kg/m2/s)
+ & - wfx_opw(:,:) - wfx_lam(:,:) - wfx_res(:,:) ) ! Sea-ice mass change from thermodynamics
+ IF( iom_use('dmidyn') ) CALL iom_put( 'dmidyn', - wfx_dyn + rhoi * diag_trp_vi ) ! Sea-ice mass change from dynamics(kg/m2/s)
+ IF( iom_use('dmiopw') ) CALL iom_put( 'dmiopw', - wfx_opw ) ! Sea-ice mass change through growth in open water
+ IF( iom_use('dmibog') ) CALL iom_put( 'dmibog', - wfx_bog ) ! Sea-ice mass change through basal growth
+ IF( iom_use('dmisni') ) CALL iom_put( 'dmisni', - wfx_sni ) ! Sea-ice mass change through snow-to-ice conversion
+ IF( iom_use('dmisum') ) CALL iom_put( 'dmisum', - wfx_sum ) ! Sea-ice mass change through surface melting
+ IF( iom_use('dmibom') ) CALL iom_put( 'dmibom', - wfx_bom ) ! Sea-ice mass change through bottom melting
+ IF( iom_use('dmilam') ) CALL iom_put( 'dmilam', - wfx_lam ) ! Sea-ice mass change through lateral melting
+ IF( iom_use('dmtsub') ) CALL iom_put( 'dmtsub', - wfx_sub ) ! Sea-ice mass change through evaporation and sublimation
+ IF( iom_use('dmssub') ) CALL iom_put( 'dmssub', - wfx_snw_sub ) ! Snow mass change through sublimation
+ IF( iom_use('dmisub') ) CALL iom_put( 'dmisub', - wfx_ice_sub ) ! Sea-ice mass change through sublimation
+ IF( iom_use('dmsspr') ) CALL iom_put( 'dmsspr', - wfx_spr ) ! Snow mass change through snow fall
+ IF( iom_use('dmsssi') ) CALL iom_put( 'dmsssi', wfx_sni*rhos*r1_rhoi ) ! Snow mass change through snow-to-ice conversion
+ IF( iom_use('dmsmel') ) CALL iom_put( 'dmsmel', - wfx_snw_sum ) ! Snow mass change through melt
+ IF( iom_use('dmsdyn') ) CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs ) ! Snow mass change through dynamics(kg/m2/s)
! Global ice diagnostics
IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. &
diff --git a/src/NST/agrif_all_update.F90 b/src/NST/agrif_all_update.F90
index b8573fd98908162982b179f9891e8cce1eb15c84..e6e888ebb7481294557ea1fa94e2cdcee7b2b9a9 100644
--- a/src/NST/agrif_all_update.F90
+++ b/src/NST/agrif_all_update.F90
@@ -120,7 +120,7 @@ CONTAINS
CALL lbc_lnk( 'finalize_lbc_for_agrif', a_i, 'T',1._wp, v_i,'T',1._wp, &
& v_s, 'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, &
& a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp, t_su,'T',1._wp )
- CALL lbc_lnk( 'finalize_lbc_for_agrif', e_i,'T',1._wp, e_s,'T',1._wp )
+ CALL lbc_lnk( 'finalize_lbc_for_agrif', e_i,'T',1._wp, e_s,'T',1._wp, szv_i,'T',1._wp )
CALL lbc_lnk( 'finalize_lbc_for_agrif', u_ice, 'U', -1._wp, v_ice, 'V', -1._wp )
#endif
#if defined key_top
diff --git a/src/NST/agrif_ice_interp.F90 b/src/NST/agrif_ice_interp.F90
index 9bc3d8aa8bd08f892b10b2d29b346d868b9f7d3b..7475a435df4faf8c9176ebc324ea64391ecafc6f 100644
--- a/src/NST/agrif_ice_interp.F90
+++ b/src/NST/agrif_ice_interp.F90
@@ -58,7 +58,7 @@ CONTAINS
IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
IF(lwp) WRITE(numout,*) ' '
- ! Set a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i:
+ ! Set a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i, szv_i:
Agrif_SpecialValue = -9999.
Agrif_UseSpecialValue = .TRUE.
CALL Agrif_Set_MaskMaxSearch(10)
@@ -67,7 +67,7 @@ CONTAINS
CALL lbc_lnk( 'agrif_istate_ice', a_i,'T',1._wp, v_i,'T',1._wp, &
& v_s,'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, &
& a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp, t_su,'T',1._wp )
- CALL lbc_lnk( 'agrif_istate_ice', e_i,'T',1._wp, e_s,'T',1._wp )
+ CALL lbc_lnk( 'agrif_istate_ice', e_i,'T',1._wp, e_s,'T',1._wp, szv_i,'T',1._wp )
!
! Set u_ice, v_ice:
use_sign_north = .TRUE.
@@ -288,6 +288,9 @@ CONTAINS
DO jk = 1, nlay_i
ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
END DO
+ DO jk = 1, nlay_i
+ ptab(i1:i2,j1:j2,jm) = szv_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
+ END DO
END DO
DO jk = k1, k2
@@ -325,6 +328,10 @@ CONTAINS
e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
jm = jm + 1
END DO
+ DO jk = 1, nlay_i
+ szv_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
+ jm = jm + 1
+ END DO
!
END DO
!
@@ -355,6 +362,10 @@ CONTAINS
! ztab(:,:,jm) = e_i(:,:,jk,jl)
! jm = jm + 1
! END DO
+! DO jk = 1, nlay_i
+! ztab(:,:,jm) = szv_i(:,:,jk,jl)
+! jm = jm + 1
+! END DO
! !
! END DO
! !
@@ -466,6 +477,10 @@ CONTAINS
! e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
! jm = jm + 1
! END DO
+! DO jk = 1, nlay_i
+! szv_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
+! jm = jm + 1
+! END DO
! !
! END DO
!
diff --git a/src/NST/agrif_ice_update.F90 b/src/NST/agrif_ice_update.F90
index 4557ef513ef4fa52c4f0e9bef05b97039c5ac8a4..21b2fdee13b5c3b7a3830d29ac54f35b719b6dd1 100644
--- a/src/NST/agrif_ice_update.F90
+++ b/src/NST/agrif_ice_update.F90
@@ -118,6 +118,9 @@ CONTAINS
DO jk = 1, nlay_i
ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) * e1e2t_frac(i1:i2,j1:j2) ; jm = jm + 1
END DO
+ DO jk = 1, nlay_i
+ ptab(i1:i2,j1:j2,jm) = szv_i(i1:i2,j1:j2,jk,jl) * e1e2t_frac(i1:i2,j1:j2) ; jm = jm + 1
+ END DO
END DO
!
DO jk = k1, k2
@@ -160,6 +163,13 @@ CONTAINS
jm = jm + 1
END DO
!
+ DO jk = 1, nlay_i
+ WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
+ szv_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
+ ENDWHERE
+ jm = jm + 1
+ END DO
+ !
END DO
!
DO jl = 1, jpl
diff --git a/src/NST/agrif_user.F90 b/src/NST/agrif_user.F90
index bfe0ec9e14abd195c7ac2e1aeb249ce5f2e49c04..5f547049e8739c05c617d2bde85b6e101c621265 100644
--- a/src/NST/agrif_user.F90
+++ b/src/NST/agrif_user.F90
@@ -724,7 +724,7 @@
ind1 = nbghostcells - 1 ! Remove one land cell in ghosts
ind2 = nn_hls + 1 + nbghostcells_x_w
ind3 = nn_hls + 1 + nbghostcells_y_s
- ipl = jpl*(9+nlay_s+nlay_i)
+ ipl = jpl*(9+nlay_s+2*nlay_i)
CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id)
CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_ice_id)
CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_ice_id)
diff --git a/src/OCE/BDY/bdydta.F90 b/src/OCE/BDY/bdydta.F90
index 062b70526f684fecb4ca4095f5f93e1bf36e0e83..aa4e30eff4dc43efaa2beb465f71d73f79e07345 100644
--- a/src/OCE/BDY/bdydta.F90
+++ b/src/OCE/BDY/bdydta.F90
@@ -183,7 +183,7 @@ CONTAINS
dta_bdy(jbdy)%t_i(ib,jl) = SUM(t_i (ii,ij,:,jl)) * r1_nlay_i * tmask(ii,ij,1)
dta_bdy(jbdy)%t_s(ib,jl) = SUM(t_s (ii,ij,:,jl)) * r1_nlay_s * tmask(ii,ij,1)
dta_bdy(jbdy)%tsu(ib,jl) = t_su(ii,ij,jl) * tmask(ii,ij,1)
- dta_bdy(jbdy)%s_i(ib,jl) = s_i (ii,ij,jl) * tmask(ii,ij,1)
+ dta_bdy(jbdy)%s_i(ib,jl) = SUM(sz_i(ii,ij,:,jl)) * r1_nlay_i * tmask(ii,ij,1)
! melt ponds
dta_bdy(jbdy)%aip(ib,jl) = a_ip(ii,ij,jl) * tmask(ii,ij,1)
dta_bdy(jbdy)%hip(ib,jl) = h_ip(ii,ij,jl) * tmask(ii,ij,1)
diff --git a/src/OCE/BDY/bdyice.F90 b/src/OCE/BDY/bdyice.F90
index c5357c3bf8994fe2503f5b2dd1f90aed36c5632f..072417f91d742278acd45b1bb82eea7974adcd2b 100644
--- a/src/OCE/BDY/bdyice.F90
+++ b/src/OCE/BDY/bdyice.F90
@@ -95,7 +95,7 @@ CONTAINS
& , a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp &
& , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
! exchange 4d arrays : third dimension = 1 and then third dimension = jpk
- CALL lbc_lnk('bdyice', t_s , 'T', 1._wp, e_s , 'T', 1._wp, t_i , 'T', 1._wp, e_i , 'T', 1._wp, &
+ CALL lbc_lnk('bdyice', t_s , 'T', 1._wp, e_s , 'T', 1._wp, t_i , 'T', 1._wp, e_i , 'T', 1._wp, szv_i , 'T', 1._wp, &
& kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
END IF
END DO ! ir
@@ -104,9 +104,9 @@ CONTAINS
! ! i.e. inputs have not the same ice thickness distribution (set by rn_himean)
! ! than the regional simulation
! ! -- lbc_lnk needed because of iceitd_reb that is called in icecor.F90
- CALL lbc_lnk( 'bdyice', a_i , 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, &
- & t_su, 'T', 1._wp, a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp )
- CALL lbc_lnk( 'bdyice', e_i , 'T', 1._wp, e_s , 'T', 1._wp )
+ CALL lbc_lnk( 'bdyice', a_i , 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, &
+ & t_su, 'T', 1._wp, a_ip, 'T', 1._wp, v_ip , 'T', 1._wp, v_il, 'T', 1._wp )
+ CALL lbc_lnk( 'bdyice', e_i , 'T', 1._wp, e_s , 'T', 1._wp, szv_i, 'T', 1._wp )
!
CALL ice_var_agg(1)
!
@@ -251,11 +251,14 @@ CONTAINS
s_i (ji,jj ,jl) = rn_icesal
sz_i(ji,jj,:,jl) = rn_icesal
ENDIF
+ IF( nn_icesal == 2 .OR. nn_icesal == 4 ) THEN
+ s_i (ji,jj ,jl) = MAX( rn_simin, MIN( s_i (ji,jj ,jl), rn_sinew*sss_m(ji,jj) ) )
+ sz_i(ji,jj,:,jl) = MAX( rn_simin, MIN( sz_i(ji,jj,:,jl), rn_sinew*sss_m(ji,jj) ) )
+ ENDIF
!
! global fields
v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) ! volume ice
v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) ! volume snw
- sv_i(ji,jj,jl) = MIN( s_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
DO jk = 1, nlay_s
t_s(ji,jj,jk,jl) = MIN( t_s(ji,jj,jk,jl), -0.15_wp + rt0 ) ! Force t_s to be lower than -0.15deg (arbitrary) => likely conservation issue
! ! otherwise instant melting can occur
@@ -272,6 +275,9 @@ CONTAINS
& - rcp * ztmelts )
e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i ! enthalpy in J/m2
END DO
+ ! salt content
+ sv_i (ji,jj, jl) = s_i (ji,jj, jl) * v_i(ji,jj,jl)
+ szv_i(ji,jj,:,jl) = sz_i(ji,jj,:,jl) * v_i(ji,jj,jl) * r1_nlay_i
!
! melt ponds
v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl)
@@ -300,13 +306,14 @@ CONTAINS
ENDIF
!
! global fields
- v_i (ji,jj, jl) = 0._wp
- v_s (ji,jj, jl) = 0._wp
- sv_i(ji,jj, jl) = 0._wp
- e_s (ji,jj,:,jl) = 0._wp
- e_i (ji,jj,:,jl) = 0._wp
- v_ip(ji,jj, jl) = 0._wp
- v_il(ji,jj, jl) = 0._wp
+ v_i (ji,jj, jl) = 0._wp
+ v_s (ji,jj, jl) = 0._wp
+ sv_i (ji,jj, jl) = 0._wp
+ e_s (ji,jj,:,jl) = 0._wp
+ e_i (ji,jj,:,jl) = 0._wp
+ szv_i(ji,jj,:,jl) = 0._wp
+ v_ip (ji,jj, jl) = 0._wp
+ v_il (ji,jj, jl) = 0._wp
ENDIF
diff --git a/src/OCE/DOM/dom_oce.F90 b/src/OCE/DOM/dom_oce.F90
index 75a49ead299134443aee836af7b784786424b812..05742adc654f0d04b30f47fb7a5e9e746060e927 100644
--- a/src/OCE/DOM/dom_oce.F90
+++ b/src/OCE/DOM/dom_oce.F90
@@ -136,19 +136,19 @@ MODULE dom_oce
LOGICAL, PUBLIC, PARAMETER :: lk_ALE = .FALSE. !: ALE key flag
#endif
#if defined key_vco_1d
- LOGICAL, PUBLIC, PARAMETER :: lk_vco_1d = .TRUE. !: zco key flag
+ LOGICAL, PUBLIC, PARAMETER :: lk_vco_1d = .TRUE. !: 1d key flag
#else
- LOGICAL, PUBLIC, PARAMETER :: lk_vco_1d = .FALSE. !: zco key flag
+ LOGICAL, PUBLIC, PARAMETER :: lk_vco_1d = .FALSE. !: 1d key flag
#endif
#if defined key_vco_1d3d
- LOGICAL, PUBLIC, PARAMETER :: lk_vco_1d3d = .TRUE. !: zps key flag
+ LOGICAL, PUBLIC, PARAMETER :: lk_vco_1d3d = .TRUE. !: 1d3d key flag
#else
- LOGICAL, PUBLIC, PARAMETER :: lk_vco_1d3d = .FALSE. !: zps key flag
+ LOGICAL, PUBLIC, PARAMETER :: lk_vco_1d3d = .FALSE. !: 1d3d key flag
#endif
#if defined key_vco_3d
- LOGICAL, PUBLIC, PARAMETER :: lk_vco_3d = .TRUE. !: sco key flag
+ LOGICAL, PUBLIC, PARAMETER :: lk_vco_3d = .TRUE. !: 3d key flag
#else
- LOGICAL, PUBLIC, PARAMETER :: lk_vco_3d = .FALSE. !: sco key flag
+ LOGICAL, PUBLIC, PARAMETER :: lk_vco_3d = .FALSE. !: 3d key flag
#endif
!!gm obsolescent feature replaced by key_xxx ==>>> to be removed when z-tilde and or ALE key added (and domvvl removed)
@@ -362,15 +362,14 @@ CONTAINS
!
ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , &
& e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(ii) )
- !
- ELSEIF( lk_vco_1d3d ) THEN !* zps : allocate 1d vertical arrays, except t-level e3 !!st WHT not ???
- !
+ ELSEIF( lk_vco_1d3d ) THEN
+ ! !* zps : allocate 1d vertical arrays for gdep and w-level e3 fields and t-level e3 fields
ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , &
& e3t_1d(jpk) , e3w_1d(jpk) , &
& e3t_3d(jpi,jpj,jpk) , e3u_3d(jpi,jpj,jpk) , &
& e3v_3d(jpi,jpj,jpk) , e3f_3d(jpi,jpj,jpk) , STAT=ierr(ii) )
ELSEIF( lk_vco_3d ) THEN
- ! !* sco : allocate 3d vertical arrays for all gdep and e3 fields (no more _1d) !!st WHT not ???
+ ! !* sco : allocate 3d vertical arrays for all gdep and e3 fields (no more _1d)
ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , &
& e3t_1d(jpk) , e3w_1d(jpk) , &
& gdept_3d(jpi,jpj,jpk) ,gdepw_3d(jpi,jpj,jpk) , &
@@ -382,7 +381,6 @@ CONTAINS
! !-------------------------------------!
ELSEIF( lk_ALE ) THEN !- combine time & space variations -! (vertical ALE coordinate)
! !-------------------------------------! NOT yet implemented
- !!st ca ne devrait pas etre des *_0 qui varient dans le temps ?
ii = ii+1
ALLOCATE( ht(jpi,jpj,jpt) , hu(jpi,jpj,jpt) , hv(jpi,jpj,jpt) , &
& r1_hu(jpi,jpj,jpt) , r1_hv (jpi,jpj,jpt) , STAT=ierr(ii) )
diff --git a/src/OCE/DOM/domzgr.F90 b/src/OCE/DOM/domzgr.F90
index 9029c88e79b3b0c632127c5457550a0b69de71df..ca1139c20dfde85ae434874f9bd5b2cbe6289de5 100644
--- a/src/OCE/DOM/domzgr.F90
+++ b/src/OCE/DOM/domzgr.F90
@@ -87,7 +87,6 @@ CONTAINS
WRITE(numout,*) '~~~~~~~'
IF( ln_linssh ) WRITE(numout,*) ' linear free surface: the vertical mesh does not change in time'
ENDIF
-CALL FLUSH(numout)
! !==============================!
IF( ln_read_cfg ) THEN !== read in domcfg.nc file ==!
! !==============================!
@@ -229,46 +228,44 @@ CALL FLUSH(numout)
! !--------------------!
IF( lk_vco_1d ) THEN !-- z-coordinate --! use only 1D arrays for all gdep and e3 fields
! !--------------------!
- l_zco = .TRUE. ! old logical ==> to be removed
- l_zps = .FALSE.
- l_sco = .FALSE.
!
+
CALL usr_def_zgr( l_zco , l_zps , l_sco, ln_isfcav, &
& k_top , k_bot , & ! 1st & last ocean level
& gdept_1d, gdepw_1d, e3t_1d, e3w_1d ) ! 1D gridpoints depth
+ !
+ IF( l_sco ) CALL ctl_stop( 'STOP','domzgr: key_vco_1d and l_sco=T are incompatible. Fix usrdef_zgr !' )
+ IF( l_zps ) CALL ctl_stop( 'STOP','domzgr: key_vco_1d and l_zps=T are incompatible. Fix usrdef_zgr !' )
+ !
! !-----------------------!
ELSEIF( lk_vco_1d3d ) THEN !-- z-partial cells --! use 3D t-level e3
! !-----------------------!
- l_zco = .FALSE. ! old logical ==> to be removed
- l_zps = .TRUE.
- l_sco = .FALSE.
!
- CALL usr_def_zgr( l_zco , l_zps , l_sco, ln_isfcav, &
+ CALL usr_def_zgr( l_zco , l_zps , l_sco, ln_isfcav , &
& k_top , k_bot , & ! 1st & last ocean level
& gdept_1d, gdepw_1d, e3t_1d, e3w_1d , & ! 1D gridpoints depth
- & e3t_3d , e3u_3d , e3v_3d, e3f_3d ) ! vertical scale factors
+ & e3t_3d , e3u_3d , e3v_3d, e3f_3d ) ! vertical scale factors
+ !
+ IF( l_sco ) CALL ctl_stop( 'STOP','domzgr: key_vco_1d3d and l_sco=T are incompatible. Fix usrdef_zgr !' )
!
! make sure that periodicities are properly applied
CALL lbc_lnk( 'dom_zgr', e3t_3d, 'T', 1._wp, e3u_3d, 'U', 1._wp, e3v_3d, 'V', 1._wp, e3f_3d, 'F', 1._wp, &
& kfillmode = jpfillcopy ) ! do not put 0 over closed boundaries
-
+ !
! !--------------------!
ELSEIF( lk_vco_3d ) THEN !-- s-coordinate --! use 3D for all gdep and e3 fields
! !--------------------!
- l_zco = .FALSE. ! old logical ==> to be removed
- l_zps = .FALSE.
- l_sco = .TRUE.
!
- CALL usr_def_zgr( l_zco , l_zps , l_sco, ln_isfcav, &
- & k_top , k_bot , & ! 1st & last ocean level
- & gdept_1d, gdepw_1d, e3t_1d, e3w_1d , & ! 1D gridpoints depth
- & e3t_3d , e3u_3d , e3v_3d, e3f_3d , & ! vertical scale factors
- & gdept_3d, gdepw_3d , & ! gridpoints depth
- & e3w_3d , e3uw_3d , e3vw_3d ) ! vertical scale factors
- CALL lbc_lnk( 'dom_zgr', gdept_3d, 'T', 1._wp, gdepw_3d, 'W', 1._wp, &
- & e3t_3d, 'T', 1._wp, e3u_3d, 'U', 1._wp, e3v_3d, 'V', 1._wp, e3f_3d, 'F', 1._wp, &
- & e3w_3d, 'W', 1._wp, e3uw_3d, 'U', 1._wp, e3vw_3d, 'V', 1._wp, &
- & kfillmode = jpfillcopy ) ! do not put 0 over closed boundaries
+ CALL usr_def_zgr( l_zco , l_zps , l_sco, ln_isfcav , &
+ & k_top , k_bot , & ! 1st & last ocean level
+ & gdept_1d, gdepw_1d, e3t_1d, e3w_1d , & ! 1D gridpoints depth
+ & e3t_3d , e3u_3d , e3v_3d, e3f_3d , & ! vertical scale factors
+ & gdept_3d, gdepw_3d , & ! gridpoints depth
+ & e3w_3d , e3uw_3d , e3vw_3d ) ! vertical scale factors
+ CALL lbc_lnk( 'dom_zgr', gdept_3d, 'T', 1._wp, gdepw_3d, 'W', 1._wp, &
+ & e3t_3d, 'T', 1._wp, e3u_3d, 'U', 1._wp, e3v_3d, 'V', 1._wp, e3f_3d, 'F', 1._wp, &
+ & e3w_3d, 'W', 1._wp, e3uw_3d, 'U', 1._wp, e3vw_3d, 'V', 1._wp, &
+ & kfillmode = jpfillcopy ) ! do not put 0 over closed boundaries
ENDIF
ENDIF
ztopbot(:,:,1) = REAL(k_top, wp)
@@ -311,7 +308,7 @@ CALL FLUSH(numout)
!
IF(lwp) THEN ! Control print
WRITE(numout,*)
- WRITE(numout,*) ' Type of vertical coordinate (read in ', TRIM( cn_domcfg ), ' file or set in userdef_nam) :'
+ WRITE(numout,*) ' Type of vertical coordinate (read in ', TRIM( cn_domcfg ), ' file or set in userdef_zgr) :'
WRITE(numout,*) ' z-coordinate - full steps l_zco = ', l_zco
WRITE(numout,*) ' z-coordinate - partial steps l_zps = ', l_zps
WRITE(numout,*) ' s- or hybrid z-s-coordinate l_sco = ', l_sco
diff --git a/src/OCE/DOM/phycst.F90 b/src/OCE/DOM/phycst.F90
index 779e0b00388ece39a41e39e430d657cadef3311f..4cac5bcf289020b47f02064243fe9a947557906e 100644
--- a/src/OCE/DOM/phycst.F90
+++ b/src/OCE/DOM/phycst.F90
@@ -26,46 +26,46 @@ MODULE phycst
REAL(wp), PUBLIC :: rad = 3.141592653589793_wp / 180._wp !: conversion from degre into radian
REAL(wp), PUBLIC :: rsmall = 0.5 * EPSILON( 1.e0 ) !: smallest real computer value
- REAL(wp), PUBLIC :: rday = 24.*60.*60. !: day [s]
- REAL(wp), PUBLIC :: rsiyea !: sideral year [s]
- REAL(wp), PUBLIC :: rsiday !: sideral day [s]
- REAL(wp), PUBLIC :: raamo = 12._wp !: number of months in one year
- REAL(wp), PUBLIC :: rjjhh = 24._wp !: number of hours in one day
- REAL(wp), PUBLIC :: rhhmm = 60._wp !: number of minutes in one hour
- REAL(wp), PUBLIC :: rmmss = 60._wp !: number of seconds in one minute
- REAL(wp), PUBLIC :: omega !: earth rotation parameter [s-1]
- REAL(wp), PUBLIC :: ra = 6371229._wp !: earth radius [m]
- REAL(wp), PUBLIC :: grav = 9.80665_wp !: gravity [m/s2]
- REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of fresh water [Kelvin]
-
- REAL(wp), PUBLIC :: rho0 !: volumic mass of reference [kg/m3]
- REAL(wp), PUBLIC :: r1_rho0 !: = 1. / rho0 [m3/kg]
- REAL(wp), PUBLIC :: rcp !: ocean specific heat [J/Kelvin]
- REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J]
- REAL(wp), PUBLIC :: rho0_rcp !: = rho0 * rcp
- REAL(wp), PUBLIC :: r1_rho0_rcp !: = 1. / ( rho0 * rcp )
-
- REAL(wp), PUBLIC :: emic = 0.97_wp !: emissivity of snow or ice (not used?)
-
- REAL(wp), PUBLIC :: sice = 6.0_wp !: salinity of ice (for pisces) [psu]
- REAL(wp), PUBLIC :: soce = 34.7_wp !: salinity of sea (for pisces and isf) [psu]
- REAL(wp), PUBLIC :: rLevap = 2.5e+6_wp !: latent heat of evaporation (water)
- REAL(wp), PUBLIC :: vkarmn = 0.4_wp !: von Karman constant
- REAL(wp), PUBLIC :: vkarmn2 = 0.4_wp*0.4_wp !: square of von Karman constant
- REAL(wp), PUBLIC :: stefan = 5.67e-8_wp !: Stefan-Boltzmann constant
-
- REAL(wp), PUBLIC :: rhos = 330._wp !: volumic mass of snow [kg/m3]
- REAL(wp), PUBLIC :: rhoi = 917._wp !: volumic mass of sea ice [kg/m3]
- REAL(wp), PUBLIC :: rhow = 1000._wp !: volumic mass of freshwater in melt ponds [kg/m3]
- REAL(wp), PUBLIC :: rcnd_i = 2.034396_wp !: thermal conductivity of fresh ice [W/m/K]
- REAL(wp), PUBLIC :: rcpi = 2067.0_wp !: specific heat of fresh ice [J/kg/K]
- REAL(wp), PUBLIC :: rLsub = 2.834e+6_wp !: pure ice latent heat of sublimation [J/kg]
- REAL(wp), PUBLIC :: rLfus = 0.334e+6_wp !: latent heat of fusion of fresh ice [J/kg]
- REAL(wp), PUBLIC :: rTmlt = 0.054_wp !: decrease of seawater meltpoint with salinity
-
- REAL(wp), PUBLIC :: r1_rhoi !: 1 / rhoi
- REAL(wp), PUBLIC :: r1_rhos !: 1 / rhos
- REAL(wp), PUBLIC :: r1_rcpi !: 1 / rcpi
+ REAL(wp), PUBLIC :: rday = 24.*60.*60. !: day [s]
+ REAL(wp), PUBLIC :: rsiyea !: sideral year [s]
+ REAL(wp), PUBLIC :: rsiday !: sideral day [s]
+ REAL(wp), PUBLIC :: raamo = 12._wp !: number of months in one year
+ REAL(wp), PUBLIC :: rjjhh = 24._wp !: number of hours in one day
+ REAL(wp), PUBLIC :: rhhmm = 60._wp !: number of minutes in one hour
+ REAL(wp), PUBLIC :: rmmss = 60._wp !: number of seconds in one minute
+ REAL(wp), PUBLIC :: omega !: earth rotation parameter [s-1]
+ REAL(wp), PUBLIC :: ra = 6371229._wp !: earth radius [m]
+ REAL(wp), PUBLIC :: grav = 9.80665_wp !: gravity [m/s2]
+ REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of fresh water [Kelvin]
+
+ REAL(wp), PUBLIC :: rho0 !: volumic mass of reference [kg/m3]
+ REAL(wp), PUBLIC :: r1_rho0 !: = 1. / rho0 [m3/kg]
+ REAL(wp), PUBLIC :: rcp !: ocean specific heat [J/Kelvin]
+ REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J]
+ REAL(wp), PUBLIC :: rho0_rcp !: = rho0 * rcp
+ REAL(wp), PUBLIC :: r1_rho0_rcp !: = 1. / ( rho0 * rcp )
+
+ REAL(wp), PUBLIC :: emic = 0.97_wp !: emissivity of snow or ice (not used?)
+
+ REAL(wp), PUBLIC :: sice = 6.0_wp !: salinity of ice (for pisces) [psu]
+ REAL(wp), PUBLIC :: soce = 34.7_wp !: salinity of sea (for pisces and isf) [psu]
+ REAL(wp), PUBLIC :: rLevap = 2.5e+6_wp !: latent heat of evaporation (water)
+ REAL(wp), PUBLIC :: vkarmn = 0.4_wp !: von Karman constant
+ REAL(wp), PUBLIC :: vkarmn2 = 0.4_wp*0.4_wp !: square of von Karman constant
+ REAL(wp), PUBLIC :: stefan = 5.67e-8_wp !: Stefan-Boltzmann constant
+
+ REAL(wp), PUBLIC :: rhos = 330._wp !: volumic mass of snow [kg/m3]
+ REAL(wp), PUBLIC :: rhoi = 917._wp !: volumic mass of sea ice (Pounder, 1965) [kg/m3]
+ REAL(wp), PUBLIC :: rhow = 1000._wp !: volumic mass of freshwater in melt ponds [kg/m3]
+ REAL(wp), PUBLIC :: rcnd_i = 2.034396_wp !: thermal conductivity of fresh ice [W/m/K]
+ REAL(wp), PUBLIC :: rcpi = 2096.7_wp !: specific heat of fresh ice (Feistel and Wagner, 2006) (previously 2067.0) [J/kg/K]
+ REAL(wp), PUBLIC :: rLsub = 2.8344e+6_wp !: pure ice latent heat of sublimation (Feistel and Wagner, 2006) [J/kg]
+ REAL(wp), PUBLIC :: rLfus = 0.3333601e+06_wp !: latent heat of fusion of fresh ice (Feistel and Wagner, 2006) (previously 0.334e+6) [J/kg]
+ REAL(wp), PUBLIC :: rTmlt = 0.054_wp !: decrease of seawater meltpoint with salinity
+
+ REAL(wp), PUBLIC :: r1_rhoi !: 1 / rhoi
+ REAL(wp), PUBLIC :: r1_rhos !: 1 / rhos
+ REAL(wp), PUBLIC :: r1_rcpi !: 1 / rcpi
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
diff --git a/src/OCE/IOM/iom.F90 b/src/OCE/IOM/iom.F90
index 382e158778991789c23b4adb1d0ab732ad4e975e..88ddf990607c68abcb515671e332022ac8bf6b41 100644
--- a/src/OCE/IOM/iom.F90
+++ b/src/OCE/IOM/iom.F90
@@ -30,7 +30,7 @@ MODULE iom
USE sbc_oce , ONLY : nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1
USE icb_oce , ONLY : nclasses, class_num ! !: iceberg classes
#if defined key_si3
- USE ice , ONLY : jpl
+ USE ice , ONLY : jpl, nlay_i
#endif
USE phycst ! physical constants
USE dianam ! build name of file
@@ -263,6 +263,7 @@ CONTAINS
CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) )
# if defined key_si3
CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
+ CALL iom_set_axis_attr( "nlayice", (/ (REAL(ji,wp), ji=1,nlay_i) /) )
! SIMIP diagnostics (4 main arctic straits)
CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) )
# endif
diff --git a/src/OCE/LBC/lbc_lnk_call_generic.h90 b/src/OCE/LBC/lbc_lnk_call_generic.h90
index b48047de6f9542871df7bbd1fd4dd167c21f65ec..d13ac2a03810d70f82c1720343a75dd235d4c919 100644
--- a/src/OCE/LBC/lbc_lnk_call_generic.h90
+++ b/src/OCE/LBC/lbc_lnk_call_generic.h90
@@ -29,6 +29,8 @@
& , pt29, cdna29, psgn29, pt30, cdna30, psgn30, pt31, cdna31, psgn31, pt32, cdna32, psgn32 &
& , pt33, cdna33, psgn33, pt34, cdna34, psgn34, pt35, cdna35, psgn35, pt36, cdna36, psgn36 &
& , pt37, cdna37, psgn37, pt38, cdna38, psgn38, pt39, cdna39, psgn39, pt40, cdna40, psgn40 &
+ & , pt41, cdna41, psgn41, pt42, cdna42, psgn42, pt43, cdna43, psgn43, pt44, cdna44, psgn44 &
+ & , pt45, cdna45, psgn45, pt46, cdna46, psgn46, pt47, cdna47, psgn47, pt48, cdna48, psgn48 &
& , kfillmode, pfillval, lsend, lrecv, ld4only, ldfull )
!!---------------------------------------------------------------------
CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine
@@ -38,21 +40,24 @@
& pt16, pt17, pt18, pt19, pt20, pt21, pt22, &
& pt23, pt24, pt25, pt26, pt27, pt28, pt29, &
& pt30, pt31, pt32, pt33, pt34, pt35, pt36, &
- & pt37, pt38, pt39, pt40
+ & pt37, pt38, pt39, pt40, pt41, pt42, pt43, &
+ & pt44, pt45, pt46, pt47, pt48
CHARACTER(len=1) , INTENT(in ) :: cdna1 ! nature of pt2D. array grid-points
CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , &
& cdna9 , cdna10, cdna11, cdna12, cdna13, cdna14, cdna15, &
& cdna16, cdna17, cdna18, cdna19, cdna20, cdna21, cdna22, &
& cdna23, cdna24, cdna25, cdna26, cdna27, cdna28, cdna29, &
& cdna30, cdna31, cdna32, cdna33, cdna34, cdna35, cdna36, &
- & cdna37, cdna38, cdna39, cdna40
+ & cdna37, cdna38, cdna39, cdna40, cdna41, cdna42, cdna43, &
+ & cdna44, cdna45, cdna46, cdna47, cdna48
REAL(PRECISION) , INTENT(in ) :: psgn1 ! sign used across the north fold
REAL(PRECISION) , OPTIONAL , INTENT(in ) :: psgn2 , psgn3 , psgn4 , psgn5 , psgn6 , psgn7 , psgn8 , &
& psgn9 , psgn10, psgn11, psgn12, psgn13, psgn14, psgn15, &
& psgn16, psgn17, psgn18, psgn19, psgn20, psgn21, psgn22, &
& psgn23, psgn24, psgn25, psgn26, psgn27, psgn28, psgn29, &
& psgn30, psgn31, psgn32, psgn33, psgn34, psgn35, psgn36, &
- & psgn37, psgn38, psgn39, psgn40
+ & psgn37, psgn38, psgn39, psgn40, psgn41, psgn42, psgn43, &
+ & psgn44, psgn45, psgn46, psgn47, psgn48
INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant)
REAL(PRECISION) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries)
LOGICAL, DIMENSION(8), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out
@@ -60,9 +65,9 @@
LOGICAL , OPTIONAL , INTENT(in ) :: ldfull ! .true. if we also update the last line of the inner domain
!!
INTEGER :: kfld ! number of elements that will be attributed
- TYPE(PTR_4d_/**/PRECISION), DIMENSION(40) :: ptab_ptr ! pointer array
- CHARACTER(len=1) , DIMENSION(40) :: cdna_ptr ! nature of ptab_ptr grid-points
- REAL(PRECISION) , DIMENSION(40) :: psgn_ptr ! sign used across the north fold boundary
+ TYPE(PTR_4d_/**/PRECISION), DIMENSION(48) :: ptab_ptr ! pointer array
+ CHARACTER(len=1) , DIMENSION(48) :: cdna_ptr ! nature of ptab_ptr grid-points
+ REAL(PRECISION) , DIMENSION(48) :: psgn_ptr ! sign used across the north fold boundary
!!---------------------------------------------------------------------
!
kfld = 0 ! initial array of pointer size
@@ -110,6 +115,14 @@
IF( PRESENT(psgn38) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt38, cdna38, psgn38, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
IF( PRESENT(psgn39) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt39, cdna39, psgn39, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
IF( PRESENT(psgn40) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt40, cdna40, psgn40, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+ IF( PRESENT(psgn41) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt41, cdna41, psgn41, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+ IF( PRESENT(psgn42) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt42, cdna42, psgn42, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+ IF( PRESENT(psgn43) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt43, cdna43, psgn43, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+ IF( PRESENT(psgn44) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt44, cdna44, psgn44, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+ IF( PRESENT(psgn45) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt45, cdna45, psgn45, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+ IF( PRESENT(psgn46) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt46, cdna46, psgn46, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+ IF( PRESENT(psgn47) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt47, cdna47, psgn47, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+ IF( PRESENT(psgn48) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt48, cdna48, psgn48, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
!
IF( nn_comm == 1 ) THEN
CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ld4only, ldfull )
diff --git a/src/OCE/USR/usrdef_zgr.F90 b/src/OCE/USR/usrdef_zgr.F90
index 4523a2fff3d193b690b04211c7c76ff3ae602f76..47dfff1e4fd9538f267fc4934ecf2a7b5f6f08f0 100644
--- a/src/OCE/USR/usrdef_zgr.F90
+++ b/src/OCE/USR/usrdef_zgr.F90
@@ -38,23 +38,23 @@ CONTAINS
SUBROUTINE usr_def_zgr( ld_zco , ld_zps , ld_sco , ld_isfcav, & ! type of vertical coordinate
& k_top , k_bot , & ! top & bottom ocean level
& pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d , & ! 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f , & ! 3D t-level vertical scale factors
& pdept , pdepw , & ! 3D t & w-points depth
- & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw ) ! - - -
+ & pe3w , pe3uw , pe3vw ) ! 3D w-level vertical scale factors
!!---------------------------------------------------------------------
!! *** ROUTINE usr_def_zgr ***
!!
!! ** Purpose : User defined the vertical coordinates
!!
!!----------------------------------------------------------------------
- LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
- LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
- INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
- REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
+ LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
+ LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
+ INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! t-level vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pdept, pdepw ! grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3w , pe3uw, pe3vw ! w-level vertical scale factors [m]
!!----------------------------------------------------------------------
!
IF(lwp) WRITE(numout,*)
@@ -76,11 +76,16 @@ CONTAINS
!
CALL zgr_msk_top_bot( k_top , k_bot ) ! masked top and bottom ocean t-level indices
!
- IF( PRESENT( pe3t ) ) THEN ! z-coordinate (3D arrays) from the 1D z-coord.
- CALL zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d, & ! in : 1D reference vertical coordinate
- & pdept , pdepw , & ! out : 3D t & w-points depth
- & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw ) ! - - -
+ IF( lk_vco_1d3d ) THEN ! z-coordinate (3D arrays) from the 1D z-coord.
+ CALL zgr_zco_1d3d( pe3t_1d, & ! in : 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f ) ! out : 3D vertical scale factors at t-level
+ ENDIF
+ !
+ IF( lk_vco_3d ) THEN ! z-coordinate (3D arrays) from the 1D z-coord.
+ CALL zgr_zco_3d( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d, & ! in : 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f , & ! out : 3D vertical scale factors at t-level
+ & pdept , pdepw , & ! 3D t & w-points depth
+ & pe3w , pe3uw , pe3vw ) ! 3D vertical scale factors at w-level
ENDIF
!
END SUBROUTINE usr_def_zgr
@@ -203,10 +208,10 @@ CONTAINS
END SUBROUTINE zgr_msk_top_bot
- SUBROUTINE zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d, & ! in : 1D reference vertical coordinate
- & pdept , pdepw , & ! out: 3D t & w-points depth
- & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw ) ! - - -
+ SUBROUTINE zgr_zco_3d( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d, & ! in : 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f , & ! out: 3D vertical scale factors at t-level
+ & pdept , pdepw , & ! 3D t & w-points depth
+ & pe3w , pe3uw , pe3vw ) ! 3D vertical scale factors at w-level
!!----------------------------------------------------------------------
!! *** ROUTINE zgr_zco ***
!!
@@ -216,13 +221,18 @@ CONTAINS
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(:) , INTENT(in ) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
REAL(wp), DIMENSION(:) , INTENT(in ) :: pe3t_1d , pe3w_1d ! 1D vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! - - -
+ REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3t , pe3u , pe3v , pe3f ! 3D vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdept, pdepw ! 3D grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! 3D vertical scale factors [m]
!
INTEGER :: jk
!!----------------------------------------------------------------------
!
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' zgr_zco_3d : defines depths and scale-factors.'
+ IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
+ IF(lwp) WRITE(numout,*) ' GYRE case : uniform'
+ !
DO jk = 1, jpk
pdept(:,:,jk) = pdept_1d(jk)
pdepw(:,:,jk) = pdepw_1d(jk)
@@ -235,7 +245,37 @@ CONTAINS
pe3vw(:,:,jk) = pe3w_1d (jk)
END DO
!
- END SUBROUTINE zgr_zco
+ END SUBROUTINE zgr_zco_3d
+
+
+ SUBROUTINE zgr_zco_1d3d( pe3t_1d, & ! in : 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f ) ! out: vertical scale factors
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE zgr_zco ***
+ !!
+ !! ** Purpose : define the reference z-coordinate system
+ !!
+ !! ** Method : set 3D coord. arrays to reference 1D array
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(:) , INTENT(in ) :: pe3t_1d ! 1D vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3t , pe3u , pe3v , pe3f ! 3D vertical scale factors [m]
+ !
+ INTEGER :: jk
+ !!----------------------------------------------------------------------
+ !
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' zgr_zco_1d3d : defines t-level scale-factors.'
+ IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~'
+ IF(lwp) WRITE(numout,*) ' GYRE case : uniform'
+ !
+ DO jk = 1, jpk
+ pe3t(:,:,jk) = pe3t_1d (jk)
+ pe3u(:,:,jk) = pe3t_1d (jk)
+ pe3v(:,:,jk) = pe3t_1d (jk)
+ pe3f(:,:,jk) = pe3t_1d (jk)
+ END DO
+ !
+ END SUBROUTINE zgr_zco_1d3d
!!======================================================================
END MODULE usrdef_zgr
diff --git a/src/TOP/trcnam.F90 b/src/TOP/trcnam.F90
index 80a181e055938ffbb7c1649e105369158c6def10..a2ef9a33bbbfe3d7d2c08b35350d7274f0acedac 100644
--- a/src/TOP/trcnam.F90
+++ b/src/TOP/trcnam.F90
@@ -62,16 +62,12 @@ CONTAINS
!
!
IF(lwp) THEN ! control print
+ WRITE(numout,*)
IF( ln_rsttr ) THEN
- WRITE(numout,*)
WRITE(numout,*) ' ==>>> Read a restart file for passive tracer : ', TRIM( cn_trcrst_in )
- ENDIF
- IF( ln_trcdta .AND. .NOT.ln_rsttr ) THEN
- WRITE(numout,*)
+ ELSE IF( ln_trcdta ) THEN
WRITE(numout,*) ' ==>>> Some of the passive tracers are initialised from climatologies '
- ENDIF
- IF( .NOT.ln_trcdta ) THEN
- WRITE(numout,*)
+ ELSE
WRITE(numout,*) ' ==>>> All the passive tracers are initialised with constant values '
ENDIF
ENDIF
diff --git a/tests/BENCH/MY_SRC/usrdef_zgr.F90 b/tests/BENCH/MY_SRC/usrdef_zgr.F90
index 1f601c214d86d2567e4e3cf840c54463f6c64764..c95eb6df7cd647158950dee2f35aa85da0a63fb1 100644
--- a/tests/BENCH/MY_SRC/usrdef_zgr.F90
+++ b/tests/BENCH/MY_SRC/usrdef_zgr.F90
@@ -39,20 +39,20 @@ CONTAINS
SUBROUTINE usr_def_zgr( ld_zco , ld_zps , ld_sco , ld_isfcav, & ! type of vertical coordinate
& k_top , k_bot , & ! top & bottom ocean level
& pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d , & ! 1D reference vertical coordinate
- & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
+ & pe3t , pe3u , pe3v , pe3f , & ! 3D vertical scale factors at t-level
& pdept , pdepw , & ! 3D t & w-points depth
- & pe3w , pe3uw , pe3vw ) ! vertical scale factors
+ & pe3w , pe3uw , pe3vw ) ! 3D vertical scale factors at w-level
!!---------------------------------------------------------------------
!! *** ROUTINE usr_def_zgr ***
!!
!! ** Purpose : User defined the vertical coordinates
!!
!!----------------------------------------------------------------------
- LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
- LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
- INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
- REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
+ LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
+ LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
+ INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pdept, pdepw ! grid-point depth [m]
REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
@@ -77,11 +77,16 @@ CONTAINS
!
CALL zgr_msk_top_bot( k_top , k_bot ) ! masked top and bottom ocean t-level indices
!
- IF( PRESENT( pe3t ) ) THEN ! z-coordinate (3D arrays) from the 1D z-coord.
- CALL zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d, & ! in : 1D reference vertical coordinate
- & pdept , pdepw , & ! out : 3D t & w-points depth
- & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw ) ! - - -
+ IF( lk_vco_1d3d ) THEN ! z-coordinate (3D arrays) from the 1D z-coord.
+ CALL zgr_zco_1d3d( pe3t_1d, & ! in : 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f ) ! out : 3D vertical scale factors at t-level
+ ENDIF
+ !
+ IF( lk_vco_3d ) THEN ! z-coordinate (3D arrays) from the 1D z-coord.
+ CALL zgr_zco_3d( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d, & ! in : 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f , & ! out : 3D vertical scale factors at t-level
+ & pdept , pdepw , & ! 3D t & w-points depth
+ & pe3w , pe3uw , pe3vw ) ! 3D vertical scale factors at w-level
ENDIF
!
END SUBROUTINE usr_def_zgr
@@ -213,10 +218,10 @@ CONTAINS
END SUBROUTINE zgr_msk_top_bot
- SUBROUTINE zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d, & ! in : 1D reference vertical coordinate
- & pdept , pdepw , & ! out: 3D t & w-points depth
- & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw ) ! - - -
+ SUBROUTINE zgr_zco_3d( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d, & ! in : 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f , & ! out: 3D vertical scale factors at t-level
+ & pdept , pdepw , & ! 3D t & w-points depth
+ & pe3w , pe3uw , pe3vw ) ! 3D vertical scale factors at w-level
!!----------------------------------------------------------------------
!! *** ROUTINE zgr_zco ***
!!
@@ -226,13 +231,18 @@ CONTAINS
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(:) , INTENT(in ) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
REAL(wp), DIMENSION(:) , INTENT(in ) :: pe3t_1d , pe3w_1d ! 1D vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! - - -
+ REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3t , pe3u , pe3v , pe3f ! 3D vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdept, pdepw ! 3D grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! 3D vertical scale factors [m]
!
INTEGER :: jk
!!----------------------------------------------------------------------
!
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' zgr_zco_3d : defines depths and scale-factors.'
+ IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
+ IF(lwp) WRITE(numout,*) ' BENCH case : uniform'
+ !
DO jk = 1, jpk
pdept(:,:,jk) = pdept_1d(jk)
pdepw(:,:,jk) = pdepw_1d(jk)
@@ -245,7 +255,37 @@ CONTAINS
pe3vw(:,:,jk) = pe3w_1d (jk)
END DO
!
- END SUBROUTINE zgr_zco
+ END SUBROUTINE zgr_zco_3d
+
+
+ SUBROUTINE zgr_zco_1d3d( pe3t_1d, & ! in : 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f ) ! out: vertical scale factors
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE zgr_zco ***
+ !!
+ !! ** Purpose : define the reference z-coordinate system
+ !!
+ !! ** Method : set 3D coord. arrays to reference 1D array
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(:) , INTENT(in ) :: pe3t_1d ! 1D vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3t , pe3u , pe3v , pe3f ! 3D vertical scale factors [m]
+ !
+ INTEGER :: jk
+ !!----------------------------------------------------------------------
+ !
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' zgr_zco_1d3d : defines t-level scale-factors.'
+ IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~'
+ IF(lwp) WRITE(numout,*) ' BENCH case : uniform'
+ !
+ DO jk = 1, jpk
+ pe3t(:,:,jk) = pe3t_1d (jk)
+ pe3u(:,:,jk) = pe3t_1d (jk)
+ pe3v(:,:,jk) = pe3t_1d (jk)
+ pe3f(:,:,jk) = pe3t_1d (jk)
+ END DO
+ !
+ END SUBROUTINE zgr_zco_1d3d
!!======================================================================
END MODULE usrdef_zgr
diff --git a/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90 b/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90
index c1d0b976524ec0e85b9bc2ea9354feff39231098..01e1aa4e951d7e39ddebd7b46f3959af77b45aca 100644
--- a/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90
+++ b/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90
@@ -13,7 +13,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
!
@@ -83,10 +82,6 @@ CONTAINS
WRITE(numout,*) 'usr_def_nam : read the user defined namelist (namusr_def) in namelist_cfg'
WRITE(numout,*) '~~~~~~~~~~~ '
WRITE(numout,*) ' Namelist namusr_def : C1 case'
- WRITE(numout,*) ' type of vertical coordinate : '
- WRITE(numout,*) ' z-coordinate flag ln_zco = ', ln_zco
- WRITE(numout,*) ' z-partial-step coordinate flag ln_zps = ', ln_zps
- WRITE(numout,*) ' s-coordinate flag ln_sco = ', ln_sco
WRITE(numout,*) ' C1D domain = 1 x 1 x 75 grid-points '
WRITE(numout,*) ' resulting global domain size : jpiglo = ', kpi
WRITE(numout,*) ' jpjglo = ', kpj
diff --git a/tests/C1D_ASICS/MY_SRC/usrdef_zgr.F90 b/tests/C1D_ASICS/MY_SRC/usrdef_zgr.F90
index 645bb83566b72865ce5f45af57b2be4f91bd9260..aa5eb7986a06ace380f6fb5cc522054052800d4b 100644
--- a/tests/C1D_ASICS/MY_SRC/usrdef_zgr.F90
+++ b/tests/C1D_ASICS/MY_SRC/usrdef_zgr.F90
@@ -36,28 +36,28 @@ MODULE usrdef_zgr
!! $Id: usrdef_zgr.F90 13295 2020-07-10 18:24:21Z acc $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
-CONTAINS
-
+CONTAINS
+
SUBROUTINE usr_def_zgr( ld_zco , ld_zps , ld_sco , ld_isfcav, & ! type of vertical coordinate
+ & k_top , k_bot , & ! top & bottom ocean level
& pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d , & ! 1D reference vertical coordinate
- & pdept , pdepw , & ! 3D t & w-points depth
& pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw , & ! - - -
- & k_top , k_bot ) ! top & bottom ocean level
+ & pdept , pdepw , & ! 3D t & w-points depth
+ & pe3w , pe3uw , pe3vw ) ! vertical scale factors
!!---------------------------------------------------------------------
!! *** ROUTINE usr_def_zgr ***
!!
!! ** Purpose : User defined the vertical coordinates
!!
!!----------------------------------------------------------------------
- LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
- LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
- REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
- INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
+ LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
+ INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pdept, pdepw ! grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
!
INTEGER :: ji, jj, jk ! dummy indices
INTEGER :: ik ! local integers
@@ -148,34 +148,34 @@ CONTAINS
!
! !* vertical coordinate system
DO jk = 1, jpk ! initialization to the reference z-coordinate
- pdept(:,:,jk) = pdept_1d(jk)
- pdepw(:,:,jk) = pdepw_1d(jk)
+!!st pdept(:,:,jk) = pdept_1d(jk)
+!!st pdepw(:,:,jk) = pdepw_1d(jk)
pe3t (:,:,jk) = pe3t_1d (jk)
pe3u (:,:,jk) = pe3t_1d (jk)
pe3v (:,:,jk) = pe3t_1d (jk)
pe3f (:,:,jk) = pe3t_1d (jk)
- pe3w (:,:,jk) = pe3w_1d (jk)
- pe3uw(:,:,jk) = pe3w_1d (jk)
- pe3vw(:,:,jk) = pe3w_1d (jk)
+!!st pe3w (:,:,jk) = pe3w_1d (jk)
+!!st pe3uw(:,:,jk) = pe3w_1d (jk)
+!!st pe3vw(:,:,jk) = pe3w_1d (jk)
END DO
! bottom scale factors and depth at T- and W-points
DO_2D( 1, 1, 1, 1 )
ik = k_bot(ji,jj)
- pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
- pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
+!!st pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
+ pe3t (ji,jj,ik ) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) - pdepw_1d(ik)
pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik )
!
- pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp
- pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
- pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) ! = pe3t (ji,jj,ik )
+!!st pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp
+!!st pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
+!!st pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) ! = pe3t (ji,jj,ik )
END_2D
! ! bottom scale factors and depth at U-, V-, UW and VW-points
! ! usually Computed as the minimum of neighbooring scale factors
pe3u (:,:,:) = pe3t(:,:,:) ! HERE C1D configuration :
pe3v (:,:,:) = pe3t(:,:,:) ! e3 increases with k-index
pe3f (:,:,:) = pe3t(:,:,:) ! so e3 minimum of (i,i+1) points is (i) point
- pe3uw(:,:,:) = pe3w(:,:,:) ! in j-direction e3v=e3t and e3f=e3v
- pe3vw(:,:,:) = pe3w(:,:,:) ! ==>> no need of lbc_lnk calls
+!!st pe3uw(:,:,:) = pe3w(:,:,:) ! in j-direction e3v=e3t and e3f=e3v
+!!st pe3vw(:,:,:) = pe3w(:,:,:) ! ==>> no need of lbc_lnk calls
!
!
END SUBROUTINE usr_def_zgr
diff --git a/tests/C1D_ASICS/cpp_C1D_ASICS.fcm b/tests/C1D_ASICS/cpp_C1D_ASICS.fcm
index 530b281ccae847d3fdb821b1c578a5fe39ce281b..6c7489696af99959faa86a17ae83e22e766be745 100644
--- a/tests/C1D_ASICS/cpp_C1D_ASICS.fcm
+++ b/tests/C1D_ASICS/cpp_C1D_ASICS.fcm
@@ -1 +1 @@
- bld::tool::fppkeys key_linssh key_xios
+ bld::tool::fppkeys key_linssh key_xios key_vco_1d3d
diff --git a/tests/CANAL/MY_SRC/usrdef_zgr.F90 b/tests/CANAL/MY_SRC/usrdef_zgr.F90
index 82d03f4329b7dc9318beab770fd1f768f8312fc7..9848d81355fc3494b0b2d2c7d4eeee18f8dd6741 100644
--- a/tests/CANAL/MY_SRC/usrdef_zgr.F90
+++ b/tests/CANAL/MY_SRC/usrdef_zgr.F90
@@ -79,12 +79,14 @@ CONTAINS
CALL zgr_msk_top_bot( k_top , k_bot ) ! masked top and bottom ocean t-level indices
!
!
+#if defined key_vco_3d
IF( PRESENT( pe3t ) ) THEN ! z-coordinate (3D arrays) from the 1D z-coord.
CALL zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d, & ! in : 1D reference vertical coordinate
& pdept , pdepw , & ! out : 3D t & w-points depth
& pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
& pe3w , pe3uw , pe3vw ) ! - - -
ENDIF
+#endif
!
END SUBROUTINE usr_def_zgr
diff --git a/tests/CPL_OASIS/cpp_CPL_OASIS.fcm b/tests/CPL_OASIS/cpp_CPL_OASIS.fcm
index 03025da82b8aceabcc067f2593519f39f77dfa1b..3101f31f34deed1fcc4c31a6e854d917d48158a2 100644
--- a/tests/CPL_OASIS/cpp_CPL_OASIS.fcm
+++ b/tests/CPL_OASIS/cpp_CPL_OASIS.fcm
@@ -1 +1 @@
-bld::tool::fppkeys key_si3 key_top key_xios key_oasis3 key_qco
+bld::tool::fppkeys key_si3 key_top key_xios key_oasis3 key_qco key_vco_3d
diff --git a/tests/DIA_GPU/cpp_DIA_GPU.fcm b/tests/DIA_GPU/cpp_DIA_GPU.fcm
index 0d5368c4acb16d017767427f1e6dbcc91f0e95c0..d97714411f9bdd07c4a74b11787f38cdda090bbb 100644
--- a/tests/DIA_GPU/cpp_DIA_GPU.fcm
+++ b/tests/DIA_GPU/cpp_DIA_GPU.fcm
@@ -1 +1 @@
-bld::tool::fppkeys key_si3 key_xios key_gpu key_qco
+bld::tool::fppkeys key_si3 key_xios key_gpu key_qco key_vco_3d
diff --git a/tests/DOME/MY_SRC/usrdef_zgr.F90 b/tests/DOME/MY_SRC/usrdef_zgr.F90
index 40bb48bd397c2ff01ad0ed15c626869ed284922e..0d4e2794ee695ab1db0e25772cd7970c81d12bff 100644
--- a/tests/DOME/MY_SRC/usrdef_zgr.F90
+++ b/tests/DOME/MY_SRC/usrdef_zgr.F90
@@ -35,27 +35,27 @@ MODULE usrdef_zgr
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
-
+
SUBROUTINE usr_def_zgr( ld_zco , ld_zps , ld_sco , ld_isfcav, & ! type of vertical coordinate
+ & k_top , k_bot , & ! top & bottom ocean level
& pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d , & ! 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
& pdept , pdepw , & ! 3D t & w-points depth
- & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw, & ! - - -
- & k_top , k_bot ) ! top & bottom ocean level
+ & pe3w , pe3uw , pe3vw ) ! vertical scale factors
!!---------------------------------------------------------------------
!! *** ROUTINE usr_def_zgr ***
!!
!! ** Purpose : User defined the vertical coordinates
!!
!!----------------------------------------------------------------------
- LOGICAL , INTENT(in ) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags ( read in namusr_def )
- LOGICAL , INTENT( out) :: ld_isfcav ! under iceshelf cavity flag
- REAL(wp), DIMENSION(:) , INTENT( out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:) , INTENT( out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! i-scale factors
- INTEGER , DIMENSION(:,:) , INTENT( out) :: k_top, k_bot ! first & last ocean level
+ LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
+ LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
+ INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pdept, pdepw ! grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
!
INTEGER :: ji, jj, jk ! dummy indices
INTEGER :: ik ! local integers
@@ -73,6 +73,7 @@ CONTAINS
! ---------------------------
! already set in usrdef_nam.F90 by reading the namusr_def namelist except for ISF
ld_isfcav = .FALSE.
+ ld_sco = .TRUE.
!
!
! Build the vertical coordinate system
diff --git a/tests/DOME/cpp_DOME.fcm b/tests/DOME/cpp_DOME.fcm
index 36212ce820bce9cdb63ac57d27a1a9ecebb7b67e..63c8f248df6412197ae383980fd285179ae59c26 100644
--- a/tests/DOME/cpp_DOME.fcm
+++ b/tests/DOME/cpp_DOME.fcm
@@ -1 +1 @@
- bld::tool::fppkeys key_xios key_agrif
+ bld::tool::fppkeys key_xios key_agrif key_vco_3d
diff --git a/tests/ICB/MY_SRC/usrdef_zgr.F90 b/tests/ICB/MY_SRC/usrdef_zgr.F90
index 602cf989fd97d6f9fa2417ddd3ec89fe3253164c..5f1cfd52e288a763cd5cb7ffb8a0383ee8fe0c49 100644
--- a/tests/ICB/MY_SRC/usrdef_zgr.F90
+++ b/tests/ICB/MY_SRC/usrdef_zgr.F90
@@ -31,27 +31,27 @@ MODULE usrdef_zgr
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
-
+
SUBROUTINE usr_def_zgr( ld_zco , ld_zps , ld_sco , ld_isfcav, & ! type of vertical coordinate
+ & k_top , k_bot , & ! top & bottom ocean level
& pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d , & ! 1D reference vertical coordinate
+ & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
& pdept , pdepw , & ! 3D t & w-points depth
- & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw, & ! - - -
- & k_top , k_bot ) ! top & bottom ocean level
+ & pe3w , pe3uw , pe3vw ) ! vertical scale factors
!!---------------------------------------------------------------------
!! *** ROUTINE usr_def_zgr ***
!!
!! ** Purpose : User defined the vertical coordinates
!!
!!----------------------------------------------------------------------
- LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
- LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
- REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
- INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
+ LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
+ INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pdept, pdepw ! grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
!
INTEGER :: jk, k_dz ! dummy indices
!!----------------------------------------------------------------------
diff --git a/tests/ICB/cpp_ICB.fcm b/tests/ICB/cpp_ICB.fcm
index 139a725f062fc59e0e85263f9396b400ff8c4a35..36aa934536085f5b155a5846dc081c2fd9a1afbd 100644
--- a/tests/ICB/cpp_ICB.fcm
+++ b/tests/ICB/cpp_ICB.fcm
@@ -1 +1 @@
- bld::tool::fppkeys key_xios key_qco
+ bld::tool::fppkeys key_xios key_qco key_vco_1d
diff --git a/tests/ICE_ADV1D/MY_SRC/usrdef_zgr.F90 b/tests/ICE_ADV1D/MY_SRC/usrdef_zgr.F90
index 559fdecfae5d5e5b4b74e940fab0cfbd533ff106..ea381ca2b9c7b8ba049099e16d92e65946c3a60c 100644
--- a/tests/ICE_ADV1D/MY_SRC/usrdef_zgr.F90
+++ b/tests/ICE_ADV1D/MY_SRC/usrdef_zgr.F90
@@ -91,6 +91,16 @@ CONTAINS
!!jpkm1 = jpk
k_bot(:,:) = 1 ! here use k_top as a land mask
! !* horizontally uniform coordinate (reference z-co everywhere)
+#if defined key_vco_1d3d
+ DO jk = 1, jpk
+ pe3t (:,:,jk) = pe3t_1d (jk)
+ pe3u (:,:,jk) = pe3t_1d (jk)
+ pe3v (:,:,jk) = pe3t_1d (jk)
+ pe3f (:,:,jk) = pe3t_1d (jk)
+ END DO
+#endif
+ !
+#if defined key_vco_3d
DO jk = 1, jpk
pdept(:,:,jk) = pdept_1d(jk)
pdepw(:,:,jk) = pdepw_1d(jk)
@@ -102,6 +112,7 @@ CONTAINS
pe3uw(:,:,jk) = pe3w_1d (jk)
pe3vw(:,:,jk) = pe3w_1d (jk)
END DO
+#endif
!
END SUBROUTINE usr_def_zgr
diff --git a/tests/ICE_ADV2D/MY_SRC/usrdef_zgr.F90 b/tests/ICE_ADV2D/MY_SRC/usrdef_zgr.F90
index 5f64ec94bb3d468901932a353753e9a0b7aeeb78..c075d1fb204df0567e548e9954f7af163686a944 100644
--- a/tests/ICE_ADV2D/MY_SRC/usrdef_zgr.F90
+++ b/tests/ICE_ADV2D/MY_SRC/usrdef_zgr.F90
@@ -91,6 +91,16 @@ CONTAINS
!!clem jpkm1 = jpk
k_bot(:,:) = 1 ! here use k_top as a land mask
! !* horizontally uniform coordinate (reference z-co everywhere)
+#if defined key_vco_1d3d
+ DO jk = 1, jpk
+ pe3t (:,:,jk) = pe3t_1d (jk)
+ pe3u (:,:,jk) = pe3t_1d (jk)
+ pe3v (:,:,jk) = pe3t_1d (jk)
+ pe3f (:,:,jk) = pe3t_1d (jk)
+ END DO
+#endif
+ !
+#if defined key_vco_3d
DO jk = 1, jpk
pdept(:,:,jk) = pdept_1d(jk)
pdepw(:,:,jk) = pdepw_1d(jk)
@@ -102,6 +112,7 @@ CONTAINS
pe3uw(:,:,jk) = pe3w_1d (jk)
pe3vw(:,:,jk) = pe3w_1d (jk)
END DO
+#endif
!
END SUBROUTINE usr_def_zgr
diff --git a/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90 b/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90
index dba8b61430f57b930cef426425cf53133057cd33..b99625de05d30981627258895711e45a648abb62 100644
--- a/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90
+++ b/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90
@@ -34,27 +34,27 @@ MODULE usrdef_zgr
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
-
+
SUBROUTINE usr_def_zgr( ld_zco , ld_zps , ld_sco , ld_isfcav, & ! type of vertical coordinate
+ & k_top , k_bot , & ! top & bottom ocean level
& pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d , & ! 1D reference vertical coordinate
- & pdept , pdepw , & ! 3D t & w-points depth
& pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw , & ! - - -
- & k_top , k_bot ) ! top & bottom ocean level
+ & pdept , pdepw , & ! 3D t & w-points depth
+ & pe3w , pe3uw , pe3vw ) ! vertical scale factors
!!---------------------------------------------------------------------
!! *** ROUTINE usr_def_zgr ***
!!
!! ** Purpose : User defined the vertical coordinates
!!
!!----------------------------------------------------------------------
- LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
- LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
- REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
- INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
+ LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
+ INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pdept, pdepw ! grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
!!----------------------------------------------------------------------
!
IF(lwp) WRITE(numout,*)
@@ -75,6 +75,7 @@ CONTAINS
pe3t_1d(1) = 2._wp*rn_dept1
pe3w_1d(1) = rn_dept1 ! LB???
+#if defined key_vco_3d
pdept(:,:,1) = rn_dept1
pdepw(:,:,1) = 0._wp
pe3t(:,:,1) = 2._wp*rn_dept1
@@ -84,13 +85,14 @@ CONTAINS
pe3w(:,:,1) = rn_dept1 ! LB???
pe3uw(:,:,1) = rn_dept1 ! LB???
pe3vw(:,:,1) = rn_dept1 ! LB???
-
+#endif
!! 2nd level, technically useless (only for the sake of code stability)
pdept_1d(2) = 3._wp*rn_dept1
pdepw_1d(2) = 2._wp*rn_dept1
pe3t_1d(2) = 2._wp*rn_dept1
pe3w_1d(2) = 2._wp*rn_dept1
+#if defined key_vco_3d
pdept(:,:,2) = 3._wp*rn_dept1
pdepw(:,:,2) = 2._wp*rn_dept1
pe3t(:,:,2) = 2._wp*rn_dept1
@@ -100,7 +102,7 @@ CONTAINS
pe3w(:,:,2) = 2._wp*rn_dept1
pe3uw(:,:,2) = 2._wp*rn_dept1
pe3vw(:,:,2) = 2._wp*rn_dept1
-
+#endif
k_top = 1
k_bot = 1
diff --git a/tests/STATION_ASF/cpp_STATION_ASF.fcm b/tests/STATION_ASF/cpp_STATION_ASF.fcm
index de2973e758b848901b6d4f965662183c38c121f6..cba7a91b9fc882bc1bae553f27694c967e279ddb 100644
--- a/tests/STATION_ASF/cpp_STATION_ASF.fcm
+++ b/tests/STATION_ASF/cpp_STATION_ASF.fcm
@@ -1 +1 @@
- bld::tool::fppkeys key_si3 key_qco key_xios
+ bld::tool::fppkeys key_si3 key_qco key_xios key_vco_1d
diff --git a/tests/TSUNAMI/MY_SRC/stpmlf.F90 b/tests/TSUNAMI/MY_SRC/stpmlf.F90
index 203f2977aed4316aa04571f01a311095e3061ae2..a5c60be853024c63492e42d25dfee282679c9830 100644
--- a/tests/TSUNAMI/MY_SRC/stpmlf.F90
+++ b/tests/TSUNAMI/MY_SRC/stpmlf.F90
@@ -141,7 +141,7 @@ CONTAINS
ENDIF
uu(:,:,:,Nrhs) = 0._wp ! set dynamics trends to zero
vv(:,:,:,Nrhs) = 0._wp
- CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa, 1 ) ! surface pressure gradient
+ CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa ) ! surface pressure gradient
CALL iom_put( "ssh" , ssh(:,:,Nnn) ) ! sea surface height
! Swap time levels
Nrhs = Nbb
diff --git a/tests/TSUNAMI/MY_SRC/usrdef_zgr.F90 b/tests/TSUNAMI/MY_SRC/usrdef_zgr.F90
index d942a2205b4ec11002251320c5a10cd8ec9ca9b8..5c91a8b1e64bd13393eee5454014246e067fd605 100644
--- a/tests/TSUNAMI/MY_SRC/usrdef_zgr.F90
+++ b/tests/TSUNAMI/MY_SRC/usrdef_zgr.F90
@@ -35,32 +35,28 @@ MODULE usrdef_zgr
!! $Id: usrdef_zgr.F90 13472 2020-09-16 13:05:19Z smasson $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
-CONTAINS
-
+CONTAINS
+
SUBROUTINE usr_def_zgr( ld_zco , ld_zps , ld_sco , ld_isfcav, & ! type of vertical coordinate
+ & k_top , k_bot , & ! top & bottom ocean level
& pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d , & ! 1D reference vertical coordinate
- & pdept , pdepw , & ! 3D t & w-points depth
& pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw , & ! - - -
- & k_top , k_bot ) ! top & bottom ocean level
+ & pdept , pdepw , & ! 3D t & w-points depth
+ & pe3w , pe3uw , pe3vw ) ! vertical scale factors
!!---------------------------------------------------------------------
!! *** ROUTINE usr_def_zgr ***
!!
!! ** Purpose : User defined the vertical coordinates
!!
!!----------------------------------------------------------------------
- LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
- LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
- REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
- INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
- !
- INTEGER :: inum ! local logical unit
- REAL(WP) :: z_zco, z_zps, z_sco, z_cav
- REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace
+ LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
+ LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
+ INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pdept, pdepw ! grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
!!----------------------------------------------------------------------
!
IF(lwp) WRITE(numout,*)
@@ -82,11 +78,13 @@ CONTAINS
!
CALL zgr_msk_top_bot( k_top , k_bot ) ! masked top and bottom ocean t-level indices
!
+#if defined key_vco_3d
! ! z-coordinate (3D arrays) from the 1D z-coord.
CALL zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d, & ! in : 1D reference vertical coordinate
& pdept , pdepw , & ! out : 3D t & w-points depth
& pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
& pe3w , pe3uw , pe3vw ) ! - - -
+#endif
!
END SUBROUTINE usr_def_zgr
diff --git a/tests/TSUNAMI/cpp_TSUNAMI.fcm b/tests/TSUNAMI/cpp_TSUNAMI.fcm
index 5c436217addfbd4f538c66ee14a62241907850fc..98315fea6dd9f40a60eec613144efcfc7c3fb8f8 100644
--- a/tests/TSUNAMI/cpp_TSUNAMI.fcm
+++ b/tests/TSUNAMI/cpp_TSUNAMI.fcm
@@ -1 +1 @@
- bld::tool::fppkeys key_qco key_xios
+ bld::tool::fppkeys key_qco key_xios key_vco_1d
diff --git a/tests/WAD/MY_SRC/usrdef_zgr.F90 b/tests/WAD/MY_SRC/usrdef_zgr.F90
index 3af894e85f6f7f40a00cabb3f43cfccfd95028b2..c6f38bd6c01dcd8ec4679231c7a04400ad47f5da 100644
--- a/tests/WAD/MY_SRC/usrdef_zgr.F90
+++ b/tests/WAD/MY_SRC/usrdef_zgr.F90
@@ -37,25 +37,25 @@ MODULE usrdef_zgr
CONTAINS
SUBROUTINE usr_def_zgr( ld_zco , ld_zps , ld_sco , ld_isfcav, & ! type of vertical coordinate
+ & k_top , k_bot , & ! top & bottom ocean level
& pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d , & ! 1D reference vertical coordinate
- & pdept , pdepw , & ! 3D t & w-points depth
& pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw , & ! - - -
- & k_top , k_bot ) ! top & bottom ocean level
+ & pdept , pdepw , & ! 3D t & w-points depth
+ & pe3w , pe3uw , pe3vw ) ! vertical scale factors
!!---------------------------------------------------------------------
!! *** ROUTINE usr_def_zgr ***
!!
!! ** Purpose : User defined the vertical coordinates
!!
!!----------------------------------------------------------------------
- LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
- LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
- REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
- INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags
+ LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag
+ INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pdept, pdepw ! grid-point depth [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
!
INTEGER :: ji, jj, jk ! dummy indices
INTEGER :: ik ! local integers
diff --git a/tests/WAD/cpp_WAD.fcm b/tests/WAD/cpp_WAD.fcm
index 139a725f062fc59e0e85263f9396b400ff8c4a35..792d99090f36ee0c040a6d9f4d6561cc35772ddd 100644
--- a/tests/WAD/cpp_WAD.fcm
+++ b/tests/WAD/cpp_WAD.fcm
@@ -1 +1 @@
- bld::tool::fppkeys key_xios key_qco
+ bld::tool::fppkeys key_xios key_qco key_vco_3d