diff --git a/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg b/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg
index 9a86b2dd4e0dc08ade1b465317cdb36e5c6ea11a..fb7cc82244b1e374e61e1f2418b52c68aa5c4b0f 100644
--- a/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg
+++ b/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg
@@ -30,12 +30,13 @@
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
!
rn_Dt = 5400. ! time step for the dynamics and tracer
+ ln_meshmask = .false. ! =T create a mesh file
/
!-----------------------------------------------------------------------
&namcfg ! parameters of the configuration (default: user defined GYRE)
!-----------------------------------------------------------------------
ln_read_cfg = .true. ! (=T) read the domain configuration file
- cn_domcfg = "ORCA_R2_zps_domcfg_agrif" ! domain configuration filename
+ cn_domcfg = "domain_cfg.nc" ! domain configuration filename
!
ln_closea = .false. ! F => suppress closed seas (defined by closea_mask field)
! ! from the bathymetry at runtime.
diff --git a/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg b/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg
index 28e26498ef03fd9e3a4c2a71120f1a3294ebb06a..ed652bd07d82e67edda89f63269bbf7241f86ea0 100644
--- a/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg
+++ b/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg
@@ -31,12 +31,13 @@
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
!
rn_Dt = 1350. ! time step for the dynamics (and tracer if nn_acc=0)
+ ln_meshmask = .false. ! =T create a mesh file
/
!-----------------------------------------------------------------------
&namcfg ! parameters of the configuration (default: user defined GYRE)
!-----------------------------------------------------------------------
ln_read_cfg = .true. ! (=T) read the domain configuration file
- cn_domcfg = "ORCA_R05_zps_domcfg_agrif" ! domain configuration filename
+ cn_domcfg = "domain_cfg.nc" ! domain configuration filename
/
!-----------------------------------------------------------------------
&namtile ! parameters of the tiling
diff --git a/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg b/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg
index 1d0ac4d10a0a7e24dfaa5c70aeb4fe4b626b1aa3..4b74ffed5fa3efe0875aa6974611b577e395a3b5 100644
--- a/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg
+++ b/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg
@@ -30,13 +30,14 @@
!-----------------------------------------------------------------------
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
!
- rn_Dt = 450. ! time step for the dynamics (and tracer if nn_acc=0)
+ rn_Dt = 450. ! time step for the dynamics (and tracer if nn_acc=0)
+ ln_meshmask = .false. ! =T create a mesh file
/
!-----------------------------------------------------------------------
&namcfg ! parameters of the configuration (default: user defined GYRE)
!-----------------------------------------------------------------------
ln_read_cfg = .true. ! (=T) read the domain configuration file
- cn_domcfg = "ORCA_R017_zps_domcfg_agrif" ! domain configuration filename
+ cn_domcfg = "domain_cfg.nc" ! domain configuration filename
/
!-----------------------------------------------------------------------
&namtile ! parameters of the tiling
@@ -154,6 +155,7 @@
&namagrif ! AGRIF zoom ("key_agrif")
!-----------------------------------------------------------------------
ln_init_chfrpar = .true. ! initialize child grids from parent
+ ln_vert_remap = .true. ! vertical remapping
/
!-----------------------------------------------------------------------
&namdrg ! top/bottom drag coefficient (default: NO selection)
diff --git a/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg b/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg
index 164d03076b1ac0373be8f9e93100eaf516c67ba3..63973baf27a0c7fdef34c341cbe6e2d22a3b3853 100644
--- a/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg
+++ b/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg
@@ -30,12 +30,13 @@
ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
!
rn_Dt = 5400. ! time step for the dynamics and tracer
+ ln_meshmask = .false. ! =T create a mesh file
/
!-----------------------------------------------------------------------
&namcfg ! parameters of the configuration (default: use namusr_def in namelist_cfg)
!-----------------------------------------------------------------------
ln_read_cfg = .true. ! (=T) read the domain configuration file
- cn_domcfg = "ORCA_R2_zps_domcfg_agrif" ! domain configuration filename
+ cn_domcfg = "domain_cfg.nc" ! domain configuration filename
!
ln_closea = .false. ! F => suppress closed seas (defined by closea_mask field)
! ! from the bathymetry at runtime.
diff --git a/cfgs/SHARED/namelist_ref b/cfgs/SHARED/namelist_ref
index 5a2400ff42a09b9cc5cbc31b098730e0de359497..31674026d3baecba5ce200124b1c99e82d9cc903 100644
--- a/cfgs/SHARED/namelist_ref
+++ b/cfgs/SHARED/namelist_ref
@@ -692,7 +692,7 @@
ln_agrif_2way = .true. ! activate two way nesting
ln_init_chfrpar = .false. ! initialize child grids from parent
ln_vert_remap = .false. ! use vertical remapping
- ln_spc_dyn = .true. ! use 0 as special value for dynamics
+ ln_spc_dyn = .false. ! use 0 as special value for dynamics
ln_chk_bathy = .true. ! =T check the parent bathymetry
rn_sponge_tra = 0.002 ! coefficient for tracer sponge layer []
rn_sponge_dyn = 0.002 ! coefficient for dynamics sponge layer []
diff --git a/ext/AGRIF/AGRIF_FILES/modtypes.F90 b/ext/AGRIF/AGRIF_FILES/modtypes.F90
index 6181de078971645b3f97a6ca06a924dbfcd3ef9f..3651d7bc1df1da5ec3049a94083f7414b5eda0b0 100644
--- a/ext/AGRIF/AGRIF_FILES/modtypes.F90
+++ b/ext/AGRIF/AGRIF_FILES/modtypes.F90
@@ -378,7 +378,7 @@ end type Agrif_Variables_List
integer :: Agrif_Regridding = 10
integer :: Agrif_Minwidth
real :: Agrif_Efficiency = 0.7
- integer :: MaxSearch = 5
+ integer :: MaxSearch = 10
real(kind=8), dimension(3) :: Agrif_mind
!> @}
!> \name parameters for the interpolation of the child grids
diff --git a/src/NST/agrif_oce.F90 b/src/NST/agrif_oce.F90
index c3a08d6792beb3ab0f9980a7d9fdc865163e5ac4..01d8034632dc960c82e8c04363a562fdc5837bd7 100644
--- a/src/NST/agrif_oce.F90
+++ b/src/NST/agrif_oce.F90
@@ -27,16 +27,24 @@ MODULE agrif_oce
REAL(wp), PUBLIC :: rn_sponge_dyn = 0.002 !: sponge coeff. for dynamics
REAL(wp), PUBLIC :: rn_trelax_tra = 0.01 !: time relaxation parameter for tracers
REAL(wp), PUBLIC :: rn_trelax_dyn = 0.01 !: time relaxation parameter for momentum
+ REAL(wp), PUBLIC :: rn_hcri = 0.05 !: minimum thickness (m) for flux blocking
+
LOGICAL , PUBLIC :: ln_chk_bathy = .FALSE. !: check of parent bathymetry
!
- INTEGER , PUBLIC, PARAMETER :: nn_sponge_len = 2 !: Sponge width (in number of parent grid points)
- INTEGER , PUBLIC, PARAMETER :: nn_shift_bar = 0 !: nb of coarse grid points by which we shift 2d interface
+ LOGICAL , PUBLIC :: l_spc_tra = .TRUE. !: turn on extrapolation for active tracers
+ LOGICAL , PUBLIC :: l_spc_ssh = .TRUE. !: turn on extrapolation for ssh
+ LOGICAL , PUBLIC :: l_spc_top = .TRUE. !: turn on extrapolation for passive tracers
+ !
+ INTEGER , PUBLIC, PARAMETER :: nn_sponge_len = 2 !: Sponge width (in number of parent grid points)
+ INTEGER , PUBLIC, PARAMETER :: nn_shift_bar = 0 !: nb of coarse grid points by which we shift 2d interface
+ INTEGER , PUBLIC, PARAMETER :: nn_dist_par_bc= 7 !: position of parent open boundary from dynamlical interface (2d mode bdy)
LOGICAL , PUBLIC :: spongedoneT = .FALSE. !: tracer sponge layer indicator
LOGICAL , PUBLIC :: spongedoneU = .FALSE. !: dynamics sponge layer indicator
LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE. !: if true: first step
LOGICAL , PUBLIC :: lk_agrif_debug = .FALSE. !: if true: print debugging info
- LOGICAL , PUBLIC :: lk_tint2d_notinterp = .FALSE. !: if true, no time interp
+ LOGICAL , PUBLIC :: lk_div_cons = .TRUE. !: if true, volume conserving formulation in ghost zone
+ LOGICAL , PUBLIC :: lk_tint2d_constant = .FALSE. !: Constant, conservative temporal interpolation of barotropic fluxes
LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_tsn
# if defined key_top
LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_trn
@@ -55,6 +63,7 @@ MODULE agrif_oce
INTEGER , PUBLIC, SAVE :: Kbb_a, Kmm_a, Krhs_a !: AGRIF module-specific copies of time-level indices
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht0_parent, hu0_parent, hv0_parent
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2t_frac, e2u_frac, e1v_frac
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t0_parent, e3u0_parent, e3v0_parent
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt_parent, mbku_parent, mbkv_parent
@@ -70,16 +79,18 @@ MODULE agrif_oce
# endif
INTEGER, PUBLIC :: unb_interp_id, vnb_interp_id, ub2b_interp_id, vb2b_interp_id
INTEGER, PUBLIC :: ub2b_update_id, vb2b_update_id, unb_update_id, vnb_update_id
- INTEGER, PUBLIC :: ub2b_cor_id, vb2b_cor_id
- INTEGER, PUBLIC :: e3t_id, sshn_id
+ INTEGER, PUBLIC :: ub2b_cor_id, vb2b_cor_id, sshn_id
+ INTEGER, PUBLIC :: sshn_frc_id
+ INTEGER, PUBLIC :: e3t_id, e3u_id, e3v_id, e3f_id
+ INTEGER, PUBLIC :: r3t_id, r3u_id, r3v_id, r3f_id
INTEGER, PUBLIC :: scales_t_id
INTEGER, PUBLIC :: avt_id, avm_id, en_id ! TKE related identificators
INTEGER, PUBLIC :: mbkt_id, ht0_id, e3t0_interp_id
+ INTEGER, PUBLIC :: e1e2t_frac_id, e2u_frac_id, e1v_frac_id
INTEGER, PUBLIC :: glamt_id, gphit_id
- INTEGER, PUBLIC :: batupd_id
INTEGER, PUBLIC :: kindic_agr
- ! North fold
+! Variables shared among grids:
!$AGRIF_DO_NOT_TREAT
LOGICAL, PUBLIC :: use_sign_north
REAL, PUBLIC :: sign_north
@@ -109,12 +120,14 @@ CONTAINS
& tabspongedone_tsn(jpi,jpj), &
& utint_stage(jpi,jpj), vtint_stage(jpi,jpj), &
# if defined key_top
- & tabspongedone_trn(jpi,jpj), &
+ & tabspongedone_trn(jpi,jpj), &
# endif
& ht0_parent(jpi,jpj), mbkt_parent(jpi,jpj), &
& hu0_parent(jpi,jpj), mbku_parent(jpi,jpj), &
& hv0_parent(jpi,jpj), mbkv_parent(jpi,jpj), &
- & tabspongedone_u (jpi,jpj), &
+ & e1e2t_frac(jpi,jpj), &
+ & e2u_frac(jpi,jpj), e1v_frac(jpi,jpj), &
+ & tabspongedone_u (jpi,jpj), &
& tabspongedone_v (jpi,jpj), STAT = ierr(1) )
ALLOCATE( ubdy(jpi,jpj), vbdy(jpi,jpj), hbdy(jpi,jpj), STAT = ierr(2) )
diff --git a/src/NST/agrif_oce_interp.F90 b/src/NST/agrif_oce_interp.F90
index 114023bff689a4f1beb1accf270f4a7b70389d41..4d4535e4a3a4834a507532f30f5bd751c4e12e68 100644
--- a/src/NST/agrif_oce_interp.F90
+++ b/src/NST/agrif_oce_interp.F90
@@ -1,3 +1,4 @@
+#define PARENT_EXT_BDY
MODULE agrif_oce_interp
!!======================================================================
!! *** MODULE agrif_oce_interp ***
@@ -45,6 +46,7 @@ MODULE agrif_oce_interp
PUBLIC interpunb, interpvnb , interpub2b, interpvb2b
PUBLIC interpglamt, interpgphit
PUBLIC interpht0, interpmbkt, interpe3t0_vremap
+ PUBLIC interp_e1e2t_frac, interp_e2u_frac, interp_e1v_frac
PUBLIC agrif_istate_oce, agrif_istate_ssh ! called by icestate.F90 and domvvl.F90
PUBLIC agrif_check_bat
@@ -53,7 +55,7 @@ MODULE agrif_oce_interp
!! * Substitutions
# include "domzgr_substitute.h90"
!! NEMO/NST 4.0 , NEMO Consortium (2018)
- !! $Id: agrif_oce_interp.F90 15437 2021-10-22 12:21:20Z jchanut $
+ !! $Id: agrif_oce_interp.F90 15119 2021-07-13 14:43:22Z jchanut $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -81,6 +83,7 @@ CONTAINS
l_ini_child = .TRUE.
Agrif_SpecialValue = 0.0_wp
Agrif_UseSpecialValue = .TRUE.
+ l_vremap = ln_vert_remap
ts(:,:,:,:,Kbb) = 0.0_wp
uu(:,:,:,Kbb) = 0.0_wp
@@ -99,6 +102,7 @@ CONTAINS
Agrif_UseSpecialValue = .FALSE.
l_ini_child = .FALSE.
+ l_vremap = .FALSE.
Krhs_a = Kaa ; Kmm_a = Kmm
@@ -114,7 +118,7 @@ CONTAINS
END SUBROUTINE Agrif_istate_oce
- SUBROUTINE Agrif_istate_ssh( Kbb, Kmm, Kaa )
+ SUBROUTINE Agrif_istate_ssh( Kbb, Kmm, Kaa, ghosts_only )
!!----------------------------------------------------------------------
!! *** ROUTINE agrif_istate_ssh ***
!!
@@ -124,6 +128,8 @@ CONTAINS
IMPLICIT NONE
!
INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
+ LOGICAL, INTENT(in), OPTIONAL :: ghosts_only
+ LOGICAL :: l_do_all
!!----------------------------------------------------------------------
IF(lwp) WRITE(numout,*) ' '
IF(lwp) WRITE(numout,*) 'Agrif_istate_ssh : interp child ssh from parent'
@@ -133,14 +139,20 @@ CONTAINS
IF ( .NOT.Agrif_Parent(l_1st_euler) ) &
& CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent')
+ l_do_all = .TRUE.
+ IF (present(ghosts_only)) l_do_all = .FALSE.
+
Krhs_a = Kbb ; Kmm_a = Kbb
!
Agrif_SpecialValue = 0._wp
Agrif_UseSpecialValue = .TRUE.
l_ini_child = .TRUE.
!
- ssh(:,:,Kbb) = 0._wp
- CALL Agrif_Init_Variable(sshini_id, procname=interpsshn)
+ IF (l_do_all) THEN
+ CALL Agrif_Init_Variable(sshini_id, procname=interpsshn)
+ ELSE
+ CALL Agrif_Bc_Variable(sshini_id, calledweight=1._wp, procname=interpsshn)
+ ENDIF
!
Agrif_UseSpecialValue = .FALSE.
l_ini_child = .FALSE.
@@ -163,7 +175,7 @@ CONTAINS
IF( Agrif_Root() ) RETURN
!
Agrif_SpecialValue = 0._wp
- Agrif_UseSpecialValue = .TRUE.
+ Agrif_UseSpecialValue = l_spc_tra
l_vremap = ln_vert_remap
!
CALL Agrif_Bc_variable( ts_interp_id, procname=interptsn )
@@ -180,9 +192,11 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt
!
- INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: ibdy1, jbdy1, ibdy2, jbdy2
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ INTEGER :: ibdy1, jbdy1, ibdy2, jbdy2
+ REAL(wp) :: zflag
REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb
+ REAL(wp), DIMENSION(jpi,jpj) :: zhub, zhvb
!!----------------------------------------------------------------------
!
IF( Agrif_Root() ) RETURN
@@ -227,35 +241,45 @@ CONTAINS
ENDIF
!
DO ji = mi0(ibdy1), mi1(ibdy2)
- zub(ji,:) = 0._wp
+ zub(ji,:) = 0._wp
+ zhub(ji,:) = 0._wp
DO jk = 1, jpkm1
DO jj = 1, jpj
- zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3u(ji,jj,jk,Krhs_a))
+ zub(ji,jj) = zub(ji,jj) + zflag * e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+ zhub(ji,jj) = zhub(ji,jj) + zflag * e3u(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
END DO
END DO
DO jj=1,jpj
- zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
+!! zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
+ zub(ji,jj) = zub(ji,jj) / ( zhub(ji,jj) + 1._wp - ssumask(ji,jj))
END DO
DO jk = 1, jpkm1
DO jj = 1, jpj
- uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3u(ji,jj,jk,Krhs_a))
+ uu(ji,jj,jk,Krhs_a) = zflag * ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
END DO
END DO
END DO
!
DO ji = mi0(ibdy1), mi1(ibdy2)
- zvb(ji,:) = 0._wp
+ zvb(ji,:) = 0._wp
+ zhvb(ji,:) = 0._wp
DO jk = 1, jpkm1
DO jj = 1, jpj
- zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3v(ji,jj,jk,Krhs_a))
+ zvb(ji,jj) = zvb(ji,jj) + zflag * e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
+ zhvb(ji,jj) = zhvb(ji,jj) + zflag * e3v(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
END DO
END DO
DO jj = 1, jpj
- zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
+!! zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
+ zvb(ji,jj) = zvb(ji,jj) / ( zhvb(ji,jj) + 1._wp - ssvmask(ji,jj))
END DO
DO jk = 1, jpkm1
DO jj = 1, jpj
- vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) )*vmask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3v(ji,jj,jk,Krhs_a))
+ vv(ji,jj,jk,Krhs_a) = zflag * ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) )*vmask(ji,jj,jk)
END DO
END DO
END DO
@@ -276,18 +300,23 @@ CONTAINS
ENDIF
!
DO ji = mi0(ibdy1), mi1(ibdy2)
- zub(ji,:) = 0._wp
+ zub(ji,:) = 0._wp
+ zhub(ji,:) = 0._wp
DO jk = 1, jpkm1
DO jj = 1, jpj
- zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3u(ji,jj,jk,Krhs_a))
+ zub(ji,jj) = zub(ji,jj) + zflag * e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+ zhub(ji,jj) = zhub(ji,jj) + zflag * e3u(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
END DO
END DO
DO jj=1,jpj
- zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
+!! zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
+ zub(ji,jj) = zub(ji,jj) / ( zhub(ji,jj) + 1._wp - ssumask(ji,jj))
END DO
DO jk = 1, jpkm1
DO jj = 1, jpj
- uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3u(ji,jj,jk,Krhs_a))
+ uu(ji,jj,jk,Krhs_a) = zflag * ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
END DO
END DO
END DO
@@ -304,18 +333,23 @@ CONTAINS
ENDIF
!
DO ji = mi0(ibdy1), mi1(ibdy2)
- zvb(ji,:) = 0._wp
+ zvb(ji,:) = 0._wp
+ zhvb(ji,:) = 0._wp
DO jk = 1, jpkm1
DO jj = 1, jpj
- zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3v(ji,jj,jk,Krhs_a))
+ zvb(ji,jj) = zvb(ji,jj) + zflag * e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
+ zhvb(ji,jj) = zhvb(ji,jj) + zflag * e3v(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
END DO
END DO
DO jj = 1, jpj
- zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
+!! zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
+ zvb(ji,jj) = zvb(ji,jj) / ( zhvb(ji,jj) + 1._wp - ssvmask(ji,jj))
END DO
DO jk = 1, jpkm1
DO jj = 1, jpj
- vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3v(ji,jj,jk,Krhs_a))
+ vv(ji,jj,jk,Krhs_a) = zflag * ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
END DO
END DO
END DO
@@ -338,34 +372,44 @@ CONTAINS
!
DO jj = mj0(jbdy1), mj1(jbdy2)
zvb(:,jj) = 0._wp
+ zhvb(:,jj) = 0._wp
DO jk=1,jpkm1
DO ji=1,jpi
- zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3v(ji,jj,jk,Krhs_a))
+ zvb(ji,jj) = zvb(ji,jj) + zflag * e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
+ zhvb(ji,jj) = zhvb(ji,jj) + zflag * e3v(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
END DO
END DO
DO ji = 1, jpi
- zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
+!! zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
+ zvb(ji,jj) = zvb(ji,jj) / ( zhvb(ji,jj) + 1._wp - ssvmask(ji,jj))
END DO
DO jk = 1, jpkm1
DO ji = 1, jpi
- vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3v(ji,jj,jk,Krhs_a))
+ vv(ji,jj,jk,Krhs_a) = zflag * ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
END DO
END DO
END DO
!
DO jj = mj0(jbdy1), mj1(jbdy2)
zub(:,jj) = 0._wp
+ zhub(:,jj) = 0._wp
DO jk = 1, jpkm1
DO ji = 1, jpi
- zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3u(ji,jj,jk,Krhs_a))
+ zub(ji,jj) = zub(ji,jj) + zflag * e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+ zhub(ji,jj) = zhub(ji,jj) + zflag * e3u(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
END DO
END DO
DO ji = 1, jpi
- zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
+!! zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
+ zub(ji,jj) = zub(ji,jj) / ( zhub(ji,jj) + 1._wp - ssumask(ji,jj))
END DO
DO jk = 1, jpkm1
DO ji = 1, jpi
- uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3u(ji,jj,jk,Krhs_a))
+ uu(ji,jj,jk,Krhs_a) = zflag * ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
END DO
END DO
END DO
@@ -387,17 +431,22 @@ CONTAINS
!
DO jj = mj0(jbdy1), mj1(jbdy2)
zvb(:,jj) = 0._wp
+ zhvb(:,jj) = 0._wp
DO jk=1,jpkm1
DO ji=1,jpi
- zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3v(ji,jj,jk,Krhs_a))
+ zvb(ji,jj) = zvb(ji,jj) + zflag * e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
+ zhvb(ji,jj) = zhvb(ji,jj) + zflag * e3v(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
END DO
END DO
DO ji = 1, jpi
- zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
+!! zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
+ zvb(ji,jj) = zvb(ji,jj) / ( zhvb(ji,jj) + 1._wp - ssvmask(ji,jj))
END DO
DO jk = 1, jpkm1
DO ji = 1, jpi
- vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3v(ji,jj,jk,Krhs_a))
+ vv(ji,jj,jk,Krhs_a) = zflag * ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
END DO
END DO
END DO
@@ -415,17 +464,22 @@ CONTAINS
!
DO jj = mj0(jbdy1), mj1(jbdy2)
zub(:,jj) = 0._wp
+ zhub(:,jj) = 0._wp
DO jk = 1, jpkm1
DO ji = 1, jpi
- zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3u(ji,jj,jk,Krhs_a))
+ zub(ji,jj) = zub(ji,jj) + zflag * e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
+ zhub(ji,jj) = zhub(ji,jj) + zflag * e3u(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
END DO
END DO
DO ji = 1, jpi
- zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
+ !!zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
+ zub(ji,jj) = zub(ji,jj) / ( zhub(ji,jj) + 1._wp - ssumask(ji,jj))
END DO
DO jk = 1, jpkm1
DO ji = 1, jpi
- uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
+ zflag = 0.5_wp - SIGN(0.5_wp, rn_hcri - e3u(ji,jj,jk,Krhs_a))
+ uu(ji,jj,jk,Krhs_a) = zflag * ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
END DO
END DO
END DO
@@ -445,70 +499,81 @@ CONTAINS
INTEGER :: istart, iend, jstart, jend
!!----------------------------------------------------------------------
!
- IF( Agrif_Root() ) RETURN
- !
- !--- West ---!
- IF( lk_west ) THEN
- istart = nn_hls + 2 ! halo + land + 1
- iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
- DO ji = mi0(istart), mi1(iend)
- DO jj=1,jpj
- va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
- ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
+ IF( Agrif_Root() ) THEN
+#if defined PARENT_EXT_BDY
+ ! Assume persistance for barotropic mode well inside overlapping zone
+ ua_e(:,:) = umask_upd(:,:) * uu_b(:,:,Kmm_a) &
+ & * hu(:,:,Kmm_a) * hur_e(:,:) &
+ & + (1._wp - umask_upd(:,:)) * ua_e(:,:)
+ va_e(:,:) = vmask_upd(:,:) * vv_b(:,:,Kmm_a) &
+ & * hv(:,:,Kmm_a) * hvr_e(:,:) &
+ & + (1._wp - vmask_upd(:,:)) * va_e(:,:)
+#endif
+ ELSE
+ !
+ !--- West ---!
+ IF( lk_west ) THEN
+ istart = nn_hls + 2 ! halo + land + 1
+ iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
+ DO ji = mi0(istart), mi1(iend)
+ DO jj=1,jpj
+ va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
+ ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
+ END DO
END DO
- END DO
- ENDIF
- !
- !--- East ---!
- IF( lk_east ) THEN
- istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()
- iend = jpiglo - ( nn_hls + 1 )
- DO ji = mi0(istart), mi1(iend)
-
- DO jj=1,jpj
- va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
+ ENDIF
+ !
+ !--- East ---!
+ IF( lk_east ) THEN
+ istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()
+ iend = jpiglo - ( nn_hls + 1 )
+ DO ji = mi0(istart), mi1(iend)
+
+ DO jj=1,jpj
+ va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
+ END DO
END DO
- END DO
- istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
- iend = jpiglo - ( nn_hls + 2 )
- DO ji = mi0(istart), mi1(iend)
- DO jj=1,jpj
- ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
+ istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
+ iend = jpiglo - ( nn_hls + 2 )
+ DO ji = mi0(istart), mi1(iend)
+ DO jj=1,jpj
+ ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
+ END DO
END DO
- END DO
- ENDIF
- !
- !--- South ---!
- IF( lk_south ) THEN
- jstart = nn_hls + 2
- jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
- DO jj = mj0(jstart), mj1(jend)
-
- DO ji=1,jpi
- ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
- va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
+ ENDIF
+ !
+ !--- South ---!
+ IF( lk_south ) THEN
+ jstart = nn_hls + 2
+ jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
+ DO jj = mj0(jstart), mj1(jend)
+
+ DO ji=1,jpi
+ ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
+ va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
+ END DO
END DO
- END DO
- ENDIF
- !
- !--- North ---!
- IF( lk_north ) THEN
- jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()
- jend = jpjglo - ( nn_hls + 1 )
- DO jj = mj0(jstart), mj1(jend)
- DO ji=1,jpi
- ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
+ ENDIF
+ !
+ !--- North ---!
+ IF( lk_north ) THEN
+ jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()
+ jend = jpjglo - ( nn_hls + 1 )
+ DO jj = mj0(jstart), mj1(jend)
+ DO ji=1,jpi
+ ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
+ END DO
END DO
- END DO
- jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
- jend = jpjglo - ( nn_hls + 2 )
- DO jj = mj0(jstart), mj1(jend)
- DO ji=1,jpi
- va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
+ jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
+ jend = jpjglo - ( nn_hls + 2 )
+ DO jj = mj0(jstart), mj1(jend)
+ DO ji=1,jpi
+ va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
+ END DO
END DO
- END DO
- ENDIF
- !
+ ENDIF
+ !
+ ENDIF
END SUBROUTINE Agrif_dyn_ts
@@ -523,66 +588,77 @@ CONTAINS
INTEGER :: istart, iend, jstart, jend
!!----------------------------------------------------------------------
!
- IF( Agrif_Root() ) RETURN
- !
- !--- West ---!
- IF( lk_west ) THEN
- istart = nn_hls + 2
- iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox()
- DO ji = mi0(istart), mi1(iend)
- DO jj=1,jpj
- zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
- zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
+ IF( Agrif_Root() ) THEN
+#if defined PARENT_EXT_BDY
+ ! Assume persistance for barotropic mode well inside overlapping zone
+ zu(:,:) = umask_upd(:,:) * uu_b(:,:,Kmm_a) &
+ & * hu(:,:,Kmm_a) * e2u(:,:) &
+ & + (1._wp - umask_upd(:,:)) * zu(:,:)
+ zv(:,:) = vmask_upd(:,:) * vv_b(:,:,Kmm_a) &
+ & * hv(:,:,Kmm_a) * e1v(:,:) &
+ & + (1._wp - vmask_upd(:,:)) * zv(:,:)
+#endif
+ ELSE
+ !
+ !--- West ---!
+ IF( lk_west ) THEN
+ istart = nn_hls + 2
+ iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox()
+ DO ji = mi0(istart), mi1(iend)
+ DO jj=1,jpj
+ zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
+ zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
+ END DO
END DO
- END DO
- ENDIF
- !
- !--- East ---!
- IF( lk_east ) THEN
- istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()
- iend = jpiglo - ( nn_hls + 1 )
- DO ji = mi0(istart), mi1(iend)
- DO jj=1,jpj
- zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
+ ENDIF
+ !
+ !--- East ---!
+ IF( lk_east ) THEN
+ istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()
+ iend = jpiglo - ( nn_hls + 1 )
+ DO ji = mi0(istart), mi1(iend)
+ DO jj=1,jpj
+ zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
+ END DO
END DO
- END DO
- istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
- iend = jpiglo - ( nn_hls + 2 )
- DO ji = mi0(istart), mi1(iend)
- DO jj=1,jpj
- zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
+ istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
+ iend = jpiglo - ( nn_hls + 2 )
+ DO ji = mi0(istart), mi1(iend)
+ DO jj=1,jpj
+ zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
+ END DO
END DO
- END DO
- ENDIF
- !
- !--- South ---!
- IF( lk_south ) THEN
- jstart = nn_hls + 2
- jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
- DO jj = mj0(jstart), mj1(jend)
- DO ji=1,jpi
- zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
- zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
+ ENDIF
+ !
+ !--- South ---!
+ IF( lk_south ) THEN
+ jstart = nn_hls + 2
+ jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
+ DO jj = mj0(jstart), mj1(jend)
+ DO ji=1,jpi
+ zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
+ zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
+ END DO
END DO
- END DO
- ENDIF
- !
- !--- North ---!
- IF( lk_north ) THEN
- jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()
- jend = jpjglo - ( nn_hls + 1 )
- DO jj = mj0(jstart), mj1(jend)
- DO ji=1,jpi
- zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
+ ENDIF
+ !
+ !--- North ---!
+ IF( lk_north ) THEN
+ jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()
+ jend = jpjglo - ( nn_hls + 1 )
+ DO jj = mj0(jstart), mj1(jend)
+ DO ji=1,jpi
+ zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
+ END DO
END DO
- END DO
- jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
- jend = jpjglo - ( nn_hls + 2 )
- DO jj = mj0(jstart), mj1(jend)
- DO ji=1,jpi
- zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
+ jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
+ jend = jpjglo - ( nn_hls + 2 )
+ DO jj = mj0(jstart), mj1(jend)
+ DO ji=1,jpi
+ zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
+ END DO
END DO
- END DO
+ ENDIF
ENDIF
!
END SUBROUTINE Agrif_dyn_ts_flux
@@ -606,7 +682,7 @@ CONTAINS
!
! Interpolate barotropic fluxes
Agrif_SpecialValue = 0._wp
- Agrif_UseSpecialValue = ln_spc_dyn
+ Agrif_UseSpecialValue = ln_spc_dyn
use_sign_north = .TRUE.
sign_north = -1.
@@ -617,13 +693,15 @@ CONTAINS
vtint_stage(:,:) = 0
!
IF( ll_int_cons ) THEN ! Conservative interpolation
- IF ( lk_tint2d_notinterp ) THEN
- Agrif_UseSpecialValue = .FALSE.
+ Agrif_UseSpecialValue = .FALSE. ! To ensure divergence conservation
+ !
+ IF ( lk_tint2d_constant ) THEN
CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b_const )
CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b_const )
! Divergence conserving correction terms:
- IF ( Agrif_Rhox()>1 ) CALL Agrif_Bc_variable( ub2b_cor_id, calledweight=1._wp, procname=ub2b_cor )
- IF ( Agrif_Rhoy()>1 ) CALL Agrif_Bc_variable( vb2b_cor_id, calledweight=1._wp, procname=vb2b_cor )
+! JC: Disable this until we found a workaround around masked corners:
+! IF ( Agrif_Rhox()>1 ) CALL Agrif_Bc_variable( ub2b_cor_id, calledweight=1._wp, procname=ub2b_cor )
+! IF ( Agrif_Rhoy()>1 ) CALL Agrif_Bc_variable( vb2b_cor_id, calledweight=1._wp, procname=vb2b_cor )
ELSE
! order matters here !!!!!!
CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated
@@ -643,8 +721,13 @@ CONTAINS
CALL Agrif_Bc_variable( unb_interp_id, procname=interpunb )
CALL Agrif_Bc_variable( vnb_interp_id, procname=interpvnb )
ENDIF
+ !
Agrif_UseSpecialValue = .FALSE.
use_sign_north = .FALSE.
+ !
+ ! Set ssh forcing over ghost zone:
+ ! No temporal interpolation here
+ IF (lk_div_cons) CALL Agrif_Bc_variable( sshn_frc_id, calledweight=1._wp, procname=interpsshn_frc )
!
END SUBROUTINE Agrif_dta_ts
@@ -664,7 +747,7 @@ CONTAINS
! Linear time interpolation of sea level
!
Agrif_SpecialValue = 0._wp
- Agrif_UseSpecialValue = .TRUE.
+ Agrif_UseSpecialValue = l_spc_ssh
CALL Agrif_Bc_variable(sshn_id, procname=interpsshn )
Agrif_UseSpecialValue = .FALSE.
!
@@ -672,6 +755,7 @@ CONTAINS
IF(lk_west) THEN
istart = nn_hls + 2 ! halo + land + 1
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
+ IF (lk_div_cons) iend = istart
DO ji = mi0(istart), mi1(iend)
DO jj = 1, jpj
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
@@ -683,6 +767,7 @@ CONTAINS
IF(lk_east) THEN
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1
iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
+ IF (lk_div_cons) istart = iend
DO ji = mi0(istart), mi1(iend)
DO jj = 1, jpj
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
@@ -694,6 +779,7 @@ CONTAINS
IF(lk_south) THEN
jstart = nn_hls + 2 ! halo + land + 1
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells
+ IF (lk_div_cons) jend = jstart
DO jj = mj0(jstart), mj1(jend)
DO ji = 1, jpi
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
@@ -705,6 +791,7 @@ CONTAINS
IF(lk_north) THEN
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1
jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
+ IF (lk_div_cons) jstart = jend
DO jj = mj0(jstart), mj1(jend)
DO ji = 1, jpi
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
@@ -725,50 +812,61 @@ CONTAINS
INTEGER :: istart, iend, jstart, jend
!!----------------------------------------------------------------------
!
- IF( Agrif_Root() ) RETURN
- !
- ! --- West --- !
- IF(lk_west) THEN
- istart = nn_hls + 2 ! halo + land + 1
- iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
- DO ji = mi0(istart), mi1(iend)
- DO jj = 1, jpj
- ssha_e(ji,jj) = hbdy(ji,jj)
+ IF( Agrif_Root() ) THEN
+#if defined PARENT_EXT_BDY
+ ! Assume persistence well inside overlapping domain
+ ssha_e(:,:) = tmask_upd(:,:) * ssh(:,:,Kmm_a) &
+ & + (1._wp - tmask_upd(:,:)) * ssha_e(:,:)
+#endif
+ ELSE
+ !
+ ! --- West --- !
+ IF(lk_west) THEN
+ istart = nn_hls + 2 ! halo + land + 1
+ iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
+ IF (lk_div_cons) iend = istart
+ DO ji = mi0(istart), mi1(iend)
+ DO jj = 1, jpj
+ ssha_e(ji,jj) = hbdy(ji,jj)
+ END DO
END DO
- END DO
- ENDIF
- !
- ! --- East --- !
- IF(lk_east) THEN
- istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1
- iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
- DO ji = mi0(istart), mi1(iend)
- DO jj = 1, jpj
- ssha_e(ji,jj) = hbdy(ji,jj)
+ ENDIF
+ !
+ ! --- East --- !
+ IF(lk_east) THEN
+ istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1
+ iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
+ IF (lk_div_cons) istart = iend
+ DO ji = mi0(istart), mi1(iend)
+ DO jj = 1, jpj
+ ssha_e(ji,jj) = hbdy(ji,jj)
+ END DO
END DO
- END DO
- ENDIF
- !
- ! --- South --- !
- IF(lk_south) THEN
- jstart = nn_hls + 2 ! halo + land + 1
- jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells
- DO jj = mj0(jstart), mj1(jend)
- DO ji = 1, jpi
- ssha_e(ji,jj) = hbdy(ji,jj)
+ ENDIF
+ !
+ ! --- South --- !
+ IF(lk_south) THEN
+ jstart = nn_hls + 2 ! halo + land + 1
+ jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells
+ IF (lk_div_cons) jend = jstart
+ DO jj = mj0(jstart), mj1(jend)
+ DO ji = 1, jpi
+ ssha_e(ji,jj) = hbdy(ji,jj)
+ END DO
END DO
- END DO
- ENDIF
- !
- ! --- North --- !
- IF(lk_north) THEN
- jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1
- jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
- DO jj = mj0(jstart), mj1(jend)
- DO ji = 1, jpi
- ssha_e(ji,jj) = hbdy(ji,jj)
+ ENDIF
+ !
+ ! --- North --- !
+ IF(lk_north) THEN
+ jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1
+ jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
+ IF (lk_div_cons) jstart = jend
+ DO jj = mj0(jstart), mj1(jend)
+ DO ji = 1, jpi
+ ssha_e(ji,jj) = hbdy(ji,jj)
+ END DO
END DO
- END DO
+ ENDIF
ENDIF
!
END SUBROUTINE Agrif_ssh_ts
@@ -810,7 +908,7 @@ CONTAINS
! vertical interpolation:
REAL(wp) :: zhtot, zwgt
REAL(wp), DIMENSION(k1:k2,1:jpts) :: tabin, tabin_i
- REAL(wp), DIMENSION(k1:k2) :: z_in, h_in_i, z_in_i
+ REAL(wp), DIMENSION(k1:k2) :: z_in, h_in
REAL(wp), DIMENSION(1:jpk) :: h_out, z_out
!!----------------------------------------------------------------------
@@ -835,10 +933,10 @@ CONTAINS
! Warning: these are masked, hence extrapolated prior interpolation.
DO jj=j1,j2
DO ji=i1,i2
- ptab(ji,jj,k1,jpts+1) = 0.5_wp * tmask(ji,jj,k1) * e3t(ji,jj,k1,Kmm_a)
+ ptab(ji,jj,k1,jpts+1) = 0.5_wp * tmask(ji,jj,k1) * e3w(ji,jj,k1,Kmm_a)
DO jk=k1+1,k2
ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * &
- & ( ptab(ji,jj,jk-1,jpts+1) + 0.5_wp * (e3t(ji,jj,jk-1,Kmm_a)+e3t(ji,jj,jk,Kmm_a)) )
+ & ( ptab(ji,jj,jk-1,jpts+1) + e3w(ji,jj,jk,Kmm_a) )
END DO
END DO
END DO
@@ -855,51 +953,65 @@ CONTAINS
IF( l_ini_child ) Krhs_a = Kbb_a
IF( l_vremap .OR. l_ini_child ) THEN
- IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp
+ IF (ln_linssh) THEN
+ ptab(i1:i2,j1:j2,k2,n2) = 0._wp
+
+ ELSE ! Assuming parent volume follows child:
+ ptab(i1:i2,j1:j2,k2,n2) = ssh(i1:i2,j1:j2,Krhs_a)
+ ENDIF
+
DO jj=j1,j2
DO ji=i1,i2
- ts(ji,jj,:,:,Krhs_a) = 0.
+ ts(ji,jj,:,:,Krhs_a) = 0._wp
!
! Build vertical grids:
- N_in = mbkt_parent(ji,jj)
- N_out = mbkt(ji,jj)
+ ! N_in = mbkt_parent(ji,jj)
+ ! Input grid (account for partial cells if any):
+ N_in = k2-1
+ z_in(1) = ptab(ji,jj,1,n2) - ptab(ji,jj,k2,n2)
+ DO jk=2,k2
+ z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2)
+ IF (( z_in(jk) <= z_in(jk-1) ).OR.(z_in(jk)>ht_0(ji,jj))) EXIT
+ END DO
+ N_in = jk-1
+ DO jk=1, N_in
+ tabin(jk,1:jpts) = ptab(ji,jj,jk,1:jpts)
+ END DO
+
+ IF (ssmask(ji,jj)==1._wp) THEN
+ N_out = mbkt(ji,jj)
+ ELSE
+ N_out = 0
+ ENDIF
+
IF (N_in*N_out > 0) THEN
- ! Input grid (account for partial cells if any):
- DO jk=1,N_in
- z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2)
- tabin(jk,1:jpts) = ptab(ji,jj,jk,1:jpts)
- END DO
-
- ! Intermediate grid:
IF ( l_vremap ) THEN
DO jk = 1, N_in
- h_in_i(jk) = e3t0_parent(ji,jj,jk) * &
+ h_in(jk) = e3t0_parent(ji,jj,jk) * &
& (1._wp + ptab(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj)))
END DO
- z_in_i(1) = 0.5_wp * h_in_i(1)
+ z_in(1) = 0.5_wp * h_in(1)
DO jk=2,N_in
- z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) )
+ z_in(jk) = z_in(jk-1) + 0.5_wp * ( h_in(jk) + h_in(jk-1) )
END DO
- z_in_i(1:N_in) = z_in_i(1:N_in) - ptab(ji,jj,k2,n2)
+ z_in(1:N_in) = z_in(1:N_in) - ptab(ji,jj,k2,n2)
ENDIF
! Output (Child) grid:
DO jk=1,N_out
h_out(jk) = e3t(ji,jj,jk,Krhs_a)
END DO
- z_out(1) = 0.5_wp * h_out(1)
+ z_out(1) = 0.5_wp * e3w(ji,jj,1,Krhs_a)
DO jk=2,N_out
- z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) )
+ z_out(jk) = z_out(jk-1) + e3w(ji,jj,jk,Krhs_a)
END DO
IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a)
IF( l_ini_child ) THEN
- CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a), &
+ CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a), &
& z_out(1:N_out),N_in,N_out,jpts)
ELSE
- CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),tabin_i(1:N_in,1:jpts), &
- & z_in_i(1:N_in),N_in,N_in,jpts)
- CALL reconstructandremap(tabin_i(1:N_in,1:jpts),h_in_i(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a), &
+ CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a), &
& h_out(1:N_out),N_in,N_out,jpts)
ENDIF
ENDIF
@@ -923,9 +1035,9 @@ CONTAINS
tabin(jk,1:jpts) = ptab(ji,jj,jk,1:jpts)
END DO
IF (.NOT.ln_linssh) z_in(1:N_in) = z_in(1:N_in) - ptab(ji,jj,k2,n2)
- z_out(1) = 0.5_wp * e3t(ji,jj,1,Krhs_a)
+ z_out(1) = 0.5_wp * e3w(ji,jj,1,Krhs_a)
DO jk=2, N_out
- z_out(jk) = z_out(jk-1) + 0.5_wp * (e3t(ji,jj,jk-1,Krhs_a) + e3t(ji,jj,jk,Krhs_a))
+ z_out(jk) = z_out(jk-1) + e3w(ji,jj,jk,Krhs_a)
END DO
IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a)
CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),ptab(ji,jj,1:N_out,1:jpts), &
@@ -967,6 +1079,25 @@ CONTAINS
END SUBROUTINE interpsshn
+ SUBROUTINE interpsshn_frc( ptab, i1, i2, j1, j2, before )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE interpsshn ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+ LOGICAL , INTENT(in ) :: before
+ !
+ !!----------------------------------------------------------------------
+ !
+ IF( before) THEN
+ ptab(i1:i2,j1:j2) = ssh_frc(i1:i2,j1:j2)
+ ELSE
+ ssh_frc(i1:i2,j1:j2) = ptab(i1:i2,j1:j2)
+ ENDIF
+ !
+ END SUBROUTINE interpsshn_frc
+
+
SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before )
!!----------------------------------------------------------------------
!! *** ROUTINE interpun ***
@@ -977,12 +1108,12 @@ CONTAINS
LOGICAL, INTENT(in) :: before
!!
INTEGER :: ji,jj,jk
- REAL(wp) :: zrhoy, zhtot
+ REAL(wp) :: zrhoy
! vertical interpolation:
+ REAL(wp), DIMENSION(i1:i2,j1:j2) :: zsshu
REAL(wp), DIMENSION(k1:k2) :: tabin, h_in, z_in
REAL(wp), DIMENSION(1:jpk) :: h_out, z_out
- INTEGER :: N_in, N_out,item
- REAL(wp) :: h_diff
+ INTEGER :: N_in, N_out, item
!!---------------------------------------------
!
IF (before) THEN
@@ -994,103 +1125,65 @@ CONTAINS
DO jj=j1,j2
DO ji=i1,i2
ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * uu(ji,jj,jk,Kmm_a)*umask(ji,jj,jk))
- IF( l_vremap .OR. l_ini_child) THEN
- ! Interpolate thicknesses (masked for subsequent extrapolation)
- ptab(ji,jj,jk,2) = umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)
- ENDIF
+ !!IF( l_vremap .OR. l_ini_child) THEN
+ !! ! Interpolate thicknesses (masked for subsequent extrapolation)
+ !! ptab(ji,jj,jk,2) = umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)
+ !!ENDIF
END DO
END DO
END DO
- IF( l_vremap .OR. l_ini_child ) THEN
- ! Extrapolate thicknesses in partial bottom cells:
- ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
- IF (ln_zps) THEN
- DO jj=j1,j2
- DO ji=i1,i2
- jk = mbku(ji,jj)
- ptab(ji,jj,jk,2) = 0._wp
- END DO
- END DO
- END IF
-
- ! Save ssh at last level:
- ptab(i1:i2,j1:j2,k2,2) = 0._wp
- IF (.NOT.ln_linssh) THEN
- ! This vertical sum below should be replaced by the sea-level at U-points (optimization):
- DO jk=1,jpk
- ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) + e3u(i1:i2,j1:j2,jk,Kmm_a) * umask(i1:i2,j1:j2,jk)
- END DO
- ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hu_0(i1:i2,j1:j2)
- END IF
- ENDIF
-
Kmm_a = item
- !
+
ELSE
zrhoy = Agrif_rhoy()
- IF( l_vremap .OR. l_ini_child) THEN
-! VERTICAL REFINEMENT BEGIN
+ IF( l_vremap ) THEN
- IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp
+ zsshu(i1:i2,j1:j2) = 0._wp
+
+ IF ( .NOT.ln_linssh ) THEN
+ zsshu(i1:i2,j1:j2) = hu(i1:i2,j1:j2,Krhs_a) - hu_0(i1:i2,j1:j2)
+ ENDIF
DO ji=i1,i2
DO jj=j1,j2
uu(ji,jj,:,Krhs_a) = 0._wp
- N_in = mbku_parent(ji,jj)
+ N_in = mbku_parent(ji,jj)
N_out = mbku(ji,jj)
IF (N_in*N_out > 0) THEN
- zhtot = 0._wp
+
DO jk=1,N_in
- !IF (jk==N_in) THEN
- ! h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
- !ELSE
- ! h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy)
- !ENDIF
- IF ( l_vremap ) THEN
- h_in(jk) = e3u0_parent(ji,jj,jk)
- ELSE
- IF (jk==N_in) THEN
- h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
- ELSE
- h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy)
- ENDIF
- ENDIF
- zhtot = zhtot + h_in(jk)
- IF( h_in(jk) .GT. 0. ) THEN
- tabin(jk) = ptab(ji,jj,jk,1)/(e2u(ji,jj)*zrhoy*h_in(jk))
- ELSE
- tabin(jk) = 0.
- ENDIF
- END DO
- z_in(1) = 0.5_wp * h_in(1) - zhtot + hu0_parent(ji,jj)
- DO jk=2,N_in
- z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk)+h_in(jk-1))
- END DO
+ h_in(jk) = e3u0_parent(ji,jj,jk) * &
+ & (1._wp + zsshu(ji,jj)/(hu0_parent(ji,jj)*ssumask(ji,jj) + 1._wp - ssumask(ji,jj)))
+ tabin(jk) = ptab(ji,jj,jk,1) / (e2u(ji,jj)*zrhoy*h_in(jk))
+ END DO
- DO jk=1, N_out
- h_out(jk) = e3u(ji,jj,jk,Krhs_a)
- END DO
-
- z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hu_0(ji,jj)
- DO jk=2,N_out
- z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1) + h_out(jk))
- END DO
-
- IF( l_ini_child ) THEN
- CALL remap_linear (tabin(1:N_in),z_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),z_out(1:N_out),N_in,N_out,1)
- ELSE
- CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),h_out(1:N_out),N_in,N_out,1)
- ENDIF
- ENDIF
+ DO jk=1, N_out
+ h_out(jk) = e3u(ji,jj,jk,Krhs_a)
+ END DO
+
+ IF( l_ini_child ) THEN
+ z_in(1) = 0.5_wp * h_in(1)
+ DO jk=2,N_in
+ z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk)+h_in(jk-1))
+ END DO
+ !
+ z_out(1) = 0.5_wp * h_out(1)
+ DO jk=2,N_out
+ z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1) + h_out(jk))
+ END DO
+
+ CALL remap_linear (tabin(1:N_in),z_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),z_out(1:N_out),N_in,N_out,1)
+ ELSE
+ CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),h_out(1:N_out),N_in,N_out,1)
+ ENDIF
+ ENDIF
END DO
END DO
ELSE
DO jk = 1, jpkm1
- DO jj=j1,j2
- uu(i1:i2,jj,jk,Krhs_a) = ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u(i1:i2,jj,jk,Krhs_a) )
- END DO
+ uu(i1:i2,j1:j2,jk,Krhs_a) = ptab(i1:i2,j1:j2,jk,1) / ( zrhoy * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Krhs_a) )
END DO
ENDIF
@@ -1111,10 +1204,10 @@ CONTAINS
INTEGER :: ji,jj,jk
REAL(wp) :: zrhox
! vertical interpolation:
+ REAL(wp), DIMENSION(i1:i2,j1:j2) :: zsshv
REAL(wp), DIMENSION(k1:k2) :: tabin, h_in, z_in
REAL(wp), DIMENSION(1:jpk) :: h_out, z_out
INTEGER :: N_in, N_out, item
- REAL(wp) :: h_diff, zhtot
!!---------------------------------------------
!
IF (before) THEN
@@ -1126,90 +1219,55 @@ CONTAINS
DO jj=j1,j2
DO ji=i1,i2
ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)*vmask(ji,jj,jk))
- IF( l_vremap .OR. l_ini_child) THEN
- ! Interpolate thicknesses (masked for subsequent extrapolation)
- ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a)
- ENDIF
+ !!IF( l_vremap .OR. l_ini_child) THEN
+ !! ! Interpolate thicknesses (masked for subsequent extrapolation)
+ !! ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a)
+ !!ENDIF
END DO
END DO
END DO
- IF( l_vremap .OR. l_ini_child) THEN
- ! Extrapolate thicknesses in partial bottom cells:
- ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
- IF (ln_zps) THEN
- DO jj=j1,j2
- DO ji=i1,i2
- jk = mbkv(ji,jj)
- ptab(ji,jj,jk,2) = 0._wp
- END DO
- END DO
- END IF
- ! Save ssh at last level:
- ptab(i1:i2,j1:j2,k2,2) = 0._wp
- IF (.NOT.ln_linssh) THEN
- ! This vertical sum below should be replaced by the sea-level at V-points (optimization):
- DO jk=1,jpk
- ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) + e3v(i1:i2,j1:j2,jk,Kmm_a) * vmask(i1:i2,j1:j2,jk)
- END DO
- ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hv_0(i1:i2,j1:j2)
- END IF
- ENDIF
- item = Kmm_a
+ Kmm_a = item
ELSE
zrhox = Agrif_rhox()
- IF( l_vremap .OR. l_ini_child ) THEN
+ IF( l_vremap ) THEN
- IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp
+ zsshv(i1:i2,j1:j2) = 0._wp
+
+ IF ( .NOT.ln_linssh ) THEN
+ zsshv(i1:i2,j1:j2) = hv(i1:i2,j1:j2,Krhs_a) - hv_0(i1:i2,j1:j2)
+ ENDIF
- DO jj=j1,j2
- DO ji=i1,i2
+ DO ji=i1,i2
+ DO jj=j1,j2
vv(ji,jj,:,Krhs_a) = 0._wp
- N_in = mbkv_parent(ji,jj)
+ N_in = mbkv_parent(ji,jj)
N_out = mbkv(ji,jj)
-
IF (N_in*N_out > 0) THEN
- zhtot = 0._wp
- DO jk=1,N_in
- !IF (jk==N_in) THEN
- ! h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
- !ELSE
- ! h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox)
- !ENDIF
- IF (l_vremap) THEN
- h_in(jk) = e3v0_parent(ji,jj,jk)
- ELSE
- IF (jk==N_in) THEN
- h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
- ELSE
- h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox)
- ENDIF
- ENDIF
- zhtot = zhtot + h_in(jk)
- IF( h_in(jk) .GT. 0. ) THEN
- tabin(jk) = ptab(ji,jj,jk,1)/(e1v(ji,jj)*zrhox*h_in(jk))
- ELSE
- tabin(jk) = 0.
- ENDIF
- END DO
- z_in(1) = 0.5_wp * h_in(1) - zhtot + hv0_parent(ji,jj)
- DO jk=2,N_in
- z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk-1)+h_in(jk))
+ DO jk=1,N_in
+ h_in(jk) = e3v0_parent(ji,jj,jk) * &
+ & (1._wp + zsshv(ji,jj)/(hv0_parent(ji,jj)*ssvmask(ji,jj) + 1._wp - ssvmask(ji,jj)))
+ tabin(jk) = ptab(ji,jj,jk,1) / (e1v(ji,jj)*zrhox*h_in(jk))
END DO
-
- DO jk=1,N_out
+
+ DO jk=1, N_out
h_out(jk) = e3v(ji,jj,jk,Krhs_a)
END DO
- z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hv_0(ji,jj)
- DO jk=2,N_out
- z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1)+h_out(jk))
- END DO
-
IF( l_ini_child ) THEN
+ z_in(1) = 0.5_wp * h_in(1)
+ DO jk=2,N_in
+ z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk)+h_in(jk-1))
+ END DO
+ !
+ z_out(1) = 0.5_wp * h_out(1)
+ DO jk=2,N_out
+ z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1) + h_out(jk))
+ END DO
+
CALL remap_linear (tabin(1:N_in),z_in(1:N_in),vv(ji,jj,1:N_out,Krhs_a),z_out(1:N_out),N_in,N_out,1)
ELSE
CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),vv(ji,jj,1:N_out,Krhs_a),h_out(1:N_out),N_in,N_out,1)
@@ -1374,7 +1432,8 @@ CONTAINS
!!----------------------------------------------------------------------
IF( before ) THEN
! IF ( ln_bt_fw ) THEN
- ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2)
+ ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) &
+ * umask(i1:i2,j1:j2,1)
! ELSE
! ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2)
! ENDIF
@@ -1407,10 +1466,12 @@ CONTAINS
jmin = MAX(j1, 2) ; jmax = MIN(j2, jpj-1)
DO ji=imin,imax
DO jj=jmin,jmax
- ptab(ji,jj) = 0.25_wp*( ( vb2_b(ji+1,jj )*e1v(ji+1,jj ) &
- & -vb2_b(ji-1,jj )*e1v(ji-1,jj ) ) &
- & -( vb2_b(ji+1,jj-1)*e1v(ji+1,jj-1) &
- & -vb2_b(ji-1,jj-1)*e1v(ji-1,jj-1) ) )
+ ptab(ji,jj) = 0.25_wp *(vmask(ji,jj ,1) &
+ & * ( vb2_b(ji+1,jj )*e1v(ji+1,jj ) &
+ & -vb2_b(ji-1,jj )*e1v(ji-1,jj ) ) &
+ & -vmask(ji,jj-1,1) &
+ & * ( vb2_b(ji+1,jj-1)*e1v(ji+1,jj-1) &
+ & -vb2_b(ji-1,jj-1)*e1v(ji-1,jj-1) ) )
END DO
END DO
ELSE
@@ -1481,7 +1542,8 @@ CONTAINS
!!----------------------------------------------------------------------
IF( before ) THEN
! IF ( ln_bt_fw ) THEN
- ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2)
+ ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) &
+ * vmask(i1:i2,j1:j2,1)
! ELSE
! ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2)
! ENDIF
@@ -1506,7 +1568,7 @@ CONTAINS
!
INTEGER :: ji, jj
INTEGER :: imin, imax, jmin, jmax
- REAL(wp) :: zrhox, zrhoy, zy
+ REAL(wp) :: zrhox, zrhoy, zy, zslope1, zslope2
!!----------------------------------------------------------------------
IF( before ) THEN
ptab(:,:) = 0._wp
@@ -1514,10 +1576,12 @@ CONTAINS
jmin = MAX(j1, 2) ; jmax = MIN(j2, jpj-1)
DO ji=imin,imax
DO jj=jmin,jmax
- ptab(ji,jj) = 0.25_wp*( ( ub2_b(ji ,jj+1)*e2u(ji ,jj+1) &
- & -ub2_b(ji ,jj-1)*e2u(ji ,jj-1) ) &
- & -( ub2_b(ji-1,jj+1)*e2u(ji-1,jj+1) &
- & -ub2_b(ji-1,jj-1)*e2u(ji-1,jj-1) ) )
+ ptab(ji,jj) = 0.25_wp *(umask(ji ,jj,1) &
+ & * ( ub2_b(ji ,jj+1)*e2u(ji ,jj+1) &
+ & -ub2_b(ji ,jj-1)*e2u(ji ,jj-1) ) &
+ & -umask(ji-1,jj,1) &
+ & * ( ub2_b(ji-1,jj+1)*e2u(ji-1,jj+1) &
+ & -ub2_b(ji-1,jj-1)*e2u(ji-1,jj-1) ) )
END DO
END DO
ELSE
@@ -1754,13 +1818,89 @@ CONTAINS
!!----------------------------------------------------------------------
!
IF( before) THEN
- ptab(i1:i2,j1:j2) = ht_0(i1:i2,j1:j2)
+ ptab(i1:i2,j1:j2) = ht_0(i1:i2,j1:j2) * ssmask(i1:i2,j1:j2)
ELSE
- ht0_parent(i1:i2,j1:j2) = ptab(i1:i2,j1:j2)
+ ht0_parent(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * ssmask(i1:i2,j1:j2)
ENDIF
!
END SUBROUTINE interpht0
+
+ SUBROUTINE interp_e1e2t_frac(tabres, i1, i2, j1, j2, before )
+ !
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE interp_e1e2t_frac ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ !!----------------------------------------------------------------------
+
+ IF (before) THEN
+ tabres(i1:i2,j1:j2) = e1e2t(i1:i2,j1:j2)
+ ELSE
+ WHERE (tabres(i1:i2,j1:j2)/=0._wp)
+ e1e2t_frac(i1:i2,j1:j2) = e1e2t(i1:i2,j1:j2) &
+ & / tabres(i1:i2,j1:j2) * Agrif_Rhox() * Agrif_Rhoy()
+ ELSEWHERE
+ e1e2t_frac(i1:i2,j1:j2) = 1._wp
+ END WHERE
+ ENDIF
+ !
+ END SUBROUTINE interp_e1e2t_frac
+
+
+ SUBROUTINE interp_e2u_frac(tabres, i1, i2, j1, j2, before )
+ !
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE interp_e2u_frac ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ !!----------------------------------------------------------------------
+
+ IF (before) THEN
+ tabres(i1:i2,j1:j2) = e2u(i1:i2,j1:j2)
+ ELSE
+ WHERE (tabres(i1:i2,j1:j2)/=0._wp)
+ e2u_frac(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) &
+ & / tabres(i1:i2,j1:j2) * Agrif_Rhoy()
+ ELSE WHERE
+ e2u_frac(i1:i2,j1:j2) = 1._wp
+ END WHERE
+ ENDIF
+ !
+ END SUBROUTINE interp_e2u_frac
+
+
+ SUBROUTINE interp_e1v_frac(tabres, i1, i2, j1, j2, before )
+ !
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE interp_e1v_frac ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ !!----------------------------------------------------------------------
+
+ IF (before) THEN
+ tabres(i1:i2,j1:j2) = e1v(i1:i2,j1:j2)
+ ELSE
+ WHERE (tabres(i1:i2,j1:j2)/=0._wp)
+ e1v_frac(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) &
+ & / tabres(i1:i2,j1:j2) * Agrif_Rhox()
+ ELSE WHERE
+ e1v_frac(i1:i2,j1:j2) = 1._wp
+ END WHERE
+ ENDIF
+ !
+ END SUBROUTINE interp_e1v_frac
+
+
SUBROUTINE Agrif_check_bat( iindic )
!!----------------------------------------------------------------------
!! *** ROUTINE Agrif_check_bat ***
@@ -1774,7 +1914,7 @@ CONTAINS
!
! --- West --- !
IF(lk_west) THEN
- ispon = nn_sponge_len * Agrif_irhox()
+ ispon = (nn_sponge_len+2) * Agrif_irhox()
istart = nn_hls + 2 ! halo + land + 1
iend = nn_hls + nbghostcells + ispon ! halo + land + nbghostcells + sponge
jstart = nn_hls + 2
@@ -1811,7 +1951,7 @@ CONTAINS
!
! --- East --- !
IF(lk_east) THEN
- ispon = nn_sponge_len * Agrif_irhox()
+ ispon = (nn_sponge_len+2) * Agrif_irhox()
istart = jpiglo - ( nn_hls + nbghostcells + ispon -1 ) ! halo + land + nbghostcells + sponge - 1
iend = jpiglo - nn_hls - 1 ! halo + land + 1 - 1
jstart = nn_hls + 2
@@ -1848,7 +1988,7 @@ CONTAINS
!
! --- South --- !
IF(lk_south) THEN
- ispon = nn_sponge_len * Agrif_irhoy()
+ ispon = (nn_sponge_len+2) * Agrif_irhoy()
jstart = nn_hls + 2 ! halo + land + 1
jend = nn_hls + nbghostcells + ispon ! halo + land + nbghostcells + sponge
istart = nn_hls + 2
@@ -1885,7 +2025,7 @@ CONTAINS
!
! --- North --- !
IF(lk_north) THEN
- ispon = nn_sponge_len * Agrif_irhoy()
+ ispon = (nn_sponge_len+2) * Agrif_irhoy()
jstart = jpjglo - ( nn_hls + nbghostcells + ispon - 1) ! halo + land + nbghostcells +sponge - 1
jend = jpjglo - nn_hls - 1 ! halo + land + 1 - 1
istart = nn_hls + 2
diff --git a/src/NST/agrif_oce_sponge.F90 b/src/NST/agrif_oce_sponge.F90
index 9cb5b05b67106fb79dc2008f7221185dd917a00f..0e728c4c29bad106535c1d03cb5246747e4f8cd7 100644
--- a/src/NST/agrif_oce_sponge.F90
+++ b/src/NST/agrif_oce_sponge.F90
@@ -54,7 +54,7 @@ CONTAINS
zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot())
Agrif_SpecialValue = 0._wp
- Agrif_UseSpecialValue = .TRUE.
+ Agrif_UseSpecialValue = l_spc_tra
l_vremap = ln_vert_remap
tabspongedone_tsn = .FALSE.
!
@@ -239,9 +239,9 @@ CONTAINS
!
! Remove vertical interpolation where not needed:
! (A null value in mbkx arrays does the job)
- WHERE (fspu(:,:) == 0._wp) mbku_parent(:,:) = 0
- WHERE (fspv(:,:) == 0._wp) mbkv_parent(:,:) = 0
- WHERE (fspt(:,:) == 0._wp) mbkt_parent(:,:) = 0
+ WHERE (ssumask(:,:) == 0._wp) mbku_parent(:,:) = 0
+ WHERE (ssvmask(:,:) == 0._wp) mbkv_parent(:,:) = 0
+ WHERE (ssmask(:,:) == 0._wp) mbkt_parent(:,:) = 0
!
#endif
!
@@ -415,10 +415,10 @@ CONTAINS
! Warning: these are masked, hence extrapolated prior interpolation.
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj,k1,jpts+1) = 0.5_wp * tmask(ji,jj,k1) * e3t(ji,jj,k1,Kbb_a)
+ tabres(ji,jj,k1,jpts+1) = 0.5_wp * tmask(ji,jj,k1) * e3w(ji,jj,k1,Kbb_a)
DO jk=k1+1,k2
tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * &
- & ( tabres(ji,jj,jk-1,jpts+1) + 0.5_wp * (e3t(ji,jj,jk-1,Kbb_a)+e3t(ji,jj,jk,Kbb_a)) )
+ & ( tabres(ji,jj,jk-1,jpts+1) + e3w(ji,jj,jk,Kbb_a) )
END DO
END DO
END DO
@@ -434,7 +434,12 @@ CONTAINS
!
IF ( l_vremap ) THEN
- IF (ln_linssh) tabres(i1:i2,j1:j2,k2,n2) = 0._wp
+ IF (ln_linssh) THEN
+ tabres(i1:i2,j1:j2,k2,n2) = 0._wp
+
+ ELSE ! Assuming parent volume follows child:
+ tabres(i1:i2,j1:j2,k2,n2) = ssh(i1:i2,j1:j2,Kbb_a)
+ ENDIF
DO jj=j1,j2
DO ji=i1,i2
@@ -465,9 +470,9 @@ CONTAINS
DO jk=1,N_out
h_out(jk) = e3t(ji,jj,jk,Kbb_a)
END DO
- z_out(1) = 0.5_wp * h_out(1)
+ z_out(1) = 0.5_wp * e3w(ji,jj,1,Kbb_a)
DO jk=2,N_out
- z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) )
+ z_out(jk) = z_out(jk-1) + e3w(ji,jj,jk,Kbb_a)
END DO
IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Kbb_a)
@@ -478,8 +483,11 @@ CONTAINS
h_in_i(1)= h_in_i(1) - ( sum(h_in_i(1:N_in))-sum(h_out(1:N_out)) )
END IF
IF (N_in*N_out > 0) THEN
- CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),tabin_i(1:N_in,1:jpts),z_in_i(1:N_in),N_in,N_in,jpts)
- CALL reconstructandremap(tabin_i(1:N_in,1:jpts),h_in_i(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts)
+! jc: disable "two steps" vertical remapping
+! since this would require e3w0_parent to be available
+! CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),tabin_i(1:N_in,1:jpts),z_in_i(1:N_in),N_in,N_in,jpts)
+! CALL reconstructandremap(tabin_i(1:N_in,1:jpts),h_in_i(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts)
+ CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in_i(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts)
! CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),z_out(1:N_in),N_in,N_out,jpts)
ENDIF
END DO
@@ -510,9 +518,9 @@ CONTAINS
END DO
IF (.NOT.ln_linssh) z_in(1:N_in) = z_in(1:N_in) - tabres(ji,jj,k2,n2)
- z_out(1) = 0.5_wp * e3t(ji,jj,1,Kbb_a)
+ z_out(1) = 0.5_wp * e3w(ji,jj,1,Kbb_a)
DO jk=2, N_out
- z_out(jk) = z_out(jk-1) + 0.5_wp * (e3t(ji,jj,jk-1,Kbb_a) + e3t(ji,jj,jk,Kbb_a))
+ z_out(jk) = z_out(jk-1) + e3w(ji,jj,jk,Kbb_a)
END DO
IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Kbb_a)
@@ -607,103 +615,65 @@ CONTAINS
INTEGER :: ji,jj,jk,jmax
INTEGER :: ind1
! sponge parameters
- REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot
+ REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zrhoy
+ REAL(wp), DIMENSION(i1:i2,j1:j2) :: zsshu
REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ubdiff
REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff
! vertical interpolation:
REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
REAL(wp), DIMENSION(k1:k2) :: tabin, h_in
REAL(wp), DIMENSION(1:jpk) :: h_out
- INTEGER ::N_in, N_out
+ INTEGER :: N_in, N_out
!!---------------------------------------------
!
IF( before ) THEN
DO jk=k1,k2
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj,jk,m1) = uu(ji,jj,jk,Kbb_a) * umask(ji,jj,jk)
+ tabres(ji,jj,jk,m1) = e2u(ji,jj) * e3u(ji,jj,jk,Kbb_a) * uu(ji,jj,jk,Kbb_a) * umask(ji,jj,jk)
END DO
END DO
END DO
- IF ( l_vremap ) THEN
-
- DO jk=k1,k2
- DO jj=j1,j2
- DO ji=i1,i2
- tabres(ji,jj,jk,m2) = e3u(ji,jj,jk,Kbb_a)*umask(ji,jj,jk)
- END DO
- END DO
- END DO
-
- ! Extrapolate thicknesses in partial bottom cells:
- ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
- IF (ln_zps) THEN
- DO jj=j1,j2
- DO ji=i1,i2
- jk = mbku(ji,jj)
- tabres(ji,jj,jk,m2) = 0._wp
- END DO
- END DO
- END IF
- ! Save ssh at last level:
- tabres(i1:i2,j1:j2,k2,m2) = 0._wp
- IF (.NOT.ln_linssh) THEN
- ! This vertical sum below should be replaced by the sea-level at U-points (optimization):
- DO jk=1,jpk
- tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3u(i1:i2,j1:j2,jk,Kbb_a) * umask(i1:i2,j1:j2,jk)
- END DO
- tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hu_0(i1:i2,j1:j2)
- END IF
- END IF
-
ELSE
+ zrhoy = Agrif_rhoy()
IF ( l_vremap ) THEN
- IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp
+ IF ( ln_linssh ) THEN
+ zsshu(i1:i2,j1:j2) = 0._wp
+ ELSE
+ zsshu(i1:i2,j1:j2) = hu(i1:i2,j1:j2,Kbb_a) - hu_0(i1:i2,j1:j2)
+ ENDIF
DO jj=j1,j2
DO ji=i1,i2
tabres_child(ji,jj,:) = 0._wp
- N_in = mbku_parent(ji,jj)
+ N_in = mbku_parent(ji,jj)
N_out = mbku(ji,jj)
IF (N_in * N_out > 0) THEN
- zhtot = 0._wp
DO jk=1,N_in
- !IF (jk==N_in) THEN
- ! h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot
- !ELSE
- ! h_in(jk) = tabres(ji,jj,jk,m2)
- !ENDIF
- h_in(jk) = e3u0_parent(ji,jj,jk)
- zhtot = zhtot + h_in(jk)
- tabin(jk) = tabres(ji,jj,jk,m1)
+ h_in(jk) = e3u0_parent(ji,jj,jk) * &
+ & (1._wp + zsshu(ji,jj)/(hu0_parent(ji,jj)*ssumask(ji,jj) + 1._wp - ssumask(ji,jj)))
+ tabin(jk) = tabres(ji,jj,jk,1) / (e2u(ji,jj)*zrhoy*h_in(jk))
END DO
!
DO jk=1,N_out
h_out(jk) = e3u(ji,jj,jk,Kbb_a)
END DO
-
- ! Account for small differences in free-surface
- IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
- h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
- ELSE
- h_in(1) = h_in(1) - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
- ENDIF
CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
ENDIF
END DO
END DO
-
- ubdiff(i1:i2,j1:j2,1:jpk) = (uu(i1:i2,j1:j2,1:jpk,Kbb_a) - tabres_child(i1:i2,j1:j2,1:jpk))*umask(i1:i2,j1:j2,1:jpk)
ELSE
-
- ubdiff(i1:i2,j1:j2,1:jpk) = (uu(i1:i2,j1:j2,1:jpk,Kbb_a) - tabres(i1:i2,j1:j2,1:jpk,1))*umask(i1:i2,j1:j2,1:jpk)
-
+ DO jk=1,jpkm1
+ tabres_child(i1:i2,j1:j2,jk) = tabres(i1:i2,j1:j2,jk,1)/(e2u(i1:i2,j1:j2)*zrhoy*e3u(i1:i2,j1:j2,jk,Kbb_a))
+ END DO
ENDIF
!
+ ubdiff(i1:i2,j1:j2,1:jpk) = (uu(i1:i2,j1:j2,1:jpk,Kbb_a) - tabres_child(i1:i2,j1:j2,1:jpk))*umask(i1:i2,j1:j2,1:jpk)
+ !
DO jk = 1, jpkm1 ! Horizontal slab
! ! ===============
@@ -792,7 +762,8 @@ CONTAINS
!
INTEGER :: ji, jj, jk, imax
INTEGER :: ind1
- REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot
+ REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zrhox
+ REAL(wp), DIMENSION(i1:i2,j1:j2) :: zsshv
REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff
REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff
! vertical interpolation:
@@ -806,88 +777,51 @@ CONTAINS
DO jk=k1,k2
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj,jk,m1) = vv(ji,jj,jk,Kbb_a) * vmask(ji,jj,jk)
+ tabres(ji,jj,jk,m1) = e1v(ji,jj) * e3v(ji,jj,jk,Kbb_a) * vv(ji,jj,jk,Kbb_a) * vmask(ji,jj,jk)
END DO
END DO
END DO
- IF ( l_vremap ) THEN
-
- DO jk=k1,k2
- DO jj=j1,j2
- DO ji=i1,i2
- tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v(ji,jj,jk,Kbb_a)
- END DO
- END DO
- END DO
- ! Extrapolate thicknesses in partial bottom cells:
- ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
- IF (ln_zps) THEN
- DO jj=j1,j2
- DO ji=i1,i2
- jk = mbkv(ji,jj)
- tabres(ji,jj,jk,m2) = 0._wp
- END DO
- END DO
- END IF
- ! Save ssh at last level:
- tabres(i1:i2,j1:j2,k2,m2) = 0._wp
- IF (.NOT.ln_linssh) THEN
- ! This vertical sum below should be replaced by the sea-level at V-points (optimization):
- DO jk=1,jpk
- tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3v(i1:i2,j1:j2,jk,Kbb_a) * vmask(i1:i2,j1:j2,jk)
- END DO
- tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hv_0(i1:i2,j1:j2)
- END IF
-
- END IF
-
ELSE
+ zrhox = Agrif_rhox()
IF ( l_vremap ) THEN
- IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp
+
+ IF ( ln_linssh ) THEN
+ zsshv(i1:i2,j1:j2) = 0._wp
+ ELSE
+ zsshv(i1:i2,j1:j2) = hv(i1:i2,j1:j2,Kbb_a) - hv_0(i1:i2,j1:j2)
+ ENDIF
+
DO jj=j1,j2
DO ji=i1,i2
tabres_child(ji,jj,:) = 0._wp
N_in = mbkv_parent(ji,jj)
N_out = mbkv(ji,jj)
IF (N_in * N_out > 0) THEN
- zhtot = 0._wp
DO jk=1,N_in
- !IF (jk==N_in) THEN
- ! h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot
- !ELSE
- ! h_in(jk) = tabres(ji,jj,jk,m2)
- !ENDIF
- h_in(jk) = e3v0_parent(ji,jj,jk)
- zhtot = zhtot + h_in(jk)
- tabin(jk) = tabres(ji,jj,jk,m1)
+ h_in(jk) = e3v0_parent(ji,jj,jk) * &
+ & (1._wp + zsshv(ji,jj)/(hv0_parent(ji,jj)*ssvmask(ji,jj) + 1._wp - ssvmask(ji,jj)))
+ tabin(jk) = tabres(ji,jj,jk,1) / (e1v(ji,jj)*zrhox*h_in(jk))
END DO
- !
+ !
DO jk=1,N_out
h_out(jk) = e3v(ji,jj,jk,Kbb_a)
END DO
- ! Account for small differences in free-surface
- IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
- h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
- ELSE
- h_in(1) = h_in(1) - ( sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
- ENDIF
-
CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
ENDIF
END DO
END DO
-
- vbdiff(i1:i2,j1:j2,1:jpk) = (vv(i1:i2,j1:j2,1:jpk,Kbb_a) - tabres_child(i1:i2,j1:j2,1:jpk))*vmask(i1:i2,j1:j2,1:jpk)
ELSE
-
- vbdiff(i1:i2,j1:j2,1:jpk) = (vv(i1:i2,j1:j2,1:jpk,Kbb_a) - tabres(i1:i2,j1:j2,1:jpk,1))*vmask(i1:i2,j1:j2,1:jpk)
-
+ DO jk=1,jpkm1
+ tabres_child(i1:i2,j1:j2,jk) = tabres(i1:i2,j1:j2,jk,1)/(e1v(i1:i2,j1:j2)*zrhox*e3v(i1:i2,j1:j2,jk,Kbb_a))
+ END DO
ENDIF
!
+ vbdiff(i1:i2,j1:j2,1:jpk) = (vv(i1:i2,j1:j2,1:jpk,Kbb_a) - tabres_child(i1:i2,j1:j2,1:jpk))*vmask(i1:i2,j1:j2,1:jpk)
+ !
DO jk = 1, jpkm1 ! Horizontal slab
! ! ===============
diff --git a/src/NST/agrif_oce_update.F90 b/src/NST/agrif_oce_update.F90
index cb8093e6a5d9fe39ba0c0445e64a7b5fe1308136..0f538408182df07010a6dfc9620eac779c7fd4d9 100644
--- a/src/NST/agrif_oce_update.F90
+++ b/src/NST/agrif_oce_update.F90
@@ -1,15 +1,16 @@
-#undef DECAL_FEEDBACK /* SEPARATION of INTERFACES */
+#define DECAL_FEEDBACK /* SEPARATION of INTERFACES */
#undef DECAL_FEEDBACK_2D /* SEPARATION of INTERFACES (Barotropic mode) */
#undef VOL_REFLUX /* VOLUME REFLUXING*/
MODULE agrif_oce_update
!!======================================================================
- !! *** MODULE agrif_oce_interp ***
+ !! *** MODULE agrif_oce_update ***
!! AGRIF: update package for the ocean dynamics (OCE)
!!======================================================================
!! History : 2.0 ! 2002-06 (L. Debreu) Original code
!! 3.2 ! 2009-04 (R. Benshila)
- !! 3.6 ! 2014-09 (R. Benshila)
+ !! 3.6 ! 2014-09 (R. Benshila)
+ !! 4.2 ! 2021-11 (J. Chanut)
!!----------------------------------------------------------------------
#if defined key_agrif
!!----------------------------------------------------------------------
@@ -34,7 +35,7 @@ MODULE agrif_oce_update
PRIVATE
PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn, Agrif_Update_vvl, Agrif_Update_ssh
- PUBLIC Update_Scales, Agrif_Check_parent_bat
+ PUBLIC Agrif_Check_parent_bat
!! * Substitutions
# include "domzgr_substitute.h90"
@@ -52,11 +53,10 @@ CONTAINS
!
IF (Agrif_Root()) RETURN
!
- IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers from grid Number',Agrif_Fixed()
+ IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers from grid Number', Agrif_Fixed()
l_vremap = ln_vert_remap
- Agrif_UseSpecialValueInUpdate = .NOT.l_vremap
- Agrif_SpecialValueFineGrid = 0._wp
+ Agrif_UseSpecialValueInUpdate = .FALSE.
!
# if ! defined DECAL_FEEDBACK
CALL Agrif_Update_Variable(ts_update_id, procname=updateTS)
@@ -68,7 +68,6 @@ CONTAINS
! CALL Agrif_Update_Variable(ts_update_id,locupdate=(/1,2/), procname=updateTS)
# endif
!
- Agrif_UseSpecialValueInUpdate = .FALSE.
l_vremap = .FALSE.
!
!
@@ -81,7 +80,7 @@ CONTAINS
!
IF (Agrif_Root()) RETURN
!
- IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed()
+ IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number', Agrif_Fixed()
Agrif_UseSpecialValueInUpdate = .FALSE.
Agrif_SpecialValueFineGrid = 0._wp
@@ -106,6 +105,10 @@ CONTAINS
CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/ nn_shift_bar,-2/),locupdate2=(/1+nn_shift_bar,-2/),procname = updateub2b)
CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1+nn_shift_bar,-2/),locupdate2=(/ nn_shift_bar,-2/),procname = updatevb2b)
# endif
+ IF (lk_agrif_fstep) THEN
+ CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/ nn_shift_bar+nn_dist_par_bc-1,-2/),locupdate2=(/ nn_shift_bar+nn_dist_par_bc ,-2/),procname = updateumsk)
+ CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/ nn_shift_bar+nn_dist_par_bc ,-2/),locupdate2=(/ nn_shift_bar+nn_dist_par_bc-1,-2/),procname = updatevmsk)
+ ENDIF
END IF
# if ! defined DECAL_FEEDBACK
@@ -123,7 +126,7 @@ CONTAINS
# endif
!
use_sign_north = .FALSE.
- l_vremap = .FALSE.
+ l_vremap = .FALSE.
!
END SUBROUTINE Agrif_Update_Dyn
@@ -134,17 +137,16 @@ CONTAINS
!
IF (Agrif_Root()) RETURN
!
- l_vremap = ln_vert_remap
- Agrif_UseSpecialValueInUpdate = .NOT.l_vremap
- Agrif_SpecialValueFineGrid = 0._wp
+ Agrif_UseSpecialValueInUpdate = .FALSE.
+ Agrif_SpecialValueFineGrid = 0._wp
# if ! defined DECAL_FEEDBACK_2D
CALL Agrif_Update_Variable(sshn_id,locupdate=(/ nn_shift_bar,-2/), procname = updateSSH)
# else
- CALL Agrif_Update_Variable(sshn_id,locupdate=(/1+nn_shift_bar,-2/),procname = updateSSH)
+ CALL Agrif_Update_Variable(sshn_id,locupdate=(/1+nn_shift_bar,-2/), procname = updateSSH)
# endif
- !
- Agrif_UseSpecialValueInUpdate = .FALSE.
- l_vremap = .FALSE.
+ IF (lk_agrif_fstep) THEN
+ CALL Agrif_Update_Variable(sshn_id,locupdate=(/1+nn_shift_bar+nn_dist_par_bc-1,-2/),procname = updatetmsk)
+ ENDIF
!
# if defined VOL_REFLUX
IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN
@@ -161,13 +163,13 @@ CONTAINS
use_sign_north = .FALSE.
END IF
# endif
+ Agrif_UseSpecialValueInUpdate = .FALSE.
!
END SUBROUTINE Agrif_Update_ssh
-
SUBROUTINE Agrif_Update_Tke( )
!!---------------------------------------------
- !! *** ROUTINE Agrif_Update_Tke ***
+ !! *** ROUINE Agrif_Update_Tke ***
!!---------------------------------------------
!!
!
@@ -194,29 +196,51 @@ CONTAINS
IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update e3 from grid Number',Agrif_Fixed(), 'Step', Agrif_Nb_Step()
!
#if defined key_qco
- CALL Agrif_ChildGrid_To_ParentGrid()
- CALL Agrif_Update_qco
- CALL Agrif_ParentGrid_To_ChildGrid()
-#elif defined key_linssh
!
-#else
Agrif_UseSpecialValueInUpdate = .FALSE.
- Agrif_SpecialValueFineGrid = 0._wp
- !
- ! No interface separation here, update vertical grid at T points
- ! everywhere over the overlapping regions (one account for refluxing in that case):
- CALL Agrif_Update_Variable(e3t_id, procname=updatee3t)
+#if ! defined DECAL_FEEDBACK_2D
+ CALL Agrif_Update_Variable(r3t_id, locupdate=(/ nn_shift_bar,-2/), procname=update_r3t)
+ CALL Agrif_Update_Variable(r3f_id, locupdate=(/ nn_shift_bar,-2/), procname=update_r3f)
+ CALL Agrif_Update_Variable(r3u_id, locupdate1=(/ nn_shift_bar,-2/), locupdate2=(/ nn_shift_bar,-2/), procname=update_r3u)
+ CALL Agrif_Update_Variable(r3v_id, locupdate1=(/ nn_shift_bar,-2/), locupdate2=(/ nn_shift_bar,-2/), procname=update_r3v)
+#else
+ CALL Agrif_Update_Variable(r3t_id, locupdate=(/1+nn_shift_bar,-2/), procname=update_r3t)
+ CALL Agrif_Update_Variable(r3f_id, locupdate=(/1+nn_shift_bar,-2/), procname=update_r3f)
+ CALL Agrif_Update_Variable(r3u_id, locupdate1=(/ nn_shift_bar,-2/), locupdate2=(/1+nn_shift_bar,-2/), procname=update_r3u)
+ CALL Agrif_Update_Variable(r3v_id, locupdate1=(/1+nn_shift_bar,-2/), locupdate2=(/ nn_shift_bar,-2/), procname=update_r3v)
+#endif
+ !
+ ! Old way (update e3 at UVF-points everywhere on parent domain):
+! CALL Agrif_ChildGrid_To_ParentGrid()
+! CALL Agrif_Update_qco
+! CALL Agrif_ParentGrid_To_ChildGrid()
+#elif defined key_linssh
!
+ ! DO NOTHING HERE
+#else
Agrif_UseSpecialValueInUpdate = .FALSE.
+ l_vremap = ln_vert_remap
+#if ! defined DECAL_FEEDBACK_2D
+ CALL Agrif_Update_Variable(e3t_id, locupdate=(/ nn_shift_bar,-2/), procname=update_e3t)
+ CALL Agrif_Update_Variable(e3f_id, locupdate=(/ nn_shift_bar,-2/), procname=update_e3f)
+ CALL Agrif_Update_Variable(e3u_id, locupdate1=(/ nn_shift_bar,-2/), locupdate2=(/ nn_shift_bar,-2/), procname=update_e3u)
+ CALL Agrif_Update_Variable(e3v_id, locupdate1=(/ nn_shift_bar,-2/), locupdate2=(/ nn_shift_bar,-2/), procname=update_e3v)
+#else
+ CALL Agrif_Update_Variable(e3t_id, locupdate=(/1+nn_shift_bar,-2/), procname=update_e3t)
+ CALL Agrif_Update_Variable(e3f_id, locupdate=(/1+nn_shift_bar,-2/), procname=update_e3f)
+ CALL Agrif_Update_Variable(e3u_id, locupdate1=(/ nn_shift_bar,-2/), locupdate2=(/1+nn_shift_bar,-2/), procname=update_e3u)
+ CALL Agrif_Update_Variable(e3v_id, locupdate1=(/1+nn_shift_bar,-2/), locupdate2=(/ nn_shift_bar,-2/), procname=update_e3v)
+#endif
+ l_vremap = .FALSE.
!
- CALL Agrif_ChildGrid_To_ParentGrid()
- CALL dom_vvl_update_UVF
- CALL Agrif_ParentGrid_To_ChildGrid()
+! Old way (update e3 at UVF-points everywhere on parent domain):
+! CALL Agrif_ChildGrid_To_ParentGrid()
+! CALL dom_vvl_update_UVF
+! CALL Agrif_ParentGrid_To_ChildGrid()
#endif
!
END SUBROUTINE Agrif_Update_vvl
-
#if defined key_qco
SUBROUTINE Agrif_Update_qco
!!---------------------------------------------
@@ -234,7 +258,6 @@ CONTAINS
END SUBROUTINE Agrif_Update_qco
#endif
-
#if ! defined key_qco && ! defined key_linssh
SUBROUTINE dom_vvl_update_UVF
!!---------------------------------------------
@@ -253,8 +276,6 @@ CONTAINS
!
e3u(:,:,:,Krhs_a) = e3u(:,:,:,Kmm_a)
e3v(:,:,:,Krhs_a) = e3v(:,:,:,Kmm_a)
-! uu(:,:,:,Krhs_a) = e3u(:,:,:,Kbb_a)
-! vv(:,:,:,Krhs_a) = e3v(:,:,:,Kbb_a)
hu(:,:,Krhs_a) = hu(:,:,Kmm_a)
hv(:,:,Krhs_a) = hv(:,:,Kmm_a)
@@ -320,9 +341,9 @@ CONTAINS
REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
LOGICAL, INTENT(in) :: before
!!
- INTEGER :: ji,jj,jk,jn
+ INTEGER :: ji,jj,jk,jn
INTEGER :: N_in, N_out
- REAL(wp) :: ztb, ztnu, ztno
+ REAL(wp) :: ztb, ztnu, ztno, ze3b
REAL(wp) :: h_in(k1:k2)
REAL(wp) :: h_out(1:jpk)
REAL(wp) :: tabin(k1:k2,1:jpts)
@@ -330,50 +351,45 @@ CONTAINS
!!---------------------------------------------
!
IF (before) THEN
- IF ( l_vremap ) THEN
- DO jn = n1,n2-1
- DO jk=k1,k2
- DO jj=j1,j2
- DO ji=i1,i2
- tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a)
- END DO
- END DO
- END DO
- END DO
- DO jk=k1,k2
+ DO jn = n1,n2-1
+ DO jk=k1,k2-1
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)
+ tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) &
+ & * e1e2t_frac(ji,jj)
END DO
END DO
END DO
- ELSE
- DO jn = 1,jpts
- DO jk=k1,k2
- DO jj=j1,j2
- DO ji=i1,i2
- tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk)
- END DO
+ END DO
+
+ IF ( l_vremap ) THEN
+ DO jk=k1,k2-1
+ DO jj=j1,j2
+ DO ji=i1,i2
+ tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) &
+ & * e1e2t_frac(ji,jj)
END DO
END DO
END DO
-
ENDIF
+
ELSE
+ tabres_child(:,:,:,:) = 0._wp
IF ( l_vremap ) THEN
- tabres_child(:,:,:,:) = 0._wp
AGRIF_SpecialValue = 0._wp
DO jj=j1,j2
DO ji=i1,i2
N_in = 0
- DO jk=k1,k2 !k2 = jpk of child grid
+ DO jk=k1,k2-1 !k2 = jpk of child grid
IF (tabres(ji,jj,jk,n2) <= 1.e-6_wp ) EXIT
N_in = N_in + 1
- tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2)
+ DO jn=n1,n2-1
+ tabin(jk,jn) = tabres(ji,jj,jk,jn)/tabres(ji,jj,jk,n2)
+ END DO
h_in(N_in) = tabres(ji,jj,jk,n2)
ENDDO
N_out = 0
- DO jk=1,jpk ! jpk of parent grid
+ DO jk=1,jpkm1 ! jpk of parent grid
IF (tmask(ji,jj,jk) == 0 ) EXIT ! TODO: Will not work with ISF
N_out = N_out + 1
h_out(N_out) = e3t(ji,jj,jk,Kmm_a)
@@ -383,73 +399,42 @@ CONTAINS
ENDIF
ENDDO
ENDDO
+ ELSE
+ DO jn = 1, jpts
+ DO jk = k1, k2-1
+ tabres_child(i1:i2,j1:j2,jk,jn) = tabres(i1:i2,j1:j2,jk,jn) / e3t(i1:i2,j1:j2,jk,Kmm_a) * tmask(i1:i2,j1:j2,jk)
+ ENDDO
+ ENDDO
+ ENDIF
- IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
- ! Add asselin part
- DO jn = 1,jpts
- DO jk = 1, jpkm1
- DO jj = j1, j2
- DO ji = i1, i2
- IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN
- ztb = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
- ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a)
- ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
- ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) ) &
- & * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
- ENDIF
- END DO
- END DO
- END DO
- END DO
- ENDIF
- DO jn = 1,jpts
+ IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
+ ! Add asselin part
+ DO jn = 1, jpts
DO jk = 1, jpkm1
DO jj = j1, j2
DO ji = i1, i2
- IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN
- ts(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn)
- END IF
+ ze3b = e3t(ji,jj,jk,Kbb_a) & ! Recover e3tb before update
+ & - rn_atfp * ( e3t(ji,jj,jk,Kmm_a) - e3t(ji,jj,jk,Krhs_a) )
+ ztb = ts(ji,jj,jk,jn,Kbb_a) * ze3b
+ ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a)
+ ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
+ ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) ) &
+ & / e3t(ji,jj,jk,Kbb_a)
END DO
END DO
END DO
END DO
- ELSE
- DO jn = 1,jpts
- tabres(i1:i2,j1:j2,k1:k2,jn) = tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) &
- & * tmask(i1:i2,j1:j2,k1:k2)
- ENDDO
-
- IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
- ! Add asselin part
- DO jn = 1,jpts
- DO jk = k1, k2
- DO jj = j1, j2
- DO ji = i1, i2
- IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN
- ztb = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
- ztnu = tabres(ji,jj,jk,jn)
- ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
- ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) ) &
- & * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)
- ENDIF
- END DO
- END DO
- END DO
- END DO
- ENDIF
- DO jn = 1,jpts
- DO jk=k1,k2
- DO jj=j1,j2
- DO ji=i1,i2
- IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN
- ts(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a)
- END IF
- END DO
+ ENDIF
+ DO jn = 1,jpts
+ DO jk = 1, jpkm1
+ DO jj = j1, j2
+ DO ji = i1, i2
+ ts(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn)
END DO
END DO
END DO
- !
- ENDIF
+ END DO
+ !
IF ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
ts(i1:i2,j1:j2,1:jpkm1,1:jpts,Kbb_a) = ts(i1:i2,j1:j2,1:jpkm1,1:jpts,Kmm_a)
ENDIF
@@ -467,7 +452,7 @@ CONTAINS
LOGICAL , INTENT(in ) :: before
!
INTEGER :: ji, jj, jk
- REAL(wp):: zrhoy, zub, zunu, zuno
+ REAL(wp):: zub, zunu, zuno, ze3b
REAL(wp), DIMENSION(jpi,jpj) :: zpgu ! 2D workspace
! VERTICAL REFINEMENT BEGIN
REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
@@ -480,15 +465,15 @@ CONTAINS
!!---------------------------------------------
!
IF( before ) THEN
- zrhoy = Agrif_Rhoy()
DO jk=k1,k2
- tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) &
+ tabres(i1:i2,j1:j2,jk,1) = e2u_frac(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) &
& * umask(i1:i2,j1:j2,jk) * uu(i1:i2,j1:j2,jk,Kmm_a)
END DO
IF ( l_vremap ) THEN
DO jk=k1,k2
- tabres(i1:i2,j1:j2,jk,2) = zrhoy * umask(i1:i2,j1:j2,jk) * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a)
+ tabres(i1:i2,j1:j2,jk,2) = e2u_frac(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) &
+ & * umask(i1:i2,j1:j2,jk)
END DO
ENDIF
@@ -503,14 +488,14 @@ CONTAINS
N_in = 0
h_in(:) = 0._wp
tabin(:) = 0._wp
- DO jk=k1,k2 !k2=jpk of child grid
- IF( tabres(ji,jj,jk,2)*r1_e2u(ji,jj) <= 1.e-6_wp ) EXIT
+ DO jk=k1,k2-1 !k2=jpk of child grid
+ IF( tabres(ji,jj,jk,2) <= 1.e-6_wp ) EXIT
N_in = N_in + 1
tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2)
- h_in(N_in) = tabres(ji,jj,jk,2) * r1_e2u(ji,jj)
+ h_in(N_in) = tabres(ji,jj,jk,2)
ENDDO
N_out = 0
- DO jk=1,jpk
+ DO jk=1,jpkm1
IF (umask(ji,jj,jk) == 0._wp) EXIT
N_out = N_out + 1
h_out(N_out) = e3u(ji,jj,jk,Kmm_a)
@@ -547,20 +532,22 @@ CONTAINS
ENDDO
ELSE
- DO jk=k1,k2
+ DO jk=k1,k2-1
DO jj=j1,j2
DO ji=i1,i2
- tabres_child(ji,jj,jk) = tabres(ji,jj,jk,1) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm_a)
+ tabres_child(ji,jj,jk) = tabres(ji,jj,jk,1) / e3u(ji,jj,jk,Kmm_a)
END DO
END DO
END DO
ENDIF
!
- DO jk=1,jpk
+ DO jk=1,jpkm1
DO jj=j1,j2
DO ji=i1,i2
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part
- zub = uu(ji,jj,jk,Kbb_a) * e3u(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+ ze3b = e3u(ji,jj,jk,Kbb_a) & ! Recover e3ub before update
+ & - rn_atfp * ( e3u(ji,jj,jk,Kmm_a) - e3u(ji,jj,jk,Krhs_a) )
+ zub = uu(ji,jj,jk,Kbb_a) * ze3b
zuno = uu(ji,jj,jk,Kmm_a) * e3u(ji,jj,jk,Krhs_a)
zunu = tabres_child(ji,jj,jk) * e3u(ji,jj,jk,Kmm_a)
uu(ji,jj,jk,Kbb_a) = ( zub + rn_atfp * ( zunu - zuno) ) &
@@ -616,7 +603,7 @@ CONTAINS
LOGICAL , INTENT(in ) :: before
!
INTEGER :: ji, jj, jk
- REAL(wp) :: zrhox, zvb, zvnu, zvno
+ REAL(wp) :: zvb, zvnu, zvno, ze3b
REAL(wp), DIMENSION(jpi,jpj) :: zpgv ! 2D workspace
! VERTICAL REFINEMENT BEGIN
REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
@@ -629,15 +616,15 @@ CONTAINS
!!---------------------------------------------
!
IF( before ) THEN
- zrhox = Agrif_Rhox()
DO jk=k1,k2
- tabres(i1:i2,j1:j2,jk,1) = zrhox * e1v(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Kmm_a) &
+ tabres(i1:i2,j1:j2,jk,1) = e1v_frac(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Kmm_a) &
& * vmask(i1:i2,j1:j2,jk) * vv(i1:i2,j1:j2,jk,Kmm_a)
END DO
IF ( l_vremap ) THEN
DO jk=k1,k2
- tabres(i1:i2,j1:j2,jk,2) = zrhox * e1v(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Kmm_a) * vmask(i1:i2,j1:j2,jk)
+ tabres(i1:i2,j1:j2,jk,2) = e1v_frac(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Kmm_a) &
+ & * vmask(i1:i2,j1:j2,jk)
END DO
ENDIF
@@ -650,14 +637,14 @@ CONTAINS
DO jj=j1,j2
DO ji=i1,i2
N_in = 0
- DO jk=k1,k2
- IF (tabres(ji,jj,jk,2)* r1_e1v(ji,jj) <= 1.e-6_wp) EXIT
+ DO jk=k1,k2-1
+ IF (tabres(ji,jj,jk,2) <= 1.e-6_wp) EXIT
N_in = N_in + 1
tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2)
- h_in(N_in) = tabres(ji,jj,jk,2) * r1_e1v(ji,jj)
+ h_in(N_in) = tabres(ji,jj,jk,2)
ENDDO
N_out = 0
- DO jk=1,jpk
+ DO jk=1,jpkm1
IF (vmask(ji,jj,jk) == 0._wp) EXIT
N_out = N_out + 1
h_out(N_out) = e3v(ji,jj,jk,Kmm_a)
@@ -694,10 +681,10 @@ CONTAINS
ENDDO
ELSE
- DO jk=k1,k2
+ DO jk=k1,k2-1
DO jj=j1,j2
DO ji=i1,i2
- tabres_child(ji,jj,jk) = tabres(ji,jj,jk,1) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm_a)
+ tabres_child(ji,jj,jk) = tabres(ji,jj,jk,1) / e3v(ji,jj,jk,Kmm_a)
END DO
END DO
END DO
@@ -707,7 +694,9 @@ CONTAINS
DO jj=j1,j2
DO ji=i1,i2
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part
- zvb = vv(ji,jj,jk,Kbb_a) * e3v(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+ ze3b = e3v(ji,jj,jk,Kbb_a) & ! Recover e3vb before update
+ & - rn_atfp * ( e3v(ji,jj,jk,Kmm_a) - e3v(ji,jj,jk,Krhs_a) )
+ zvb = vv(ji,jj,jk,Kbb_a) * ze3b
zvno = vv(ji,jj,jk,Kmm_a) * e3v(ji,jj,jk,Krhs_a)
zvnu = tabres_child(ji,jj,jk) * e3v(ji,jj,jk,Kmm_a)
vv(ji,jj,jk,Kbb_a) = ( zvb + rn_atfp * ( zvnu - zvno) ) &
@@ -765,21 +754,18 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj) :: zpgu ! 2D workspace
!!
INTEGER :: ji, jj, jk
- REAL(wp) :: zrhoy
REAL(wp) :: zcorr
!!---------------------------------------------
!
IF( before ) THEN
- zrhoy = Agrif_Rhoy()
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj) = zrhoy * uu_b(ji,jj,Kmm_a) * hu(ji,jj,Kmm_a) * e2u(ji,jj)
+ tabres(ji,jj) = uu_b(ji,jj,Kmm_a) * hu(ji,jj,Kmm_a) * e2u_frac(ji,jj)
END DO
END DO
ELSE
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj) = tabres(ji,jj) * r1_e2u(ji,jj)
!
! Update barotropic velocities:
IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN
@@ -793,9 +779,36 @@ CONTAINS
END DO
END DO
!
+ ! Correct now and before 3d velocities (needed in case of interface shift)
+ DO jj=j1,j2
+ DO ji=i1,i2
+ zpgu(ji,jj) = 0._wp
+ DO jk=1,jpkm1
+ zpgu(ji,jj) = zpgu(ji,jj) + e3u(ji,jj,jk,Kmm_a) * uu(ji,jj,jk,Kmm_a)
+ END DO
+ !
+ DO jk=1,jpkm1
+ uu(ji,jj,jk,Kmm_a) = uu(ji,jj,jk,Kmm_a) + &
+ & (uu_b(ji,jj,Kmm_a) - zpgu(ji,jj) * r1_hu(ji,jj,Kmm_a)) * umask(ji,jj,jk)
+ END DO
+ !
+ zpgu(ji,jj) = 0._wp
+ DO jk=1,jpkm1
+ zpgu(ji,jj) = zpgu(ji,jj) + e3u(ji,jj,jk,Kbb_a) * uu(ji,jj,jk,Kbb_a)
+ END DO
+ !
+ DO jk=1,jpkm1
+ uu(ji,jj,jk,Kbb_a) = uu(ji,jj,jk,Kbb_a) + &
+ & (uu_b(ji,jj,Kbb_a) - zpgu(ji,jj) * r1_hu(ji,jj,Kbb_a)) * umask(ji,jj,jk)
+ END DO
+ !
+ END DO
+ END DO
+ !
IF ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
uu_b(i1:i2,j1:j2,Kbb_a) = uu_b(i1:i2,j1:j2,Kmm_a)
ENDIF
+ !
ENDIF
!
END SUBROUTINE updateu2d
@@ -812,20 +825,18 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj) :: zpgv ! 2D workspace
!
INTEGER :: ji, jj, jk
- REAL(wp) :: zrhox, zcorr
+ REAL(wp) :: zcorr
!!----------------------------------------------------------------------
!
IF( before ) THEN
- zrhox = Agrif_Rhox()
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj) = zrhox * vv_b(ji,jj,Kmm_a) * hv(ji,jj,Kmm_a) * e1v(ji,jj)
+ tabres(ji,jj) = vv_b(ji,jj,Kmm_a) * hv(ji,jj,Kmm_a) * e1v_frac(ji,jj)
END DO
END DO
ELSE
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj) = tabres(ji,jj) * r1_e1v(ji,jj)
! Update barotropic velocities:
IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part
@@ -838,6 +849,32 @@ CONTAINS
END DO
END DO
!
+ ! Correct now and before 3d velocities (in case of interface shift):
+ DO jj=j1,j2
+ DO ji=i1,i2
+ zpgv(ji,jj) = 0._wp
+ DO jk=1,jpkm1
+ zpgv(ji,jj) = zpgv(ji,jj) + e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)
+ END DO
+ !
+ DO jk=1,jpkm1
+ vv(ji,jj,jk,Kmm_a) = vv(ji,jj,jk,Kmm_a) + &
+ & (vv_b(ji,jj,Kmm_a) - zpgv(ji,jj) * r1_hv(ji,jj,Kmm_a)) * vmask(ji,jj,jk)
+ END DO
+ !
+ zpgv(ji,jj) = 0._wp
+ DO jk=1,jpkm1
+ zpgv(ji,jj) = zpgv(ji,jj) + e3v(ji,jj,jk,Kbb_a) * vv(ji,jj,jk,Kbb_a)
+ END DO
+ !
+ DO jk=1,jpkm1
+ vv(ji,jj,jk,Kbb_a) = vv(ji,jj,jk,Kbb_a) + &
+ & (vv_b(ji,jj,Kbb_a) - zpgv(ji,jj) * r1_hv(ji,jj,Kbb_a)) * vmask(ji,jj,jk)
+ END DO
+ !
+ END DO
+ END DO
+ !
IF ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
vv_b(i1:i2,j1:j2,Kbb_a) = vv_b(i1:i2,j1:j2,Kmm_a)
ENDIF
@@ -861,10 +898,11 @@ CONTAINS
IF( before ) THEN
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj) = ssh(ji,jj,Kmm_a)
+ tabres(ji,jj) = e1e2t_frac(ji,jj) * ssh(ji,jj,Kmm_a)
END DO
END DO
ELSE
+ !
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
DO jj=j1,j2
DO ji=i1,i2
@@ -884,12 +922,62 @@ CONTAINS
ssh(i1:i2,j1:j2,Kbb_a) = ssh(i1:i2,j1:j2,Kmm_a)
ENDIF
!
-
ENDIF
!
END SUBROUTINE updateSSH
+ SUBROUTINE updatetmsk( tabres, i1, i2, j1, j2, before )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE updatetmsk ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ !!----------------------------------------------------------------------
+ !
+ IF( .NOT.before ) THEN
+ tmask_upd(i1:i2,j1:j2) = 1._wp
+ ENDIF
+ !
+ END SUBROUTINE updatetmsk
+
+
+ SUBROUTINE updateumsk( tabres, i1, i2, j1, j2, before )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE updateumsk ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ !!----------------------------------------------------------------------
+ !
+ IF( .NOT.before ) THEN
+ umask_upd(i1:i2,j1:j2) = 1._wp
+ ENDIF
+ !
+ END SUBROUTINE updateumsk
+
+
+ SUBROUTINE updatevmsk( tabres, i1, i2, j1, j2, before )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE updatevmsk ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ !!----------------------------------------------------------------------
+ !
+ IF( .NOT.before ) THEN
+ vmask_upd(i1:i2,j1:j2) = 1._wp
+ ENDIF
+ !
+ END SUBROUTINE updatevmsk
+
+
SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before )
!!----------------------------------------------------------------------
!! *** ROUTINE updateub2b ***
@@ -899,20 +987,16 @@ CONTAINS
LOGICAL , INTENT(in) :: before
!!
INTEGER :: ji, jj
- REAL(wp) :: zrhoy, za1, zcor
+ REAL(wp) :: za1, zcor
!!---------------------------------------------
!
IF (before) THEN
- zrhoy = Agrif_Rhoy()
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj) = ub2_i_b(ji,jj) * e2u(ji,jj)
+ tabres(ji,jj) = ub2_i_b(ji,jj) * e2u_frac(ji,jj)
END DO
END DO
- tabres = zrhoy * tabres
ELSE
- !
- tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e2u(i1:i2,j1:j2)
!
za1 = 1._wp / REAL(Agrif_rhot(), wp)
DO jj=j1,j2
@@ -941,20 +1025,16 @@ CONTAINS
!!
LOGICAL :: western_side, eastern_side
INTEGER :: ji, jj
- REAL(wp) :: zrhoy, za1, zcor
+ REAL(wp) :: zcor
!!---------------------------------------------
!
IF (before) THEN
- zrhoy = Agrif_Rhoy()
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj) = ub2_i_b(ji,jj) * e2u(ji,jj)
+ tabres(ji,jj) = ub2_i_b(ji,jj) * e2u_frac(ji,jj)
END DO
END DO
- tabres = zrhoy * tabres
ELSE
- !
- tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e2u(i1:i2,j1:j2)
!
western_side = (nb == 1).AND.(ndir == 1)
eastern_side = (nb == 1).AND.(ndir == 2)
@@ -987,20 +1067,16 @@ CONTAINS
LOGICAL , INTENT(in ) :: before
!!
INTEGER :: ji, jj
- REAL(wp) :: zrhox, za1, zcor
+ REAL(wp) :: za1, zcor
!!---------------------------------------------
!
IF( before ) THEN
- zrhox = Agrif_Rhox()
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj) = vb2_i_b(ji,jj) * e1v(ji,jj)
+ tabres(ji,jj) = vb2_i_b(ji,jj) * e1v_frac(ji,jj)
END DO
END DO
- tabres = zrhox * tabres
ELSE
- !
- tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e1v(i1:i2,j1:j2)
!
za1 = 1._wp / REAL(Agrif_rhot(), wp)
DO jj=j1,j2
@@ -1029,20 +1105,16 @@ CONTAINS
!!
LOGICAL :: southern_side, northern_side
INTEGER :: ji, jj
- REAL(wp) :: zrhox, za1, zcor
+ REAL(wp) :: zcor
!!---------------------------------------------
!
IF (before) THEN
- zrhox = Agrif_Rhox()
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj) = vb2_i_b(ji,jj) * e1v(ji,jj)
+ tabres(ji,jj) = vb2_i_b(ji,jj) * e1v_frac(ji,jj)
END DO
END DO
- tabres = zrhox * tabres
ELSE
- !
- tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e1v(i1:i2,j1:j2)
!
southern_side = (nb == 2).AND.(ndir == 1)
northern_side = (nb == 2).AND.(ndir == 2)
@@ -1066,56 +1138,6 @@ CONTAINS
!
END SUBROUTINE reflux_sshv
- SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before )
- !
- ! ====>>>>>>>>>> currently not used
- !
- !!----------------------------------------------------------------------
- !! *** ROUTINE updateT ***
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2
- REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
- LOGICAL , INTENT(in ) :: before
- !!
- INTEGER :: ji,jj,jk
- REAL(wp) :: ztemp
- !!----------------------------------------------------------------------
-
- IF (before) THEN
- DO jk=k1,k2
- DO jj=j1,j2
- DO ji=i1,i2
- tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
- tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk)
- tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk)
- END DO
- END DO
- END DO
- tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy()
- tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox()
- tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy()
- ELSE
- DO jk=k1,k2
- DO jj=j1,j2
- DO ji=i1,i2
- IF( tabres(ji,jj,jk,1) .NE. 0._wp ) THEN
- print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
- print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk)
- print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk)
- ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3)))
- print *,'CORR = ',ztemp-1.
- print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, &
- tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp
- e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp
- e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp
- END IF
- END DO
- END DO
- END DO
- ENDIF
- !
- END SUBROUTINE update_scales
-
SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before )
!!----------------------------------------------------------------------
@@ -1167,32 +1189,41 @@ CONTAINS
END SUBROUTINE updateAVM
#if ! defined key_qco && ! defined key_linssh
- SUBROUTINE updatee3t(ptab_dum, i1, i2, j1, j2, k1, k2, before )
+ SUBROUTINE update_e3t(tabres, i1, i2, j1, j2, k1, k2, before )
!!---------------------------------------------
- !! *** ROUTINE updatee3t ***
+ !! *** ROUTINE update_e3t ***
!!---------------------------------------------
- REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ptab_dum
- INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
- LOGICAL, INTENT(in) :: before
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
+ LOGICAL , INTENT(in ) :: before
!
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptab
- INTEGER :: ji,jj,jk
+ INTEGER :: ji, jj, jk
REAL(wp) :: zcoef
+ REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
!!---------------------------------------------
!
- IF (.NOT.before) THEN
- !
- ALLOCATE(ptab(i1:i2,j1:j2,1:jpk))
+ IF ( before ) THEN
+ tabres(i1:i2,j1:j2,k2) = 0._wp
+ IF ( .NOT.l_vremap ) THEN
+ DO jk = k1, k2-1
+ tabres(i1:i2,j1:j2,jk) = e1e2t_frac(i1:i2,j1:j2) &
+ & * e3t(i1:i2,j1:j2,jk,Kmm_a) &
+ & * tmask(i1:i2,j1:j2,jk)
+ END DO
+ ENDIF
+ ELSE
!
- ! Update e3t from ssh (z* case only)
- DO jk = 1, jpkm1
- DO jj=j1,j2
- DO ji=i1,i2
- ptab(ji,jj,jk) = e3t_0(ji,jj,jk) * (1._wp + ssh(ji,jj,Kmm_a) &
- & *ssmask(ji,jj)/(ht_0(ji,jj)-1._wp + ssmask(ji,jj)))
- END DO
+ IF ( .NOT.l_vremap ) THEN ! Update e3t from parent thicknesses
+ tabres_child(i1:i2,j1:j2,1:jpk) = e3t_0(i1:i2,j1:j2,1:jpk)
+ WHERE( tmask(i1:i2,j1:j2,k1:k2) /= 0._wp )
+ tabres_child(i1:i2,j1:j2,k1:k2) = tabres(i1:i2,j1:j2,k1:k2)
+ ENDWHERE
+ ELSE ! Update e3t from ssh
+ DO jk = 1, jpkm1
+ tabres_child(i1:i2,j1:j2,jk) = e3t_0(i1:i2,j1:j2,jk) &
+ * (1._wp + ssh(i1:i2,j1:j2,Kmm_a)*r1_ht_0(i1:i2,j1:j2))
END DO
- END DO
+ ENDIF
!
! 1) Updates at BEFORE time step:
! -------------------------------
@@ -1201,15 +1232,12 @@ CONTAINS
! of prognostic variables
e3t(i1:i2,j1:j2,1:jpkm1,Krhs_a) = e3t(i1:i2,j1:j2,1:jpkm1,Kmm_a)
- ! One should also save e3t(:,:,:,Kbb_a), but lacking of workspace...
-! hdiv(i1:i2,j1:j2,1:jpkm1) = e3t(i1:i2,j1:j2,1:jpkm1,Kbb_a)
-
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler) )) THEN
DO jk = 1, jpkm1
DO jj=j1,j2
DO ji=i1,i2
e3t(ji,jj,jk,Kbb_a) = e3t(ji,jj,jk,Kbb_a) &
- & + rn_atfp * ( ptab(ji,jj,jk) - e3t(ji,jj,jk,Kmm_a) )
+ & + rn_atfp * ( tabres_child(ji,jj,jk) - e3t(ji,jj,jk,Kmm_a) )
END DO
END DO
END DO
@@ -1218,7 +1246,7 @@ CONTAINS
gdepw(i1:i2,j1:j2,1,Kbb_a) = 0.0_wp
gdept(i1:i2,j1:j2,1,Kbb_a) = 0.5_wp * e3w(i1:i2,j1:j2,1,Kbb_a)
!
- DO jk = 2, jpk
+ DO jk = 2, jpkm1
DO jj = j1,j2
DO ji = i1,i2
zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
@@ -1239,7 +1267,7 @@ CONTAINS
! ----------------------------
!
! Update vertical scale factor at T-points:
- e3t(i1:i2,j1:j2,1:jpkm1,Kmm_a) = ptab(i1:i2,j1:j2,1:jpkm1)
+ e3t(i1:i2,j1:j2,1:jpkm1,Kmm_a) = tabres_child(i1:i2,j1:j2,1:jpkm1)
!
! Update total depth:
ht(i1:i2,j1:j2) = 0._wp
@@ -1253,7 +1281,7 @@ CONTAINS
gdepw(i1:i2,j1:j2,1,Kmm_a) = 0.0_wp
gde3w(i1:i2,j1:j2,1) = gdept(i1:i2,j1:j2,1,Kmm_a) - (ht(i1:i2,j1:j2)-ht_0(i1:i2,j1:j2)) ! Last term in the rhs is ssh
!
- DO jk = 2, jpk
+ DO jk = 2, jpkm1
DO jj = j1,j2
DO ji = i1,i2
zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
@@ -1268,37 +1296,472 @@ CONTAINS
END DO
!
IF ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
- e3t (i1:i2,j1:j2,1:jpk,Kbb_a) = e3t (i1:i2,j1:j2,1:jpk,Kmm_a)
- e3w (i1:i2,j1:j2,1:jpk,Kbb_a) = e3w (i1:i2,j1:j2,1:jpk,Kmm_a)
- gdepw(i1:i2,j1:j2,1:jpk,Kbb_a) = gdepw(i1:i2,j1:j2,1:jpk,Kmm_a)
- gdept(i1:i2,j1:j2,1:jpk,Kbb_a) = gdept(i1:i2,j1:j2,1:jpk,Kmm_a)
+ e3t (i1:i2,j1:j2,1:jpkm1,Kbb_a) = e3t (i1:i2,j1:j2,1:jpkm1,Kmm_a)
+ e3w (i1:i2,j1:j2,1:jpkm1,Kbb_a) = e3w (i1:i2,j1:j2,1:jpkm1,Kmm_a)
+ gdepw(i1:i2,j1:j2,1:jpkm1,Kbb_a) = gdepw(i1:i2,j1:j2,1:jpkm1,Kmm_a)
+ gdept(i1:i2,j1:j2,1:jpkm1,Kbb_a) = gdept(i1:i2,j1:j2,1:jpkm1,Kmm_a)
+ ENDIF
+ !
+ ENDIF
+ !
+ END SUBROUTINE update_e3t
+
+
+ SUBROUTINE update_e3u(tabres, i1, i2, j1, j2, k1, k2, before )
+ !!---------------------------------------------
+ !! *** ROUTINE update_e3u ***
+ !!---------------------------------------------
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
+ LOGICAL , INTENT(in ) :: before
+ !
+ INTEGER :: ji, jj, jk
+ REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
+ !!---------------------------------------------
+ !
+ IF ( before ) THEN
+ tabres(i1:i2,j1:j2,k2) = 0._wp
+ IF ( .NOT.l_vremap ) THEN
+ DO jk = k1, k2-1
+ tabres(i1:i2,j1:j2,jk) = e2u_frac(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) * umask(i1:i2,j1:j2,jk)
+ END DO
+ ELSE
+ ! Retrieve sea level at U-points:
+ DO jk = k1, k2-1
+ tabres(i1:i2,j1:j2,k2) = tabres(i1:i2,j1:j2,k2) + &
+ & e2u_frac(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) * umask(i1:i2,j1:j2,jk)
+ END DO
+ tabres(i1:i2,j1:j2,k2) = tabres(i1:i2,j1:j2,k2) - hu_0(i1:i2,j1:j2)
+ ENDIF
+ ELSE
+ !
+ IF ( .NOT.l_vremap ) THEN ! Update e3u from parent thicknesses
+ tabres_child(i1:i2,j1:j2,1:jpk) = e3u_0(i1:i2,j1:j2,1:jpk)
+ WHERE( umask(i1:i2,j1:j2,k1:k2) /= 0._wp )
+ tabres_child(i1:i2,j1:j2,k1:k2) = tabres(i1:i2,j1:j2,k1:k2)
+ ENDWHERE
+ ELSE ! Update e3u from ssh stored in tabres(:,:,k2)
+ DO jk = 1, jpkm1
+ tabres_child(i1:i2,j1:j2,jk) = e3u_0(i1:i2,j1:j2,jk) &
+ * (1._wp + tabres(i1:i2,j1:j2,k2)*r1_hu_0(i1:i2,j1:j2))
+ END DO
+ ENDIF
+ !
+ ! 1) Updates at BEFORE time step:
+ ! -------------------------------
+ !
+ ! Save "old" scale factor (prior update) for subsequent asselin correction
+ ! of prognostic variables
+ e3u(i1:i2,j1:j2,1:jpkm1,Krhs_a) = e3u(i1:i2,j1:j2,1:jpkm1,Kmm_a)
+
+ IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler) )) THEN
+ DO jk = 1, jpkm1
+ DO jj = j1, j2
+ DO ji = i1, i2
+ e3u(ji,jj,jk,Kbb_a) = e3u(ji,jj,jk,Kbb_a) &
+ & + rn_atfp * ( tabres_child(ji,jj,jk) - e3u(ji,jj,jk,Kmm_a) )
+ END DO
+ END DO
+ END DO
+ !
+ ! Update total depth:
+ hu(i1:i2,j1:j2,Kbb_a) = 0._wp
+ DO jk = 1, jpkm1
+ hu(i1:i2,j1:j2,Kbb_a) = hu(i1:i2,j1:j2,Kbb_a) + e3u(i1:i2,j1:j2,jk,Kbb_a) * umask(i1:i2,j1:j2,jk)
+ END DO
+ r1_hu(i1:i2,j1:j2,Kbb_a) = ssumask(i1:i2,j1:j2) / ( hu(i1:i2,j1:j2,Kbb_a) + 1._wp - ssumask(i1:i2,j1:j2) )
+ !
+ e3uw (i1:i2,j1:j2,1,Kbb_a) = e3uw_0(i1:i2,j1:j2,1) + e3u(i1:i2,j1:j2,1,Kbb_a) - e3u_0(i1:i2,j1:j2,1)
+ DO jk = 2, jpkm1
+ DO jj = j1,j2
+ DO ji = i1,i2
+ e3uw(ji,jj,jk,Kbb_a) = e3uw_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * umask(ji,jj,jk) ) * &
+ & ( e3u(ji,jj,jk-1,Kbb_a) - e3u_0(ji,jj,jk-1) ) &
+ & + 0.5_wp * umask(ji,jj,jk) * &
+ & ( e3u(ji,jj,jk ,Kbb_a) - e3u_0(ji,jj,jk ) )
+ END DO
+ END DO
+ END DO
+ !
+ ENDIF
+ !
+ ! 2) Updates at NOW time step:
+ ! ----------------------------
+ !
+ ! Update vertical scale factor at U-points:
+ e3u(i1:i2,j1:j2,1:jpkm1,Kmm_a) = tabres_child(i1:i2,j1:j2,1:jpkm1)
+ !
+ ! Update total depth:
+ hu(i1:i2,j1:j2,Kmm_a) = 0._wp
+ DO jk = 1, jpkm1
+ hu(i1:i2,j1:j2,Kmm_a) = hu(i1:i2,j1:j2,Kmm_a) + e3u(i1:i2,j1:j2,jk,Kmm_a) * umask(i1:i2,j1:j2,jk)
+ END DO
+ r1_hu(i1:i2,j1:j2,Kmm_a) = ssumask(i1:i2,j1:j2) / ( hu(i1:i2,j1:j2,Kmm_a) + 1._wp - ssumask(i1:i2,j1:j2) )
+ !
+ ! Update vertical scale factor at W-points and depths:
+ e3uw (i1:i2,j1:j2,1,Kmm_a) = e3uw_0(i1:i2,j1:j2,1) + e3u(i1:i2,j1:j2,1,Kmm_a) - e3u_0(i1:i2,j1:j2,1)
+ DO jk = 2, jpkm1
+ DO jj = j1,j2
+ DO ji = i1,i2
+ e3uw(ji,jj,jk,Kmm_a) = e3uw_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * umask(ji,jj,jk) ) * &
+ & ( e3u(ji,jj,jk-1,Kmm_a) - e3u_0(ji,jj,jk-1) ) &
+ & + 0.5_wp * umask(ji,jj,jk) * &
+ & ( e3u(ji,jj,jk ,Kmm_a) - e3u_0(ji,jj,jk ) )
+ END DO
+ END DO
+ END DO
+ !
+ IF ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+ e3u (i1:i2,j1:j2,1:jpkm1,Kbb_a) = e3u (i1:i2,j1:j2,1:jpkm1,Kmm_a)
+ e3uw(i1:i2,j1:j2,1:jpkm1,Kbb_a) = e3uw(i1:i2,j1:j2,1:jpkm1,Kmm_a)
+ hu (i1:i2,j1:j2,Kbb_a) = hu (i1:i2,j1:j2,Kmm_a)
+ r1_hu(i1:i2,j1:j2,Kbb_a) = r1_hu(i1:i2,j1:j2,Kmm_a)
ENDIF
!
- DEALLOCATE(ptab)
ENDIF
!
- END SUBROUTINE updatee3t
+ END SUBROUTINE update_e3u
+
+
+ SUBROUTINE update_e3v(tabres, i1, i2, j1, j2, k1, k2, before )
+ !!---------------------------------------------
+ !! *** ROUTINE update_e3v ***
+ !!---------------------------------------------
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
+ LOGICAL , INTENT(in ) :: before
+ !
+ INTEGER :: ji, jj, jk
+ REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
+ !!---------------------------------------------
+ !
+ IF ( before ) THEN
+ tabres(i1:i2,j1:j2,k2) = 0._wp
+ IF ( .NOT.l_vremap ) THEN
+ DO jk = k1, k2-1
+ tabres(i1:i2,j1:j2,jk) = e1v_frac(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Kmm_a) * vmask(i1:i2,j1:j2,jk)
+ END DO
+ ELSE
+ ! Retrieve sea level at V-points:
+ DO jk = k1, k2-1
+ tabres(i1:i2,j1:j2,k2) = tabres(i1:i2,j1:j2,k2) + &
+ & e1v_frac(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Kmm_a) * vmask(i1:i2,j1:j2,jk)
+ END DO
+ tabres(i1:i2,j1:j2,k2) = tabres(i1:i2,j1:j2,k2) - hv_0(i1:i2,j1:j2)
+ ENDIF
+ ELSE
+ !
+ IF ( .NOT.l_vremap ) THEN ! Update e3v from parent thicknesses
+ tabres_child(i1:i2,j1:j2,1:jpk) = e3v_0(i1:i2,j1:j2,1:jpk)
+ WHERE( vmask(i1:i2,j1:j2,k1:k2) /= 0._wp )
+ tabres_child(i1:i2,j1:j2,k1:k2) = tabres(i1:i2,j1:j2,k1:k2)
+ ENDWHERE
+ ELSE ! Update e3v from ssh stored in tabres(:,:,k2)
+ DO jk = 1, jpkm1
+ tabres_child(i1:i2,j1:j2,jk) = e3v_0(i1:i2,j1:j2,jk) &
+ * (1._wp + tabres(i1:i2,j1:j2,k2)*r1_hv_0(i1:i2,j1:j2))
+ END DO
+ ENDIF
+ !
+ ! 1) Updates at BEFORE time step:
+ ! -------------------------------
+ !
+ ! Save "old" scale factor (prior update) for subsequent asselin correction
+ ! of prognostic variables
+ e3v(i1:i2,j1:j2,k1:k2,Krhs_a) = e3v(i1:i2,j1:j2,k1:k2,Kmm_a)
+
+ IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler) )) THEN
+ DO jk = 1, jpkm1
+ DO jj = j1, j2
+ DO ji = i1, i2
+ e3v(ji,jj,jk,Kbb_a) = e3v(ji,jj,jk,Kbb_a) &
+ & + rn_atfp * ( tabres_child(ji,jj,jk) - e3v(ji,jj,jk,Kmm_a) )
+ END DO
+ END DO
+ END DO
+ !
+ ! Update total depth:
+ hv(i1:i2,j1:j2,Kbb_a) = 0._wp
+ DO jk = 1, jpkm1
+ hv(i1:i2,j1:j2,Kbb_a) = hv(i1:i2,j1:j2,Kbb_a) + e3v(i1:i2,j1:j2,jk,Kbb_a) * vmask(i1:i2,j1:j2,jk)
+ END DO
+ r1_hv(i1:i2,j1:j2,Kbb_a) = ssvmask(i1:i2,j1:j2) / ( hv(i1:i2,j1:j2,Kbb_a) + 1._wp - ssvmask(i1:i2,j1:j2) )
+ !
+ e3vw(i1:i2,j1:j2,1,Kbb_a) = e3vw_0(i1:i2,j1:j2,1) + e3v(i1:i2,j1:j2,1,Kbb_a) - e3v_0(i1:i2,j1:j2,1)
+ DO jk = 2, jpkm1
+ DO jj = j1,j2
+ DO ji = i1,i2
+ e3vw(ji,jj,jk,Kbb_a) = e3vw_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * vmask(ji,jj,jk) ) * &
+ & ( e3v(ji,jj,jk-1,Kbb_a) - e3v_0(ji,jj,jk-1) ) &
+ & + 0.5_wp * vmask(ji,jj,jk) * &
+ & ( e3v(ji,jj,jk ,Kbb_a) - e3v_0(ji,jj,jk ) )
+ END DO
+ END DO
+ END DO
+ !
+ ENDIF
+ !
+ ! 2) Updates at NOW time step:
+ ! ----------------------------
+ !
+ ! Update vertical scale factor at U-points:
+ e3v(i1:i2,j1:j2,1:jpkm1,Kmm_a) = tabres_child(i1:i2,j1:j2,1:jpkm1)
+ !
+ ! Update total depth:
+ hv(i1:i2,j1:j2,Kmm_a) = 0._wp
+ DO jk = 1, jpkm1
+ hv(i1:i2,j1:j2,Kmm_a) = hv(i1:i2,j1:j2,Kmm_a) + e3v(i1:i2,j1:j2,jk,Kmm_a) * vmask(i1:i2,j1:j2,jk)
+ END DO
+ r1_hv(i1:i2,j1:j2,Kmm_a) = ssvmask(i1:i2,j1:j2) / ( hv(i1:i2,j1:j2,Kmm_a) + 1._wp - ssvmask(i1:i2,j1:j2) )
+ !
+ ! Update vertical scale factor at W-points and depths:
+ e3vw (i1:i2,j1:j2,1,Kmm_a) = e3vw_0(i1:i2,j1:j2,1) + e3v(i1:i2,j1:j2,1,Kmm_a) - e3v_0(i1:i2,j1:j2,1)
+ DO jk = 2, jpkm1
+ DO jj = j1, j2
+ DO ji = i1, i2
+ e3vw(ji,jj,jk,Kmm_a) = e3vw_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * vmask(ji,jj,jk) ) * &
+ & ( e3v(ji,jj,jk-1,Kmm_a) - e3v_0(ji,jj,jk-1) ) &
+ & + 0.5_wp * vmask(ji,jj,jk) * &
+ & ( e3v(ji,jj,jk ,Kmm_a) - e3v_0(ji,jj,jk ) )
+ END DO
+ END DO
+ END DO
+ !
+ IF ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+ e3v (i1:i2,j1:j2,1:jpkm1,Kbb_a) = e3v (i1:i2,j1:j2,1:jpkm1,Kmm_a)
+ e3vw (i1:i2,j1:j2,1:jpkm1,Kbb_a) = e3vw (i1:i2,j1:j2,1:jpkm1,Kmm_a)
+ hv (i1:i2,j1:j2,Kbb_a) = hv (i1:i2,j1:j2,Kmm_a)
+ r1_hv(i1:i2,j1:j2,Kbb_a) = r1_hv(i1:i2,j1:j2,Kmm_a)
+ ENDIF
+ !
+ ENDIF
+ !
+ END SUBROUTINE update_e3v
+
+
+ SUBROUTINE update_e3f(tabres, i1, i2, j1, j2, k1, k2, before )
+ !!---------------------------------------------
+ !! *** ROUTINE update_e3f ***
+ !!---------------------------------------------
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
+ LOGICAL , INTENT(in ) :: before
+ !
+ INTEGER :: ji, jj, jk
+ REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
+ !!---------------------------------------------
+ !
+ IF ( before ) THEN
+ tabres(i1:i2,j1:j2,k2) = 0._wp
+ IF ( .NOT.l_vremap ) THEN
+ DO jk = k1, k2-1
+ tabres(i1:i2,j1:j2,jk) = e3f(i1:i2,j1:j2,jk) * fe3mask(i1:i2,j1:j2,jk)
+ END DO
+ ELSE
+ ! Retrieve sea level at F-points:
+ DO jk = k1, k2-1
+ tabres(i1:i2,j1:j2,k2) = tabres(i1:i2,j1:j2,k2) + &
+ & e3f(i1:i2,j1:j2,jk) * fe3mask(i1:i2,j1:j2,jk)
+ END DO
+ tabres(i1:i2,j1:j2,k2) = tabres(i1:i2,j1:j2,k2) - hf_0(i1:i2,j1:j2)
+ ENDIF
+ ELSE
+ !
+ IF ( .NOT.l_vremap ) THEN ! Update e3f from parent thicknesses
+ tabres_child(i1:i2,j1:j2,1:jpkm1) = e3f_0(i1:i2,j1:j2,1:jpkm1)
+ WHERE( fe3mask(i1:i2,j1:j2,k1:k2) /= 0._wp )
+ tabres_child(i1:i2,j1:j2,k1:k2) = tabres(i1:i2,j1:j2,k1:k2)
+ ENDWHERE
+ ELSE ! Update e3f from ssh stored in tabres(:,:,k2)
+ DO jk = 1, jpkm1
+ tabres_child(i1:i2,j1:j2,jk) = e3f_0(i1:i2,j1:j2,jk) &
+ * (1._wp + tabres(i1:i2,j1:j2,k2)*r1_hf_0(i1:i2,j1:j2))
+ END DO
+ ENDIF
+ !
+ ! Update vertical scale factor at F-points:
+ e3f(i1:i2,j1:j2,1:jpkm1) = tabres_child(i1:i2,j1:j2,1:jpkm1)
+ !
+ ENDIF
+ !
+ END SUBROUTINE update_e3f
#endif
+#if defined key_qco
+ SUBROUTINE update_r3t(tabres, i1, i2, j1, j2, before )
+ !!---------------------------------------------
+ !! *** ROUTINE update_r3t ***
+ !!---------------------------------------------
+ REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ LOGICAL , INTENT(in ) :: before
+ !
+ !!---------------------------------------------
+ IF ( before ) THEN
+ tabres(i1:i2,j1:j2) = e1e2t_frac(i1:i2,j1:j2) &
+ & * r3t(i1:i2,j1:j2,Kmm_a) &
+ & * ht_0(i1:i2,j1:j2) &
+ & * tmask(i1:i2,j1:j2,1)
+ ELSE
+ !
+ tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_ht_0(i1:i2,j1:j2)
+ !
+ ! 1) Update at BEFORE time step:
+ ! ------------------------------
+ ! Save "old" array (prior update) for subsequent asselin correction
+ ! of prognostic variables
+ r3t(i1:i2,j1:j2,Krhs_a) = r3t(i1:i2,j1:j2,Kmm_a)
+
+ IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler) )) THEN
+ r3t(i1:i2,j1:j2,Kbb_a) = r3t(i1:i2,j1:j2,Kbb_a) &
+ & + rn_atfp * ( tabres(i1:i2,j1:j2) - r3t(i1:i2,j1:j2,Kmm_a) )
+ ENDIF
+ !
+ ! 2) Updates at NOW time step:
+ ! ----------------------------
+ r3t(i1:i2,j1:j2,Kmm_a) = tabres(i1:i2,j1:j2)
+ !
+ ! 3) Special case for euler startup only:
+ ! ---------------------------------------
+ IF ( (l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+ r3t(i1:i2,j1:j2,Kbb_a) = r3t(i1:i2,j1:j2,Kmm_a)
+ ENDIF
+ !
+ ENDIF
+ END SUBROUTINE update_r3t
+
+
+ SUBROUTINE update_r3u(tabres, i1, i2, j1, j2, before )
+ !!---------------------------------------------
+ !! *** ROUTINE update_r3u ***
+ !!---------------------------------------------
+ REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ LOGICAL , INTENT(in ) :: before
+ !
+ !!---------------------------------------------
+ IF ( before ) THEN
+ tabres(i1:i2,j1:j2) = e2u_frac(i1:i2,j1:j2) &
+ & * r3u(i1:i2,j1:j2,Kmm_a) &
+ & * hu_0(i1:i2,j1:j2) &
+ & * umask(i1:i2,j1:j2,1)
+ ELSE
+ !
+ tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_hu_0(i1:i2,j1:j2)
+ !
+ ! 1) Update at BEFORE time step:
+ ! ------------------------------
+ ! Save "old" array (prior update) for subsequent asselin correction
+ ! of prognostic variables
+ r3u(i1:i2,j1:j2,Krhs_a) = r3u(i1:i2,j1:j2,Kmm_a)
+
+ IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler) )) THEN
+ r3u(i1:i2,j1:j2,Kbb_a) = r3u(i1:i2,j1:j2,Kbb_a) &
+ & + rn_atfp * ( tabres(i1:i2,j1:j2) - r3u(i1:i2,j1:j2,Kmm_a) )
+ ENDIF
+ !
+ ! 2) Updates at NOW time step:
+ ! ----------------------------
+ r3u(i1:i2,j1:j2,Kmm_a) = tabres(i1:i2,j1:j2)
+ !
+ ! 3) Special case for euler startup only:
+ ! ---------------------------------------
+ IF ( (l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+ r3u(i1:i2,j1:j2,Kbb_a) = r3u(i1:i2,j1:j2,Kmm_a)
+ ENDIF
+ !
+ ENDIF
+ END SUBROUTINE update_r3u
+
+
+ SUBROUTINE update_r3v(tabres, i1, i2, j1, j2, before )
+ !!---------------------------------------------
+ !! *** ROUTINE update_r3v ***
+ !!---------------------------------------------
+ REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ LOGICAL , INTENT(in ) :: before
+ !
+ !!---------------------------------------------
+ IF ( before ) THEN
+ tabres(i1:i2,j1:j2) = e1v_frac(i1:i2,j1:j2) &
+ & * r3v(i1:i2,j1:j2,Kmm_a) &
+ & * hv_0(i1:i2,j1:j2) &
+ & * vmask(i1:i2,j1:j2,1)
+ ELSE
+ !
+ tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_hv_0(i1:i2,j1:j2)
+ !
+ ! 1) Update at BEFORE time step:
+ ! ------------------------------
+ ! Save "old" array (prior update) for subsequent asselin correction
+ ! of prognostic variables
+ r3v(i1:i2,j1:j2,Krhs_a) = r3v(i1:i2,j1:j2,Kmm_a)
+
+ IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler) )) THEN
+ r3v(i1:i2,j1:j2,Kbb_a) = r3v(i1:i2,j1:j2,Kbb_a) &
+ & + rn_atfp * ( tabres(i1:i2,j1:j2) - r3v(i1:i2,j1:j2,Kmm_a) )
+ ENDIF
+ !
+ ! 2) Updates at NOW time step:
+ ! ----------------------------
+ r3v(i1:i2,j1:j2,Kmm_a) = tabres(i1:i2,j1:j2)
+ !
+ ! 3) Special case for euler startup only:
+ ! ---------------------------------------
+ IF ( (l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN
+ r3v(i1:i2,j1:j2,Kbb_a) = r3v(i1:i2,j1:j2,Kmm_a)
+ ENDIF
+ !
+ ENDIF
+ END SUBROUTINE update_r3v
+
+
+ SUBROUTINE update_r3f(tabres, i1, i2, j1, j2, before )
+ !!---------------------------------------------
+ !! *** ROUTINE update_r3f ***
+ !!---------------------------------------------
+ REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ LOGICAL , INTENT(in ) :: before
+ !
+ !!---------------------------------------------
+ IF ( before ) THEN
+ tabres(i1:i2,j1:j2) = r3f(i1:i2,j1:j2) &
+ & * hf_0(i1:i2,j1:j2) &
+ & * fe3mask(i1:i2,j1:j2,1)
+ ELSE
+ !
+ r3f(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_hf_0(i1:i2,j1:j2)
+ !
+ ENDIF
+ END SUBROUTINE update_r3f
+
+#endif
+
SUBROUTINE Agrif_Check_parent_bat( )
!!----------------------------------------------------------------------
!! *** ROUTINE Agrif_Check_parent_bat ***
!!----------------------------------------------------------------------
!
IF (( .NOT.ln_agrif_2way ).OR.(.NOT.ln_chk_bathy) &
- & .OR.(.NOT.ln_vert_remap).OR.(Agrif_Root())) RETURN
+ & .OR.(Agrif_Root())) RETURN
!
Agrif_UseSpecialValueInUpdate = .FALSE.
+ l_vremap = ln_vert_remap
!
IF(lwp) WRITE(numout,*) ' '
IF(lwp) WRITE(numout,*) 'AGRIF: Check parent volume at Level:', Agrif_Level()
!
# if ! defined DECAL_FEEDBACK
- CALL Agrif_Update_Variable(batupd_id,procname = update_bat)
+ CALL Agrif_Update_Variable(e3t_id,procname = check_parent_e3t0)
+ CALL Agrif_Update_Variable(e3u_id,procname = check_parent_e3u0)
+ CALL Agrif_Update_Variable(e3v_id,procname = check_parent_e3v0)
# else
- CALL Agrif_Update_Variable(batupd_id,locupdate=(/1,0/),procname = update_bat)
+ CALL Agrif_Update_Variable(e3t0_interp_id,locupdate=(/1,0/),procname = check_parent_e3t0)
# endif
!
+ l_vremap = .FALSE.
kindic_agr = Agrif_Parent(kindic_agr)
CALL mpp_sum( 'Agrif_Check_parent_bat', kindic_agr )
@@ -1311,35 +1774,135 @@ CONTAINS
!
END SUBROUTINE Agrif_Check_parent_bat
- SUBROUTINE update_bat(ptab, i1, i2, j1, j2, before )
+
+ SUBROUTINE check_parent_e3t0(ptab, i1, i2, j1, j2, k1, k2, before )
!!---------------------------------------------
- !! *** ROUTINE update_bat ***
+ !! *** ROUTINE check_parent__e3t0 ***
!!---------------------------------------------
- REAL(wp), DIMENSION(i1:i2,j1:j2) :: ptab
- INTEGER, INTENT(in) :: i1, i2, j1, j2
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ptab
+ INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
LOGICAL, INTENT(in) :: before
- INTEGER :: ji, jj
+ INTEGER :: ji, jj, jk
+ REAL(wp), DIMENSION(i1:i2,j1:j2) :: zh0 ! 2D workspace
+ !
+ !!---------------------------------------------
+ !
+ IF( before ) THEN
+ DO jk=k1,k2-1
+ ptab(i1:i2,j1:j2,jk) = e3t_0(i1:i2,j1:j2,jk) * tmask(i1:i2,j1:j2,jk) &
+ & * e1e2t_frac(i1:i2,j1:j2)
+ END DO
+ ELSE
+ kindic_agr = 0
+ !
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( ssmask(ji,jj).NE.0._wp ) THEN
+ IF ( l_vremap ) THEN ! Check total depths:
+ zh0(ji,jj) = 0._wp
+ DO jk=k1,k2-1
+ zh0(ji,jj) = zh0(ji,jj) + ptab(ji,jj,jk)
+ END DO
+ IF (ABS(zh0(ji,jj)-ht_0(ji,jj)).GE.1.e-6) THEN
+ kindic_agr = kindic_agr + 1
+ ENDIF
+ ELSE ! Check individual cells volumes:
+ DO jk=k1,k2-1
+ IF (ABS((ptab(ji,jj,jk)-e3t_0(ji,jj,jk))*tmask(ji,jj,jk)).GE.1.e-6) THEN
+ kindic_agr = kindic_agr + 1
+ ENDIF
+ END DO
+ ENDIF
+ ENDIF
+ END DO
+ END DO
+ !
+ ENDIF
+ !
+ END SUBROUTINE check_parent_e3t0
+
+
+ SUBROUTINE check_parent_e3u0(ptab, i1, i2, j1, j2, k1, k2, before )
+ !!---------------------------------------------
+ !! *** ROUTINE check_parent_e3u0 ***
+ !!---------------------------------------------
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ptab
+ INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+ LOGICAL, INTENT(in) :: before
+ INTEGER :: ji, jj, jk, ikbot
!
!!---------------------------------------------
!
IF( before ) THEN
- ptab(i1:i2,j1:j2) = ht_0(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
+ DO jk=k1,k2-1
+ ptab(i1:i2,j1:j2,jk) = e3u_0(i1:i2,j1:j2,jk) * umask(i1:i2,j1:j2,jk) &
+ & * e2u_frac(i1:i2,j1:j2)
+ END DO
ELSE
kindic_agr = 0
!
DO jj=j1,j2
DO ji=i1,i2
- IF ( (ssmask(ji,jj).NE.0._wp).AND.&
- & (ABS(ptab(ji,jj)-ht_0(ji,jj)).GE.1.e-6) ) THEN
- kindic_agr = kindic_agr + 1
+ IF ( ssumask(ji,jj).NE.0._wp ) THEN
+ IF ( l_vremap ) THEN ! Assume depths can differ: do not check
+ ELSE ! Check individual cells area:
+ DO jk=k1,k2-1
+ IF (ptab(ji,jj,jk)>1.e-6) ikbot = jk
+ ENDDO
+ DO jk=k1,k2-1
+ IF (ABS((ptab(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk)).GE.1.e-6) THEN
+ kindic_agr = kindic_agr + 1
+ print *, 'erro u-pt', mig0(ji), mjg0(jj), jk, mbku(ji,jj), ikbot, ptab(ji,jj,jk), e3u_0(ji,jj,jk)
+ ENDIF
+ END DO
+ ENDIF
ENDIF
END DO
END DO
!
ENDIF
!
- END SUBROUTINE update_bat
+ END SUBROUTINE check_parent_e3u0
+
+ SUBROUTINE check_parent_e3v0(ptab, i1, i2, j1, j2, k1, k2, before )
+ !!---------------------------------------------
+ !! *** ROUTINE check_parent_e3v0 ***
+ !!---------------------------------------------
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ptab
+ INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+ LOGICAL, INTENT(in) :: before
+ INTEGER :: ji, jj, jk
+ !
+ !!---------------------------------------------
+ !
+ IF( before ) THEN
+ DO jk=k1,k2-1
+ ptab(i1:i2,j1:j2,jk) = e3v_0(i1:i2,j1:j2,jk) * vmask(i1:i2,j1:j2,jk) &
+ & * e1v_frac(i1:i2,j1:j2)
+ END DO
+ ELSE
+ kindic_agr = 0
+ !
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( ssvmask(ji,jj).NE.0._wp ) THEN
+ IF ( l_vremap ) THEN ! Assume depths can differ: do not check
+ ELSE ! Check individual cells volumes:
+ DO jk=k1,k2-1
+ IF (ABS((ptab(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk)).GE.1.e-6) THEN
+ kindic_agr = kindic_agr + 1
+ print *, 'erro v-pt', mig0(ji), mjg0(jj), mbkv(ji,jj), ptab(ji,jj,jk), e3v_0(ji,jj,jk)
+ ENDIF
+ END DO
+ ENDIF
+ ENDIF
+ END DO
+ END DO
+ !
+ ENDIF
+ !
+ END SUBROUTINE check_parent_e3v0
#else
!!----------------------------------------------------------------------
!! Empty module no AGRIF zoom
diff --git a/src/NST/agrif_top_interp.F90 b/src/NST/agrif_top_interp.F90
index f82ab3864acd3c4a7aee582a92bc1eb3f089e151..ad7770e4372e5d17aa598ef5c82561164e93ae66 100644
--- a/src/NST/agrif_top_interp.F90
+++ b/src/NST/agrif_top_interp.F90
@@ -43,7 +43,7 @@ CONTAINS
IF( Agrif_Root() ) RETURN
!
Agrif_SpecialValue = 0._wp
- Agrif_UseSpecialValue = .TRUE.
+ Agrif_UseSpecialValue = l_spc_top
l_vremap = ln_vert_remap
!
CALL Agrif_Bc_variable( trn_id, procname=interptrn )
@@ -67,7 +67,7 @@ CONTAINS
! vertical interpolation:
REAL(wp) :: zhtot, zwgt
REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin, tabin_i
- REAL(wp), DIMENSION(k1:k2) :: z_in, h_in_i, z_in_i
+ REAL(wp), DIMENSION(k1:k2) :: z_in, h_in
REAL(wp), DIMENSION(1:jpk) :: h_out, z_out
!!----------------------------------------------------------------------
@@ -91,10 +91,10 @@ CONTAINS
! Warning: these are masked, hence extrapolated prior interpolation.
DO jj=j1,j2
DO ji=i1,i2
- ptab(ji,jj,k1,jptra+1) = 0.5_wp * tmask(ji,jj,k1) * e3t(ji,jj,k1,Kmm_a)
+ ptab(ji,jj,k1,jptra+1) = 0.5_wp * tmask(ji,jj,k1) * e3w(ji,jj,k1,Kmm_a)
DO jk=k1+1,k2
ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * &
- & ( ptab(ji,jj,jk-1,jptra+1) + 0.5_wp * (e3t(ji,jj,jk-1,Kmm_a)+e3t(ji,jj,jk,Kmm_a)) )
+ & ( ptab(ji,jj,jk-1,jptra+1) + e3w(ji,jj,jk,Kmm_a) )
END DO
END DO
END DO
@@ -111,52 +111,65 @@ CONTAINS
IF( l_ini_child ) Krhs_a = Kbb_a
IF( l_vremap .OR. l_ini_child ) THEN
- IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp
+ IF (ln_linssh) THEN
+ ptab(i1:i2,j1:j2,k2,n2) = 0._wp
+
+ ELSE ! Assuming parent volume follows child:
+ ptab(i1:i2,j1:j2,k2,n2) = ssh(i1:i2,j1:j2,Krhs_a)
+ ENDIF
DO jj=j1,j2
DO ji=i1,i2
tr(ji,jj,:,:,Krhs_a) = 0.
!
! Build vertical grids:
- N_in = mbkt_parent(ji,jj)
- N_out = mbkt(ji,jj)
+ ! N_in = mbkt_parent(ji,jj)
+ ! Input grid (account for partial cells if any):
+ N_in = k2-1
+ z_in(1) = ptab(ji,jj,1,n2) - ptab(ji,jj,k2,n2)
+ DO jk=2,k2
+ z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2)
+ IF (( z_in(jk) <= z_in(jk-1) ).OR.(z_in(jk)>ht_0(ji,jj))) EXIT
+ END DO
+ N_in = jk-1
+ DO jk=1, N_in
+ tabin(jk,1:jptra) = ptab(ji,jj,jk,1:jptra)
+ END DO
+
+ IF (ssmask(ji,jj)==1._wp) THEN
+ N_out = mbkt(ji,jj)
+ ELSE
+ N_out = 0
+ ENDIF
+
IF (N_in*N_out > 0) THEN
- ! Input grid (account for partial cells if any):
- DO jk=1,N_in
- z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2)
- tabin(jk,1:jptra) = ptab(ji,jj,jk,1:jptra)
- END DO
-
- ! Intermediate grid:
IF ( l_vremap ) THEN
DO jk = 1, N_in
- h_in_i(jk) = e3t0_parent(ji,jj,jk) * &
+ h_in(jk) = e3t0_parent(ji,jj,jk) * &
& (1._wp + ptab(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj)))
END DO
- z_in_i(1) = 0.5_wp * h_in_i(1)
+ z_in(1) = 0.5_wp * h_in(1)
DO jk=2,N_in
- z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) )
+ z_in(jk) = z_in(jk-1) + 0.5_wp * ( h_in(jk) + h_in(jk-1) )
END DO
- z_in_i(1:N_in) = z_in_i(1:N_in) - ptab(ji,jj,k2,n2)
- ENDIF
+ z_in(1:N_in) = z_in(1:N_in) - ptab(ji,jj,k2,n2)
+ ENDIF
! Output (Child) grid:
DO jk=1,N_out
h_out(jk) = e3t(ji,jj,jk,Krhs_a)
END DO
- z_out(1) = 0.5_wp * h_out(1)
+ z_out(1) = 0.5_wp * e3w(ji,jj,1,Krhs_a)
DO jk=2,N_out
- z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) )
+ z_out(jk) = z_out(jk-1) + e3w(ji,jj,jk,Krhs_a)
END DO
- IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a)
+ IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a)
IF( l_ini_child ) THEN
- CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a), &
+ CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a), &
& z_out(1:N_out),N_in,N_out,jptra)
- ELSE
- CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tabin_i(1:N_in,1:jptra), &
- & z_in_i(1:N_in),N_in,N_in,jptra)
- CALL reconstructandremap(tabin_i(1:N_in,1:jptra),h_in_i(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a), &
+ ELSE
+ CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a), &
& h_out(1:N_out),N_in,N_out,jptra)
ENDIF
ENDIF
@@ -180,9 +193,9 @@ CONTAINS
tabin(jk,1:jptra) = ptab(ji,jj,jk,1:jptra)
END DO
IF (.NOT.ln_linssh) z_in(1:N_in) = z_in(1:N_in) - ptab(ji,jj,k2,n2)
- z_out(1) = 0.5_wp * e3t(ji,jj,1,Krhs_a)
+ z_out(1) = 0.5_wp * e3w(ji,jj,1,Krhs_a)
DO jk=2, N_out
- z_out(jk) = z_out(jk-1) + 0.5_wp * (e3t(ji,jj,jk-1,Krhs_a) + e3t(ji,jj,jk,Krhs_a))
+ z_out(jk) = z_out(jk-1) + e3w(ji,jj,jk,Krhs_a)
END DO
IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a)
CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),ptab(ji,jj,1:N_out,1:jptra), &
diff --git a/src/NST/agrif_top_sponge.F90 b/src/NST/agrif_top_sponge.F90
index d6d51ab6b4a1edefa35b26bbc246527c9df7d8a4..0b29cb59c2d35f57282dc3db7134cac5aaa4429e 100644
--- a/src/NST/agrif_top_sponge.F90
+++ b/src/NST/agrif_top_sponge.F90
@@ -50,7 +50,7 @@ CONTAINS
zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot())
Agrif_SpecialValue = 0._wp
- Agrif_UseSpecialValue = .TRUE.
+ Agrif_UseSpecialValue = l_spc_top
l_vremap = ln_vert_remap
tabspongedone_trn = .FALSE.
!
@@ -101,10 +101,10 @@ CONTAINS
! Warning: these are masked, hence extrapolated prior interpolation.
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj,k1,jptra+1) = 0.5_wp * tmask(ji,jj,k1) * e3t(ji,jj,k1,Kbb_a)
+ tabres(ji,jj,k1,jptra+1) = 0.5_wp * tmask(ji,jj,k1) * e3w(ji,jj,k1,Kbb_a)
DO jk=k1+1,k2
tabres(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * &
- & ( tabres(ji,jj,jk-1,jptra+1) + 0.5_wp * (e3t(ji,jj,jk-1,Kbb_a)+e3t(ji,jj,jk,Kbb_a)) )
+ & ( tabres(ji,jj,jk-1,jptra+1) + e3w(ji,jj,jk,Kbb_a) )
END DO
END DO
END DO
@@ -119,8 +119,13 @@ CONTAINS
ELSE
!
IF ( l_vremap ) THEN
+
+ IF (ln_linssh) THEN
+ tabres(i1:i2,j1:j2,k2,n2) = 0._wp
- IF (ln_linssh) tabres(i1:i2,j1:j2,k2,n2) = 0._wp
+ ELSE ! Assuming parent volume follows child:
+ tabres(i1:i2,j1:j2,k2,n2) = ssh(i1:i2,j1:j2,Kbb_a)
+ ENDIF
DO jj=j1,j2
DO ji=i1,i2
@@ -151,9 +156,9 @@ CONTAINS
DO jk=1,N_out
h_out(jk) = e3t(ji,jj,jk,Kbb_a)
END DO
- z_out(1) = 0.5_wp * h_out(1)
+ z_out(1) = 0.5_wp * e3w(ji,jj,1,Kbb_a)
DO jk=2,N_out
- z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) )
+ z_out(jk) = z_out(jk-1) + e3w(ji,jj,jk,Kbb_a)
END DO
IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Kbb_a)
@@ -164,8 +169,10 @@ CONTAINS
h_in_i(1)= h_in_i(1) - ( sum(h_in_i(1:N_in))-sum(h_out(1:N_out)) )
END IF
IF (N_in*N_out > 0) THEN
- CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tabin_i(1:N_in,1:jptra),z_in_i(1:N_in),N_in,N_in,jptra)
- CALL reconstructandremap(tabin_i(1:N_in,1:jptra),h_in_i(1:N_in),tabres_child(ji,jj,1:N_out,1:jptra),h_out(1:N_out),N_in,N_out,jptra)
+! jc: disable "two steps" vertical remapping
+! since this would require e3w0_parent to be available
+! CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tabin_i(1:N_in,1:jptra),z_in_i(1:N_in),N_in,N_in,jptra)
+ CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in_i(1:N_in),tabres_child(ji,jj,1:N_out,1:jptra),h_out(1:N_out),N_in,N_out,jptra)
! CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jptra),z_out(1:N_in),N_in,N_out,jptra)
ENDIF
END DO
@@ -196,9 +203,9 @@ CONTAINS
END DO
IF (.NOT.ln_linssh) z_in(1:N_in) = z_in(1:N_in) - tabres(ji,jj,k2,n2)
- z_out(1) = 0.5_wp * e3t(ji,jj,1,Kbb_a)
+ z_out(1) = 0.5_wp * e3w(ji,jj,1,Kbb_a)
DO jk=2, N_out
- z_out(jk) = z_out(jk-1) + 0.5_wp * (e3t(ji,jj,jk-1,Kbb_a) + e3t(ji,jj,jk,Kbb_a))
+ z_out(jk) = z_out(jk-1) + e3w(ji,jj,jk,Kbb_a)
END DO
IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Kbb_a)
diff --git a/src/NST/agrif_top_update.F90 b/src/NST/agrif_top_update.F90
index ed73b6bd80c2f81a03bd3ab4d4b5b39586dc8b48..9a8f188f92c3c50980e4ee2aa3511d18a9a4c7f3 100644
--- a/src/NST/agrif_top_update.F90
+++ b/src/NST/agrif_top_update.F90
@@ -42,7 +42,7 @@ CONTAINS
IF (Agrif_Root()) RETURN
!
l_vremap = ln_vert_remap
- Agrif_UseSpecialValueInUpdate = .NOT.l_vremap
+ Agrif_UseSpecialValueInUpdate = .FALSE.
Agrif_SpecialValueFineGrid = 0._wp
!
@@ -66,7 +66,7 @@ CONTAINS
LOGICAL, INTENT(in) :: before
!!
INTEGER :: ji,jj,jk,jn
- REAL(wp) :: ztb, ztnu, ztno
+ REAL(wp) :: ztb, ztnu, ztno, ze3b
REAL(wp) :: h_in(k1:k2)
REAL(wp) :: h_out(1:jpk)
INTEGER :: N_in, N_out
@@ -75,34 +75,25 @@ CONTAINS
REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jptra) :: tabres_child
IF (before) THEN
- IF ( l_vremap ) THEN
- DO jn = n1,n2-1
- DO jk=k1,k2
- DO jj=j1,j2
- DO ji=i1,i2
- tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a)
- END DO
- END DO
- END DO
- END DO
+ DO jn = n1,n2-1
DO jk=k1,k2
DO jj=j1,j2
DO ji=i1,i2
- tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)
+ tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) &
+ & * e1e2t_frac(ji,jj)
END DO
END DO
END DO
- ELSE
- DO jn = 1,jptra
- DO jk=k1,k2
- DO jj=j1,j2
- DO ji=i1,i2
- tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk)
- END DO
+ END DO
+ IF ( l_vremap ) THEN
+ DO jk=k1,k2
+ DO jj=j1,j2
+ DO ji=i1,i2
+ tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) &
+ & * e1e2t_frac(ji,jj)
END DO
END DO
END DO
-
ENDIF
ELSE
IF ( l_vremap ) THEN
@@ -114,7 +105,9 @@ CONTAINS
DO jk=k1,k2 !k2 = jpk of child grid
IF (tabres(ji,jj,jk,n2) <= 1.e-6_wp ) EXIT
N_in = N_in + 1
- tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2)
+ DO jn=n1,n2-1
+ tabin(jk,jn) = tabres(ji,jj,jk,jn)/tabres(ji,jj,jk,n2)
+ END DO
h_in(N_in) = tabres(ji,jj,jk,n2)
ENDDO
N_out = 0
@@ -136,7 +129,9 @@ CONTAINS
DO jj = j1, j2
DO ji = i1, i2
IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN
- ztb = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+ ze3b = e3t(ji,jj,jk,Kbb_a) & ! Recover e3tb before update
+ & - rn_atfp * ( e3t(ji,jj,jk,Kmm_a) - e3t(ji,jj,jk,Krhs_a) )
+ ztb = tr(ji,jj,jk,jn,Kbb_a) * ze3b
ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a)
ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) ) &
@@ -160,8 +155,10 @@ CONTAINS
END DO
ELSE
DO jn = 1,jptra
- tabres(i1:i2,j1:j2,k1:k2,jn) = tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) &
- & * tmask(i1:i2,j1:j2,k1:k2)
+ DO jk = k1, k2
+ tabres(i1:i2,j1:j2,jk,jn) = tabres(i1:i2,j1:j2,jk,jn) &
+ & * tmask(i1:i2,j1:j2,jk)
+ END DO
ENDDO
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
! Add asselin part
@@ -170,7 +167,9 @@ CONTAINS
DO jj = j1, j2
DO ji = i1, i2
IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN
- ztb = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used
+ ze3b = e3t(ji,jj,jk,Kbb_a) & ! Recover e3tb before update
+ & - rn_atfp * ( e3t(ji,jj,jk,Kmm_a) - e3t(ji,jj,jk,Krhs_a) )
+ ztb = tr(ji,jj,jk,jn,Kbb_a) * ze3b
ztnu = tabres(ji,jj,jk,jn)
ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)
tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) ) &
diff --git a/src/NST/agrif_user.F90 b/src/NST/agrif_user.F90
index 06bf76ce78af4fc937b3fa4af78327dc2a3bb445..321c5b91d2ab8ceabf81420df48d8f5151b819fd 100644
--- a/src/NST/agrif_user.F90
+++ b/src/NST/agrif_user.F90
@@ -1,5 +1,4 @@
#undef UPD_HIGH /* MIX HIGH UPDATE */
-#define DIV_CONS /* DIVERGENCE CONS */
#if defined key_agrif
!! * Substitutions
# include "do_loop_substitute.h90"
@@ -89,11 +88,23 @@
ind1 = MAX(nbghostcellsfine_tot_x, nbghostcellsfine_tot_y)
imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
- CALL agrif_declare_variable((/2,2,0 /),(/ind2 ,ind3,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /), e3t_id)
- CALL agrif_declare_variable((/2,2,0 /),(/ind2 ,ind3,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /),e3t0_interp_id)
+ CALL agrif_declare_variable((/2,2,0 /),(/ind2 ,ind3, 0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /), e3t_id)
+ CALL agrif_declare_variable((/1,2,0 /),(/ind2-1,ind3, 0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /), e3u_id)
+ CALL agrif_declare_variable((/2,1,0 /),(/ind2 ,ind3-1,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /), e3v_id)
+ CALL agrif_declare_variable((/1,1,0 /),(/ind2-1,ind3-1,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /), e3f_id)
+#if defined key_qco
+ CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), r3t_id)
+ CALL agrif_declare_variable((/1,2 /),(/ind2-1,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), r3u_id)
+ CALL agrif_declare_variable((/2,1 /),(/ind2 ,ind3-1 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), r3v_id)
+ CALL agrif_declare_variable((/1,1 /),(/ind2-1,ind3-1 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), r3f_id)
+#endif
+ CALL agrif_declare_variable((/2,2,0 /),(/ind2 ,ind3 ,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /),e3t0_interp_id)
CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), mbkt_id)
CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), ht0_id)
-
+ CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), e1e2t_frac_id)
+ CALL agrif_declare_variable((/1,2 /),(/ind2-1,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), e2u_frac_id)
+ CALL agrif_declare_variable((/2,1 /),(/ind2 ,ind3-1 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), e1v_frac_id)
+
! Initial or restart velues
its = jpts+1
CALL agrif_declare_variable((/2,2,0,0/),(/ind2 ,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,its/), tsini_id)
@@ -101,18 +112,32 @@
CALL agrif_declare_variable((/2,1,0,0/),(/ind2 ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /), vini_id)
CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /),sshini_id)
!
- ! Update location
- CALL agrif_declare_variable((/2,2/),(/ind2 ,ind3 /),(/'x','y'/),(/1,1/),(/jpi,jpj/), batupd_id)
! 2. Type of interpolation
!-------------------------
CALL Agrif_Set_bcinterp( e3t_id,interp =AGRIF_constant)
+ CALL Agrif_Set_bcinterp( e3u_id,interp =AGRIF_constant)
+ CALL Agrif_Set_bcinterp( e3v_id,interp =AGRIF_constant)
+ CALL Agrif_Set_bcinterp( e3f_id,interp =AGRIF_constant)
+#if defined key_qco
+ CALL Agrif_Set_bcinterp( r3t_id,interp =AGRIF_constant)
+ CALL Agrif_Set_bcinterp( r3u_id,interp =AGRIF_constant)
+ CALL Agrif_Set_bcinterp( r3v_id,interp =AGRIF_constant)
+ CALL Agrif_Set_bcinterp( r3f_id,interp =AGRIF_constant)
+#endif
CALL Agrif_Set_bcinterp(e3t0_interp_id,interp =AGRIF_linear )
CALL Agrif_Set_interp (e3t0_interp_id,interp =AGRIF_linear )
CALL Agrif_Set_bcinterp( mbkt_id,interp =AGRIF_constant)
CALL Agrif_Set_interp ( mbkt_id,interp =AGRIF_constant)
CALL Agrif_Set_bcinterp( ht0_id,interp =AGRIF_constant)
CALL Agrif_Set_interp ( ht0_id,interp =AGRIF_constant)
+ CALL Agrif_Set_bcinterp( e1e2t_frac_id,interp =AGRIF_constant)
+ CALL Agrif_Set_interp ( e1e2t_frac_id,interp =AGRIF_constant)
+ CALL Agrif_Set_bcinterp( e2u_frac_id,interp =AGRIF_constant)
+ CALL Agrif_Set_interp ( e2u_frac_id,interp =AGRIF_constant)
+ CALL Agrif_Set_bcinterp( e1v_frac_id,interp =AGRIF_constant)
+ CALL Agrif_Set_interp ( e1v_frac_id,interp =AGRIF_constant)
+
! Initial fields
CALL Agrif_Set_bcinterp( tsini_id,interp =AGRIF_linear )
@@ -121,30 +146,57 @@
CALL Agrif_Set_interp ( uini_id,interp =AGRIF_linear )
CALL Agrif_Set_bcinterp( vini_id,interp =AGRIF_linear )
CALL Agrif_Set_interp ( vini_id,interp =AGRIF_linear )
- CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear )
+ IF ( lk_div_cons ) THEN
+ CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_constant)
+ ELSE
+ CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear )
+ ENDIF
CALL Agrif_Set_interp (sshini_id,interp =AGRIF_linear )
! 3. Location of interpolation
!-----------------------------
CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
-
+ CALL Agrif_Set_bc( e3u_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
+ CALL Agrif_Set_bc( e3v_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
+ CALL Agrif_Set_bc( e3f_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
+#if defined key_qco
+ CALL Agrif_Set_bc( r3t_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
+ CALL Agrif_Set_bc( r3u_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
+ CALL Agrif_Set_bc( r3v_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
+ CALL Agrif_Set_bc( r3f_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
+#endif
! extend the interpolation zone by 1 more point than necessary:
! RB check here
CALL Agrif_Set_bc( e3t0_interp_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
+ CALL Agrif_Set_bc( e1e2t_frac_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
+ CALL Agrif_Set_bc( e2u_frac_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
+ CALL Agrif_Set_bc( e1v_frac_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
CALL Agrif_Set_bc( tsini_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4
CALL Agrif_Set_bc( uini_id, (/0,ind1-1/) )
CALL Agrif_Set_bc( vini_id, (/0,ind1-1/) )
- CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) )
+ CALL Agrif_Set_bc( sshini_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
! 4. Update type
!---------------
# if defined UPD_HIGH
- CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Full_Weighting)
+ CALL Agrif_Set_Updatetype(e3t0_interp_id, update = Agrif_Update_Full_Weighting)
+#if defined key_qco
+ CALL Agrif_Set_Updatetype( r3t_id,update = Agrif_Update_Full_Weighting)
+ CALL Agrif_Set_Updatetype( r3u_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
+ CALL Agrif_Set_Updatetype( r3v_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
+ CALL Agrif_Set_Updatetype( r3f_id,update = Agrif_Update_Copy )
+#endif
#else
- CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Average)
+ CALL Agrif_Set_Updatetype(e3t0_interp_id, update = Agrif_Update_Average)
+#if defined key_qco
+ CALL Agrif_Set_Updatetype( r3t_id,update = AGRIF_Update_Average)
+ CALL Agrif_Set_Updatetype( r3u_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
+ CALL Agrif_Set_Updatetype( r3v_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
+ CALL Agrif_Set_Updatetype( r3f_id,update = Agrif_Update_Copy )
+#endif
#endif
CALL Agrif_Set_ExternalMapping(nemo_mapping)
@@ -186,14 +238,17 @@
! Build consistent parent bathymetry and number of levels
! on the child grid
- Agrif_UseSpecialValue = .FALSE.
+ Agrif_UseSpecialValue = .TRUE.
ht0_parent( :,:) = 0._wp
mbkt_parent(:,:) = 0
!
! CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
! CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
- CALL Agrif_Init_Variable(ht0_id , procname=interpht0 )
- CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt)
+ CALL Agrif_Init_Variable(ht0_id, procname=interpht0 )
+ CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt)
+ CALL Agrif_Init_variable(e1e2t_frac_id, procname=interp_e1e2t_frac)
+ CALL Agrif_Init_variable( e2u_frac_id, procname=interp_e2u_frac)
+ CALL Agrif_Init_variable( e1v_frac_id, procname=interp_e1v_frac)
!
! Assume step wise change of bathymetry near interface
! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case
@@ -317,7 +372,7 @@
! 2. First interpolations of potentially non zero fields
!-------------------------------------------------------
Agrif_SpecialValue = 0._wp
- Agrif_UseSpecialValue = .TRUE.
+ Agrif_UseSpecialValue = l_spc_tra
l_vremap = ln_vert_remap
CALL Agrif_Bc_variable(ts_interp_id,calledweight=1.,procname=interptsn)
CALL Agrif_Sponge
@@ -350,7 +405,7 @@
uu(:,:,:,Krhs_a) = 0._wp
vv(:,:,:,Krhs_a) = 0._wp
- Agrif_UseSpecialValue = .TRUE.
+ Agrif_UseSpecialValue = l_spc_ssh
CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
hbdy(:,:) = 0._wp
ssh(:,:,Krhs_a) = 0._wp
@@ -449,6 +504,7 @@
CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id)
CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/) ,sshn_id)
+ CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/) ,sshn_frc_id)
CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_interp_id)
CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_interp_id)
CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id)
@@ -473,27 +529,43 @@
! 2. Type of interpolation
!-------------------------
- CALL Agrif_Set_bcinterp( ts_interp_id,interp =AGRIF_linear)
- CALL Agrif_Set_bcinterp( ts_sponge_id,interp =AGRIF_linear)
-
-#if defined DIV_CONS
- lk_tint2d_notinterp = .TRUE.
- CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
- CALL Agrif_Set_bcinterp(ub2b_cor_id,interp=AGRIF_constant)
- CALL Agrif_Set_bcinterp(vb2b_cor_id,interp=AGRIF_constant)
- CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_linearconserv)
- CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_linearconserv,interp2=Agrif_linear)
-#else
- lk_tint2d_notinterp = .FALSE.
- CALL Agrif_Set_bcinterp(sshn_id,interp =AGRIF_linear)
- CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
- CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-#endif
-
- CALL Agrif_Set_bcinterp(unb_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
- CALL Agrif_Set_bcinterp(vnb_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
- CALL Agrif_Set_bcinterp(unb_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
- CALL Agrif_Set_bcinterp(vnb_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
+ l_spc_tra = .TRUE. ! No extrapolation
+ CALL Agrif_Set_bcinterp( ts_interp_id,interp =AGRIF_constant)
+ CALL Agrif_Set_bcinterp( ts_sponge_id,interp =AGRIF_constant)
+! l_spc_tra = .TRUE. ! Use extrapolation
+! CALL Agrif_Set_bcinterp( ts_interp_id,interp =AGRIF_linear)
+! CALL Agrif_Set_bcinterp( ts_sponge_id,interp =AGRIF_linear)
+
+ IF ( lk_div_cons ) THEN
+ l_spc_ssh = .FALSE.
+ CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bcinterp(ub2b_cor_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bcinterp(vb2b_cor_id,interp=AGRIF_constant)
+! JC: Disable this until we found a workaround for masked corners:
+! Revert to zero order interpolation meanwhile
+! CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_linearconserv)
+! CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_linearconserv,interp2=Agrif_linear)
+ CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant)
+ CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear)
+
+ CALL Agrif_Set_bcinterp(unb_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant )
+ CALL Agrif_Set_bcinterp(vnb_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear )
+ CALL Agrif_Set_bcinterp(unb_sponge_id,interp1=Agrif_linear,interp2=AGRIF_constant )
+ CALL Agrif_Set_bcinterp(vnb_sponge_id,interp1=AGRIF_constant,interp2=Agrif_linear )
+
+ CALL Agrif_Set_bcinterp(sshn_frc_id,interp=AGRIF_constant)
+
+ ELSE
+ l_spc_ssh = .TRUE.
+ CALL Agrif_Set_bcinterp(sshn_id,interp =AGRIF_linear)
+ CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+ CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+ CALL Agrif_Set_bcinterp(unb_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
+ CALL Agrif_Set_bcinterp(vnb_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
+ CALL Agrif_Set_bcinterp(unb_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
+ CALL Agrif_Set_bcinterp(vnb_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
+ ENDIF
CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
@@ -501,6 +573,12 @@
CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
+! CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant )
+! CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_constant ,interp2=Agrif_linear)
+
+! CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_constant )
+! CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_constant ,interp2=Agrif_linear)
+
IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
@@ -518,6 +596,7 @@
CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) ) ! columns 4 to 11
CALL Agrif_Set_bc( sshn_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
+ CALL Agrif_Set_bc( sshn_frc_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
CALL Agrif_Set_bc( unb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
CALL Agrif_Set_bc( vnb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
CALL Agrif_Set_bc(ub2b_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
@@ -543,7 +622,11 @@
CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
CALL Agrif_Set_Updatetype( sshn_id,update = Agrif_Update_Full_Weighting)
+ CALL Agrif_Set_Updatetype( sshn_frc_id,update = Agrif_Update_Full_Weighting)
CALL Agrif_Set_Updatetype( e3t_id,update = Agrif_Update_Full_Weighting)
+ CALL Agrif_Set_Updatetype( e3u_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
+ CALL Agrif_Set_Updatetype( e3v_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
+ CALL Agrif_Set_Updatetype( e3f_id,update = Agrif_Update_Copy )
! IF( ln_zdftke.OR.ln_zdfgls ) THEN
! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
@@ -561,7 +644,11 @@
CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
CALL Agrif_Set_Updatetype( sshn_id,update = AGRIF_Update_Average)
+ CALL Agrif_Set_Updatetype( sshn_frc_id,update = AGRIF_Update_Average)
CALL Agrif_Set_Updatetype( e3t_id,update = AGRIF_Update_Average)
+ CALL Agrif_Set_Updatetype( e3u_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
+ CALL Agrif_Set_Updatetype( e3v_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
+ CALL Agrif_Set_Updatetype( e3f_id,update = Agrif_Update_Copy )
! IF( ln_zdftke.OR.ln_zdfgls ) THEN
! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
@@ -715,8 +802,8 @@
! 2. First interpolations of potentially non zero fields
!-------------------------------------------------------
- Agrif_SpecialValue=0._wp
- Agrif_UseSpecialValue = .TRUE.
+ Agrif_SpecialValue = 0._wp
+ Agrif_UseSpecialValue = l_spc_top
l_vremap = ln_vert_remap
CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
CALL Agrif_Sponge
@@ -791,8 +878,12 @@
! 2. Type of interpolation
!-------------------------
- CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
- CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
+! l_spc_top = .TRUE.
+! CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
+! CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
+ l_spc_top = .FALSE.
+ CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_constant)
! 3. Location of interpolation
!-----------------------------
diff --git a/src/OCE/DOM/dom_oce.F90 b/src/OCE/DOM/dom_oce.F90
index 9cfa0f0c3edf277998be7a5f80afa7dfc10525f0..7d73a76d14d0446a62b183b4c1d1beaf83bc553a 100644
--- a/src/OCE/DOM/dom_oce.F90
+++ b/src/OCE/DOM/dom_oce.F90
@@ -199,6 +199,7 @@ MODULE dom_oce
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WU- and WV-pts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_upd, umask_upd, vmask_upd !: land/ocean mask at F-pts
!!----------------------------------------------------------------------
!! calendar variables
@@ -338,6 +339,11 @@ CONTAINS
!
ii = ii+1
ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(ii) )
+ !
+#if defined key_agrif
+ ii = ii+1
+ ALLOCATE( tmask_upd(jpi,jpj) , umask_upd(jpi,jpj), vmask_upd(jpi,jpj) , STAT=ierr(ii) )
+#endif
!
dom_oce_alloc = MAXVAL(ierr)
!
diff --git a/src/OCE/DOM/dommsk.F90 b/src/OCE/DOM/dommsk.F90
index 3d349e1f192dbe88eb1edf4b483f5bc4b3a35130..904fec9b03f78748a6aa4e12da5f2420d1f7428d 100644
--- a/src/OCE/DOM/dommsk.F90
+++ b/src/OCE/DOM/dommsk.F90
@@ -217,6 +217,16 @@ CONTAINS
!
CALL usr_def_fmask( cn_cfg, nn_cfg, fmask )
!
+#if defined key_agrif
+ ! Reset masks defining updated points over parent grids
+ ! = 1 : updated point from child(s)
+ ! = 0 : point not updated
+ !
+ tmask_upd(:,:) = 0._wp
+ umask_upd(:,:) = 0._wp
+ vmask_upd(:,:) = 0._wp
+#endif
+ !
END SUBROUTINE dom_msk
!!======================================================================
diff --git a/src/OCE/DOM/domvvl.F90 b/src/OCE/DOM/domvvl.F90
index e0f3af4023f5fc87c5a3abc536c3533073bde01f..7d36c28556ceaabee2503d63bcf363c025209b1e 100644
--- a/src/OCE/DOM/domvvl.F90
+++ b/src/OCE/DOM/domvvl.F90
@@ -537,6 +537,15 @@ CONTAINS
IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssh(:,:,Kaa)))) =', z_tmax
END IF
+#if defined key_agrif
+ ! *********************************** !
+ ! After scale factors at w- points !
+ ! *********************************** !
+ ! At some point, "after" depths at T-points may be required
+ ! for AGRIF vertical remap. To prevent from saving an
+ ! additional array, re-compute depths from e3w when needed
+ CALL dom_vvl_interpol( e3t(:,:,:,Kaa), e3w(:,:,:,Kaa), 'W' )
+#endif
! *********************************** !
! After scale factors at u- v- points !
! *********************************** !
diff --git a/src/OCE/DOM/dtatsd.F90 b/src/OCE/DOM/dtatsd.F90
index 6652d962b4ddc5704ce151139c6b0c19e9d7866c..e4059c253cf43de79a0f4c24c7c4b791e6cc8c25 100644
--- a/src/OCE/DOM/dtatsd.F90
+++ b/src/OCE/DOM/dtatsd.F90
@@ -200,7 +200,8 @@ CONTAINS
ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk)
END_3D
!
- IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==!
+! JC I think it's more convenient to consider the general sco case as the rule
+! IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==!
!
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
IF( kt == nit000 .AND. lwp )THEN
@@ -236,31 +237,31 @@ CONTAINS
ptsd(ji,jj,jpk,jp_sal) = 0._wp
END_2D
!
- ELSE !== z- or zps- coordinate ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
- ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask
- ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
- END_3D
- !
- IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- ik = mbkt(ji,jj)
- IF( ik > 1 ) THEN
- zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
- ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
- ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
- ENDIF
- ik = mikt(ji,jj)
- IF( ik > 1 ) THEN
- zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
- ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem)
- ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
- END IF
- END_2D
- ENDIF
- !
- ENDIF
+! ELSE !== z- or zps- coordinate ==!
+! !
+! DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+! ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask
+! ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
+! END_3D
+! !
+! IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level
+! DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+! ik = mbkt(ji,jj)
+! IF( ik > 1 ) THEN
+! zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+! ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
+! ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
+! ENDIF
+! ik = mikt(ji,jj)
+! IF( ik > 1 ) THEN
+! zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
+! ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem)
+! ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
+! END IF
+! END_2D
+! ENDIF
+! !
+! ENDIF
!
IF( .NOT.ln_tsd_dmp ) THEN !== deallocate T & S structure ==!
! (data used only for initialisation)
diff --git a/src/OCE/DYN/dynspg_ts.F90 b/src/OCE/DYN/dynspg_ts.F90
index 06840a7127a3690404b3b6b05b751d0b5f1e7e34..f8856aedf4774b83c2f8cc215cf73454827f0540 100644
--- a/src/OCE/DYN/dynspg_ts.F90
+++ b/src/OCE/DYN/dynspg_ts.F90
@@ -156,7 +156,7 @@ CONTAINS
REAL(wp) :: zztmp, zldg ! - -
REAL(wp) :: zhu_bck, zhv_bck, zhdiv ! - -
REAL(wp) :: zun_save, zvn_save ! - -
- REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg, zssh_frc
+ REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg
REAL(wp), DIMENSION(jpi,jpj) :: zv_trd, zv_frc, zv_spg
REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhtp2_e
REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zsshp2_e
@@ -319,17 +319,17 @@ CONTAINS
! != Net water flux forcing applied to a water column =!
! ! --------------------------------------------------- !
IF (ln_bt_fw) THEN ! FORWARD integration: use kt+1/2 fluxes (NOW+1/2)
- zssh_frc(:,:) = r1_rho0 * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) )
+ ssh_frc(:,:) = r1_rho0 * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) )
ELSE ! CENTRED integration: use kt-1/2 + kt+1/2 fluxes (NOW)
zztmp = r1_rho0 * r1_2
- zssh_frc(:,:) = zztmp * ( emp(:,:) + emp_b(:,:) &
- & - rnf(:,:) - rnf_b(:,:) &
- & - fwfisf_cav(:,:) - fwfisf_cav_b(:,:) &
- & - fwfisf_par(:,:) - fwfisf_par_b(:,:) )
+ ssh_frc(:,:) = zztmp * ( emp(:,:) + emp_b(:,:) &
+ & - rnf(:,:) - rnf_b(:,:) &
+ & - fwfisf_cav(:,:) - fwfisf_cav_b(:,:) &
+ & - fwfisf_par(:,:) - fwfisf_par_b(:,:) )
ENDIF
! != Add Stokes drift divergence =! (if exist)
IF( ln_sdw ) THEN ! ----------------------------- !
- zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:)
+ ssh_frc(:,:) = ssh_frc(:,:) + div_sd(:,:)
ENDIF
!
! ! ice sheet coupling
@@ -337,12 +337,12 @@ CONTAINS
!
! ice sheet coupling
IF( ln_rstart .AND. kt == nit000 ) THEN
- zssh_frc(:,:) = zssh_frc(:,:) + risfcpl_ssh(:,:)
+ ssh_frc(:,:) = ssh_frc(:,:) + risfcpl_ssh(:,:)
END IF
!
! conservation option
IF( ln_isfcpl_cons ) THEN
- zssh_frc(:,:) = zssh_frc(:,:) + risfcpl_cons_ssh(:,:)
+ ssh_frc(:,:) = ssh_frc(:,:) + risfcpl_cons_ssh(:,:)
END IF
!
END IF
@@ -351,7 +351,7 @@ CONTAINS
! != Add the IAU weighted SSH increment =!
! ! ------------------------------------ !
IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
- zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:)
+ ssh_frc(:,:) = ssh_frc(:,:) - ssh_iau(:,:)
ENDIF
#endif
! != Fill boundary data arrays for AGRIF
@@ -507,9 +507,9 @@ CONTAINS
!
#if defined key_agrif
! Set fluxes during predictor step to ensure volume conservation
- IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) CALL agrif_dyn_ts_flux( jn, zhU, zhV )
+ IF( ln_bt_fw ) CALL agrif_dyn_ts_flux( jn, zhU, zhV )
#endif
- IF( ln_wd_il ) CALL wad_lmt_bt(zhU, zhV, sshn_e, zssh_frc, rDt_e) !!gm wad_lmt_bt use of lbc_lnk on zhU, zhV
+ IF( ln_wd_il ) CALL wad_lmt_bt(zhU, zhV, sshn_e, ssh_frc, rDt_e) !!gm wad_lmt_bt use of lbc_lnk on zhU, zhV
IF( ln_wd_dl ) THEN ! un_e and vn_e are set to zero at faces where
! ! the direction of the flow is from dry cells
@@ -524,7 +524,7 @@ CONTAINS
!-------------------------------------------------------------------------!
DO_2D( 0, 0, 0, 0 )
zhdiv = ( zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1) ) * r1_e1e2t(ji,jj)
- ssha_e(ji,jj) = ( sshn_e(ji,jj) - rDt_e * ( zssh_frc(ji,jj) + zhdiv ) ) * ssmask(ji,jj)
+ ssha_e(ji,jj) = ( sshn_e(ji,jj) - rDt_e * ( ssh_frc(ji,jj) + zhdiv ) ) * ssmask(ji,jj)
END_2D
!
CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._wp, zhU, 'U', -1._wp, zhV, 'V', -1._wp )
@@ -532,7 +532,7 @@ CONTAINS
! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T)
IF( ln_bdy ) CALL bdy_ssh( ssha_e )
#if defined key_agrif
- IF( .NOT.Agrif_Root() ) CALL agrif_ssh_ts( jn )
+ CALL agrif_ssh_ts( jn )
#endif
!
! ! Sum over sub-time-steps to compute advective velocities
@@ -697,7 +697,7 @@ CONTAINS
! ! open boundaries
IF( ln_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e )
#if defined key_agrif
- IF( .NOT.Agrif_Root() ) CALL agrif_dyn_ts( jn ) ! Agrif
+ CALL agrif_dyn_ts( jn ) ! Agrif
#endif
! !* Swap
! ! ----
diff --git a/src/OCE/IOM/restart.F90 b/src/OCE/IOM/restart.F90
index 13a2fcff2f074dd8094384b88af66ef401117891..783247cc1a063303d335fc67727cd9716be3da43 100644
--- a/src/OCE/IOM/restart.F90
+++ b/src/OCE/IOM/restart.F90
@@ -30,6 +30,9 @@ MODULE restart
USE usrdef_istate, ONLY : usr_def_istate_ssh ! user defined ssh initial state
USE trdmxl_oce ! ocean active mixed layer tracers trends variables
USE diu_bulk ! ???
+#if defined key_agrif
+ USE agrif_oce_interp
+#endif
!
USE in_out_manager ! I/O manager
USE iom ! I/O module
@@ -378,6 +381,10 @@ CONTAINS
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' Euler first time step : ssh(Kbb) = ssh(Kmm)'
ssh(:,:,Kbb) = ssh(:,:,Kmm)
+#if defined key_agrif
+ ! Set ghosts points from parent
+ IF (.NOT.Agrif_Root()) CALL Agrif_istate_ssh( Kbb, Kmm, Kaa, .true. )
+#endif
!
ELSE !* MLF: read ssh at Kbb
IF(lwp) WRITE(numout,*)
@@ -412,7 +419,10 @@ CONTAINS
CALL usr_def_istate_ssh( tmask, ssh(:,:,Kbb) )
!
ENDIF
- !
+#if defined key_agrif
+ ! Set ghosts points from parent
+ IF (.NOT.Agrif_Root()) CALL Agrif_istate_ssh( Kbb, Kmm, Kaa, .true. )
+#endif
#if defined key_RK3
ssh(:,:,Kmm) = 0._wp !* RK3: set Kmm to 0 for AGRIF
#else
diff --git a/src/OCE/oce.F90 b/src/OCE/oce.F90
index 5c8e630d5cb398361086b3c5c2fdf90f084fd495..db45ce295f45f0577c01c50a9f84a48dd6cde58d 100644
--- a/src/OCE/oce.F90
+++ b/src/OCE/oce.F90
@@ -34,7 +34,8 @@ MODULE oce
!! free surface
!! ------------
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ssh, uu_b, vv_b !: SSH [m] and barotropic velocities [m/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ssh, uu_b, vv_b !: SSH [m] and barotropic velocities [m/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssh_frc !: Forcing term in external mode for SSH [m/s]
!! Arrays at barotropic time step: ! befbefore! before ! now ! after !
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubb_e , ub_e , un_e , ua_e !: u-external velocity
@@ -96,6 +97,7 @@ CONTAINS
& rhd (jpi,jpj,jpk) , rhop (jpi,jpj,jpk) , STAT=ierr(1) )
!
ALLOCATE( ssh (jpi,jpj,jpt) , uu_b(jpi,jpj,jpt) , vv_b(jpi,jpj,jpt) , &
+ & ssh_frc(jpi,jpj) , &
& gtsu(jpi,jpj,jpts) , gtsv(jpi,jpj,jpts) , &
& gru (jpi,jpj) , grv (jpi,jpj) , &
& gtui(jpi,jpj,jpts) , gtvi(jpi,jpj,jpts) , &
diff --git a/tests/DOME/EXPREF/1_namelist_cfg b/tests/DOME/EXPREF/1_namelist_cfg
index 71d30acbc21eb1e12ebf25d6af9b0b253fe0ab49..7cafa15f9cff6de024b101ae5b15a6e9dcd43395 100644
--- a/tests/DOME/EXPREF/1_namelist_cfg
+++ b/tests/DOME/EXPREF/1_namelist_cfg
@@ -7,6 +7,7 @@
&namagrif ! AGRIF zoom ("key_agrif")
!-----------------------------------------------------------------------
ln_vert_remap = .true. ! use vertical remapping
+ rn_sponge_tra = 0.0 ! coefficient for tracer sponge layer []
/
!-----------------------------------------------------------------------
&namusr_def ! User defined : OVERFLOW configuration
@@ -205,7 +206,7 @@
!-----------------------------------------------------------------------
&namzdf ! vertical physics (default: NO selection)
!-----------------------------------------------------------------------
- ln_zad_Aimp = .false. ! Courant number dependent scheme (Shchepetkin 2015)
+ ln_zad_Aimp = .true. ! Courant number dependent scheme (Shchepetkin 2015)
! ! type of vertical closure (required)
ln_zdfcst = .false. ! constant mixing
ln_zdfric = .false. ! local Richardson dependent formulation (T => fill namzdf_ric)
diff --git a/tests/DOME/EXPREF/anim_dome.py b/tests/DOME/EXPREF/anim_dome.py
index 22c48efb20acb97a519693d934dddd1f3f82e6ec..c194926da3cf006f3e29090b7ce36f401d7159cb 100755
--- a/tests/DOME/EXPREF/anim_dome.py
+++ b/tests/DOME/EXPREF/anim_dome.py
@@ -14,8 +14,8 @@ from matplotlib.animation import FuncAnimation
#
# Parent grid data:
ncid = Dataset('DOME_grid_T.nc')
-lon0 = ncid.variables['nav_lon'][:, :]
-lat0 = ncid.variables['nav_lat'][:, :]
+lon0 = ncid.variables['nav_lon_grid_T'][:, :]
+lat0 = ncid.variables['nav_lat_grid_T'][:, :]
work = ncid.variables['btra'][:, :, :]
zos = ncid.variables['zos'][:, :, :]
ncid.close()
@@ -27,8 +27,8 @@ tra0 = np.ma.array(work, mask=mask, hard_mask=True)
#
# Child grid data:
ncid = Dataset('1_DOME_grid_T.nc')
-lon1 = ncid.variables['nav_lon'][:, :]
-lat1 = ncid.variables['nav_lat'][:, :]
+lon1 = ncid.variables['nav_lon_grid_T'][:, :]
+lat1 = ncid.variables['nav_lat_grid_T'][:, :]
work = ncid.variables['btra'][:, :, :]
zos = ncid.variables['zos'][:, :, :]
sp = ncid.variables['Agrif_sponge'][:, :, :]
diff --git a/tools/DOMAINcfg/1_namelist_ref b/tools/DOMAINcfg/1_namelist_ref
deleted file mode 100644
index 273d80f61c6d9fd702e55bb8bcd3459cb992ceae..0000000000000000000000000000000000000000
--- a/tools/DOMAINcfg/1_namelist_ref
+++ /dev/null
@@ -1,210 +0,0 @@
-!! NEMO/OCE : Reference namelist_ref !!
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/OCE : 1 - Domain & run manager (namrun, namcfg, namdom, namzgr, namzgr_sco )
-!! 2 - diagnostics (namnc4)
-!! 3 - miscellaneous (nammpp, namctl)
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!-----------------------------------------------------------------------
-&namrun ! parameters of the run
-!-----------------------------------------------------------------------
- cn_exp = "ORCA2" ! experience name
- nn_it000 = 1 ! first time step
- nn_itend = 5840 ! last time step (std 5840)
- nn_date0 = 010101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
- nn_time0 = 0 ! initial time of day in hhmm
- nn_leapy = 0 ! Leap year calendar (1) or not (0)
- ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%)
- ln_clobber = .true. ! clobber (overwrite) an existing file
- nn_chunksz = 0 ! chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
- ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard
- ln_iscpl = .false. ! cavity evolution forcing or coupling to ice sheet model
-/
-!-----------------------------------------------------------------------
-&namdom ! space and time domain (bathymetry, mesh, timestep)
-!-----------------------------------------------------------------------
- ln_read_cfg = .false. ! Read from a domain_cfg file
- nn_bathy = 1 ! compute analyticaly (=0) or read (=1) the bathymetry file
- ! or compute (2) from external bathymetry
- nn_interp = 1 ! type of interpolation (nn_bathy =2)
- cn_domcfg = ' ' ! Name of the domain_cfg input file
- cn_fcoord = 'coordinates.nc' ! external coordinates file (jphgr_msh = 0)
- cn_topo = 'bathy_meter.nc ' ! external topo file (nn_bathy =1/2)
- cn_topolvl = 'bathy_level.nc ' ! external topo file (nn_bathy =1)
- cn_fisfd = 'isf_draft_meter.nc' ! external isf draft (nn_bathy =1 and ln_isfcav = .true.)
- cn_bath = 'Bathymetry' ! topo name in file (nn_bathy =1/2)
- cn_bathlvl = 'Bathy_level' ! lvl name in file (nn_bathy =1)
- cn_visfd = 'isf_draft' ! isf draft variable (nn_bathy =1 and ln_isfcav = .true.)
- cn_lon = 'nav_lon' ! lon name in file (nn_bathy =2)
- cn_lat = 'nav_lat' ! lat name in file (nn_bathy =2)
- rn_bathy = 0. ! value of the bathymetry. if (=0) bottom flat at jpkm1
- nn_msh = 0 ! create (=1) a mesh file or not (=0)
- rn_hmin = -3. ! min depth of the ocean (>0) or min number of ocean level (<0)
- rn_e3zps_min= 20. ! partial step thickness is set larger than the minimum of
- rn_e3zps_rat= 0.1 ! rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
- !
- rn_rdt = 5760. ! time step for the dynamics (and tracer if nn_acc=0)
- rn_atfp = 0.1 ! asselin time filter parameter
- ln_crs = .false. ! Logical switch for coarsening module
- jphgr_msh = 0 ! type of horizontal mesh
- ! = 0 curvilinear coordinate on the sphere read in coordinate.nc
- ! = 1 geographical mesh on the sphere with regular grid-spacing
- ! = 2 f-plane with regular grid-spacing
- ! = 3 beta-plane with regular grid-spacing
- ! = 4 Mercator grid with T/U point at the equator
- ppglam0 = 0.0 ! longitude of first raw and column T-point (jphgr_msh = 1)
- ppgphi0 = -35.0 ! latitude of first raw and column T-point (jphgr_msh = 1)
- ppe1_deg = 1.0 ! zonal grid-spacing (degrees)
- ppe2_deg = 0.5 ! meridional grid-spacing (degrees)
- ppe1_m = 5000.0 ! zonal grid-spacing (degrees)
- ppe2_m = 5000.0 ! meridional grid-spacing (degrees)
- ppsur = -4762.96143546300 ! ORCA r4, r2 and r05 coefficients
- ppa0 = 255.58049070440 ! (default coefficients)
- ppa1 = 245.58132232490 !
- ppkth = 21.43336197938 !
- ppacr = 3.0 !
- ppdzmin = 10. ! Minimum vertical spacing
- pphmax = 5000. ! Maximum depth
- ldbletanh = .TRUE. ! Use/do not use double tanf function for vertical coordinates
- ppa2 = 100.760928500000 ! Double tanh function parameters
- ppkth2 = 48.029893720000 !
- ppacr2 = 13.000000000000 !
-/
-!-----------------------------------------------------------------------
-&namcfg ! parameters of the configuration
-!-----------------------------------------------------------------------
- !
- ln_e3_dep = .true. ! =T : e3=dk[depth] in discret sens.
- ! ! ===>>> will become the only possibility in v4.0
- ! ! =F : e3 analytical derivative of depth function
- ! ! only there for backward compatibility test with v3.6
- ! !
- cp_cfg = "orca" ! name of the configuration
- jp_cfg = 2 ! resolution of the configuration
- jpidta = 180 ! 1st lateral dimension ( >= jpi )
- jpjdta = 148 ! 2nd " " ( >= jpj )
- jpkdta = 31 ! number of levels ( >= jpk )
- Ni0glo = 180 ! 1st dimension of global domain --> i =jpidta
- Nj0glo = 148 ! 2nd - - --> j =jpjdta
- jpkglo = 31
- jperio = 4 ! lateral cond. type (between 0 and 6)
- ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
- ! in netcdf input files, as the start j-row for reading
- ln_domclo = .false. ! computation of closed sea masks (see namclo)
-/
-!-----------------------------------------------------------------------
-&namzgr ! vertical coordinate (default: NO selection)
-!-----------------------------------------------------------------------
- ln_zco = .false. ! z-coordinate - full steps
- ln_zps = .false. ! z-coordinate - partial steps
- ln_sco = .false. ! s- or hybrid z-s-coordinate
- ln_isfcav = .false. ! ice shelf cavity (T: see namzgr_isf)
-/
-!-----------------------------------------------------------------------
-&namzgr_isf ! isf cavity geometry definition (default: OFF)
-!-----------------------------------------------------------------------
- rn_isfdep_min = 10. ! minimum isf draft tickness (if lower, isf draft set to this value)
- rn_glhw_min = 1.e-3 ! minimum water column thickness to define the grounding line
- rn_isfhw_min = 10 ! minimum water column thickness in the cavity once the grounding line defined.
- ln_isfchannel = .false. ! remove channel (based on 2d mask build from isfdraft-bathy)
- ln_isfconnect = .false. ! force connection under the ice shelf (based on 2d mask build from isfdraft-bathy)
- nn_kisfmax = 999 ! limiter in level on the previous condition. (if change larger than this number, get back to value before we enforce the connection)
- rn_zisfmax = 7000. ! limiter in m on the previous condition. (if change larger than this number, get back to value before we enforce the connection)
- ln_isfcheminey = .false. ! close cheminey
- ln_isfsubgl = .false. ! remove subglacial lake created by the remapping process
- rn_isfsubgllon = 0.0 ! longitude of the seed to determine the open ocean
- rn_isfsubgllat = 0.0 ! latitude of the seed to determine the open ocean
-/
-!-----------------------------------------------------------------------
-&namzgr_sco ! s-coordinate or hybrid z-s-coordinate (default: OFF)
-!-----------------------------------------------------------------------
- ln_s_sh94 = .false. ! Song & Haidvogel 1994 hybrid S-sigma (T)|
- ln_s_sf12 = .false. ! Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
- ln_sigcrit = .false. ! use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
- ! stretching coefficients for all functions
- rn_sbot_min = 10.0 ! minimum depth of s-bottom surface (>0) (m)
- rn_sbot_max = 7000.0 ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
- rn_hc = 150.0 ! critical depth for transition to stretched coordinates
- !!!!!!! Envelop bathymetry
- rn_rmax = 0.3 ! maximum cut-off r-value allowed (0<r_max<1)
- !!!!!!! SH94 stretching coefficients (ln_s_sh94 = .true.)
- rn_theta = 6.0 ! surface control parameter (0<=theta<=20)
- rn_bb = 0.8 ! stretching with SH94 s-sigma
- !!!!!!! SF12 stretching coefficient (ln_s_sf12 = .true.)
- rn_alpha = 4.4 ! stretching with SF12 s-sigma
- rn_efold = 0.0 ! efold length scale for transition to stretched coord
- rn_zs = 1.0 ! depth of surface grid box
- ! bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
- rn_zb_a = 0.024 ! bathymetry scaling factor for calculating Zb
- rn_zb_b = -0.2 ! offset for calculating Zb
- !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above]
- rn_thetb = 1.0 ! bottom control parameter (0<=thetb<= 1)
-/
-!-----------------------------------------------------------------------
-&namclo ! (closed sea : need ln_domclo = .true. in namcfg) (default: OFF)
-!-----------------------------------------------------------------------
- rn_lon_opnsea = 0.0 ! longitude seed of open ocean
- rn_lat_opnsea = 0.0 ! latitude seed of open ocean
- nn_closea = 8 ! number of closed seas ( = 0; only the open_sea mask will be computed)
- !
- ! name ! lon_src ! lat_src ! lon_trg ! lat_trg ! river mouth area ! correction scheme ! radius trg ! id trg
- ! ! (degree)! (degree)! (degree)! (degree)! local/coast/global ! (glo/rnf/emp) ! (m) !
- ! North American lakes
- sn_lake(1) = 'superior' , -86.57 , 47.30 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(2) = 'michigan' , -87.06 , 42.74 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(3) = 'huron' , -82.51 , 44.74 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(4) = 'erie' , -81.13 , 42.25 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(5) = 'ontario' , -77.72 , 43.62 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- ! African Lake
- sn_lake(6) = 'victoria' , 32.93 , -1.08 , 30.44 , 31.37 , 'coast' , 'emp' , 100000.0 , 3
- ! Asian Lakes
- sn_lake(7) = 'caspian' , 50.0 , 44.0 , 0.0 , 0.0 , 'global' , 'glo' , 0.0 , 1
- sn_lake(8) = 'aral' , 60.0 , 45.0 , 0.0 , 0.0 , 'global' , 'glo' , 0.0 , 1
-/
-!-----------------------------------------------------------------------
-&namlbc ! lateral momentum boundary condition (default: NO selection)
-!-----------------------------------------------------------------------
- ! ! free slip ! partial slip ! no slip ! strong slip
- rn_shlat = 0 ! shlat = 0 ! 0 < shlat < 2 ! shlat = 2 ! 2 < shlat
- ln_vorlat = .false. ! consistency of vorticity boundary condition with analytical Eqs.
-/
-!-----------------------------------------------------------------------
-&namagrif ! AGRIF zoom ("key_agrif")
-!-----------------------------------------------------------------------
- ln_remove_closedseas = .true. ! Fill lakes inside zoom
- ln_vert_remap = .false. ! volume conserving update
- npt_connect = 2
- npt_copy = 2
-/
-!-----------------------------------------------------------------------
-&nammpp ! Massively Parallel Processing ("key_mpp_mpi")
-!-----------------------------------------------------------------------
- ln_listonly = .false. ! do nothing else than listing the best domain decompositions (with land domains suppression)
- ! ! if T: the largest number of cores tested is defined by max(mppsize, jpni*jpnj)
- ln_nnogather = .true. ! activate code to avoid mpi_allgather use at the northfold
- jpni = 0 ! number of processors following i (set automatically if < 1), see also ln_listonly = T
- jpnj = 0 ! number of processors following j (set automatically if < 1), see also ln_listonly = T
- nn_hls = 1 ! halo width (applies to both rows and columns)
-/
-!-----------------------------------------------------------------------
-&namctl ! Control prints (default: OFF)
-!-----------------------------------------------------------------------
- sn_cfctl%l_runstat = .FALSE. ! switches and which areas produce reports with the proc integer settings.
- sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure
- sn_cfctl%l_oceout = .FALSE. ! that all areas report.
- sn_cfctl%l_layout = .FALSE. !
- sn_cfctl%l_prtctl = .FALSE. !
- sn_cfctl%l_prttrc = .FALSE. !
- sn_cfctl%l_oasout = .FALSE. !
- sn_cfctl%procmin = 0 ! Minimum area number for reporting [default:0]
- sn_cfctl%procmax = 1000000 ! Maximum area number for reporting [default:1000000]
- sn_cfctl%procincr = 1 ! Increment for optional subsetting of areas [default:1]
- sn_cfctl%ptimincr = 1 ! Timestep increment for writing time step progress info
- nn_ictls = 0 ! start i indice of control sum (use to compare mono versus
- nn_ictle = 0 ! end i indice of control sum multi processor runs
- nn_jctls = 0 ! start j indice of control over a subdomain)
- nn_jctle = 0 ! end j indice of control
- nn_isplt = 1 ! number of processors in i-direction
- nn_jsplt = 1 ! number of processors in j-direction
- ln_timing = .false. ! timing by routine write out in timing.output file
- ln_diacfl = .false. ! CFL diagnostics write out in cfl_diagnostics.ascii
-/
diff --git a/tools/DOMAINcfg/2_namelist_ref b/tools/DOMAINcfg/2_namelist_ref
deleted file mode 100644
index 273d80f61c6d9fd702e55bb8bcd3459cb992ceae..0000000000000000000000000000000000000000
--- a/tools/DOMAINcfg/2_namelist_ref
+++ /dev/null
@@ -1,210 +0,0 @@
-!! NEMO/OCE : Reference namelist_ref !!
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/OCE : 1 - Domain & run manager (namrun, namcfg, namdom, namzgr, namzgr_sco )
-!! 2 - diagnostics (namnc4)
-!! 3 - miscellaneous (nammpp, namctl)
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!-----------------------------------------------------------------------
-&namrun ! parameters of the run
-!-----------------------------------------------------------------------
- cn_exp = "ORCA2" ! experience name
- nn_it000 = 1 ! first time step
- nn_itend = 5840 ! last time step (std 5840)
- nn_date0 = 010101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
- nn_time0 = 0 ! initial time of day in hhmm
- nn_leapy = 0 ! Leap year calendar (1) or not (0)
- ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%)
- ln_clobber = .true. ! clobber (overwrite) an existing file
- nn_chunksz = 0 ! chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
- ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard
- ln_iscpl = .false. ! cavity evolution forcing or coupling to ice sheet model
-/
-!-----------------------------------------------------------------------
-&namdom ! space and time domain (bathymetry, mesh, timestep)
-!-----------------------------------------------------------------------
- ln_read_cfg = .false. ! Read from a domain_cfg file
- nn_bathy = 1 ! compute analyticaly (=0) or read (=1) the bathymetry file
- ! or compute (2) from external bathymetry
- nn_interp = 1 ! type of interpolation (nn_bathy =2)
- cn_domcfg = ' ' ! Name of the domain_cfg input file
- cn_fcoord = 'coordinates.nc' ! external coordinates file (jphgr_msh = 0)
- cn_topo = 'bathy_meter.nc ' ! external topo file (nn_bathy =1/2)
- cn_topolvl = 'bathy_level.nc ' ! external topo file (nn_bathy =1)
- cn_fisfd = 'isf_draft_meter.nc' ! external isf draft (nn_bathy =1 and ln_isfcav = .true.)
- cn_bath = 'Bathymetry' ! topo name in file (nn_bathy =1/2)
- cn_bathlvl = 'Bathy_level' ! lvl name in file (nn_bathy =1)
- cn_visfd = 'isf_draft' ! isf draft variable (nn_bathy =1 and ln_isfcav = .true.)
- cn_lon = 'nav_lon' ! lon name in file (nn_bathy =2)
- cn_lat = 'nav_lat' ! lat name in file (nn_bathy =2)
- rn_bathy = 0. ! value of the bathymetry. if (=0) bottom flat at jpkm1
- nn_msh = 0 ! create (=1) a mesh file or not (=0)
- rn_hmin = -3. ! min depth of the ocean (>0) or min number of ocean level (<0)
- rn_e3zps_min= 20. ! partial step thickness is set larger than the minimum of
- rn_e3zps_rat= 0.1 ! rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
- !
- rn_rdt = 5760. ! time step for the dynamics (and tracer if nn_acc=0)
- rn_atfp = 0.1 ! asselin time filter parameter
- ln_crs = .false. ! Logical switch for coarsening module
- jphgr_msh = 0 ! type of horizontal mesh
- ! = 0 curvilinear coordinate on the sphere read in coordinate.nc
- ! = 1 geographical mesh on the sphere with regular grid-spacing
- ! = 2 f-plane with regular grid-spacing
- ! = 3 beta-plane with regular grid-spacing
- ! = 4 Mercator grid with T/U point at the equator
- ppglam0 = 0.0 ! longitude of first raw and column T-point (jphgr_msh = 1)
- ppgphi0 = -35.0 ! latitude of first raw and column T-point (jphgr_msh = 1)
- ppe1_deg = 1.0 ! zonal grid-spacing (degrees)
- ppe2_deg = 0.5 ! meridional grid-spacing (degrees)
- ppe1_m = 5000.0 ! zonal grid-spacing (degrees)
- ppe2_m = 5000.0 ! meridional grid-spacing (degrees)
- ppsur = -4762.96143546300 ! ORCA r4, r2 and r05 coefficients
- ppa0 = 255.58049070440 ! (default coefficients)
- ppa1 = 245.58132232490 !
- ppkth = 21.43336197938 !
- ppacr = 3.0 !
- ppdzmin = 10. ! Minimum vertical spacing
- pphmax = 5000. ! Maximum depth
- ldbletanh = .TRUE. ! Use/do not use double tanf function for vertical coordinates
- ppa2 = 100.760928500000 ! Double tanh function parameters
- ppkth2 = 48.029893720000 !
- ppacr2 = 13.000000000000 !
-/
-!-----------------------------------------------------------------------
-&namcfg ! parameters of the configuration
-!-----------------------------------------------------------------------
- !
- ln_e3_dep = .true. ! =T : e3=dk[depth] in discret sens.
- ! ! ===>>> will become the only possibility in v4.0
- ! ! =F : e3 analytical derivative of depth function
- ! ! only there for backward compatibility test with v3.6
- ! !
- cp_cfg = "orca" ! name of the configuration
- jp_cfg = 2 ! resolution of the configuration
- jpidta = 180 ! 1st lateral dimension ( >= jpi )
- jpjdta = 148 ! 2nd " " ( >= jpj )
- jpkdta = 31 ! number of levels ( >= jpk )
- Ni0glo = 180 ! 1st dimension of global domain --> i =jpidta
- Nj0glo = 148 ! 2nd - - --> j =jpjdta
- jpkglo = 31
- jperio = 4 ! lateral cond. type (between 0 and 6)
- ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
- ! in netcdf input files, as the start j-row for reading
- ln_domclo = .false. ! computation of closed sea masks (see namclo)
-/
-!-----------------------------------------------------------------------
-&namzgr ! vertical coordinate (default: NO selection)
-!-----------------------------------------------------------------------
- ln_zco = .false. ! z-coordinate - full steps
- ln_zps = .false. ! z-coordinate - partial steps
- ln_sco = .false. ! s- or hybrid z-s-coordinate
- ln_isfcav = .false. ! ice shelf cavity (T: see namzgr_isf)
-/
-!-----------------------------------------------------------------------
-&namzgr_isf ! isf cavity geometry definition (default: OFF)
-!-----------------------------------------------------------------------
- rn_isfdep_min = 10. ! minimum isf draft tickness (if lower, isf draft set to this value)
- rn_glhw_min = 1.e-3 ! minimum water column thickness to define the grounding line
- rn_isfhw_min = 10 ! minimum water column thickness in the cavity once the grounding line defined.
- ln_isfchannel = .false. ! remove channel (based on 2d mask build from isfdraft-bathy)
- ln_isfconnect = .false. ! force connection under the ice shelf (based on 2d mask build from isfdraft-bathy)
- nn_kisfmax = 999 ! limiter in level on the previous condition. (if change larger than this number, get back to value before we enforce the connection)
- rn_zisfmax = 7000. ! limiter in m on the previous condition. (if change larger than this number, get back to value before we enforce the connection)
- ln_isfcheminey = .false. ! close cheminey
- ln_isfsubgl = .false. ! remove subglacial lake created by the remapping process
- rn_isfsubgllon = 0.0 ! longitude of the seed to determine the open ocean
- rn_isfsubgllat = 0.0 ! latitude of the seed to determine the open ocean
-/
-!-----------------------------------------------------------------------
-&namzgr_sco ! s-coordinate or hybrid z-s-coordinate (default: OFF)
-!-----------------------------------------------------------------------
- ln_s_sh94 = .false. ! Song & Haidvogel 1994 hybrid S-sigma (T)|
- ln_s_sf12 = .false. ! Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
- ln_sigcrit = .false. ! use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
- ! stretching coefficients for all functions
- rn_sbot_min = 10.0 ! minimum depth of s-bottom surface (>0) (m)
- rn_sbot_max = 7000.0 ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
- rn_hc = 150.0 ! critical depth for transition to stretched coordinates
- !!!!!!! Envelop bathymetry
- rn_rmax = 0.3 ! maximum cut-off r-value allowed (0<r_max<1)
- !!!!!!! SH94 stretching coefficients (ln_s_sh94 = .true.)
- rn_theta = 6.0 ! surface control parameter (0<=theta<=20)
- rn_bb = 0.8 ! stretching with SH94 s-sigma
- !!!!!!! SF12 stretching coefficient (ln_s_sf12 = .true.)
- rn_alpha = 4.4 ! stretching with SF12 s-sigma
- rn_efold = 0.0 ! efold length scale for transition to stretched coord
- rn_zs = 1.0 ! depth of surface grid box
- ! bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
- rn_zb_a = 0.024 ! bathymetry scaling factor for calculating Zb
- rn_zb_b = -0.2 ! offset for calculating Zb
- !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above]
- rn_thetb = 1.0 ! bottom control parameter (0<=thetb<= 1)
-/
-!-----------------------------------------------------------------------
-&namclo ! (closed sea : need ln_domclo = .true. in namcfg) (default: OFF)
-!-----------------------------------------------------------------------
- rn_lon_opnsea = 0.0 ! longitude seed of open ocean
- rn_lat_opnsea = 0.0 ! latitude seed of open ocean
- nn_closea = 8 ! number of closed seas ( = 0; only the open_sea mask will be computed)
- !
- ! name ! lon_src ! lat_src ! lon_trg ! lat_trg ! river mouth area ! correction scheme ! radius trg ! id trg
- ! ! (degree)! (degree)! (degree)! (degree)! local/coast/global ! (glo/rnf/emp) ! (m) !
- ! North American lakes
- sn_lake(1) = 'superior' , -86.57 , 47.30 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(2) = 'michigan' , -87.06 , 42.74 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(3) = 'huron' , -82.51 , 44.74 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(4) = 'erie' , -81.13 , 42.25 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(5) = 'ontario' , -77.72 , 43.62 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- ! African Lake
- sn_lake(6) = 'victoria' , 32.93 , -1.08 , 30.44 , 31.37 , 'coast' , 'emp' , 100000.0 , 3
- ! Asian Lakes
- sn_lake(7) = 'caspian' , 50.0 , 44.0 , 0.0 , 0.0 , 'global' , 'glo' , 0.0 , 1
- sn_lake(8) = 'aral' , 60.0 , 45.0 , 0.0 , 0.0 , 'global' , 'glo' , 0.0 , 1
-/
-!-----------------------------------------------------------------------
-&namlbc ! lateral momentum boundary condition (default: NO selection)
-!-----------------------------------------------------------------------
- ! ! free slip ! partial slip ! no slip ! strong slip
- rn_shlat = 0 ! shlat = 0 ! 0 < shlat < 2 ! shlat = 2 ! 2 < shlat
- ln_vorlat = .false. ! consistency of vorticity boundary condition with analytical Eqs.
-/
-!-----------------------------------------------------------------------
-&namagrif ! AGRIF zoom ("key_agrif")
-!-----------------------------------------------------------------------
- ln_remove_closedseas = .true. ! Fill lakes inside zoom
- ln_vert_remap = .false. ! volume conserving update
- npt_connect = 2
- npt_copy = 2
-/
-!-----------------------------------------------------------------------
-&nammpp ! Massively Parallel Processing ("key_mpp_mpi")
-!-----------------------------------------------------------------------
- ln_listonly = .false. ! do nothing else than listing the best domain decompositions (with land domains suppression)
- ! ! if T: the largest number of cores tested is defined by max(mppsize, jpni*jpnj)
- ln_nnogather = .true. ! activate code to avoid mpi_allgather use at the northfold
- jpni = 0 ! number of processors following i (set automatically if < 1), see also ln_listonly = T
- jpnj = 0 ! number of processors following j (set automatically if < 1), see also ln_listonly = T
- nn_hls = 1 ! halo width (applies to both rows and columns)
-/
-!-----------------------------------------------------------------------
-&namctl ! Control prints (default: OFF)
-!-----------------------------------------------------------------------
- sn_cfctl%l_runstat = .FALSE. ! switches and which areas produce reports with the proc integer settings.
- sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure
- sn_cfctl%l_oceout = .FALSE. ! that all areas report.
- sn_cfctl%l_layout = .FALSE. !
- sn_cfctl%l_prtctl = .FALSE. !
- sn_cfctl%l_prttrc = .FALSE. !
- sn_cfctl%l_oasout = .FALSE. !
- sn_cfctl%procmin = 0 ! Minimum area number for reporting [default:0]
- sn_cfctl%procmax = 1000000 ! Maximum area number for reporting [default:1000000]
- sn_cfctl%procincr = 1 ! Increment for optional subsetting of areas [default:1]
- sn_cfctl%ptimincr = 1 ! Timestep increment for writing time step progress info
- nn_ictls = 0 ! start i indice of control sum (use to compare mono versus
- nn_ictle = 0 ! end i indice of control sum multi processor runs
- nn_jctls = 0 ! start j indice of control over a subdomain)
- nn_jctle = 0 ! end j indice of control
- nn_isplt = 1 ! number of processors in i-direction
- nn_jsplt = 1 ! number of processors in j-direction
- ln_timing = .false. ! timing by routine write out in timing.output file
- ln_diacfl = .false. ! CFL diagnostics write out in cfl_diagnostics.ascii
-/
diff --git a/tools/DOMAINcfg/3_namelist_ref b/tools/DOMAINcfg/3_namelist_ref
deleted file mode 100644
index 273d80f61c6d9fd702e55bb8bcd3459cb992ceae..0000000000000000000000000000000000000000
--- a/tools/DOMAINcfg/3_namelist_ref
+++ /dev/null
@@ -1,210 +0,0 @@
-!! NEMO/OCE : Reference namelist_ref !!
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/OCE : 1 - Domain & run manager (namrun, namcfg, namdom, namzgr, namzgr_sco )
-!! 2 - diagnostics (namnc4)
-!! 3 - miscellaneous (nammpp, namctl)
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!-----------------------------------------------------------------------
-&namrun ! parameters of the run
-!-----------------------------------------------------------------------
- cn_exp = "ORCA2" ! experience name
- nn_it000 = 1 ! first time step
- nn_itend = 5840 ! last time step (std 5840)
- nn_date0 = 010101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
- nn_time0 = 0 ! initial time of day in hhmm
- nn_leapy = 0 ! Leap year calendar (1) or not (0)
- ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%)
- ln_clobber = .true. ! clobber (overwrite) an existing file
- nn_chunksz = 0 ! chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
- ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard
- ln_iscpl = .false. ! cavity evolution forcing or coupling to ice sheet model
-/
-!-----------------------------------------------------------------------
-&namdom ! space and time domain (bathymetry, mesh, timestep)
-!-----------------------------------------------------------------------
- ln_read_cfg = .false. ! Read from a domain_cfg file
- nn_bathy = 1 ! compute analyticaly (=0) or read (=1) the bathymetry file
- ! or compute (2) from external bathymetry
- nn_interp = 1 ! type of interpolation (nn_bathy =2)
- cn_domcfg = ' ' ! Name of the domain_cfg input file
- cn_fcoord = 'coordinates.nc' ! external coordinates file (jphgr_msh = 0)
- cn_topo = 'bathy_meter.nc ' ! external topo file (nn_bathy =1/2)
- cn_topolvl = 'bathy_level.nc ' ! external topo file (nn_bathy =1)
- cn_fisfd = 'isf_draft_meter.nc' ! external isf draft (nn_bathy =1 and ln_isfcav = .true.)
- cn_bath = 'Bathymetry' ! topo name in file (nn_bathy =1/2)
- cn_bathlvl = 'Bathy_level' ! lvl name in file (nn_bathy =1)
- cn_visfd = 'isf_draft' ! isf draft variable (nn_bathy =1 and ln_isfcav = .true.)
- cn_lon = 'nav_lon' ! lon name in file (nn_bathy =2)
- cn_lat = 'nav_lat' ! lat name in file (nn_bathy =2)
- rn_bathy = 0. ! value of the bathymetry. if (=0) bottom flat at jpkm1
- nn_msh = 0 ! create (=1) a mesh file or not (=0)
- rn_hmin = -3. ! min depth of the ocean (>0) or min number of ocean level (<0)
- rn_e3zps_min= 20. ! partial step thickness is set larger than the minimum of
- rn_e3zps_rat= 0.1 ! rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
- !
- rn_rdt = 5760. ! time step for the dynamics (and tracer if nn_acc=0)
- rn_atfp = 0.1 ! asselin time filter parameter
- ln_crs = .false. ! Logical switch for coarsening module
- jphgr_msh = 0 ! type of horizontal mesh
- ! = 0 curvilinear coordinate on the sphere read in coordinate.nc
- ! = 1 geographical mesh on the sphere with regular grid-spacing
- ! = 2 f-plane with regular grid-spacing
- ! = 3 beta-plane with regular grid-spacing
- ! = 4 Mercator grid with T/U point at the equator
- ppglam0 = 0.0 ! longitude of first raw and column T-point (jphgr_msh = 1)
- ppgphi0 = -35.0 ! latitude of first raw and column T-point (jphgr_msh = 1)
- ppe1_deg = 1.0 ! zonal grid-spacing (degrees)
- ppe2_deg = 0.5 ! meridional grid-spacing (degrees)
- ppe1_m = 5000.0 ! zonal grid-spacing (degrees)
- ppe2_m = 5000.0 ! meridional grid-spacing (degrees)
- ppsur = -4762.96143546300 ! ORCA r4, r2 and r05 coefficients
- ppa0 = 255.58049070440 ! (default coefficients)
- ppa1 = 245.58132232490 !
- ppkth = 21.43336197938 !
- ppacr = 3.0 !
- ppdzmin = 10. ! Minimum vertical spacing
- pphmax = 5000. ! Maximum depth
- ldbletanh = .TRUE. ! Use/do not use double tanf function for vertical coordinates
- ppa2 = 100.760928500000 ! Double tanh function parameters
- ppkth2 = 48.029893720000 !
- ppacr2 = 13.000000000000 !
-/
-!-----------------------------------------------------------------------
-&namcfg ! parameters of the configuration
-!-----------------------------------------------------------------------
- !
- ln_e3_dep = .true. ! =T : e3=dk[depth] in discret sens.
- ! ! ===>>> will become the only possibility in v4.0
- ! ! =F : e3 analytical derivative of depth function
- ! ! only there for backward compatibility test with v3.6
- ! !
- cp_cfg = "orca" ! name of the configuration
- jp_cfg = 2 ! resolution of the configuration
- jpidta = 180 ! 1st lateral dimension ( >= jpi )
- jpjdta = 148 ! 2nd " " ( >= jpj )
- jpkdta = 31 ! number of levels ( >= jpk )
- Ni0glo = 180 ! 1st dimension of global domain --> i =jpidta
- Nj0glo = 148 ! 2nd - - --> j =jpjdta
- jpkglo = 31
- jperio = 4 ! lateral cond. type (between 0 and 6)
- ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
- ! in netcdf input files, as the start j-row for reading
- ln_domclo = .false. ! computation of closed sea masks (see namclo)
-/
-!-----------------------------------------------------------------------
-&namzgr ! vertical coordinate (default: NO selection)
-!-----------------------------------------------------------------------
- ln_zco = .false. ! z-coordinate - full steps
- ln_zps = .false. ! z-coordinate - partial steps
- ln_sco = .false. ! s- or hybrid z-s-coordinate
- ln_isfcav = .false. ! ice shelf cavity (T: see namzgr_isf)
-/
-!-----------------------------------------------------------------------
-&namzgr_isf ! isf cavity geometry definition (default: OFF)
-!-----------------------------------------------------------------------
- rn_isfdep_min = 10. ! minimum isf draft tickness (if lower, isf draft set to this value)
- rn_glhw_min = 1.e-3 ! minimum water column thickness to define the grounding line
- rn_isfhw_min = 10 ! minimum water column thickness in the cavity once the grounding line defined.
- ln_isfchannel = .false. ! remove channel (based on 2d mask build from isfdraft-bathy)
- ln_isfconnect = .false. ! force connection under the ice shelf (based on 2d mask build from isfdraft-bathy)
- nn_kisfmax = 999 ! limiter in level on the previous condition. (if change larger than this number, get back to value before we enforce the connection)
- rn_zisfmax = 7000. ! limiter in m on the previous condition. (if change larger than this number, get back to value before we enforce the connection)
- ln_isfcheminey = .false. ! close cheminey
- ln_isfsubgl = .false. ! remove subglacial lake created by the remapping process
- rn_isfsubgllon = 0.0 ! longitude of the seed to determine the open ocean
- rn_isfsubgllat = 0.0 ! latitude of the seed to determine the open ocean
-/
-!-----------------------------------------------------------------------
-&namzgr_sco ! s-coordinate or hybrid z-s-coordinate (default: OFF)
-!-----------------------------------------------------------------------
- ln_s_sh94 = .false. ! Song & Haidvogel 1994 hybrid S-sigma (T)|
- ln_s_sf12 = .false. ! Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
- ln_sigcrit = .false. ! use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
- ! stretching coefficients for all functions
- rn_sbot_min = 10.0 ! minimum depth of s-bottom surface (>0) (m)
- rn_sbot_max = 7000.0 ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
- rn_hc = 150.0 ! critical depth for transition to stretched coordinates
- !!!!!!! Envelop bathymetry
- rn_rmax = 0.3 ! maximum cut-off r-value allowed (0<r_max<1)
- !!!!!!! SH94 stretching coefficients (ln_s_sh94 = .true.)
- rn_theta = 6.0 ! surface control parameter (0<=theta<=20)
- rn_bb = 0.8 ! stretching with SH94 s-sigma
- !!!!!!! SF12 stretching coefficient (ln_s_sf12 = .true.)
- rn_alpha = 4.4 ! stretching with SF12 s-sigma
- rn_efold = 0.0 ! efold length scale for transition to stretched coord
- rn_zs = 1.0 ! depth of surface grid box
- ! bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
- rn_zb_a = 0.024 ! bathymetry scaling factor for calculating Zb
- rn_zb_b = -0.2 ! offset for calculating Zb
- !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above]
- rn_thetb = 1.0 ! bottom control parameter (0<=thetb<= 1)
-/
-!-----------------------------------------------------------------------
-&namclo ! (closed sea : need ln_domclo = .true. in namcfg) (default: OFF)
-!-----------------------------------------------------------------------
- rn_lon_opnsea = 0.0 ! longitude seed of open ocean
- rn_lat_opnsea = 0.0 ! latitude seed of open ocean
- nn_closea = 8 ! number of closed seas ( = 0; only the open_sea mask will be computed)
- !
- ! name ! lon_src ! lat_src ! lon_trg ! lat_trg ! river mouth area ! correction scheme ! radius trg ! id trg
- ! ! (degree)! (degree)! (degree)! (degree)! local/coast/global ! (glo/rnf/emp) ! (m) !
- ! North American lakes
- sn_lake(1) = 'superior' , -86.57 , 47.30 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(2) = 'michigan' , -87.06 , 42.74 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(3) = 'huron' , -82.51 , 44.74 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(4) = 'erie' , -81.13 , 42.25 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- sn_lake(5) = 'ontario' , -77.72 , 43.62 , -66.49 , 50.45 , 'local' , 'rnf' , 550000.0 , 2
- ! African Lake
- sn_lake(6) = 'victoria' , 32.93 , -1.08 , 30.44 , 31.37 , 'coast' , 'emp' , 100000.0 , 3
- ! Asian Lakes
- sn_lake(7) = 'caspian' , 50.0 , 44.0 , 0.0 , 0.0 , 'global' , 'glo' , 0.0 , 1
- sn_lake(8) = 'aral' , 60.0 , 45.0 , 0.0 , 0.0 , 'global' , 'glo' , 0.0 , 1
-/
-!-----------------------------------------------------------------------
-&namlbc ! lateral momentum boundary condition (default: NO selection)
-!-----------------------------------------------------------------------
- ! ! free slip ! partial slip ! no slip ! strong slip
- rn_shlat = 0 ! shlat = 0 ! 0 < shlat < 2 ! shlat = 2 ! 2 < shlat
- ln_vorlat = .false. ! consistency of vorticity boundary condition with analytical Eqs.
-/
-!-----------------------------------------------------------------------
-&namagrif ! AGRIF zoom ("key_agrif")
-!-----------------------------------------------------------------------
- ln_remove_closedseas = .true. ! Fill lakes inside zoom
- ln_vert_remap = .false. ! volume conserving update
- npt_connect = 2
- npt_copy = 2
-/
-!-----------------------------------------------------------------------
-&nammpp ! Massively Parallel Processing ("key_mpp_mpi")
-!-----------------------------------------------------------------------
- ln_listonly = .false. ! do nothing else than listing the best domain decompositions (with land domains suppression)
- ! ! if T: the largest number of cores tested is defined by max(mppsize, jpni*jpnj)
- ln_nnogather = .true. ! activate code to avoid mpi_allgather use at the northfold
- jpni = 0 ! number of processors following i (set automatically if < 1), see also ln_listonly = T
- jpnj = 0 ! number of processors following j (set automatically if < 1), see also ln_listonly = T
- nn_hls = 1 ! halo width (applies to both rows and columns)
-/
-!-----------------------------------------------------------------------
-&namctl ! Control prints (default: OFF)
-!-----------------------------------------------------------------------
- sn_cfctl%l_runstat = .FALSE. ! switches and which areas produce reports with the proc integer settings.
- sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure
- sn_cfctl%l_oceout = .FALSE. ! that all areas report.
- sn_cfctl%l_layout = .FALSE. !
- sn_cfctl%l_prtctl = .FALSE. !
- sn_cfctl%l_prttrc = .FALSE. !
- sn_cfctl%l_oasout = .FALSE. !
- sn_cfctl%procmin = 0 ! Minimum area number for reporting [default:0]
- sn_cfctl%procmax = 1000000 ! Maximum area number for reporting [default:1000000]
- sn_cfctl%procincr = 1 ! Increment for optional subsetting of areas [default:1]
- sn_cfctl%ptimincr = 1 ! Timestep increment for writing time step progress info
- nn_ictls = 0 ! start i indice of control sum (use to compare mono versus
- nn_ictle = 0 ! end i indice of control sum multi processor runs
- nn_jctls = 0 ! start j indice of control over a subdomain)
- nn_jctle = 0 ! end j indice of control
- nn_isplt = 1 ! number of processors in i-direction
- nn_jsplt = 1 ! number of processors in j-direction
- ln_timing = .false. ! timing by routine write out in timing.output file
- ln_diacfl = .false. ! CFL diagnostics write out in cfl_diagnostics.ascii
-/
diff --git a/tools/DOMAINcfg/AGRIF_FixedGrids.in b/tools/DOMAINcfg/AGRIF_FixedGrids.in
index 11d92b1d441bc5d58bdf3398ae03ba4e510feb87..e3b23b5ee195521f5b670b5994c3a3429d3e2890 100644
--- a/tools/DOMAINcfg/AGRIF_FixedGrids.in
+++ b/tools/DOMAINcfg/AGRIF_FixedGrids.in
@@ -1,7 +1,3 @@
-2
-45 85 53 95 1 1 1
-125 156 114 147 4 4 4
0
-1
-38 80 71 111 3 3 3
+45 85 53 95 1 1 1
0
diff --git a/tools/DOMAINcfg/AGRIF_FixedGrids.in_agrifdemo b/tools/DOMAINcfg/AGRIF_FixedGrids.in_agrifdemo
deleted file mode 100644
index af6d7e92ff497d87ba18403acf77c852b15ffa42..0000000000000000000000000000000000000000
--- a/tools/DOMAINcfg/AGRIF_FixedGrids.in_agrifdemo
+++ /dev/null
@@ -1,7 +0,0 @@
-2
-42 82 49 91 1 1 1
-122 153 110 143 4 4 4
-0
-1
-38 80 71 111 3 3 3
-0
diff --git a/tools/DOMAINcfg/AGRIF_FixedGrids.in_cmems b/tools/DOMAINcfg/AGRIF_FixedGrids.in_cmems
deleted file mode 100644
index cd19f2521025a2b25595eacf2c3e2083f00229ad..0000000000000000000000000000000000000000
--- a/tools/DOMAINcfg/AGRIF_FixedGrids.in_cmems
+++ /dev/null
@@ -1,7 +0,0 @@
-3
--10 15 57 75 3 3 3
-30 70 126 170 3 3 3
-1 181 1 35 3 3 3
-0
-0
-0
diff --git a/tools/DOMAINcfg/1_namelist_cfg b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/1_namelist_cfg
similarity index 93%
rename from tools/DOMAINcfg/1_namelist_cfg
rename to tools/DOMAINcfg/cfgs/AGRIF_DEMO/1_namelist_cfg
index 32881b6b35954cc3c7a0b70016c76235f2986170..1f23fb27ef0a03b2c09684b3c71adc4b42804f8f 100644
--- a/tools/DOMAINcfg/1_namelist_cfg
+++ b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/1_namelist_cfg
@@ -14,10 +14,12 @@
&namdom ! space and time domain (bathymetry, mesh, timestep)
!-----------------------------------------------------------------------
ln_read_cfg = .false.
- nn_bathy = 2
- ! or compute (2) from external bathymetry
+ nn_bathy = 3
+ ! = 1 read the bathymetry file
+ ! = 2 compute from external bathymetry
+ ! = 3 compute from parent (if "key_agrif")
nn_interp = 1
- cn_domcfg = 'ORCA_R2_zps_domcfg_agrif.nc'
+ cn_domcfg = 'ORCA_R2_zps_domcfg.nc'
cn_topo = 'GEBCO_2020.nc'
cn_bath = 'elevation'
cn_lon = 'lon'
@@ -51,6 +53,8 @@
! ! ===>>> will become the only possibility in v4.0
! ! =F : e3 analytical derivative of depth function
! ! only there for backward compatibility test with v3.6
+ ! ! if ln_e3_dep = T
+ ln_dept_mid = .true. ! =T : set T points in the middle of cells
! !
cp_cfg = 'dumb'
jp_cfg = 2 ! resolution of the configuration
diff --git a/tools/DOMAINcfg/cfgs/AGRIF_DEMO/1_namelist_ref b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/1_namelist_ref
new file mode 120000
index 0000000000000000000000000000000000000000..10614842eabd73c6eb44bfa6f75cd7e69e82f7fd
--- /dev/null
+++ b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/1_namelist_ref
@@ -0,0 +1 @@
+../../namelist_ref
\ No newline at end of file
diff --git a/tools/DOMAINcfg/2_namelist_cfg b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/2_namelist_cfg
similarity index 92%
rename from tools/DOMAINcfg/2_namelist_cfg
rename to tools/DOMAINcfg/cfgs/AGRIF_DEMO/2_namelist_cfg
index c71e9229e0465ba236dde71a27cf1ba923f9506d..f1a430529a6cf0f931b4e213d4efa7a60a24f609 100644
--- a/tools/DOMAINcfg/2_namelist_cfg
+++ b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/2_namelist_cfg
@@ -15,9 +15,11 @@
!-----------------------------------------------------------------------
ln_read_cfg = .false.
nn_bathy = 2
- ! or compute (2) from external bathymetry
+ ! = 1 read the bathymetry file
+ ! = 2 compute from external bathymetry
+ ! = 3 compute from parent (if "key_agrif")
nn_interp = 1
- cn_domcfg = 'ORCA_R2_zps_domcfg_agrif.nc'
+ cn_domcfg = 'ORCA_R2_zps_domcfg.nc'
cn_topo = 'GEBCO_2020.nc'
cn_bath = 'elevation'
cn_lon = 'lon'
@@ -51,15 +53,17 @@
! ! ===>>> will become the only possibility in v4.0
! ! =F : e3 analytical derivative of depth function
! ! only there for backward compatibility test with v3.6
+ ! ! if ln_e3_dep = T
+ ln_dept_mid = .true. ! =T : set T points in the middle of cells
! !
cp_cfg = 'dumb'
jp_cfg = 2 ! resolution of the configuration
- jpidta = 132
- jpjdta = 140
+ jpidta = 108
+ jpjdta = 88
jpkdta = 31 ! number of levels ( >= jpk )
- Ni0glo = 132
- Nj0glo = 140
- jpkglo = 31
+ Ni0glo = 108
+ Nj0glo = 88
+ jpkglo = 29
jperio = 0
ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
! in netcdf input files, as the start j-row for reading
diff --git a/tools/DOMAINcfg/cfgs/AGRIF_DEMO/2_namelist_ref b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/2_namelist_ref
new file mode 120000
index 0000000000000000000000000000000000000000..10614842eabd73c6eb44bfa6f75cd7e69e82f7fd
--- /dev/null
+++ b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/2_namelist_ref
@@ -0,0 +1 @@
+../../namelist_ref
\ No newline at end of file
diff --git a/tools/DOMAINcfg/3_namelist_cfg b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/3_namelist_cfg
similarity index 79%
rename from tools/DOMAINcfg/3_namelist_cfg
rename to tools/DOMAINcfg/cfgs/AGRIF_DEMO/3_namelist_cfg
index 878cec3aff67efb7d2bfc523d5999b24e5968397..eb9d9eb5e2c088123d89c36336ef98a4ebb14f15 100644
--- a/tools/DOMAINcfg/3_namelist_cfg
+++ b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/3_namelist_cfg
@@ -15,14 +15,17 @@
!-----------------------------------------------------------------------
ln_read_cfg = .false.
nn_bathy = 2
- ! or compute (2) from external bathymetry
+ ! = 1 read the bathymetry file
+ ! = 2 compute from external bathymetry
+ ! = 3 compute from parent (if "key_agrif")
nn_interp = 1
- cn_domcfg = 'ORCA_R2_zps_domcfg_agrif.nc'
+ cn_domcfg = 'ORCA_R2_zps_domcfg.nc'
cn_topo = 'GEBCO_2020.nc'
cn_bath = 'elevation'
cn_lon = 'lon'
cn_lat = 'lat'
rn_scale = -1
+ rn_hmin = -8
rn_bathy = 0. ! value of the bathymetry. if (=0) bottom flat at jpkm1
jphgr_msh = 0 ! type of horizontal mesh
ppglam0 = 999999.0 ! longitude of first raw and column T-point (jphgr_msh = 1)
@@ -31,17 +34,17 @@
ppe2_deg = 999999.0 ! meridional grid-spacing (degrees)
ppe1_m = 999999.0 ! zonal grid-spacing (degrees)
ppe2_m = 999999.0 ! meridional grid-spacing (degrees)
- ppsur = -4762.96143546300 ! ORCA r4, r2 and r05 coefficients
- ppa0 = 255.58049070440 ! (default coefficients)
- ppa1 = 245.58132232490 !
- ppkth = 21.43336197938 !
- ppacr = 3.0 !
- ppdzmin = 999999. ! Minimum vertical spacing
- pphmax = 999999. ! Maximum depth
- ldbletanh = .FALSE. ! Use/do not use double tanf function for vertical coordinates
- ppa2 = 999999. ! Double tanh function parameters
- ppkth2 = 999999. !
- ppacr2 = 999999. !
+ ppsur = -3958.951371276829 ! ORCA r4, r2 and r05 coefficients
+ ppa0 = 103.9530096000000 ! (default coefficients)
+ ppa1 = 2.415951269000000 !
+ ppkth = 15.35101370000000 !
+ ppacr = 7.0 !
+ ppdzmin = 999999.0 ! Minimum vertical spacing
+ pphmax = 999999.0 ! Maximum depth
+ ldbletanh = .TRUE. ! Use/do not use double tanf function for vertical coordinates
+ ppa2 = 100.7609285000000 ! Double tanh function parameters
+ ppkth2 = 48.02989372000000 !
+ ppacr2 = 13.00000000000 !
/
!-----------------------------------------------------------------------
&namcfg ! parameters of the configuration
@@ -51,15 +54,17 @@
! ! ===>>> will become the only possibility in v4.0
! ! =F : e3 analytical derivative of depth function
! ! only there for backward compatibility test with v3.6
+ ! ! if ln_e3_dep = T
+ ln_dept_mid = .true. ! =T : set T points in the middle of cells
! !
cp_cfg = 'dumb'
jp_cfg = 2 ! resolution of the configuration
- jpidta = 134
- jpjdta = 128
- jpkdta = 31 ! number of levels ( >= jpk )
- Ni0glo = 134
- Nj0glo = 128
- jpkglo = 31
+ jpidta = 128
+ jpjdta = 107
+ jpkdta = 75 ! number of levels ( >= jpk )
+ Ni0glo = 128
+ Nj0glo = 107
+ jpkglo = 60
jperio = 0
ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
! in netcdf input files, as the start j-row for reading
@@ -93,6 +98,7 @@
!-----------------------------------------------------------------------
&namagrif ! AGRIF zoom ("key_agrif")
!-----------------------------------------------------------------------
+ ln_vert_remap = .true.
/
!-----------------------------------------------------------------------
&namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4")
diff --git a/tools/DOMAINcfg/cfgs/AGRIF_DEMO/3_namelist_ref b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/3_namelist_ref
new file mode 120000
index 0000000000000000000000000000000000000000..10614842eabd73c6eb44bfa6f75cd7e69e82f7fd
--- /dev/null
+++ b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/3_namelist_ref
@@ -0,0 +1 @@
+../../namelist_ref
\ No newline at end of file
diff --git a/tools/DOMAINcfg/cfgs/AGRIF_DEMO/AGRIF_FixedGrids.in b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/AGRIF_FixedGrids.in
new file mode 120000
index 0000000000000000000000000000000000000000..cbd7951b6f335ea6840d1890acd1db39f3de2d73
--- /dev/null
+++ b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/AGRIF_FixedGrids.in
@@ -0,0 +1 @@
+../../../../cfgs/AGRIF_DEMO/EXPREF/AGRIF_FixedGrids.in
\ No newline at end of file
diff --git a/tools/DOMAINcfg/cfgs/AGRIF_DEMO/make_domain_cfg.exe b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/make_domain_cfg.exe
new file mode 120000
index 0000000000000000000000000000000000000000..8d81caa2096415e5443d5837091c581ef8fa47d0
--- /dev/null
+++ b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/make_domain_cfg.exe
@@ -0,0 +1 @@
+../../make_domain_cfg.exe
\ No newline at end of file
diff --git a/tools/DOMAINcfg/cfgs/AGRIF_DEMO/make_namelist.py b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/make_namelist.py
new file mode 120000
index 0000000000000000000000000000000000000000..aa01ae6c69da31c80bb329033684402e5de402ad
--- /dev/null
+++ b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/make_namelist.py
@@ -0,0 +1 @@
+../../make_namelist.py
\ No newline at end of file
diff --git a/tools/DOMAINcfg/cfgs/AGRIF_DEMO/namelist_cfg b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/namelist_cfg
new file mode 100644
index 0000000000000000000000000000000000000000..cf3587795288680b79426b5876dbcbb4b48f4483
--- /dev/null
+++ b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/namelist_cfg
@@ -0,0 +1,105 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE : Configuration namelist_cfg used to overwrite defaults value defined in namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE : 1 - Domain & run manager (namrun, namcfg, namdom, namzgr, namzgr_sco )
+!! 2 - diagnostics (namnc4)
+!! 3 - miscellaneous (nammpp, namctl)
+!!
+!! namelist skeleton : egrep -E '(^/ *$|^! *$|^ *$|&nam.*|!---.*|!! .*|!!==.*|!!>>>.*)' namelist_ref > namelist_skl
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun ! parameters of the run
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom ! space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+ ln_read_cfg = .true.
+ nn_bathy = 1 ! = 0 compute analyticaly
+ ! = 1 read the bathymetry file
+ ! = 2 compute from external bathymetry
+ ! = 3 compute from parent (if "key_agrif")
+ nn_interp = 1 ! type of interpolation (nn_bathy =2)
+ cn_domcfg = 'ORCA_R2_zps_domcfg.nc'
+ cn_topo = 'bathymetry_ORCA12_V3.3.nc' ! external topo file (nn_bathy =2)
+ cn_bath = 'Bathymetry' ! topo name in file (nn_bathy =2)
+ cn_lon = 'nav_lon' ! lon name in file (nn_bathy =2)
+ cn_lat = 'nav_lat' ! lat name in file (nn_bathy =2)
+ rn_scale = 1
+ rn_bathy = 0. ! value of the bathymetry. if (=0) bottom flat at jpkm1
+ jphgr_msh = 0 ! type of horizontal mesh
+ ppglam0 = 999999.0 ! longitude of first raw and column T-point (jphgr_msh = 1)
+ ppgphi0 = 999999.0 ! latitude of first raw and column T-point (jphgr_msh = 1)
+ ppe1_deg = 999999.0 ! zonal grid-spacing (degrees)
+ ppe2_deg = 999999.0 ! meridional grid-spacing (degrees)
+ ppe1_m = 999999.0 ! zonal grid-spacing (degrees)
+ ppe2_m = 999999.0 ! meridional grid-spacing (degrees)
+ ppsur = -4762.96143546300 ! ORCA r4, r2 and r05 coefficients
+ ppa0 = 255.58049070440 ! (default coefficients)
+ ppa1 = 245.58132232490 !
+ ppkth = 21.43336197938 !
+ ppacr = 3.0 !
+ ppdzmin = 999999. ! Minimum vertical spacing
+ pphmax = 999999. ! Maximum depth
+ ldbletanh = .FALSE. ! Use/do not use double tanf function for vertical coordinates
+ ppa2 = 999999. ! Double tanh function parameters
+ ppkth2 = 999999. !
+ ppacr2 = 999999. !
+/
+!-----------------------------------------------------------------------
+&namcfg ! parameters of the configuration
+!-----------------------------------------------------------------------
+ !
+ ln_e3_dep = .true. ! =T : e3=dk[depth] in discret sens.
+ ! ! ===>>> will become the only possibility in v4.0
+ ! ! =F : e3 analytical derivative of depth function
+ ! ! only there for backward compatibility test with v3.6
+ ! ! if ln_e3_dep = T
+ ln_dept_mid = .true. ! =T : set T points in the middle of cells
+ ! !
+ cp_cfg = "orca" ! name of the configuration
+ jp_cfg = 2 ! resolution of the configuration
+ jpidta = 180 ! 1st lateral dimension ( >= jpi )
+ jpjdta = 148 ! 2nd " " ( >= jpj )
+ jpkdta = 31 ! number of levels ( >= jpk )
+ Ni0glo = 180 ! 1st dimension of global domain --> i =jpidta
+ Nj0glo = 148 ! 2nd - - --> j =jpjdta
+ jpkglo = 31
+ jperio = 4 ! lateral cond. type (between 0 and 6)
+ ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
+ ! in netcdf input files, as the start j-row for reading
+ ln_domclo = .false. ! computation of closed sea masks (see namclo)
+/
+!-----------------------------------------------------------------------
+&namzgr ! vertical coordinate (default: NO selection)
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ ln_zco = .false. ! z-coordinate - full steps
+ ln_zps = .true. ! z-coordinate - partial steps
+ ln_sco = .false. ! s- or hybrid z-s-coordinate
+ ln_isfcav = .false. ! ice shelf cavity (T: see namzgr_isf)
+/
+!-----------------------------------------------------------------------
+&namzgr_isf ! isf cavity geometry definition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzgr_sco ! s-coordinate or hybrid z-s-coordinate (default F)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namclo ! (closed sea : need ln_domclo = .true. in namcfg)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc ! lateral momentum boundary condition (default: NO selection)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif ! AGRIF zoom ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
diff --git a/tools/DOMAINcfg/cfgs/AGRIF_DEMO/namelist_ref b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/namelist_ref
new file mode 120000
index 0000000000000000000000000000000000000000..10614842eabd73c6eb44bfa6f75cd7e69e82f7fd
--- /dev/null
+++ b/tools/DOMAINcfg/cfgs/AGRIF_DEMO/namelist_ref
@@ -0,0 +1 @@
+../../namelist_ref
\ No newline at end of file
diff --git a/tools/DOMAINcfg/namelist_cfg b/tools/DOMAINcfg/namelist_cfg
index f40a4fcd050c66c658159725c11e93a6b5e68804..8615fede68c3a0a58103a2e4f177baf01b9037c8 100644
--- a/tools/DOMAINcfg/namelist_cfg
+++ b/tools/DOMAINcfg/namelist_cfg
@@ -15,8 +15,10 @@
&namdom ! space and time domain (bathymetry, mesh, timestep)
!-----------------------------------------------------------------------
ln_read_cfg = .true.
- nn_bathy = 1 ! compute analyticaly (=0) or read (=1) the bathymetry file
- ! or compute (2) from external bathymetry
+ nn_bathy = 1 ! = 0 compute analyticaly
+ ! = 1 read the bathymetry file
+ ! = 2 compute from external bathymetry
+ ! = 3 compute from parent (if "key_agrif")
nn_interp = 1 ! type of interpolation (nn_bathy =2)
cn_domcfg = 'ORCA_R2_zps_domcfg.nc'
cn_topo = 'bathymetry_ORCA12_V3.3.nc' ! external topo file (nn_bathy =2)
diff --git a/tools/DOMAINcfg/namelist_ref b/tools/DOMAINcfg/namelist_ref
index 273d80f61c6d9fd702e55bb8bcd3459cb992ceae..24dae48f4539f55863d1cf4ad87106823859f1b5 100644
--- a/tools/DOMAINcfg/namelist_ref
+++ b/tools/DOMAINcfg/namelist_ref
@@ -23,8 +23,10 @@
&namdom ! space and time domain (bathymetry, mesh, timestep)
!-----------------------------------------------------------------------
ln_read_cfg = .false. ! Read from a domain_cfg file
- nn_bathy = 1 ! compute analyticaly (=0) or read (=1) the bathymetry file
- ! or compute (2) from external bathymetry
+ nn_bathy = 1 ! = 0 compute analyticaly
+ ! = 1 read the bathymetry file
+ ! = 2 compute from external bathymetry
+ ! = 3 compute from parent (if "key_agrif")
nn_interp = 1 ! type of interpolation (nn_bathy =2)
cn_domcfg = ' ' ! Name of the domain_cfg input file
cn_fcoord = 'coordinates.nc' ! external coordinates file (jphgr_msh = 0)
@@ -36,6 +38,7 @@
cn_visfd = 'isf_draft' ! isf draft variable (nn_bathy =1 and ln_isfcav = .true.)
cn_lon = 'nav_lon' ! lon name in file (nn_bathy =2)
cn_lat = 'nav_lat' ! lat name in file (nn_bathy =2)
+ rn_scale = 1. ! multiplicative factor to account for possibly negative input bathymetry (agrif only)
rn_bathy = 0. ! value of the bathymetry. if (=0) bottom flat at jpkm1
nn_msh = 0 ! create (=1) a mesh file or not (=0)
rn_hmin = -3. ! min depth of the ocean (>0) or min number of ocean level (<0)
@@ -78,6 +81,10 @@
! ! =F : e3 analytical derivative of depth function
! ! only there for backward compatibility test with v3.6
! !
+ ! ! if ln_e3_dep = T
+ ln_dept_mid = .false. ! =T : set T points in the middle of cells
+ ! ! =F : e3 analytical depth function
+ ! !
cp_cfg = "orca" ! name of the configuration
jp_cfg = 2 ! resolution of the configuration
jpidta = 180 ! 1st lateral dimension ( >= jpi )
@@ -173,7 +180,7 @@
ln_remove_closedseas = .true. ! Fill lakes inside zoom
ln_vert_remap = .false. ! volume conserving update
npt_connect = 2
- npt_copy = 2
+ npt_copy = 4
/
!-----------------------------------------------------------------------
&nammpp ! Massively Parallel Processing ("key_mpp_mpi")
diff --git a/tools/DOMAINcfg/src/agrif_connect.F90 b/tools/DOMAINcfg/src/agrif_connect.F90
index 5ee28d0bd75afa3145df240fa9a8f5e1305fc9c6..d8ade8baa6d9c14edf9909121df513c3547ca8b5 100644
--- a/tools/DOMAINcfg/src/agrif_connect.F90
+++ b/tools/DOMAINcfg/src/agrif_connect.F90
@@ -3,10 +3,17 @@ MODULE agrif_connect
USE dom_oce
USE agrif_parameters
USE agrif_profiles
+ USE lbclnk
+ USE domzgr, ONLY: rn_sbot_min
IMPLICIT NONE
PRIVATE
+ REAL(wp), ALLOCATABLE, SAVE , DIMENSION(:,:) :: ht0_parent, &
+ hu0_parent, &
+ hv0_parent, &
+ hf0_parent
+
PUBLIC agrif_boundary_connections, agrif_bathymetry_connect
CONTAINS
@@ -17,26 +24,70 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** ROUTINE agrif_boundary_connections ***
!!----------------------------------------------------------------------
+ INTEGER :: ji, jj
+
IF( Agrif_Root() ) return
- CALL agrif_connection()
+! CALL agrif_connection()
!
-! CALL Agrif_Bc_variable(bottom_level_id, procname = connect_bottom_level)
+! CALL Agrif_Bc_variable(mbkt_id, procname = connect_bottom_level)
!
! CALL Agrif_Bc_variable(e3t_copy_id, procname = connect_e3t_copy)
- ALLOCATE(e3t_interp_done(jpi,jpj))
- e3t_interp_done(:,:) = .FALSE.
- ! set extrapolation on for interpolation near the coastline:
- Agrif_UseSpecialValue = .TRUE.
- Agrif_SpecialValue = 0._wp
- CALL Agrif_Bc_variable(e3t_connect_id, procname = connect_e3t_connect)
- ! Override in ghost zone by nearest value:
- Agrif_UseSpecialValue = .FALSE.
- e3t_interp_done(:,:) = .FALSE.
- CALL Agrif_Bc_variable(e3t_copy_id, procname = connect_e3t_connect)
- Agrif_UseSpecialValue = .FALSE.
- DEALLOCATE(e3t_interp_done)
+! ALLOCATE(e3t_interp_done(jpi,jpj))
+!! e3t_interp_done(:,:) = .FALSE.
+!! ! set extrapolation on for interpolation near the coastline:
+!! Agrif_UseSpecialValue = .TRUE.
+!! Agrif_SpecialValue = 0._wp
+!! CALL Agrif_Bc_variable(e3t_connect_id, procname = connect_e3t_connect)
+ ! If child has zps, ensure parent bathymetry is used:
+ ! No need to do this if vertical grids are the same
+ IF ( ln_zps.AND.ln_vert_remap ) THEN
+ Agrif_UseSpecialValue = .FALSE.
+ CALL Agrif_Bc_variable(e3t_id, procname = connect_e3t_connect)
+ ENDIF
+ IF ( ln_sco.AND.ln_vert_remap ) THEN
+! Build parent grid bathymetry over child grid
+ ALLOCATE(ht0_parent(jpi,jpj), &
+ & hu0_parent(jpi,jpj), &
+ & hv0_parent(jpi,jpj), &
+ & hf0_parent(jpi,jpj) )
+
+ Agrif_UseSpecialValue = .FALSE.
+ CALL Agrif_Init_Variable(ht0_id, procname = interpht0 )
+ !
+ IF ( Agrif_Parent(ln_sco) ) THEN
+ DO ji=1, jpim1
+ DO jj=1, jpjm1
+ hu0_parent(ji,jj) = ssumask(ji,jj) * 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) )
+ hv0_parent(ji,jj) = ssvmask(ji,jj) * 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) )
+ hf0_parent(ji,jj) = ssfmask(ji,jj) * 0.25_wp * ( ht0_parent(ji,jj )+ht0_parent(ji+1,jj ) &
+ & +ht0_parent(ji,jj+1)+ht0_parent(ji+1,jj+1) )
+ END DO
+ END DO
+ ELSE
+ DO ji=1, jpim1
+ DO jj=1, jpjm1
+ hu0_parent(ji,jj) = MIN( ht0_parent(ji ,jj ), ht0_parent(ji+1,jj ) )
+ hv0_parent(ji,jj) = MIN( ht0_parent(ji ,jj ), ht0_parent(ji ,jj+1) )
+ hf0_parent(ji,jj) = MIN( ht0_parent(ji ,jj ), ht0_parent(ji+1,jj ) , &
+ & ht0_parent(ji ,jj+1), ht0_parent(ji+1,jj+1) )
+ END DO
+ END DO
+ ENDIF
+ CALL lbc_lnk_multi( 'Agrif_boundary_condtions', hu0_parent, 'U', 1.0_wp, &
+ & hv0_parent, 'V', 1.0_wp, &
+ & hf0_parent, 'F', 1.0_wp )
+
+! Agrif_UseSpecialValue = .TRUE.
+! Agrif_SpecialValue = 0._wp
+ CALL Agrif_Bc_variable(e3u_id, procname = connect_e3u_connect)
+ CALL Agrif_Bc_variable(e3v_id, procname = connect_e3v_connect)
+ CALL Agrif_Bc_variable(e3f_id, procname = connect_e3f_connect)
+ DEALLOCATE(ht0_parent, hu0_parent, hv0_parent, hf0_parent)
+ ENDIF
+
+! DEALLOCATE(e3t_interp_done)
!
END SUBROUTINE agrif_boundary_connections
@@ -53,10 +104,12 @@ CONTAINS
! set extrapolation on for interpolation near the coastline:
Agrif_UseSpecialValue = .TRUE.
Agrif_SpecialValue = 0._wp
+ l_set_hmin = .TRUE.
CALL Agrif_Bc_variable(e3t_connect_id, procname = connect_bathy_connect)
! Override in ghost zone by nearest value:
Agrif_UseSpecialValue = .FALSE.
e3t_interp_done(:,:) = .FALSE.
+ l_set_hmin = .FALSE.
CALL Agrif_Bc_variable(e3t_copy_id, procname = connect_bathy_connect)
Agrif_UseSpecialValue = .FALSE.
DEALLOCATE(e3t_interp_done)
@@ -117,8 +170,7 @@ CONTAINS
!
!!----------------------------------------------------------------------
INTEGER :: ji, jj, jk, ik
- REAL(wp), DIMENSION(i1:i2,j1:j2) :: bathy_local, bathy_interp
- REAL(wp) :: zdepth, zdepwp, zmax, ze3tp, ze3wp, zhmin
+ REAL(wp) :: ze3min, zdepth, zdepwp, zmax, ze3tp, ze3wp, zhmin
!
IF( before) THEN
DO jk=k1, k2
@@ -139,39 +191,12 @@ CONTAINS
END DO
END DO
ELSE
- DO jj=j1,j2
- DO ji=i1,i2
- bathy_local (ji,jj) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj)
- bathy_interp (ji,jj) = ptab(ji,jj,k2)
- ! keep child masking in transition zone:
- IF ((ztabramp(ji,jj)/=1._wp).AND.(bathy_local(ji,jj)==0._wp)) bathy_interp(ji,jj)=0._wp
- ! Connected bathymetry
- IF( .NOT.e3t_interp_done(ji,jj) ) THEN
- bathy_local(ji,jj)=(1.-ztabramp(ji,jj))*bathy_local(ji,jj)+ztabramp(ji,jj)*bathy_interp(ji,jj)
- ENDIF
- END DO
- END DO
- ! Update mbkt and ssmask
- IF( rn_hmin < 0._wp ) THEN
- ik = - INT( rn_hmin )
- ELSE
- ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 )
- ENDIF
- zhmin = gdepw_1d(ik+1)
-
- zmax = gdepw_1d(jpk) + e3t_1d(jpk)
- bathy_local(:,:) = MAX(MIN(zmax,bathy_local(:,:)),0._wp)
- WHERE( bathy_local(i1:i2,j1:j2) == 0._wp)
- mbathy(i1:i2,j1:j2) = 0
- ELSE WHERE
- mbathy(i1:i2,j1:j2) = jpkm1
- bathy_local(i1:i2,j1:j2) = MAX( zhmin , bathy_local(i1:i2,j1:j2) )
- END WHERE
+ bathy(i1:i2, j1:j2) = ptab(i1:i2,j1:j2,k2)
- DO jk=jpkm1,1,-1
- zdepth = gdepw_1d(jk) + MIN(e3zps_min,e3t_1d(jk)*e3zps_rat)
- WHERE( 0._wp < bathy_local(:,:) .AND. bathy_local(:,:) <= zdepth ) mbathy(i1:i2,j1:j2) = jk-1
+ DO jk=jpk,1,-1
+ zdepth = gdepw_1d(jk) + 1.e-6
+ WHERE( 0._wp < bathy(i1:i2,j1:j2) .AND. bathy(i1:i2,j1:j2) <= zdepth ) mbathy(i1:i2,j1:j2) = jk-1
ENDDO
WHERE (mbathy(i1:i2,j1:j2) == 0); ssmask(i1:i2,j1:j2) = 0
@@ -182,57 +207,210 @@ CONTAINS
!
DO jj = j1, j2
DO ji = i1, i2
- IF( .NOT.e3t_interp_done(ji,jj) ) THEN ! the connection has not yet been done
- DO jk = 1, jpk
- gdept_0(ji,jj,jk) = gdept_1d(jk)
- gdepw_0(ji,jj,jk) = gdepw_1d(jk)
- e3t_0 (ji,jj,jk) = e3t_1d (jk)
- e3w_0 (ji,jj,jk) = e3w_1d (jk)
- END DO
- !
- ik = mbathy(ji,jj)
- IF( ik > 0 ) THEN ! ocean point only
- ! max ocean level case
- IF( ik == jpkm1 ) THEN
- zdepwp = bathy_local(ji,jj)
- ze3tp = bathy_local(ji,jj) - gdepw_1d(ik)
- ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
- e3t_0(ji,jj,ik ) = ze3tp
- e3t_0(ji,jj,ik+1) = ze3tp
+ DO jk = 1, jpk
+ gdept_0(ji,jj,jk) = gdept_1d(jk)
+ gdepw_0(ji,jj,jk) = gdepw_1d(jk)
+ e3t_0 (ji,jj,jk) = e3t_1d (jk)
+ e3w_0 (ji,jj,jk) = e3w_1d (jk)
+ END DO
+ !
+ ik = mbathy(ji,jj)
+ IF( ik > 0 ) THEN ! ocean point only
+ ! max ocean level case
+ IF( ik == jpkm1 ) THEN
+ zdepwp = bathy(ji,jj)
+ ze3tp = bathy(ji,jj) - gdepw_1d(ik)
+ ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
+ e3t_0(ji,jj,ik ) = ze3tp
+ e3w_0(ji,jj,ik ) = ze3wp
+ IF ( ln_e3_dep.AND.ln_dept_mid ) THEN
+ gdept_0(ji,jj,ik) = gdepw_1d(ik) + 0.5_wp * ze3tp
+ e3w_0(ji,jj,ik ) = gdept_0(ji,jj,ik) - gdept_0(ji,jj,ik-1)
+ ELSE
+ gdept_0(ji,jj,ik) = gdept_1d(ik-1) + ze3wp
e3w_0(ji,jj,ik ) = ze3wp
- e3w_0(ji,jj,ik+1) = ze3tp
- gdepw_0(ji,jj,ik+1) = zdepwp
- gdept_0(ji,jj,ik ) = gdept_1d(ik-1) + ze3wp
- gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
- !
- ELSE ! standard case
- IF( bathy_local(ji,jj) <= gdepw_1d(ik+1) ) THEN
- gdepw_0(ji,jj,ik+1) = bathy_local(ji,jj)
- ELSE
- gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
- ENDIF
+ ENDIF
+ gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
+ e3w_0(ji,jj,ik+1) = ze3tp
+ gdepw_0(ji,jj,ik+1) = zdepwp
+ !
+ ELSE ! standard case
+ IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN
+ gdepw_0(ji,jj,ik+1) = bathy(ji,jj)
+ ELSE
+ gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
+ ENDIF
+ e3t_0 (ji,jj,ik) = e3t_1d (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik)) &
+ & / ( gdepw_1d( ik+1) - gdepw_1d(ik))
+ IF ( ln_e3_dep.AND.ln_dept_mid ) THEN
+ gdept_0(ji,jj,ik) = gdepw_1d(ik) + 0.5_wp * e3t_0(ji,jj,ik)
+ e3w_0(ji,jj,ik) = gdept_0(ji,jj,ik) - gdept_0(ji,jj,ik-1)
+ ELSE
gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) ) &
& * ((gdept_1d( ik ) - gdepw_1d(ik) ) &
& / ( gdepw_1d( ik+1) - gdepw_1d(ik) ))
- e3t_0 (ji,jj,ik) = e3t_1d (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik)) &
- & / ( gdepw_1d( ik+1) - gdepw_1d(ik))
e3w_0(ji,jj,ik) = &
& 0.5_wp * (gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) ) &
& * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
- ! ... on ik+1
- e3w_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
- e3t_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
- gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
ENDIF
- ENDIF
+ ! ... on ik+1
+ e3w_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
+ e3t_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
+ gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
+ ENDIF
ENDIF
- e3t_interp_done(ji,jj) = .TRUE.
END DO
END DO
+ !
+ ! Expand last level if too thin:
+! DO jj=j1,j2
+! DO ji=i1,i2
+! ik = mbathy(ji,jj)
+! IF ( ik > 2 ) THEN
+! ze3min = MIN( e3zps_min, e3t_1d(ik)*e3zps_rat )
+! IF ( e3t_0(ji,jj,ik) < ze3min ) THEN
+! e3t_0(ji,jj,ik-1) = e3t_0(ji,jj,ik-1) - (ze3min - e3t_0(ji,jj,ik))
+! e3t_0(ji,jj,ik ) = ze3min
+! e3w_0(ji,jj,ik-1) = 0.5_wp * (e3t_0(ji,jj,ik-1) + e3t_0(ji,jj,ik-2))
+! e3w_0(ji,jj,ik ) = 0.5_wp * (e3t_0(ji,jj,ik ) + e3t_0(ji,jj,ik-1))
+! e3w_0 (ji,jj,ik+1) = e3t_0(ji,jj,ik)
+! e3t_0 (ji,jj,ik+1) = e3t_0(ji,jj,ik)
+! ENDIF
+! ENDIF
+! END DO
+! END DO
ENDIF
!
END SUBROUTINE connect_e3t_connect
+ SUBROUTINE connect_e3u_connect( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE connect_e3u_connect ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+ LOGICAL , INTENT(in ) :: before
+ INTEGER , INTENT(in ) :: nb , ndir
+ !
+ !!----------------------------------------------------------------------
+ INTEGER :: ji, jj, jk
+ REAL(wp) :: zup
+ !
+ IF(.NOT.before) THEN
+
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( ssumask(ji,jj) > 0 ) THEN
+ zup = 0._wp
+ DO jk=1, mbku(ji,jj)
+ zup = zup + e3u_0(ji,jj,jk)
+ END DO
+ IF (ABS(zup-hu0_parent(ji,jj))>1.e-3) THEN
+ zup = 0._wp
+ DO jk=1, jpkm1
+ IF ( (zup + 1.5_wp * e3u_0(ji,jj,jk) ) >= hu0_parent(ji,jj) ) THEN
+ e3u_0(ji,jj,jk) = hu0_parent(ji,jj) - zup
+ e3uw_0(ji,jj,jk) = 0.5_wp * (e3u_0(ji,jj,jk-1) + e3u_0(ji,jj,jk))
+ mbku(ji,jj) = jk
+ EXIT
+ ELSE
+ zup = zup + e3u_0(ji,jj,jk)
+ END IF
+ END DO
+ END IF
+ END IF
+ END DO
+ END DO
+
+ ENDIF
+ !
+ END SUBROUTINE connect_e3u_connect
+
+ SUBROUTINE connect_e3v_connect( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE connect_e3v_connect ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+ LOGICAL , INTENT(in ) :: before
+ INTEGER , INTENT(in ) :: nb , ndir
+ !
+ !!----------------------------------------------------------------------
+ INTEGER :: ji, jj, jk
+ REAL(wp) :: zup
+ !
+ IF(.NOT.before) THEN
+
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( ssvmask(ji,jj) > 0 ) THEN
+ zup = 0._wp
+ DO jk=1, mbkv(ji,jj)
+ zup = zup + e3v_0(ji,jj,jk)
+ END DO
+ IF (ABS(zup-hv0_parent(ji,jj))>1.e-3) THEN
+ zup = 0._wp
+ DO jk=1, jpkm1
+ IF ( (zup + 1.5_wp * e3v_0(ji,jj,jk) ) >= hv0_parent(ji,jj) ) THEN
+ e3v_0(ji,jj,jk) = hv0_parent(ji,jj) - zup
+ e3vw_0(ji,jj,jk) = 0.5_wp * (e3v_0(ji,jj,jk-1) + e3v_0(ji,jj,jk))
+ mbkv(ji,jj) = jk
+ EXIT
+ ELSE
+ zup = zup + e3v_0(ji,jj,jk)
+ END IF
+ END DO
+ END IF
+ END IF
+ END DO
+ END DO
+
+ ENDIF
+ !
+ END SUBROUTINE connect_e3v_connect
+
+ SUBROUTINE connect_e3f_connect( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE connect_e3f_connect ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+ LOGICAL , INTENT(in ) :: before
+ INTEGER , INTENT(in ) :: nb , ndir
+ !
+ !!----------------------------------------------------------------------
+ INTEGER :: ji, jj, jk
+ REAL(wp) :: zup
+ !
+ IF(.NOT.before) THEN
+
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( ssfmask(ji,jj) > 0 ) THEN
+ zup = 0._wp
+ DO jk=1, mbkf(ji,jj)
+ zup = zup + e3f_0(ji,jj,jk)
+ END DO
+ IF (ABS(zup-hf0_parent(ji,jj))>1.e-3) THEN
+ zup = 0._wp
+ DO jk=1, jpkm1
+ IF ( (zup + 1.5_wp * e3f_0(ji,jj,jk) ) >= hf0_parent(ji,jj) ) THEN
+ e3f_0(ji,jj,jk) = hf0_parent(ji,jj) - zup
+ mbkf(ji,jj) = jk
+ EXIT
+ ELSE
+ zup = zup + e3f_0(ji,jj,jk)
+ END IF
+ END DO
+ END IF
+ END IF
+ END DO
+ END DO
+
+ ENDIF
+ !
+ END SUBROUTINE connect_e3f_connect
+
SUBROUTINE connect_bathy_connect( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir)
!!----------------------------------------------------------------------
!! *** ROUTINE connect_e3t_connect ***
@@ -243,13 +421,14 @@ CONTAINS
INTEGER , INTENT(in ) :: nb , ndir
!
!!----------------------------------------------------------------------
- INTEGER :: ji, jj, jk
+ INTEGER :: ji, jj, jk, ik
+ REAL(wp) :: zhmin
!
IF( before) THEN
DO jk=k1,k2
DO jj=j1,j2
DO ji=i1,i2
- IF( mbkt(ji,jj) .GE. jk ) THEN
+ IF ((ssmask(ji,jj)/=0._wp).AND.( mbkt(ji,jj) .GE. jk )) THEN
ptab(ji,jj,jk) = e3t_0(ji,jj,jk)
ELSE
ptab(ji,jj,jk) = 0._wp
@@ -264,15 +443,33 @@ CONTAINS
END DO
END DO
ELSE
+
+ IF (l_set_hmin) THEN
+ IF ( ln_sco ) THEN
+ zhmin = rn_sbot_min
+ ELSE
+ IF( rn_hmin < 0._wp ) THEN
+ ik = - INT( rn_hmin )
+ ELSE
+ ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 )
+ ENDIF
+ zhmin = gdepw_1d(ik+1)
+ ENDIF
+ ELSE
+ zhmin = 0._wp
+ ENDIF
+
DO jj=j1,j2
DO ji=i1,i2
! keep child masking in transition zone:
IF ((ztabramp(ji,jj)/=1._wp).AND.(bathy(ji,jj)==0._wp)) ptab(ji,jj,k2) = 0._wp
- ! Connected bathymetry
+ ! Connected bathymetry:
IF( .NOT.e3t_interp_done(ji,jj) ) THEN
bathy(ji,jj)=(1._wp-ztabramp(ji,jj))*bathy(ji,jj)+ztabramp(ji,jj)*ptab(ji,jj,k2)
+ IF (bathy(ji,jj)/=0._wp) bathy(ji,jj) = MAX(bathy(ji,jj), zhmin)
e3t_interp_done(ji,jj) = .TRUE.
ENDIF
+
END DO
END DO
ENDIF
@@ -291,9 +488,9 @@ CONTAINS
! Define ramp from boundaries towards domain interior at T-points
! Store it in ztabramp
- ALLOCATE(ztabramp(jpi,jpj))
+ IF (.NOT.ALLOCATED(ztabramp)) ALLOCATE(ztabramp(jpi,jpj))
ispongearea = 1 + npt_connect * Agrif_iRhox()
- istart = npt_copy * Agrif_iRhox()
+ istart = npt_copy * Agrif_iRhox() + 1
z1_spongearea = 1._wp / REAL( ispongearea, wp )
ztabramp(:,:) = 0._wp
@@ -309,7 +506,7 @@ CONTAINS
ENDDO
! ghost cells:
ind1 = 1
- ind2 = nn_hls + nbghostcells + istart ! halo + land + nbghostcells
+ ind2 = nn_hls + nbghostcells + istart ! halo + land + nbghostcells
DO ji = mi0(ind1), mi1(ind2)
DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp
@@ -337,7 +534,7 @@ CONTAINS
ENDIF
ispongearea = 1 + npt_connect * Agrif_iRhoy()
- istart = npt_copy * Agrif_iRhoy()
+ istart = npt_copy * Agrif_iRhoy() + 1
z1_spongearea = 1._wp / REAL( ispongearea, wp )
! --- South --- !
@@ -380,6 +577,31 @@ CONTAINS
!
END SUBROUTINE agrif_connection
+
+ SUBROUTINE interpht0( ptab, i1, i2, j1, j2, before )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE interpht0 ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+ LOGICAL , INTENT(in ) :: before
+ INTEGER :: jk
+ !
+ !!----------------------------------------------------------------------
+ !
+ IF( before) THEN
+ ptab(i1:i2,j1:j2) = 0._wp
+ DO jk=1,jpkm1
+ ptab(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) + &
+ & e3t_0(i1:i2,j1:j2,jk) * tmask(i1:i2,j1:j2,jk)
+ END DO
+ ELSE
+ ht0_parent(i1:i2,j1:j2) = ptab(i1:i2,j1:j2)
+ ENDIF
+ !
+ END SUBROUTINE interpht0
+
+
#else
SUBROUTINE agrif_boundary_connections
END SUBROUTINE agrif_boundary_connections
diff --git a/tools/DOMAINcfg/src/agrif_dom_update.F90 b/tools/DOMAINcfg/src/agrif_dom_update.F90
index 81b3ec0ddd8024aecf643348d370d04fac6c0074..64a95f0809a285de78ec97042a04d6bb61cf6a09 100644
--- a/tools/DOMAINcfg/src/agrif_dom_update.F90
+++ b/tools/DOMAINcfg/src/agrif_dom_update.F90
@@ -4,10 +4,14 @@ MODULE agrif_dom_update
USE agrif_parameters
USE agrif_profiles
USE agrif_recompute_scales
+ USE lbclnk
IMPLICIT none
PRIVATE
+ REAL(wp), PARAMETER :: rminfrac = 0.98_wp ! Should be < 1
+ LOGICAL :: l_match_area=.FALSE.
+
PUBLIC agrif_update_all
CONTAINS
@@ -19,40 +23,96 @@ CONTAINS
!! *** ROUTINE agrif_update_all ***
!!----------------------------------------------------------------------
!
- INTEGER :: ind1, ind2
IF( Agrif_Root() ) return
+ !
+ ! Update e1t and e2t (set grid cell area as over child grid):
+ CALL agrif_update_variable(e1e2t_upd_id, procname = update_e1e2t)
+ ! Update e2u and e1v at cell faces:
+ CALL agrif_update_variable(e2u_id, procname = update_e2u)
+ CALL agrif_update_variable(e1v_id, procname = update_e1v)
+
+ ! Then compute fractional area over child grid:
+ ALLOCATE(e1e2t_frac(jpi,jpj), e2u_frac(jpi,jpj), e1v_frac(jpi,jpj))
+ CALL Agrif_Init_variable(e1e2t_frac_id, procname = interp_e1e2t_frac)
+ ! And fractional size of cell faces:
+ CALL Agrif_Init_variable(e2u_frac_id, procname = interp_e2u_frac)
+ CALL Agrif_Init_variable(e1v_frac_id, procname = interp_e1v_frac)
+ !
+ ! Update scale factors:
+ !
+ Agrif_UseSpecialValueInUpdate = .FALSE.
IF ( .NOT.ln_vert_remap ) THEN
- CALL agrif_update_variable(bottom_level_id,procname = update_bottom_level)
- Agrif_UseSpecialValueInUpdate = .FALSE.
- Agrif_SpecialValueFineGrid = 0._wp
- CALL agrif_update_variable(e3t_copy_id, procname = update_e3t_z)
+ ! Get max bottom level over coarse grid (mbkt):
+ CALL agrif_update_variable(mbkt_id, procname = update_mbkt)
+ ! Set e3t over parent as averages of child grid cells:
+ CALL agrif_update_variable(e3t_id, procname = update_e3t_z)
+ ! Set e3w over parent as the center of child cells volumes:
+ CALL agrif_update_variable(e3w_id, procname = update_e3w_z)
+ !
+ ! Update surface mask at U/V points in case it has been updated above:
+ CALL Agrif_ChildGrid_To_ParentGrid()
+ CALL update_surf_masks
+ CALL Agrif_ParentGrid_To_ChildGrid()
+ !
+ ! Set mbku as maximum over U-faces:
+ CALL agrif_update_variable(mbku_id, procname = update_mbku)
+ ! Set e3u/e3uw as U-faces averages:
+ CALL agrif_update_variable(e3u_id, procname = update_e3u_z)
+ ! Set e3uw over parent as the center of child cells volumes:
+ CALL agrif_update_variable(e3uw_id, procname = update_e3uw_z)
+ ! Set mbkv as maximum over V-faces:
+ CALL agrif_update_variable(mbkv_id, procname = update_mbkv)
+ ! Set e3v/e3vw as v-faces averages:
+ CALL agrif_update_variable(e3v_id, procname = update_e3v_z)
+ ! Set e3vw over parent as the center of child cells volumes:
+ CALL agrif_update_variable(e3vw_id, procname = update_e3vw_z)
+ ! Copy mbkf value at F-points:
+ CALL agrif_update_variable(mbkf_id, procname = update_mbkf)
+ ! Copy e3f at faces corners:
+ CALL agrif_update_variable(e3f_id, procname = update_e3f_z)
!
ELSE
- Agrif_UseSpecialValueInUpdate = .FALSE.
- Agrif_SpecialValueFineGrid = 0._wp
- CALL agrif_update_variable(e3t_id, procname = update_e3t_z_cons)
-
- ! jc: extend update zone outside dynamical interface within sponge zone:
- ! Use max operator this time to account for cases for which Agrif_Rho > nbghostcells
- ind1 = CEILING(REAL(max(nbghostcells_x_w-1, nbghostcells_x_e-1), wp) / Agrif_Rhox() )
- ind2 = CEILING(REAL(max(nbghostcells_y_s-1, nbghostcells_y_n-1), wp) / Agrif_Rhoy() )
- CALL agrif_update_variable(e3t_copy_id, locupdate1=(/-ind1,0/), &
- & locupdate2=(/-ind2,0/),procname = update_e3t_z_cons)
+ ! Reconstruct e3t/e3w over parent grid such that total volume is conserved:
+ CALL agrif_update_variable(e3t_id, procname = update_e3tw_z_gen)
+ !
+ ! Update vertical scale factors at U, V and F-points:
+ CALL Agrif_ChildGrid_To_ParentGrid()
+ CALL update_surf_masks
+ CALL agrif_recompute_scalefactors
+ CALL Agrif_ParentGrid_To_ChildGrid()
ENDIF
- Agrif_UseSpecialValueInUpdate = .FALSE.
- !
- ! Update vertical scale factors at U, V and F-points:
- CALL Agrif_ChildGrid_To_ParentGrid()
- CALL agrif_recompute_scalefactors
- CALL Agrif_ParentGrid_To_ChildGrid()
+ DEALLOCATE(e1e2t_frac, e2u_frac, e1v_frac)
!
END SUBROUTINE agrif_update_all
- SUBROUTINE update_bottom_level( ptab, i1, i2, j1, j2, before)
+
+ SUBROUTINE update_surf_masks
!!----------------------------------------------------------------------
- !! *** ROUTINE update_bottom_level ***
+ !! *** ROUTINE update_surf_masks ***
+ !!
+ !! Update surface mask at U/V points from mask at T-points
+ !!----------------------------------------------------------------------
+ INTEGER :: ji, jj
+ !!----------------------------------------------------------------------
+ DO jj = 1, jpjm1
+ DO ji = 1, jpim1
+ ssumask(ji,jj) = ssmask(ji ,jj ) * ssmask(ji+1,jj )
+ ssvmask(ji,jj) = ssmask(ji ,jj ) * ssmask(ji ,jj+1)
+ ssfmask(ji,jj) = ssmask(ji ,jj ) * ssmask(ji+1,jj ) &
+ &*ssmask(ji+1,jj+1) * ssmask(ji ,jj+1)
+ END DO
+ END DO
+ !
+ CALL lbc_lnk_multi( 'update_surf_masks', ssumask, 'U', 1., ssvmask, 'V', 1., ssfmask,'F', 1.)
+ !
+ END SUBROUTINE update_surf_masks
+
+
+ SUBROUTINE update_mbkt( ptab, i1, i2, j1, j2, before)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE update_mbkt ***
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: i1, i2, j1, j2
REAL, DIMENSION(i1:i2,j1:j2) , INTENT(inout) :: ptab
@@ -61,19 +121,89 @@ CONTAINS
!!----------------------------------------------------------------------
!
IF( before) THEN
- ptab(i1:i2,j1:j2) = mbkt(i1:i2,j1:j2)*ssmask(i1:i2,j1:j2)
+ ptab(i1:i2,j1:j2) = mbkt(i1:i2,j1:j2) * ssmask(i1:i2,j1:j2)
ELSE
mbkt(i1:i2,j1:j2) = nint(ptab(i1:i2,j1:j2))
WHERE ( mbkt(i1:i2,j1:j2) .EQ. 0 )
ssmask(i1:i2,j1:j2) = 0._wp
- mbkt(i1:i2,j1:j2) = 1
+ mbkt(i1:i2,j1:j2) = 1
ELSEWHERE
ssmask(i1:i2,j1:j2) = 1._wp
END WHERE
ENDIF
!
- END SUBROUTINE update_bottom_level
+ END SUBROUTINE update_mbkt
+
+
+ SUBROUTINE update_mbku( ptab, i1, i2, j1, j2, before)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE update_mbku ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL, DIMENSION(i1:i2,j1:j2) , INTENT(inout) :: ptab
+ LOGICAL , INTENT(in ) :: before
+ !
+ !!----------------------------------------------------------------------
+ !
+ IF( before) THEN
+ ptab(i1:i2,j1:j2) = mbku(i1:i2,j1:j2) * ssumask(i1:i2,j1:j2)
+ ELSE
+ mbku(i1:i2,j1:j2) = nint(ptab(i1:i2,j1:j2))
+
+ WHERE ( mbku(i1:i2,j1:j2) .EQ. 0 )
+ mbku(i1:i2,j1:j2) = 1
+ END WHERE
+ ENDIF
+ !
+ END SUBROUTINE update_mbku
+
+
+ SUBROUTINE update_mbkv( ptab, i1, i2, j1, j2, before)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE update_mbkv ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL, DIMENSION(i1:i2,j1:j2) , INTENT(inout) :: ptab
+ LOGICAL , INTENT(in ) :: before
+ !
+ !!----------------------------------------------------------------------
+ !
+ IF( before) THEN
+ ptab(i1:i2,j1:j2) = mbkv(i1:i2,j1:j2) * ssvmask(i1:i2,j1:j2)
+ ELSE
+ mbkv(i1:i2,j1:j2) = nint(ptab(i1:i2,j1:j2))
+
+ WHERE ( mbkv(i1:i2,j1:j2) .EQ. 0 )
+ mbkv(i1:i2,j1:j2) = 1
+ END WHERE
+ ENDIF
+ !
+ END SUBROUTINE update_mbkv
+
+
+ SUBROUTINE update_mbkf( ptab, i1, i2, j1, j2, before)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE update_mbkf ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL, DIMENSION(i1:i2,j1:j2) , INTENT(inout) :: ptab
+ LOGICAL , INTENT(in ) :: before
+ !
+ !!----------------------------------------------------------------------
+ !
+ IF( before) THEN
+ ptab(i1:i2,j1:j2) = mbkf(i1:i2,j1:j2) * ssfmask(i1:i2,j1:j2)
+ ELSE
+ mbkf(i1:i2,j1:j2) = nint(ptab(i1:i2,j1:j2))
+
+ WHERE ( mbkf(i1:i2,j1:j2) .EQ. 0 )
+ mbkf(i1:i2,j1:j2) = 1
+ END WHERE
+ ENDIF
+ !
+ END SUBROUTINE update_mbkf
+
SUBROUTINE update_e3t_z( tabres, i1, i2, j1, j2, k1, k2, before )
!!---------------------------------------------
@@ -83,7 +213,8 @@ CONTAINS
REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
LOGICAL, INTENT(in) :: before
!!
- INTEGER :: ji, jj, jk
+ INTEGER :: ji, jj, jk, ik
+ REAL(wp) :: zimin
!!---------------------------------------------
!
IF (before) THEN
@@ -91,20 +222,21 @@ CONTAINS
DO jj=j1,j2
DO ji=i1,i2
IF ( (ssmask(ji,jj) /=0._wp).AND.(mbkt(ji,jj).GE.jk) ) THEN
- tabres(ji,jj,jk) = e3t_0(ji,jj,jk)
+ tabres(ji,jj,jk) = e1e2t_frac(ji,jj) * e3t_0(ji,jj,jk)
ELSE
tabres(ji,jj,jk) = 0._wp
ENDIF
END DO
END DO
END DO
+ tabres(i1:i2,j1:j2,k2) = e1e2t_frac(i1:i2,j1:j2) * ssmask(i1:i2,j1:j2) ! To get fractional area
ELSE
- DO jk=1,jpk
+ !
+ DO jk=1,jpkm1
DO jj=j1,j2
DO ji=i1,i2
- IF ( ( mbkt(ji,jj).GE.jk ).AND.(ssmask(ji,jj)==1._wp) ) THEN
- e3t_0(ji,jj,jk) = MAX(tabres(ji,jj,jk),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
- ! e3t_0(ji,jj,jk) = tabres(ji,jj,jk)
+ IF ( (ssmask(ji,jj)==1._wp).AND.(mbkt(ji,jj).GE.jk) ) THEN
+ e3t_0(ji,jj,jk) = tabres(ji,jj,jk)
ELSE
e3t_0(ji,jj,jk) = e3t_1d(jk)
ENDIF
@@ -112,20 +244,52 @@ CONTAINS
END DO
END DO
!
+ ! Change surface mask below in case of too shallow
+ ! depth on parent grid
+ !---------------------------------------------------
+ ! Update bathymetry:
+ DO jj=j1,j2
+ DO ji=i1,i2
+ bathy(ji,jj) = SUM(e3t_0(ji,jj,1:mbkt(ji,jj) ) )
+ END DO
+ END DO
+ !
+ ! Mask points:
+
+
+ IF ( l_match_area) THEN ; zimin = 0._wp ; ELSE ; zimin = rminfrac ; ENDIF
+
+ WHERE ( ( mbkt(i1:i2,j1:j2) .EQ. 1 ) &
+ & .OR.(tabres(i1:i2,j1:j2,k2)<=zimin) )
+ bathy(i1:i2,j1:j2) = 0._wp
+ ssmask(i1:i2,j1:j2) = 0._wp
+ mbkt(i1:i2,j1:j2) = 1
+ END WHERE
+ !
+ ! Reset thicknesses to the one from the reference grid over land:
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF (mbkt(ji,jj)==1) THEN
+ DO jk=1,jpk
+ e3t_0(ji,jj,jk) = e3t_1d(jk)
+ END DO
+ ENDIF
+ END DO
+ END DO
ENDIF
!
END SUBROUTINE update_e3t_z
- SUBROUTINE update_e3t_z_cons( tabres, i1, i2, j1, j2, k1, k2, before )
+ SUBROUTINE update_e3tw_z_gen( tabres, i1, i2, j1, j2, k1, k2, before )
!!---------------------------------------------
- !! *** update_e3t_z_cons ***
+ !! *** update_e3tw_z_gen ***
!!---------------------------------------------
INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
LOGICAL, INTENT(in) :: before
!!
INTEGER :: ji, jj, jk, ik
- REAL(wp) :: zhmin, zdepth, zdepwp, ze3tp, ze3wp
+ REAL(wp) :: ze3min, zdepth, zdepwp, ze3tp, ze3wp, zimin
!!---------------------------------------------
!
IF (before) THEN
@@ -133,22 +297,16 @@ CONTAINS
DO jj = j1, j2
DO ji = i1, i2
IF ( (ssmask(ji,jj) /=0._wp).AND.( mbkt(ji,jj) .GE. jk ) ) THEN
- tabres(ji,jj,jk) = e3t_0(ji,jj,jk)
+ tabres(ji,jj,jk) = e1e2t_frac(ji,jj) * e3t_0(ji,jj,jk)
ELSE
tabres(ji,jj,jk) = 0._wp
endif
END DO
END DO
END DO
- tabres(i1:i2,j1:j2,k2) = ssmask(i1:i2,j1:j2) ! To get fractional area
+ tabres(i1:i2,j1:j2,k2) = e1e2t_frac(i1:i2,j1:j2) * ssmask(i1:i2,j1:j2) ! To get fractional area
ELSE
- IF( rn_hmin < 0._wp ) THEN
- ik = - INT( rn_hmin )
- ELSE
- ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 )
- ENDIF
- zhmin = gdepw_1d(ik+1)
-
+ !
! Compute child bathymetry:
bathy(i1:i2,j1:j2) = 0._wp
DO jk=k1,k2-1
@@ -159,7 +317,7 @@ CONTAINS
END WHERE
DO jk = jpkm1, 1, -1
- zdepth = gdepw_1d(jk) ! + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+ zdepth = gdepw_1d(jk) + 1.e-6 ! + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
WHERE( 0._wp < bathy(i1:i2,j1:j2) .AND. bathy(i1:i2,j1:j2) <= zdepth ) mbathy(i1:i2,j1:j2) = jk-1
END DO
@@ -181,12 +339,17 @@ CONTAINS
ze3tp = bathy(ji,jj) - gdepw_1d(ik)
ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
e3t_0(ji,jj,ik ) = ze3tp
- e3t_0(ji,jj,ik+1) = ze3tp
e3w_0(ji,jj,ik ) = ze3wp
+ IF ( ln_e3_dep.AND.ln_dept_mid ) THEN
+ gdept_0(ji,jj,ik) = gdepw_1d(ik) + 0.5_wp * ze3tp
+ e3w_0(ji,jj,ik ) = gdept_0(ji,jj,ik) - gdept_0(ji,jj,ik-1)
+ ELSE
+ gdept_0(ji,jj,ik) = gdept_1d(ik-1) + ze3wp
+ e3w_0(ji,jj,ik ) = ze3wp
+ ENDIF
+ gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
e3w_0(ji,jj,ik+1) = ze3tp
gdepw_0(ji,jj,ik+1) = zdepwp
- gdept_0(ji,jj,ik ) = gdept_1d(ik-1) + ze3wp
- gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
!
ELSE ! standard case
IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN
@@ -194,14 +357,19 @@ CONTAINS
ELSE
gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
ENDIF
- gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) ) &
- & * ((gdept_1d( ik ) - gdepw_1d(ik) ) &
- & / ( gdepw_1d( ik+1) - gdepw_1d(ik) ))
e3t_0 (ji,jj,ik) = e3t_1d (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik)) &
& / ( gdepw_1d( ik+1) - gdepw_1d(ik))
- e3w_0(ji,jj,ik) = &
- & 0.5_wp * (gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) ) &
- & * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+ IF ( ln_e3_dep.AND.ln_dept_mid ) THEN
+ gdept_0(ji,jj,ik) = gdepw_1d(ik) + 0.5_wp * e3t_0(ji,jj,ik)
+ e3w_0(ji,jj,ik) = gdept_0(ji,jj,ik) - gdept_0(ji,jj,ik-1)
+ ELSE
+ gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) ) &
+ & * ((gdept_1d( ik ) - gdepw_1d(ik) ) &
+ & / ( gdepw_1d( ik+1) - gdepw_1d(ik) ))
+ e3w_0(ji,jj,ik) = &
+ & 0.5_wp * (gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) ) &
+ & * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+ ENDIF
! ... on ik+1
e3w_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
e3t_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
@@ -211,25 +379,533 @@ CONTAINS
END DO
END DO
!
+ ! Expand last level if too thin:
+! DO jj=j1,j2
+! DO ji=i1,i2
+! ik = mbathy(ji,jj)
+! IF ( ik > 2 ) THEN
+! ze3min = MIN( e3zps_min, e3t_1d(ik)*e3zps_rat )
+! IF ( e3t_0(ji,jj,ik) < ze3min ) THEN
+! e3t_0(ji,jj,ik-1) = e3t_0(ji,jj,ik-1) - (ze3min - e3t_0(ji,jj,ik))
+! e3t_0(ji,jj,ik ) = ze3min
+! gdept_0(ji,jj,ik-1) = gdepw_1d(ik-1) + 0.5_wp * e3t_0(ji,jj,ik-1)
+! gdept_0(ji,jj,ik ) = gdept_0(ji,jj,ik-1) + 0.5_wp * (e3t_0(ji,jj,ik) + e3t_0(ji,jj,ik-1))
+! e3w_0(ji,jj,ik-1) = gdept_0(ji,jj,ik-1)-gdept_0(ji,jj,ik-2)
+! e3w_0(ji,jj,ik ) = gdept_0(ji,jj,ik )-gdept_0(ji,jj,ik-1)
+! e3w_0 (ji,jj,ik+1) = e3t_0(ji,jj,ik)
+! e3t_0 (ji,jj,ik+1) = e3t_0(ji,jj,ik)
+! ENDIF
+! ENDIF
+! END DO
+! END DO
+ !
+ mbkt(i1:i2,j1:j2) = MAX( mbathy(i1:i2,j1:j2), 1 )
DO jj=j1,j2
DO ji=i1,i2
bathy(ji,jj) = SUM(e3t_0(ji,jj,1:mbkt(ji,jj) ) )
END DO
END DO
!
- WHERE ( ( mbathy(i1:i2,j1:j2) .EQ. 0 ) &
- & .OR.(tabres(i1:i2,j1:j2,k2)<0.5_wp) &
- & .OR.(bathy(i1:i2,j1:j2)<zhmin) )
+ IF ( l_match_area) THEN ; zimin = 0._wp ; ELSE ; zimin = rminfrac ; ENDIF
+
+ WHERE ( ( mbkt(i1:i2,j1:j2) .EQ. 1 ) &
+ & .OR.(tabres(i1:i2,j1:j2,k2)<zimin) )
+ bathy(i1:i2,j1:j2) = 0._wp
ssmask(i1:i2,j1:j2) = 0._wp
- mbathy(i1:i2,j1:j2) = 0
+ mbkt(i1:i2,j1:j2) = 1
ELSEWHERE
ssmask(i1:i2,j1:j2) = 1._wp
END WHERE
- mbkt(i1:i2,j1:j2) = MAX( mbathy(i1:i2,j1:j2), 1 )
+
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF (mbkt(ji,jj)==1) THEN
+ DO jk=1,jpk
+ e3t_0(ji,jj,jk) = e3t_1d(jk)
+ e3w_0(ji,jj,jk) = e3w_1d(jk)
+ gdept_0(ji,jj,jk) = gdept_1d(jk)
+ gdepw_0(ji,jj,jk) = gdepw_1d(jk)
+ END DO
+ ENDIF
+ END DO
+ END DO
ENDIF
!
- END SUBROUTINE update_e3t_z_cons
-
+ END SUBROUTINE update_e3tw_z_gen
+
+
+ SUBROUTINE update_e3w_z( tabres, i1, i2, j1, j2, k1, k2, before )
+ !!---------------------------------------------
+ !! *** update_e3w_z ***
+ !!---------------------------------------------
+ INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+ REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+ LOGICAL, INTENT(in) :: before
+ !!
+ INTEGER :: ji, jj, jk
+ !!---------------------------------------------
+ !
+ IF (before) THEN
+ DO jk=k1,k2
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( (ssmask(ji,jj)/=0._wp).AND.(mbkt(ji,jj).GE.jk) ) THEN
+ tabres(ji,jj,jk) = e1e2t_frac(ji,jj) * e3w_0(ji,jj,jk) * e3t_0(ji,jj,jk)
+ ELSE
+ tabres(ji,jj,jk) = 0._wp
+ ENDIF
+ END DO
+ END DO
+ END DO
+ ELSE
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( ssmask(ji,jj)==1._wp ) THEN
+ e3w_0(ji,jj,1) = tabres(ji,jj,1) / e3t_0(ji,jj,1)
+ gdept_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1)
+ ELSE
+ e3w_0(ji,jj,1) = e3w_1d(1)
+ gdept_0(ji,jj,1) = gdept_1d(1)
+ ENDIF
+ !
+ DO jk=2,jpkm1
+ IF ( (ssmask(ji,jj)==1._wp).AND.(mbkt(ji,jj).GE.jk) ) THEN
+ gdept_0(ji,jj,jk) = gdept_1d(jk-1) + tabres(ji,jj,jk) / e3t_0(ji,jj,jk)
+ ELSE
+ gdept_0(ji,jj,jk) = gdept_1d(jk)
+ ENDIF
+ END DO
+ DO jk=2,jpk
+ IF ( (ssmask(ji,jj)==1._wp).AND.(mbkt(ji,jj).GE.jk) ) THEN
+ e3w_0(ji,jj,jk) = gdept_0(ji,jj,jk) - gdept_0(ji,jj,jk-1)
+ ELSE
+ e3w_0(ji,jj,jk) = e3w_1d(jk)
+ ENDIF
+ END DO
+ END DO
+ END DO
+ !
+ ENDIF
+ !
+ END SUBROUTINE update_e3w_z
+
+
+ SUBROUTINE update_e3uw_z( tabres, i1, i2, j1, j2, k1, k2, before )
+ !!---------------------------------------------
+ !! *** update_e3uw_z ***
+ !!---------------------------------------------
+ INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+ REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: gdepu
+ LOGICAL, INTENT(in) :: before
+ !!
+ INTEGER :: ji, jj, jk
+ !!---------------------------------------------
+ !
+ IF (before) THEN
+ DO jk=k1,k2
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( (ssumask(ji,jj)/=0._wp).AND.(mbku(ji,jj).GE.jk) ) THEN
+ tabres(ji,jj,jk) = e2u_frac(ji,jj) * e3uw_0(ji,jj,jk) * e3u_0(ji,jj,jk)
+ ELSE
+ tabres(ji,jj,jk) = 0._wp
+ ENDIF
+ END DO
+ END DO
+ END DO
+ ELSE
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( ssumask(ji,jj)==1._wp ) THEN
+ e3uw_0(ji,jj,1) = tabres(ji,jj,1) / e3u_0(ji,jj,1)
+ gdepu(ji,jj,1) = 0.5_wp * e3uw_0(ji,jj,1)
+ ELSE
+ e3uw_0(ji,jj,1) = e3w_1d(1)
+ gdepu(ji,jj,1) = gdept_1d(1)
+ ENDIF
+ !
+ DO jk=2,jpkm1
+ IF ( (ssumask(ji,jj)==1._wp).AND.(mbku(ji,jj).GE.jk) ) THEN
+ gdepu(ji,jj,jk) = gdept_1d(jk-1) + tabres(ji,jj,jk) / e3u_0(ji,jj,jk)
+ ELSE
+ gdepu(ji,jj,jk) = gdept_1d(jk)
+ ENDIF
+ END DO
+ DO jk=2,jpk
+ IF ( (ssumask(ji,jj)==1._wp).AND.(mbku(ji,jj).GE.jk) ) THEN
+ e3uw_0(ji,jj,jk) = gdepu(ji,jj,jk) - gdepu(ji,jj,jk-1)
+ ELSE
+ e3uw_0(ji,jj,jk) = e3w_1d(jk)
+ ENDIF
+ END DO
+ END DO
+ END DO
+ !
+ ENDIF
+ !
+ END SUBROUTINE update_e3uw_z
+
+
+ SUBROUTINE update_e3vw_z( tabres, i1, i2, j1, j2, k1, k2, before )
+ !!---------------------------------------------
+ !! *** update_e3vw_z ***
+ !!---------------------------------------------
+ INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+ REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+ REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: gdepv
+ LOGICAL, INTENT(in) :: before
+ !!
+ INTEGER :: ji, jj, jk
+ !!---------------------------------------------
+ !
+ IF (before) THEN
+ DO jk=k1,k2
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( (ssvmask(ji,jj)/=0._wp).AND.(mbkv(ji,jj).GE.jk) ) THEN
+ tabres(ji,jj,jk) = e1v_frac(ji,jj) * e3vw_0(ji,jj,jk) * e3v_0(ji,jj,jk)
+ ELSE
+ tabres(ji,jj,jk) = 0._wp
+ ENDIF
+ END DO
+ END DO
+ END DO
+ ELSE
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( ssvmask(ji,jj)==1._wp ) THEN
+ e3vw_0(ji,jj,1) = tabres(ji,jj,1) / e3v_0(ji,jj,1)
+ gdepv(ji,jj,1) = 0.5_wp * e3vw_0(ji,jj,1)
+ ELSE
+ e3vw_0(ji,jj,1) = e3w_1d(1)
+ gdepv(ji,jj,1) = gdept_1d(1)
+ ENDIF
+ !
+ DO jk=2,jpkm1
+ IF ( (ssvmask(ji,jj)==1._wp).AND.(mbkv(ji,jj).GE.jk) ) THEN
+ gdepv(ji,jj,jk) = gdept_1d(jk-1) + tabres(ji,jj,jk) / e3v_0(ji,jj,jk)
+ ELSE
+ gdepv(ji,jj,jk) = gdept_1d(jk)
+ ENDIF
+ END DO
+ DO jk=2,jpk
+ IF ( (ssvmask(ji,jj)==1._wp).AND.(mbkv(ji,jj).GE.jk) ) THEN
+ e3vw_0(ji,jj,jk) = gdepv(ji,jj,jk) - gdepv(ji,jj,jk-1)
+ ELSE
+ e3vw_0(ji,jj,jk) = e3w_1d(jk)
+ ENDIF
+ END DO
+ END DO
+ END DO
+ !
+ ENDIF
+ !
+ END SUBROUTINE update_e3vw_z
+
+
+ SUBROUTINE update_e3u_z( tabres, i1, i2, j1, j2, k1, k2, before )
+ !!---------------------------------------------
+ !! *** update_e3u_z ***
+ !!---------------------------------------------
+ INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+ REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+ LOGICAL, INTENT(in) :: before
+ !!
+ INTEGER :: ji, jj, jk
+ !!---------------------------------------------
+ !
+ IF (before) THEN
+ DO jk=k1,k2
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( (ssumask(ji,jj) /=0._wp).AND.(mbku(ji,jj).GE.jk) ) THEN
+ tabres(ji,jj,jk) = e2u_frac(ji,jj) * e3u_0(ji,jj,jk)
+ ELSE
+ tabres(ji,jj,jk) = 0._wp
+ ENDIF
+ END DO
+ END DO
+ END DO
+ ELSE
+ !
+ DO jk=1,jpkm1
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( (ssumask(ji,jj)==1._wp).AND.(mbku(ji,jj).GE.jk) ) THEN
+ e3u_0(ji,jj,jk) = tabres(ji,jj,jk)
+ ELSE
+ e3u_0(ji,jj,jk) = e3t_1d(jk)
+ ENDIF
+ END DO
+ END DO
+ END DO
+ !
+ ENDIF
+ !
+ END SUBROUTINE update_e3u_z
+
+
+ SUBROUTINE update_e3v_z( tabres, i1, i2, j1, j2, k1, k2, before )
+ !!---------------------------------------------
+ !! *** update_e3v_z ***
+ !!---------------------------------------------
+ INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+ REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+ LOGICAL, INTENT(in) :: before
+ !!
+ INTEGER :: ji, jj, jk
+ !!---------------------------------------------
+ !
+ IF (before) THEN
+ DO jk=k1,k2
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( (ssvmask(ji,jj) /=0._wp).AND.(mbkv(ji,jj).GE.jk) ) THEN
+ tabres(ji,jj,jk) = e1v_frac(ji,jj) * e3v_0(ji,jj,jk)
+ ELSE
+ tabres(ji,jj,jk) = 0._wp
+ ENDIF
+ END DO
+ END DO
+ END DO
+ ELSE
+ !
+ DO jk=1,jpkm1
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( (ssvmask(ji,jj)==1._wp).AND.(mbkv(ji,jj).GE.jk) ) THEN
+ e3v_0(ji,jj,jk) = tabres(ji,jj,jk)
+ ELSE
+ e3v_0(ji,jj,jk) = e3t_1d(jk)
+ ENDIF
+ END DO
+ END DO
+ END DO
+ !
+ ENDIF
+ !
+ END SUBROUTINE update_e3v_z
+
+
+ SUBROUTINE update_e3f_z( tabres, i1, i2, j1, j2, k1, k2, before )
+ !!---------------------------------------------
+ !! *** update_e3f_z ***
+ !!---------------------------------------------
+ INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+ REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+ LOGICAL, INTENT(in) :: before
+ !!
+ INTEGER :: ji, jj, jk
+ !!---------------------------------------------
+ !
+ IF (before) THEN
+ DO jk=k1,k2
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( (ssfmask(ji,jj) /=0._wp).AND.(mbkf(ji,jj).GE.jk) ) THEN
+ tabres(ji,jj,jk) = e3f_0(ji,jj,jk)
+ ELSE
+ tabres(ji,jj,jk) = 0._wp
+ ENDIF
+ END DO
+ END DO
+ END DO
+ ELSE
+ !
+ DO jk=1,jpkm1
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( (ssfmask(ji,jj)==1._wp).AND.(mbkf(ji,jj).GE.jk) ) THEN
+ e3f_0(ji,jj,jk) = tabres(ji,jj,jk)
+ ELSE
+ e3f_0(ji,jj,jk) = e3t_1d(jk)
+ ENDIF
+ END DO
+ END DO
+ END DO
+ !
+ ENDIF
+ !
+ END SUBROUTINE update_e3f_z
+
+
+ SUBROUTINE update_e1e2t(tabres, i1, i2, j1, j2, n1, n2, before )
+ !
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE update_e1e2t ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2, n1, n2
+ REAL(wp),DIMENSION(i1:i2,j1:j2,n1:n2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ INTEGER :: ji ,jj, jk
+ REAL(wp) :: ztemp
+ !!----------------------------------------------------------------------
+
+ IF (before) THEN
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF ( l_match_area ) THEN
+ tabres(ji,jj,1) = e1t(ji,jj)*e2t(ji,jj)*ssmask(ji,jj)
+ tabres(ji,jj,2) = e1t(ji,jj)*ssmask(ji,jj)
+ tabres(ji,jj,3) = e2t(ji,jj)*ssmask(ji,jj)
+ ELSE
+ tabres(ji,jj,1) = e1t(ji,jj)*e2t(ji,jj)
+ tabres(ji,jj,2) = e1t(ji,jj)
+ tabres(ji,jj,3) = e2t(ji,jj)
+ ENDIF
+ END DO
+ END DO
+ tabres(i1:i2,j1:j2,1) = tabres(i1:i2,j1:j2,1)*Agrif_Rhox()*Agrif_Rhoy()
+ tabres(i1:i2,j1:j2,2) = tabres(i1:i2,j1:j2,2)*Agrif_Rhox()
+ tabres(i1:i2,j1:j2,3) = tabres(i1:i2,j1:j2,3)*Agrif_Rhoy()
+ ELSE
+ DO jj=j1,j2
+ DO ji=i1,i2
+ IF (tabres(ji,jj,1)/=0._wp) THEN
+ ztemp = SQRT(tabres(ji,jj,1) &
+ & /(tabres(ji,jj,2)*tabres(ji,jj,3)))
+ e1t(ji,jj) = tabres(ji,jj,2)*ztemp
+ e2t(ji,jj) = tabres(ji,jj,3)*ztemp
+ e1e2t(ji,jj) = tabres(ji,jj,1)
+ r1_e1e2t(ji,jj) = 1._wp / tabres(ji,jj,1)
+ r1_e1t(ji,jj) = 1._wp / (tabres(ji,jj,2)*ztemp)
+ r1_e2t(ji,jj) = 1._wp / (tabres(ji,jj,3)*ztemp)
+ ENDIF
+ END DO
+ END DO
+ ENDIF
+ !
+ END SUBROUTINE update_e1e2t
+
+
+ SUBROUTINE update_e2u(tabres, i1, i2, j1, j2, before )
+ !
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE update_e2u ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ INTEGER :: ji ,jj
+ !!----------------------------------------------------------------------
+
+ IF (before) THEN
+ IF ( l_match_area ) THEN
+ tabres(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ssumask(i1:i2,j1:j2) * Agrif_Rhoy()
+ ELSE
+ tabres(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * Agrif_Rhoy()
+ ENDIF
+ ELSE
+ DO ji=i1,i2
+ DO jj=j1,j2
+ IF (tabres(ji,jj)/=0._wp) THEN
+ e2u(ji,jj) = tabres(ji,jj)
+ r1_e2u(ji,jj) = 1._wp / tabres(ji,jj)
+ END IF
+ END DO
+ END DO
+ ENDIF
+ !
+ END SUBROUTINE update_e2u
+
+
+ SUBROUTINE update_e1v(tabres, i1, i2, j1, j2, before )
+ !
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE update_e1v ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ INTEGER :: ji ,jj
+ !!----------------------------------------------------------------------
+
+ IF (before) THEN
+ IF ( l_match_area ) THEN
+ tabres(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * ssvmask(i1:i2,j1:j2) * Agrif_Rhox()
+ ELSE
+ tabres(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * Agrif_Rhox()
+ ENDIF
+ ELSE
+ DO ji=i1,i2
+ DO jj=j1,j2
+ IF (tabres(ji,jj)/=0._wp) THEN
+ e1v(ji,jj) = tabres(ji,jj)
+ r1_e1v(ji,jj) = 1._wp / tabres(ji,jj)
+ END IF
+ END DO
+ END DO
+ ENDIF
+ !
+ END SUBROUTINE update_e1v
+
+
+ SUBROUTINE interp_e1e2t_frac(tabres, i1, i2, j1, j2, before )
+ !
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE interp_e1e2t_frac ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ !!----------------------------------------------------------------------
+
+ IF (before) THEN
+ tabres(i1:i2,j1:j2) = e1e2t(i1:i2,j1:j2)
+ ELSE
+ e1e2t_frac(i1:i2,j1:j2) = e1e2t(i1:i2,j1:j2) &
+ & / tabres(i1:i2,j1:j2) * Agrif_Rhox() * Agrif_Rhoy()
+ ENDIF
+ !
+ END SUBROUTINE interp_e1e2t_frac
+
+
+ SUBROUTINE interp_e2u_frac(tabres, i1, i2, j1, j2, before )
+ !
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE interp_e2u_frac ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ !!----------------------------------------------------------------------
+
+ IF (before) THEN
+ tabres(i1:i2,j1:j2) = e2u(i1:i2,j1:j2)
+ ELSE
+ e2u_frac(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) &
+ & / tabres(i1:i2,j1:j2) * Agrif_Rhoy()
+ ENDIF
+ !
+ END SUBROUTINE interp_e2u_frac
+
+
+ SUBROUTINE interp_e1v_frac(tabres, i1, i2, j1, j2, before )
+ !
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE interp_e1v_frac ***
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: i1, i2, j1, j2
+ REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+ LOGICAL , INTENT(in ) :: before
+ !!
+ !!----------------------------------------------------------------------
+
+ IF (before) THEN
+ tabres(i1:i2,j1:j2) = e1v(i1:i2,j1:j2)
+ ELSE
+ e1v_frac(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) &
+ & / tabres(i1:i2,j1:j2) * Agrif_Rhox()
+ ENDIF
+ !
+ END SUBROUTINE interp_e1v_frac
+
#else
SUBROUTINE agrif_update_all
END SUBROUTINE agrif_update_all
diff --git a/tools/DOMAINcfg/src/agrif_parameters.F90 b/tools/DOMAINcfg/src/agrif_parameters.F90
index 1217a5c103110b8f72f2700b3544d4ebc93a468c..2924b79161dc7a43fdc66a8a2796e6034de6bb9f 100644
--- a/tools/DOMAINcfg/src/agrif_parameters.F90
+++ b/tools/DOMAINcfg/src/agrif_parameters.F90
@@ -11,9 +11,16 @@ MODULE agrif_parameters
! constant bathymetry inside child zoom: should equal the sponge length
INTEGER :: npt_connect ! area (in coarse grid points) of coarse/child
! bathymetry blending
+ INTEGER, PARAMETER :: npt_shift_bar = 2
+
REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: ztabramp
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2t_frac
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e2u_frac
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1v_frac
LOGICAL, PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e3t_interp_done
-
+!$AGRIF_DO_NOT_TREAT
+ LOGICAL, PUBLIC :: l_set_hmin = .FALSE.
+!$AGRIF_END_DO_NOT_TREAT
#endif
END MODULE agrif_parameters
diff --git a/tools/DOMAINcfg/src/agrif_profiles.F90 b/tools/DOMAINcfg/src/agrif_profiles.F90
index a2e545783ac01113e68d59e1fb0be450cada593e..d362f6ad9b2d1f6f32cbe47de721a597fc2852ce 100644
--- a/tools/DOMAINcfg/src/agrif_profiles.F90
+++ b/tools/DOMAINcfg/src/agrif_profiles.F90
@@ -8,19 +8,22 @@ INTEGER :: glamt_id, glamu_id, glamv_id,glamf_id
INTEGER :: gphit_id, gphiu_id, gphiv_id,gphif_id
INTEGER :: e1t_id, e1u_id, e1v_id, e1f_id
INTEGER :: e2t_id, e2u_id, e2v_id, e2f_id
+INTEGER :: e1e2t_upd_id
+INTEGER :: e1e2t_frac_id, e2u_frac_id, e1v_frac_id
-
-INTEGER :: bathy_id
+INTEGER :: bathy_id, ht0_id
! Vertical scale factors
INTEGER :: e3t_id
+INTEGER :: e3w_id
INTEGER :: e3t_copy_id
INTEGER :: e3t_connect_id
-INTEGER :: e3u_id, e3v_id
+INTEGER :: e3u_id, e3v_id, e3f_id
+INTEGER :: e3uw_id, e3vw_id
! Bottom level
-INTEGER :: bottom_level_id
+INTEGER :: mbkt_id, mbku_id, mbkv_id, mbkf_id
# endif
-END MODULE agrif_profiles
\ No newline at end of file
+END MODULE agrif_profiles
diff --git a/tools/DOMAINcfg/src/agrif_recompute_scales.F90 b/tools/DOMAINcfg/src/agrif_recompute_scales.F90
index 447cc63ef053487e512575938684842308adeb6d..2a56d97b184b8c9ab7097883d24dcaa506511651 100644
--- a/tools/DOMAINcfg/src/agrif_recompute_scales.F90
+++ b/tools/DOMAINcfg/src/agrif_recompute_scales.F90
@@ -19,6 +19,10 @@ CONTAINS
!!----------------------------------------------------------------------
!
INTEGER :: ji, jj, jk, ikb, ikt
+ REAL(wp), DIMENSION(jpi,jpj) :: zk ! workspace
+
+
+ IF ( ln_sco ) RETURN
! Scale factors and depth at U-, V-, UW and VW-points
DO jk = 1, jpk ! initialisation to z-scale factors
@@ -99,6 +103,23 @@ CONTAINS
IF( MINVAL( gdept_0(:,:,:) ) < 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r gdept_0 < 0' )
IF( MINVAL( gdepw_0(:,:,:) ) < 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r gdepw_0 < 0' )
!
+ ! since these are read, re-compute mbku, mbkv, mbkf
+ DO jj = 1, jpjm1
+ DO ji = 1, jpim1
+ mbku(ji,jj) = MIN( mbkt(ji+1,jj ) , mbkt(ji ,jj ) )
+ mbkv(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji ,jj ) )
+ mbkf(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji ,jj ), &
+ & mbkt(ji+1,jj ) , mbkt(ji+1,jj+1) )
+ END DO
+ END DO
+ !
+ zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1.)
+ mbku(:,:) = MAX( NINT( zk(:,:) ), 1 )
+ zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1.)
+ mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 )
+ zk(:,:) = REAL( mbkf(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'F', 1.)
+ mbkf(:,:) = MAX( NINT( zk(:,:) ), 1 )
+ !
END SUBROUTINE agrif_recompute_scalefactors
#else
SUBROUTINE agrif_recompute_scalefactors
diff --git a/tools/DOMAINcfg/src/agrif_user.F90 b/tools/DOMAINcfg/src/agrif_user.F90
index cb55f8b024422fb85cf9cffccd454be1c5431011..4d384c96f1dc7020f25bf31995572f31502bc2f7 100644
--- a/tools/DOMAINcfg/src/agrif_user.F90
+++ b/tools/DOMAINcfg/src/agrif_user.F90
@@ -276,21 +276,37 @@
CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2f_id)
+ CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,3/),e1e2t_upd_id)
+
+ CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1e2t_frac_id)
+ CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2u_frac_id)
+ CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1v_frac_id)
+
! Bathymetry
CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),bathy_id)
+ CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id)
! Vertical scale factors
CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id)
CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_copy_id)
CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk+1/),e3t_connect_id)
- CALL agrif_declare_variable((/1,2,0/),(/ind2-1,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3u_id)
- CALL agrif_declare_variable((/2,1,0/),(/ind2,ind3-1,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3v_id)
+ CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3w_id)
+
+ CALL agrif_declare_variable((/1,2,0/),(/ind2-1,ind3 ,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3u_id)
+ CALL agrif_declare_variable((/2,1,0/),(/ind2 ,ind3-1,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3v_id)
+ CALL agrif_declare_variable((/1,1,0/),(/ind2-1,ind3-1,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3f_id)
+
+ CALL agrif_declare_variable((/1,2,0/),(/ind2-1,ind3 ,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3uw_id)
+ CALL agrif_declare_variable((/2,1,0/),(/ind2 ,ind3-1,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3vw_id)
! Bottom level
- CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),bottom_level_id)
+ CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id)
+ CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbku_id)
+ CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkv_id)
+ CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkf_id)
CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_linear)
CALL Agrif_Set_interp(glamt_id,interp=AGRIF_linear)
@@ -323,12 +339,12 @@
CALL Agrif_Set_bcinterp(gphif_id,interp=AGRIF_linear)
CALL Agrif_Set_interp(gphif_id,interp=AGRIF_linear)
CALL Agrif_Set_bc( gphif_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)/) )
-
!
- CALL Agrif_Set_bcinterp(e1t_id,interp=AGRIF_ppm)
+! CALL Agrif_Set_bcinterp(e1t_id,interp=AGRIF_ppm)
+ CALL Agrif_Set_bcinterp(e1t_id,interp=AGRIF_constant)
CALL Agrif_Set_interp(e1t_id,interp=AGRIF_ppm)
- CALL Agrif_Set_bc( e1t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+ CALL Agrif_Set_bc( e1t_id, (/-MAX(Agrif_irhox(), Agrif_irhoy())*npt_shift_bar,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
CALL Agrif_Set_bcinterp(e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
CALL Agrif_Set_interp(e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
@@ -337,18 +353,21 @@
CALL Agrif_Set_bcinterp(e1v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
CALL Agrif_Set_interp(e1v_id, interp1=AGRIF_ppm, interp2=Agrif_linear)
CALL Agrif_Set_bc( e1v_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)/) )
+ CALL Agrif_Set_Updatetype(e1v_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
CALL Agrif_Set_bcinterp(e1f_id,interp=AGRIF_linear)
CALL Agrif_Set_interp(e1f_id,interp=AGRIF_linear)
CALL Agrif_Set_bc( e1f_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)/) )
- CALL Agrif_Set_bcinterp(e2t_id,interp=AGRIF_ppm)
+! CALL Agrif_Set_bcinterp(e2t_id,interp=AGRIF_ppm)
+ CALL Agrif_Set_bcinterp(e2t_id,interp=AGRIF_constant)
CALL Agrif_Set_interp(e2t_id,interp=AGRIF_ppm)
- CALL Agrif_Set_bc( e2t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+ CALL Agrif_Set_bc( e2t_id, (/-MAX(Agrif_irhox(), Agrif_irhoy())*npt_shift_bar,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
CALL Agrif_Set_bcinterp(e2u_id,interp1=Agrif_linear, interp2=AGRIF_ppm)
CALL Agrif_Set_interp(e2u_id,interp1=Agrif_linear, interp2=AGRIF_ppm)
CALL Agrif_Set_bc( e2u_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)/) )
+ CALL Agrif_Set_Updatetype(e2u_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
CALL Agrif_Set_interp(e2v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
@@ -358,13 +377,31 @@
CALL Agrif_Set_interp(e2f_id,interp=AGRIF_linear)
CALL Agrif_Set_bc( e2f_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)/) )
+ CALL Agrif_Set_bcinterp(e1e2t_frac_id,interp=AGRIF_constant)
+ CALL Agrif_Set_interp(e1e2t_frac_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bc(e1e2t_frac_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)/) )
+
+ CALL Agrif_Set_bcinterp(e2u_frac_id,interp=AGRIF_constant)
+ CALL Agrif_Set_interp(e2u_frac_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bc(e2u_frac_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)/) )
+
+ CALL Agrif_Set_bcinterp(e1v_frac_id,interp=AGRIF_constant)
+ CALL Agrif_Set_interp(e1v_frac_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bc(e1v_frac_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)/) )
+
+ CALL Agrif_Set_Updatetype(e1e2t_upd_id, update = AGRIF_Update_Average)
+
CALL Agrif_Set_bcinterp(bathy_id,interp=AGRIF_linear)
CALL Agrif_Set_interp(bathy_id,interp=AGRIF_linear)
- CALL Agrif_Set_bc( bathy_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+ CALL Agrif_Set_bc(bathy_id, (/0, max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+ CALL Agrif_Set_bcinterp(ht0_id,interp=AGRIF_constant)
+ CALL Agrif_Set_interp( ht0_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bc( ht0_id, (/-npt_copy*MAX(Agrif_irhox(), Agrif_irhoy())-2, max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
! Vertical scale factors
- CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_ppm)
- CALL Agrif_Set_interp(e3t_id,interp=AGRIF_ppm)
+ CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
+ CALL Agrif_Set_interp(e3t_id,interp=AGRIF_constant)
CALL Agrif_Set_bc( e3t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
CALL Agrif_Set_Updatetype( e3t_id, update = AGRIF_Update_Average)
@@ -381,24 +418,60 @@
CALL Agrif_Set_bc( e3t_connect_id, &
& (/-(npt_copy+npt_connect)*iraf-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
+ CALL Agrif_Set_bcinterp(e3w_id,interp=AGRIF_constant)
+ CALL Agrif_Set_interp(e3w_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bc( e3w_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+ CALL Agrif_Set_Updatetype( e3w_id, update = AGRIF_Update_Average)
+
CALL Agrif_Set_bcinterp(e3u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
CALL Agrif_Set_interp(e3u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
- CALL Agrif_Set_bc( e3u_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+ CALL Agrif_Set_bc( e3u_id, (/-npt_copy*MAX(Agrif_irhox(), Agrif_irhoy()),max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
CALL Agrif_Set_Updatetype(e3u_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
- CALL Agrif_Set_bcinterp(e3v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
+ CALL Agrif_Set_bcinterp(e3v_id,interp1=AGRIF_linear, interp2=Agrif_linear)
CALL Agrif_Set_interp(e3v_id, interp1=AGRIF_ppm, interp2=Agrif_linear)
- CALL Agrif_Set_bc( e3v_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+ CALL Agrif_Set_bc( e3v_id, (/-npt_copy*MAX(Agrif_irhox(), Agrif_irhoy()),max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
CALL Agrif_Set_Updatetype(e3v_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
- ! Bottom level
- CALL Agrif_Set_bcinterp(bottom_level_id,interp=AGRIF_constant)
- CALL Agrif_Set_interp(bottom_level_id,interp=AGRIF_constant)
- CALL Agrif_Set_bc( bottom_level_id, (/-npt_copy*iraf-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
- CALL Agrif_Set_Updatetype( bottom_level_id, update = AGRIF_Update_Max)
+ CALL Agrif_Set_bcinterp(e3f_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
+ CALL Agrif_Set_interp(e3f_id, interp1=AGRIF_ppm, interp2=Agrif_linear)
+ CALL Agrif_Set_bc( e3f_id, (/-npt_copy*MAX(Agrif_irhox(), Agrif_irhoy()),max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+ CALL Agrif_Set_Updatetype(e3f_id,update = Agrif_Update_Copy)
+
+ CALL Agrif_Set_bcinterp(e3uw_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
+ CALL Agrif_Set_interp(e3uw_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
+ CALL Agrif_Set_bc( e3uw_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+ CALL Agrif_Set_Updatetype(e3uw_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+
+ CALL Agrif_Set_bcinterp(e3vw_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
+ CALL Agrif_Set_interp(e3vw_id, interp1=AGRIF_ppm, interp2=Agrif_linear)
+ CALL Agrif_Set_bc( e3vw_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+ CALL Agrif_Set_Updatetype(e3vw_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
+ ! Bottom levels
+ CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant)
+ CALL Agrif_Set_interp(mbkt_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bc( mbkt_id, (/-npt_copy*iraf-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
+ CALL Agrif_Set_Updatetype( mbkt_id, update = AGRIF_Update_Max)
+
+ CALL Agrif_Set_bcinterp(mbku_id,interp=AGRIF_constant)
+ CALL Agrif_Set_interp(mbku_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bc( mbku_id, (/-npt_copy*iraf-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
+ CALL Agrif_Set_Updatetype( mbku_id, update1 = Agrif_Update_Copy, update2 = AGRIF_Update_Max)
+
+ CALL Agrif_Set_bcinterp(mbkv_id,interp=AGRIF_constant)
+ CALL Agrif_Set_interp(mbkv_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bc( mbkv_id, (/-npt_copy*iraf-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
+ CALL Agrif_Set_Updatetype( mbkv_id, update1 = Agrif_Update_Max, update2 = AGRIF_Update_Copy)
+
+ CALL Agrif_Set_bcinterp(mbkf_id,interp=AGRIF_constant)
+ CALL Agrif_Set_interp(mbkf_id,interp=AGRIF_constant)
+ CALL Agrif_Set_bc( mbkf_id, (/-npt_copy*iraf-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
+ CALL Agrif_Set_Updatetype( mbkf_id, update = Agrif_Update_Copy)
CALL Agrif_Set_ExternalMapping(nemo_mapping)
+
END SUBROUTINE agrif_declare_var
SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks)
diff --git a/tools/DOMAINcfg/src/dom_oce.F90 b/tools/DOMAINcfg/src/dom_oce.F90
index 0f1259c99c335382304d623c4732307ac9b45e69..57ef5d3a4200e75d825628e6949cb49f2940bc08 100644
--- a/tools/DOMAINcfg/src/dom_oce.F90
+++ b/tools/DOMAINcfg/src/dom_oce.F90
@@ -239,7 +239,7 @@ MODULE dom_oce
!!gm
INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbathy !: number of ocean level (=0, 1, ... , jpk-1)
REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bathy !: number of ocean level (=0, 1, ... , jpk-1)
- INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt, mbku, mbkv !: bottom last wet T-, U- and V-level
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt, mbku, mbkv, mbkf !: bottom last wet T-, U- and V-level
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i !: interior domain T-point mask
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_h !: internal domain T-point mask (Figure 8.5 NEMO book)
@@ -247,7 +247,7 @@ MODULE dom_oce
INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfdep !: Iceshelf draft (ISF)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask !: surface mask at T-,U-, V- and F-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask !: surface mask at T-,U-, V- and F-pts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask !: land/ocean mask at W- pts
@@ -367,8 +367,8 @@ CONTAINS
ALLOCATE( gdept_1d(jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(6) )
!
ALLOCATE( bathy(jpi,jpj),mbathy(jpi,jpj), tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , &
- & ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , &
- & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , STAT=ierr(7) )
+ & ssmask (jpi,jpj) , ssfmask(jpi,jpj), ssumask(jpi,jpj) , ssvmask(jpi,jpj) , &
+ & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj), mbkf(jpi,jpj) , STAT=ierr(7) )
!
ALLOCATE( misfdep(jpi,jpj) , mikt(jpi,jpj) , miku(jpi,jpj) , &
& risfdep(jpi,jpj) , mikv(jpi,jpj) , mikf(jpi,jpj) , STAT=ierr(8) )
diff --git a/tools/DOMAINcfg/src/domain.F90 b/tools/DOMAINcfg/src/domain.F90
index 895e29f0221f0252a88a0091d098f7d946dec33b..dfeca554be5d1a205b43e1bf82a43ba6bc05f18d 100644
--- a/tools/DOMAINcfg/src/domain.F90
+++ b/tools/DOMAINcfg/src/domain.F90
@@ -475,6 +475,13 @@ CONTAINS
! !== ocean top and bottom level ==!
!
CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points
+#if defined key_agrif
+!! IF ( Agrif_level() /= Agrif_maxlevel() ) THEN
+ CALL iom_rstput( 0, 0, inum, 'mbku' , REAL( mbku, wp )*ssumask, ktype = jp_i4 ) ! nb of ocean U-points
+ CALL iom_rstput( 0, 0, inum, 'mbkv' , REAL( mbkv, wp )*ssvmask, ktype = jp_i4 ) ! nb of ocean V-points
+ CALL iom_rstput( 0, 0, inum, 'mbkf' , REAL( mbkf, wp )*ssfmask, ktype = jp_i4 ) ! nb of ocean F-points
+!! ENDIF
+#endif
CALL iom_rstput( 0, 0, inum, 'top_level' , REAL( mikt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points (ISF)
CALL iom_rstput( 0, 0, inum, 'isf_draft' , risfdep , ktype = jp_r8 )
DO jj = 1,jpj
diff --git a/tools/DOMAINcfg/src/dombat.F90 b/tools/DOMAINcfg/src/dombat.F90
index 18e4751b7147af9d3b4b6ec5d9fcf819e25b23fe..2467aa81c811feda261bf105ad7b8f1ca5ebabed 100644
--- a/tools/DOMAINcfg/src/dombat.F90
+++ b/tools/DOMAINcfg/src/dombat.F90
@@ -17,6 +17,11 @@ MODULE dombat
PRIVATE
PUBLIC dom_bat ! called by dom_zgr.F90
+#if defined key_agrif
+ PUBLIC remove_closedseas ! called by dom_zgr.F90
+
+#endif
+
CONTAINS
@@ -25,7 +30,6 @@ CONTAINS
INTEGER :: inum, id, ji, jj,ji1,jj1
INTEGER :: iimin,iimax,jjmin,jjmax
INTEGER :: tabdim1, tabdim2, nxhr, nyhr, nxyhr
- INTEGER :: nbadd, istart, iend, jstart, jend
INTEGER, DIMENSION(2) :: ddims
INTEGER, DIMENSION(3) :: status
INTEGER, DIMENSION(1) :: i_min,i_max
@@ -411,78 +415,11 @@ CONTAINS
ENDIF
CALL lbc_lnk( 'dom_bat', bathy, 'T', 1.,kfillmode = jpfillcopy)
-#if defined key_agrif
- IF (ln_remove_closedseas.AND.(.NOT.Agrif_Root())) THEN
- ALLOCATE(bathy_test(jpi,jpj))
- bathy_test(:,:) = 0._wp
- !
- ! --- West --- !
- IF(lk_west) THEN
- istart = nn_hls + 2
- iend = nn_hls + nbghostcells
- DO ji = mi0(istart), mi1(iend)
- DO jj = 1, jpj
- IF ( bathy (ji,jj)/=0._wp ) bathy_test(ji,jj) = 1._wp
- END DO
- END DO
- ENDIF
- !
- ! --- East --- !
- IF(lk_east) THEN
- istart = jpiglo - ( nn_hls + nbghostcells -1 )
- iend = jpiglo - ( nn_hls + 1 )
- DO ji = mi0(istart), mi1(iend)
- DO jj = 1, jpj
- IF ( bathy (ji,jj)/=0._wp ) bathy_test(ji,jj) = 1._wp
- END DO
- END DO
- ENDIF
- !
- ! --- South --- !
- IF(lk_south) THEN
- jstart = nn_hls + 2
- jend = nn_hls + nbghostcells
- DO jj = mj0(jstart), mj1(jend)
- DO ji = 1, jpi
- IF ( bathy (ji,jj)/=0._wp ) bathy_test(ji,jj) = 1._wp
- END DO
- END DO
- ENDIF
- !
- ! --- North --- !
- IF(lk_north) THEN
- jstart = jpjglo - ( nn_hls + nbghostcells -1 )
- jend = jpjglo - ( nn_hls + 1 )
- DO jj = mj0(jstart), mj1(jend)
- DO ji = 1, jpi
- IF ( bathy (ji,jj)/=0._wp ) bathy_test(ji,jj) = 1._wp
- END DO
- END DO
- ENDIF
-
- nbadd = 1
- DO WHILE ( nbadd/=0 )
- nbadd = 0
- DO ji = 1+nn_hls, jpi-nn_hls
- DO jj = 1+nn_hls, jpj-nn_hls
- IF (bathy(ji,jj) > 0._wp) THEN
- IF (MAX(bathy_test(ji,jj+1),bathy_test(ji,jj-1), &
- & bathy_test(ji-1,jj),bathy_test(ji+1,jj))==1._wp) THEN
- IF (bathy_test(ji,jj)/=1._wp) nbadd = nbadd + 1
- bathy_test(ji,jj)=1._wp
- ENDIF
- ENDIF
- END DO
- END DO
- IF( lk_mpp ) CALL mpp_sum('dom_bat', nbadd )
- CALL lbc_lnk( 'dom_bat', bathy_test, 'T', 1.,kfillmode = jpfillcopy)
-
- END DO
-
- WHERE(bathy_test==0._wp) bathy = 0._wp
- DEALLOCATE(bathy_test)
- ENDIF
-#endif
+!#if defined key_agrif
+! IF (ln_remove_closedseas.AND.(.NOT.Agrif_Root())) THEN
+! CALL remove_closedseas
+! ENDIF
+!#endif
! Correct South and North
@@ -517,4 +454,84 @@ CONTAINS
END SUBROUTINE dom_bat
+#if defined key_agrif
+ SUBROUTINE remove_closedseas
+
+ INTEGER :: ji, jj
+ INTEGER :: nbadd, istart, iend, jstart, jend
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: bathy_test
+
+
+ ALLOCATE(bathy_test(jpi,jpj))
+ bathy_test(:,:) = 0._wp
+ !
+ ! --- West --- !
+ IF(lk_west) THEN
+ istart = nn_hls + 2
+ iend = nn_hls + nbghostcells
+ DO ji = mi0(istart), mi1(iend)
+ DO jj = 1, jpj
+ IF ( bathy (ji,jj)/=0._wp ) bathy_test(ji,jj) = 1._wp
+ END DO
+ END DO
+ ENDIF
+ !
+ ! --- East --- !
+ IF(lk_east) THEN
+ istart = jpiglo - ( nn_hls + nbghostcells -1 )
+ iend = jpiglo - ( nn_hls + 1 )
+ DO ji = mi0(istart), mi1(iend)
+ DO jj = 1, jpj
+ IF ( bathy (ji,jj)/=0._wp ) bathy_test(ji,jj) = 1._wp
+ END DO
+ END DO
+ ENDIF
+ !
+ ! --- South --- !
+ IF(lk_south) THEN
+ jstart = nn_hls + 2
+ jend = nn_hls + nbghostcells
+ DO jj = mj0(jstart), mj1(jend)
+ DO ji = 1, jpi
+ IF ( bathy (ji,jj)/=0._wp ) bathy_test(ji,jj) = 1._wp
+ END DO
+ END DO
+ ENDIF
+ !
+ ! --- North --- !
+ IF(lk_north) THEN
+ jstart = jpjglo - ( nn_hls + nbghostcells -1 )
+ jend = jpjglo - ( nn_hls + 1 )
+ DO jj = mj0(jstart), mj1(jend)
+ DO ji = 1, jpi
+ IF ( bathy (ji,jj)/=0._wp ) bathy_test(ji,jj) = 1._wp
+ END DO
+ END DO
+ ENDIF
+
+ nbadd = 1
+ DO WHILE ( nbadd/=0 )
+ nbadd = 0
+ DO ji = 1+nn_hls, jpi-nn_hls
+ DO jj = 1+nn_hls, jpj-nn_hls
+ IF (bathy(ji,jj) > 0._wp) THEN
+ IF (MAX(bathy_test(ji,jj+1),bathy_test(ji,jj-1), &
+ & bathy_test(ji-1,jj),bathy_test(ji+1,jj))==1._wp) THEN
+ IF (bathy_test(ji,jj)/=1._wp) nbadd = nbadd + 1
+ bathy_test(ji,jj)=1._wp
+ ENDIF
+ ENDIF
+ END DO
+ END DO
+ IF( lk_mpp ) CALL mpp_sum('remove_closedseas', nbadd )
+ CALL lbc_lnk( 'dom_bat', bathy_test, 'T', 1.,kfillmode = jpfillcopy)
+
+ END DO
+
+ WHERE(bathy_test==0._wp) bathy = 0._wp
+ DEALLOCATE(bathy_test)
+
+ END SUBROUTINE remove_closedseas
+#endif
+
END MODULE dombat
diff --git a/tools/DOMAINcfg/src/dommsk.F90 b/tools/DOMAINcfg/src/dommsk.F90
index efe390853d29a1c7e09c6de976057513bd08ae5a..1226ff97e8ac69be46b5c3c4c147c4c0cb73f181 100644
--- a/tools/DOMAINcfg/src/dommsk.F90
+++ b/tools/DOMAINcfg/src/dommsk.F90
@@ -204,6 +204,7 @@ CONTAINS
ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 )
ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 )
ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 )
+ ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 )
! Interior domain mask (used for global sum)
! --------------------
diff --git a/tools/DOMAINcfg/src/domzgr.F90 b/tools/DOMAINcfg/src/domzgr.F90
index eeae0f6af126f63a0e302d4e1086a5eeac5be996..f45cadbc0fb1184ecc32812b0af68abad7accf72 100644
--- a/tools/DOMAINcfg/src/domzgr.F90
+++ b/tools/DOMAINcfg/src/domzgr.F90
@@ -44,8 +44,11 @@ MODULE domzgr
USE lib_fortran
USE dombat
USE domisf
+
+#if defined key_agrif
USE agrif_connect
USE agrif_domzgr
+#endif
IMPLICIT NONE
PRIVATE
@@ -56,7 +59,7 @@ MODULE domzgr
LOGICAL :: ln_s_sh94 ! use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1 (ln_sco=T)
LOGICAL :: ln_s_sf12 ! use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma (ln_sco=T)
!
- REAL(wp) :: rn_sbot_min ! minimum depth of s-bottom surface (>0) (m)
+ REAL(wp), PUBLIC :: rn_sbot_min ! minimum depth of s-bottom surface (>0) (m)
REAL(wp) :: rn_sbot_max ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
REAL(wp) :: rn_rmax ! maximum cut-off r-value allowed (0<rn_rmax<1)
REAL(wp) :: rn_hc ! Critical depth for transition from sigma to stretched coordinates
@@ -106,10 +109,9 @@ CONTAINS
INTEGER :: ioptio, ibat ! local integer
INTEGER :: ios
!
- INTEGER :: jk
+ INTEGER :: ji,jj,jk
REAL(wp) :: zrefdep ! depth of the reference level (~10m)
-
NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
!!----------------------------------------------------------------------
!
@@ -123,6 +125,15 @@ CONTAINS
902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist')
IF(lwm) WRITE ( numond, namzgr )
+#if defined key_agrif
+ IF (.NOT.Agrif_root()) THEN
+ IF (.NOT.(ln_dept_mid.AND.ln_e3_dep).OR. &
+ & .NOT.(Agrif_Parent(ln_dept_mid).AND.Agrif_Parent(ln_e3_dep)) ) THEN
+ CALL ctl_stop( 'STOP', 'namcfg: with AGRIF zooms, set ln_dept_mid = ln_e3_dep = T' )
+ ENDIF
+ ENDIF
+#endif
+
IF(ln_read_cfg) THEN
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' ==>>> Read vertical mesh in ', TRIM( cn_domcfg ), ' file'
@@ -203,6 +214,35 @@ CONTAINS
WHERE( bathy(:,:) <= 0._wp ) k_top(:,:) = 0 ! set k_top to zero over land
ENDIF
!
+#if defined key_agrif
+ IF ( Agrif_root() ) THEN
+#endif
+ IF ( ln_read_cfg.AND.ln_e3_dep.AND.ln_dept_mid ) THEN
+ ! Define depths at cell centers
+ DO jk = 1, jpkm1
+ gdept_1d(jk) = 0.5_wp * (gdepw_1d(jk)+gdepw_1d(jk+1))
+ END DO
+ DO jk = 2, jpk
+ e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1)
+ END DO
+ e3w_1d(1 ) = 2._wp * (gdept_1d(1) - gdepw_1d(1))
+
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ gdept_0(ji,jj,jk) = 0.5_wp * ( gdepw_0(ji,jj,jk) + gdepw_0(ji,jj,jk+1) )
+ END_3D
+ e3w_0(:,:,1) = e3t_0(:,:,1)
+ e3uw_0(:,:,1) = e3u_0(:,:,1)
+ e3vw_0(:,:,1) = e3v_0(:,:,1)
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk )
+ e3w_0(ji,jj,jk) = 0.5_wp * (e3t_0(ji,jj,jk)+e3t_0(ji,jj,jk-1))
+ e3uw_0(ji,jj,jk) = 0.5_wp * (e3u_0(ji,jj,jk)+e3u_0(ji,jj,jk-1))
+ e3vw_0(ji,jj,jk) = 0.5_wp * (e3v_0(ji,jj,jk)+e3v_0(ji,jj,jk-1))
+ END_3D
+ ENDIF
+#if defined key_agrif
+ ENDIF
+#endif
+ !
IF( lwp ) THEN
WRITE(numout,*) ' MIN val k_top ', MINVAL( k_top(:,:) ), ' MAX ', MAXVAL( k_top(:,:) )
WRITE(numout,*) ' MIN val k_bot ', MINVAL( k_bot(:,:) ), ' MAX ', MAXVAL( k_bot(:,:) )
@@ -331,9 +371,9 @@ CONTAINS
!! ** Action : mikt, miku, mikv : vertical indices of the shallowest
!! ocean level at t-, u- & v-points
!! (min value = 1)
- !! ** Action : mbkt, mbku, mbkv : vertical indices of the deeptest
- !! ocean level at t-, u- & v-points
- !! (min value = 1 over land)
+ !! ** Action : mbkt, mbku, mbkv, mbkf : vertical indices of the deeptest
+ !! ocean level at t-, u-, v- & f-points
+ !! (min value = 1 over land)
!!----------------------------------------------------------------------
INTEGER , DIMENSION(:,:), INTENT(in) :: k_top, k_bot ! top & bottom ocean level indices
!
@@ -359,6 +399,7 @@ CONTAINS
!
mbku(ji,jj) = MIN( mbkt(ji+1,jj ) , mbkt(ji,jj) )
mbkv(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji,jj) )
+ mbkf(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji,jj), mbkt(ji+1,jj ), mbkt(ji+1,jj+1) )
END DO
END DO
! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
@@ -368,6 +409,7 @@ CONTAINS
!
zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1. ) ; mbku(:,:) = MAX( NINT( zk(:,:) ), 1 )
zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1. ) ; mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 )
+ zk(:,:) = REAL( mbkf(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'F', 1. ) ; mbkf(:,:) = MAX( NINT( zk(:,:) ), 1 )
!
END SUBROUTINE zgr_top_bot
@@ -457,7 +499,7 @@ CONTAINS
- za1 = zhmax / FLOAT(jpk-1)
+ za1 = zhmax / FLOAT(jpkdta-1)
DO jk = 1, jpk
zw = FLOAT( jk )
@@ -502,6 +544,11 @@ CONTAINS
END DO
e3t_1d(jpk) = e3t_1d(jpk-1) ! we don't care because this level is masked in NEMO
+ IF ( ln_dept_mid ) THEN
+ DO jk = 1, jpkm1
+ gdept_1d(jk) = 0.5_wp * (gdepw_1d(jk)+gdepw_1d(jk+1))
+ END DO
+ ENDIF
DO jk = 2, jpk
e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1)
END DO
@@ -567,6 +614,7 @@ CONTAINS
REAL(wp) :: r_bump , h_bump , h_oce ! bump characteristics
REAL(wp) :: zi, zj, zh, zhmin ! local scalars
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zrand, zbatv
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztemp
!!----------------------------------------------------------------------
!
IF(lwp) WRITE(numout,*)
@@ -617,7 +665,6 @@ CONTAINS
IF ( cp_cfg=='DOME' ) THEN
ALLOCATE(zbatv(jpi,jpj))
zbatv(:,:) = MIN(3600._wp, MAX( 600._wp, 600._wp -gphiv(:,:)*1.e3*0.01 ))
- bathy(:,1) = 0._wp
DO jj =2,jpj
bathy(:,jj) = 0.5_wp*(zbatv(:,jj) + zbatv(:,jj-1))
END DO
@@ -645,7 +692,7 @@ CONTAINS
misfdep(:,:)=1
!
! ! ================ !
- ELSEIF( ntopo == 1 .OR. ntopo ==2 ) THEN ! read in file ! (over the local domain)
+ ELSEIF( ntopo > 0 ) THEN ! read in file ! (over the local domain)
! ! ================ !
!
IF( ln_zco ) THEN ! zco : read level bathymetry
@@ -696,9 +743,15 @@ CONTAINS
#if defined key_agrif
ELSE
IF( ntopo == 1) THEN
- CALL agrif_create_bathy_meter()
- ELSE
- CALL dom_bat
+ CALL iom_open ( cn_topo, inum )
+ CALL iom_get ( inum, jpdom_auto, cn_bath, bathy )
+ CALL iom_close( inum )
+ ELSE
+ IF( ntopo == 3) THEN
+ CALL agrif_create_bathy_meter()
+ ELSE
+ CALL dom_bat
+ ENDIF
ENDIF
ENDIF
#endif
@@ -755,7 +808,17 @@ CONTAINS
IF(lwp) write(numout,*) 'Minimum ocean depth: ', zhmin, ' minimum number of ocean levels : ', ik
ENDIF
#if defined key_agrif
- IF ( .NOT.Agrif_Root() ) CALL agrif_bathymetry_connect
+! IF (Agrif_Root()) THEN
+! IF (Agrif_level()==1) THEN
+! ALLOCATE(ztemp(jpi,jpj))
+! CALL smooth_bat_negative(bathy, ztemp, 0.1_wp, 10._wp)
+! WHERE (bathy/=0._wp) bathy(:,:) = ztemp(:,:)
+! DEALLOCATE(ztemp)
+! ENDIF
+ IF (( .NOT.ln_sco).AND.(.NOT.Agrif_Root() )) THEN
+ CALL agrif_bathymetry_connect
+ IF ( ln_remove_closedseas ) CALL remove_closedseas
+ ENDIF
#endif
!
END SUBROUTINE zgr_bat
@@ -836,13 +899,15 @@ CONTAINS
IF( jperio == 0 ) THEN
IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west boundary: jperio = ', jperio
- IF( ln_zco .OR. ln_zps ) THEN
+! IF( ln_zco .OR. ln_zps ) THEN
mbathy( mi0( 1+nn_hls):mi1( 1+nn_hls),:) = 0
mbathy( mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls),:) = 0
- ELSE
- mbathy( mi0( 1+nn_hls):mi1( 1+nn_hls),:) = jpkm1
- mbathy( mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls),:) = jpkm1
- ENDIF
+ mbathy(:, mj0( 1+nn_hls):mj1( 1+nn_hls)) = 0
+ mbathy(:, mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls)) = 0
+! ELSE
+! mbathy( mi0( 1+nn_hls):mi1( 1+nn_hls),:) = jpkm1
+! mbathy( mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls),:) = jpkm1
+! ENDIF
ELSEIF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: jperio = ', jperio
! mbathy( 1 ,:) = mbathy(jpim1,:)
@@ -911,11 +976,13 @@ CONTAINS
DO ji = 1, jpim1
mbku(ji,jj) = MIN( mbkt(ji+1,jj ) , mbkt(ji,jj) )
mbkv(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji,jj) )
+ mbkf(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji,jj), mbkt(ji+1,jj ), mbkt(ji+1,jj+1) )
END DO
END DO
! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
zmbk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk('domzgr',zmbk,'U',1.) ; mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 )
zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk('domzgr',zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+ zmbk(:,:) = REAL( mbkf(:,:), wp ) ; CALL lbc_lnk('domzgr',zmbk,'F',1.) ; mbkf (:,:) = MAX( INT( zmbk(:,:) ), 1 )
!
DEALLOCATE( zmbk )
!
@@ -1097,11 +1164,16 @@ CONTAINS
ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
e3t_0(ji,jj,ik ) = ze3tp
e3t_0(ji,jj,ik+1) = ze3tp
- e3w_0(ji,jj,ik ) = ze3wp
+ IF ( ln_e3_dep.AND.ln_dept_mid ) THEN
+ gdept_0(ji,jj,ik) = gdepw_1d(ik) + 0.5_wp * ze3tp
+ e3w_0(ji,jj,ik ) = gdept_0(ji,jj,ik) - gdept_0(ji,jj,ik-1)
+ ELSE
+ gdept_0(ji,jj,ik) = gdept_1d(ik-1) + ze3wp
+ e3w_0(ji,jj,ik ) = ze3wp
+ ENDIF
+ gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
e3w_0(ji,jj,ik+1) = ze3tp
gdepw_0(ji,jj,ik+1) = zdepwp
- gdept_0(ji,jj,ik ) = gdept_1d(ik-1) + ze3wp
- gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
!
ELSE ! standard case
IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN ; gdepw_0(ji,jj,ik+1) = bathy(ji,jj)
@@ -1109,13 +1181,18 @@ CONTAINS
ENDIF
!gm Bug? check the gdepw_1d
! ... on ik
- gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) ) &
- & * ((gdept_1d( ik ) - gdepw_1d(ik) ) &
- & / ( gdepw_1d( ik+1) - gdepw_1d(ik) ))
e3t_0 (ji,jj,ik) = e3t_1d (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) ) &
& / ( gdepw_1d( ik+1) - gdepw_1d(ik) )
- e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) ) &
- & * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+ IF ( ln_e3_dep.AND.ln_dept_mid ) THEN
+ gdept_0(ji,jj,ik) = gdepw_1d(ik) + 0.5_wp * e3t_0(ji,jj,ik)
+ e3w_0(ji,jj,ik) = gdept_0(ji,jj,ik) - gdept_0(ji,jj,ik-1)
+ ELSE
+ gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) ) &
+ & * ((gdept_1d( ik ) - gdepw_1d(ik) ) &
+ & / ( gdepw_1d( ik+1) - gdepw_1d(ik) ))
+ e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) ) &
+ & * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+ ENDIF
! ... on ik+1
e3w_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
e3t_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
@@ -1318,6 +1395,13 @@ CONTAINS
hiff(:,:) = rn_sbot_min
! ! set maximum ocean depth
+#if defined key_agrif
+ ! Set boundary conditions prior filtering from parent:
+ IF (.NOT.Agrif_Root()) THEN
+ CALL agrif_bathymetry_connect
+ IF ( ln_remove_closedseas ) CALL remove_closedseas
+ ENDIF
+#endif
bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) )
DO jj = 1, jpj
@@ -1328,103 +1412,14 @@ CONTAINS
! ! =============================
! ! Define the envelop bathymetry (hbatt)
! ! =============================
- ! use r-value to create hybrid coordinates
- zenv(:,:) = bathy(:,:)
- !
- ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( bathy(ji,jj) == 0._wp ) THEN
- iip1 = MIN( ji+1, jpi )
- ijp1 = MIN( jj+1, jpj )
- iim1 = MAX( ji-1, 1 )
- ijm1 = MAX( jj-1, 1 )
-!!gm BUG fix see ticket #1617
- IF( ( + bathy(iim1,ijm1) + bathy(ji,ijp1) + bathy(iip1,ijp1) &
- & + bathy(iim1,jj ) + bathy(iip1,jj ) &
- & + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1) ) > 0._wp ) &
- & zenv(ji,jj) = rn_sbot_min
-!!gm
-!!gm IF( ( bathy(iip1,jj ) + bathy(iim1,jj ) + bathy(ji,ijp1 ) + bathy(ji,ijm1) + &
-!!gm & bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN
-!!gm zenv(ji,jj) = rn_sbot_min
-!!gm ENDIF
-!!gm end
- ENDIF
- END DO
- END DO
-
- ! apply lateral boundary condition CAUTION: keep the value when the lbc field is zero
- CALL lbc_lnk( 'domzgr',zenv, 'T', 1._wp, kfillmode=jpfillnothing )
!
! smooth the bathymetry (if required)
scosrf(:,:) = 0._wp ! ocean surface depth (here zero: no under ice-shelf sea)
scobot(:,:) = bathy(:,:) ! ocean bottom depth
!
- jl = 0
- zrmax = 1._wp
- !
- !
- ! set scaling factor used in reducing vertical gradients
- zrfact = ( 1._wp - rn_rmax ) / ( 1._wp + rn_rmax )
- !
- ! initialise temporary evelope depth arrays
- ztmpi1(:,:) = zenv(:,:)
- ztmpi2(:,:) = zenv(:,:)
- ztmpj1(:,:) = zenv(:,:)
- ztmpj2(:,:) = zenv(:,:)
- !
- ! initialise temporary r-value arrays
- zri(:,:) = 1._wp
- zrj(:,:) = 1._wp
- ! ! ================ !
- DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8_wp ) ! Iterative loop !
- ! ! ================ !
- jl = jl + 1
- zrmax = 0._wp
- ! we set zrmax from previous r-values (zri and zrj) first
- ! if set after current r-value calculation (as previously)
- ! we could exit DO WHILE prematurely before checking r-value
- ! of current zenv
- DO_2D( 0, 0, 0, 0 )
- zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
- END_2D
- zri(:,:) = 0._wp
- zrj(:,:) = 0._wp
- DO_2D( 0, 0, 0, 0 )
- iip1 = MIN( ji+1, jpi ) ! force zri = 0 on last line (ji=ncli+1 to jpi)
- ijp1 = MIN( jj+1, jpj ) ! force zrj = 0 on last raw (jj=nclj+1 to jpj)
- IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(iip1,jj) > 0._wp)) THEN
- zri(ji,jj) = ( zenv(iip1,jj ) - zenv(ji,jj) ) / ( zenv(iip1,jj ) + zenv(ji,jj) )
- END IF
- IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(ji,ijp1) > 0._wp)) THEN
- zrj(ji,jj) = ( zenv(ji ,ijp1) - zenv(ji,jj) ) / ( zenv(ji ,ijp1) + zenv(ji,jj) )
- END IF
- IF( zri(ji,jj) > rn_rmax ) ztmpi1(ji ,jj ) = zenv(iip1,jj ) * zrfact
- IF( zri(ji,jj) < -rn_rmax ) ztmpi2(iip1,jj ) = zenv(ji ,jj ) * zrfact
- IF( zrj(ji,jj) > rn_rmax ) ztmpj1(ji ,jj ) = zenv(ji ,ijp1) * zrfact
- IF( zrj(ji,jj) < -rn_rmax ) ztmpj2(ji ,ijp1) = zenv(ji ,jj ) * zrfact
- END_2D
- ! IF( lk_mpp ) CALL mpp_max( zrmax ) ! max over the global domain
- !
- IF(lwp)WRITE(numout,*) 'zgr_sco : iter= ',jl, ' rmax= ', zrmax
- !
- DO_2D( 0, 0, 0, 0 )
- zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) )
- END_2D
- ! apply lateral boundary condition CAUTION: keep the value when the lbc field is zero
- CALL lbc_lnk( 'toto',zenv, 'T', 1._wp, kfillmode=jpfillnothing)
- ! ! ================ !
- END DO ! End loop !
- ! ! ================ !
- DO jj = 1, jpj
- DO ji = 1, jpi
- zenv(ji,jj) = MAX( zenv(ji,jj), rn_sbot_min ) ! set all points to avoid undefined scale value warnings
- END DO
- END DO
- !
! Envelope bathymetry saved in hbatt
- hbatt(:,:) = zenv(:,:)
+ CALL smooth_bat_negative(bathy, hbatt, rn_rmax, rn_sbot_min)
+
IF ((ntopo>0).AND.MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN
CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' )
DO jj = 1, jpj
@@ -1434,6 +1429,18 @@ CONTAINS
END DO
END DO
ENDIF
+
+#if defined key_agrif
+ IF (.NOT.Agrif_Root()) THEN
+ WHERE (bathy(:,:)>0._wp ) bathy(:,:) = hbatt(:,:)
+ CALL agrif_bathymetry_connect
+ IF ( ln_remove_closedseas ) CALL remove_closedseas
+ ! Discard the enveloppe in the agrif case
+ hbatt(:,:) = bathy(:,:)
+ WHERE ( bathy(:,:) == 0._wp ) hbatt(:,:) = rn_sbot_min
+ scobot(:,:) = bathy(:,:)
+ ENDIF
+#endif
!
! ! ==============================
! ! hbatu, hbatv, hbatf fields
@@ -1588,16 +1595,16 @@ CONTAINS
& e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk )
END DO
END DO
- DO jj = mj0(74), mj1(74)
- DO ji = mi0(10), mi1(10)
- WRITE(numout,*)
- WRITE(numout,*) ' domzgr: vertical coordinates : point (10,74,k) bathy = ', bathy(ji,jj), hbatt(ji,jj)
- WRITE(numout,*) ' ~~~~~~ --------------------'
- WRITE(numout,"(9x,' level gdept_0 gdepw_0 e3t_0 e3w_0')")
- WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk), &
- & e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk )
- END DO
- END DO
+! DO jj = mj0(74), mj1(74)
+! DO ji = mi0(10), mi1(10)
+! WRITE(numout,*)
+! WRITE(numout,*) ' domzgr: vertical coordinates : point (10,74,k) bathy = ', bathy(ji,jj), hbatt(ji,jj)
+! WRITE(numout,*) ' ~~~~~~ --------------------'
+! WRITE(numout,"(9x,' level gdept_0 gdepw_0 e3t_0 e3w_0')")
+! WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk), &
+! & e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk )
+! END DO
+! END DO
ENDIF
!
!================================================================================
@@ -1692,7 +1699,12 @@ CONTAINS
DO jk = 1, jpk
z_gsigw3(ji,jj,jk) = REAL(jk-1,wp) / REAL(jpk-1,wp)
z_gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(jpk-1,wp)
- END DO
+ END DO
+ ENDIF
+ IF ( ln_e3_dep.AND.ln_dept_mid ) THEN
+ DO jk = 1, jpkm1
+ z_gsigt3(ji,jj,jk) = 0.5_wp * (z_gsigw3(ji,jj,jk) +z_gsigw3(ji,jj,jk+1))
+ END DO
ENDIF
!
DO jk = 1, jpkm1
@@ -1832,6 +1844,12 @@ CONTAINS
ENDIF
+ IF ( ln_e3_dep.AND.ln_dept_mid ) THEN
+ DO jk = 1, jpkm1
+ z_gsigt3(ji,jj,jk) = 0.5_wp * (z_gsigw3(ji,jj,jk) +z_gsigw3(ji,jj,jk+1))
+ END DO
+ ENDIF
+
DO jk = 1, jpkm1
z_esigt3(ji,jj,jk) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
@@ -1942,6 +1960,13 @@ CONTAINS
z_gsigw(jk) = -fssig( REAL(jk,wp)-0.5_wp )
z_gsigt(jk) = -fssig( REAL(jk,wp) )
END DO
+
+ IF ( ln_e3_dep.AND.ln_dept_mid ) THEN
+ DO jk = 1, jpkm1
+ z_gsigt(jk) = 0.5_wp * (z_gsigw(jk)+z_gsigw(jk+1))
+ END DO
+ ENDIF
+
IF( lwp ) WRITE(numout,*) 'z_gsigw 1 jpk ', z_gsigw(1), z_gsigw(jpk)
!
! Coefficients for vertical scale factors at w-, t- levels
@@ -2083,5 +2108,108 @@ CONTAINS
!
END FUNCTION fgamma
+ SUBROUTINE smooth_bat_negative(batin, batout, rmax, batmin)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE smooth_bat_negative ***
+ !!
+ !! ** Purpose : Smooth bathymetry according to rmax factor
+ !! such that the result is greater than the input
+ !! bathymetry
+ !!
+ !! ** Method :
+ !!
+ !! Reference :
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: batin
+ REAL(wp), DIMEnSION(jpi,jpj), INTENT(out) :: batout
+ REAL(wp) , INTENT(in) :: rmax, batmin
+ INTEGER :: ji, jj, jl ! dummy loop argument
+ INTEGER :: iip1, ijp1, iim1, ijm1
+ REAL(wp) :: zrmax, zrfact
+ REAL(wp), DIMENSION(jpi,jpj) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2, zri, zrj
+ !!----------------------------------------------------------------------
+ !
+ batout(:,:) = batin(:,:)
+ !
+ ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( batin(ji,jj) == 0._wp ) THEN
+ iip1 = MIN( ji+1, jpi )
+ ijp1 = MIN( jj+1, jpj )
+ iim1 = MAX( ji-1, 1 )
+ ijm1 = MAX( jj-1, 1 )
+ IF( ( + batin(iim1,ijm1) + batin(ji,ijp1) + batin(iip1,ijp1) &
+ & + batin(iim1,jj ) + batin(iip1,jj ) &
+ & + batin(iim1,ijm1) + batin(ji,ijm1) + batin(iip1,ijp1) ) > 0._wp ) &
+ & batout(ji,jj) = batmin
+ ENDIF
+ END DO
+ END DO
+ !
+ ! apply lateral boundary condition CAUTION: keep the value when the lbc field is zero
+ CALL lbc_lnk( 'domzgr',batout, 'T', 1._wp, kfillmode=jpfillnothing )
+ !
+ jl = 0
+ zrmax = 1._wp
+ !
+ ! set scaling factor used in reducing vertical gradients
+ zrfact = ( 1._wp - rmax ) / ( 1._wp + rmax )
+ !
+ ! initialise temporary evelope depth arrays
+ ztmpi1(:,:) = batout(:,:)
+ ztmpi2(:,:) = batout(:,:)
+ ztmpj1(:,:) = batout(:,:)
+ ztmpj2(:,:) = batout(:,:)
+ !
+ ! initialise temporary r-value arrays
+ zri(:,:) = 1._wp
+ zrj(:,:) = 1._wp
+ ! ! ================ !
+ DO WHILE( jl <= 10000 .AND. ( zrmax - rmax ) > 1.e-8_wp ) ! Iterative loop !
+ ! ! ================ !
+ jl = jl + 1
+ zrmax = 0._wp
+ ! we set zrmax from previous r-values (zri and zrj) first
+ ! if set after current r-value calculation (as previously)
+ ! we could exit DO WHILE prematurely before checking r-value
+ ! of current batout
+ DO_2D( 0, 0, 0, 0 )
+ zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
+ END_2D
+ zri(:,:) = 0._wp
+ zrj(:,:) = 0._wp
+ DO_2D( 0, 0, 0, 0 )
+ iip1 = MIN( ji+1, jpi ) ! force zri = 0 on last line (ji=ncli+1 to jpi)
+ ijp1 = MIN( jj+1, jpj ) ! force zrj = 0 on last raw (jj=nclj+1 to jpj)
+ IF( (batout(ji,jj) > 0._wp) .AND. (batout(iip1,jj) > 0._wp)) THEN
+ zri(ji,jj) = ( batout(iip1,jj ) - batout(ji,jj) ) / ( batout(iip1,jj ) + batout(ji,jj) )
+ END IF
+ IF( (batout(ji,jj) > 0._wp) .AND. (batout(ji,ijp1) > 0._wp)) THEN
+ zrj(ji,jj) = ( batout(ji ,ijp1) - batout(ji,jj) ) / ( batout(ji ,ijp1) + batout(ji,jj) )
+ END IF
+ IF( zri(ji,jj) > rmax ) ztmpi1(ji ,jj ) = batout(iip1,jj ) * zrfact
+ IF( zri(ji,jj) < -rmax ) ztmpi2(iip1,jj ) = batout(ji ,jj ) * zrfact
+ IF( zrj(ji,jj) > rmax ) ztmpj1(ji ,jj ) = batout(ji ,ijp1) * zrfact
+ IF( zrj(ji,jj) < -rmax ) ztmpj2(ji ,ijp1) = batout(ji ,jj ) * zrfact
+ END_2D
+ !
+ IF(lwp)WRITE(numout,*) 'smooth_bat_negative: iter= ',jl, ' rmax= ', zrmax
+ !
+ DO_2D( 0, 0, 0, 0 )
+ batout(ji,jj) = MAX(batout(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) )
+ END_2D
+ ! apply lateral boundary condition CAUTION: keep the value when the lbc field is zero
+ CALL lbc_lnk( 'smooth_bat_negative',batout, 'T', 1._wp, kfillmode=jpfillnothing)
+ ! ! ================ !
+ END DO ! End loop !
+ ! ! ================ !
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ batout(ji,jj) = MAX( batout(ji,jj), batmin ) ! set all points to avoid undefined scale value warnings
+ END DO
+ END DO
+ !
+ END SUBROUTINE smooth_bat_negative
!!======================================================================
END MODULE domzgr
diff --git a/tools/DOMAINcfg/src/nemogcm.F90 b/tools/DOMAINcfg/src/nemogcm.F90
index 7d9131433b42f4cebf71947a2e6a7c03bfe68042..dcb731acc784dc0cc6c6a090877842907905c55f 100644
--- a/tools/DOMAINcfg/src/nemogcm.F90
+++ b/tools/DOMAINcfg/src/nemogcm.F90
@@ -103,11 +103,11 @@ CONTAINS
#if defined key_agrif
CALL Agrif_Regrid()
-! CALL Agrif_Step_Child(agrif_boundary_connections)
+ CALL Agrif_Step_Child(agrif_boundary_connections)
+
+ CALL Agrif_Step_Child(agrif_recompute_scalefactors)
CALL Agrif_Step_Child_adj(agrif_update_all)
-
-! CALL Agrif_Step_Child(agrif_recompute_scalefactors)
CALL Agrif_Step_Child(cfg_write)
#endif
@@ -155,7 +155,7 @@ CONTAINS
!!
NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, &
& nn_isplt, nn_jsplt, nn_ictls, nn_ictle, nn_jctls, nn_jctle
- NAMELIST/namcfg/ ln_e3_dep, &
+ NAMELIST/namcfg/ ln_e3_dep, ln_dept_mid, &
& cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, Ni0glo, Nj0glo, &
& jpkglo, jperio, ln_use_jattr, ln_domclo
!!----------------------------------------------------------------------
@@ -293,7 +293,7 @@ CONTAINS
! jpi = ( jpiglo -2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim.
! jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.
! ENDIF
- jpk = jpkdta ! third dim
+ jpk = jpkglo ! third dim
jpim1 = jpi-1 ! inner domain indices
jpjm1 = jpj-1 ! " "
jpkm1 = jpk-1 ! " "
diff --git a/tools/DOMAINcfg/src/par_oce.f90 b/tools/DOMAINcfg/src/par_oce.f90
index 5184a36ba17ff22804e9e78fb841b62d4ba578db..295165682df15b1607ae1bea56d9e910e67bc03d 100644
--- a/tools/DOMAINcfg/src/par_oce.f90
+++ b/tools/DOMAINcfg/src/par_oce.f90
@@ -22,6 +22,7 @@ MODULE par_oce
INTEGER :: jpjdta !: 2nd " " ( >= jpj )
INTEGER :: jpkdta !: number of levels ( >= jpk )
LOGICAL :: ln_e3_dep ! e3. definition flag
+ LOGICAL :: ln_dept_mid !: set cell depths at cell centers
REAL(wp) :: pp_not_used = 999999._wp !: vertical grid parameter
REAL(wp) :: pp_to_be_computed = 999999._wp !: - - -
!!----------------------------------------------------------------------
diff --git a/tools/DOMAINcfg/tests/DOME/1_namelist_cfg b/tools/DOMAINcfg/tests/DOME/1_namelist_cfg
new file mode 100644
index 0000000000000000000000000000000000000000..64193f254353a1d3d04ec7a75d52e5b46380b8ce
--- /dev/null
+++ b/tools/DOMAINcfg/tests/DOME/1_namelist_cfg
@@ -0,0 +1,94 @@
+!! NEMO/OCE : Configuration namelist_cfg used to overwrite defaults value defined in namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE : 1 - Domain & run manager (namrun, namcfg, namdom, namzgr, namzgr_sco )
+!! 2 - diagnostics (namnc4)
+!! 3 - miscellaneous (nammpp, namctl)
+!!
+!! namelist skeleton : egrep -E '(^/ *$|^! *$|^ *$|&nam.*|!---.*|!! .*|!!==.*|!!>>>.*)' namelist_ref > namelist_skl
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun ! parameters of the run
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom ! space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+ ln_read_cfg = .false.
+ nn_bathy = -1
+ ! or compute (2) from external bathymetry
+ jphgr_msh = 2 ! f-plan
+ ppgphi0 = 43.7 ! reference latitude
+ ppe1_m = 5000.0 ! zonal grid-spacing (degrees)
+ ppe2_m = 5000.0 ! meridional grid-spacing (degrees)
+ ppkth = 0.0 ! if =0. assume uniform grid over pphmax meters
+ pphmax = 3600.0 ! Maximum depth
+ rn_e3zps_min= 99999. ! partial step thickness is set larger than the minimum of
+ rn_e3zps_rat= 0.1 ! rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+/
+!-----------------------------------------------------------------------
+&namcfg ! parameters of the configuration
+!-----------------------------------------------------------------------
+ !
+ ln_e3_dep = .true. ! =T : e3=dk[depth] in discret sens.
+ ! ! ===>>> will become the only possibility in v4.0
+ ! ! =F : e3 analytical derivative of depth function
+ ! ! only there for backward compatibility test with v3.6
+ ! ! if ln_e3_dep = T
+ ln_dept_mid = .true. ! =T : set T points in the middle of cells
+ ! !
+ cp_cfg = 'DOME'
+ jp_cfg = 5 ! resolution of the configuration
+ jpidta = 168
+ jpjdta = 104
+ jpkdta = 31 ! number of levels ( >= jpk )
+ Ni0glo = 168
+ Nj0glo = 104
+ jpkglo = 31
+ jperio = 0
+ ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
+ ! in netcdf input files, as the start j-row for reading
+ ln_domclo = .false. ! computation of closed sea masks (see namclo)
+/
+!-----------------------------------------------------------------------
+&namzgr ! vertical coordinate (default: NO selection)
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ ln_zco = .false. ! z-coordinate - full steps
+ ln_zps = .false. ! z-coordinate - partial steps
+ ln_sco = .true. ! s- or hybrid z-s-coordinate
+ ln_isfcav = .false. ! ice shelf cavity (T: see namzgr_isf)
+/
+!-----------------------------------------------------------------------
+&namzgr_isf ! isf cavity geometry definition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzgr_sco ! s-coordinate or hybrid z-s-coordinate (default F)
+!-----------------------------------------------------------------------
+ ln_s_sh94 = .true. ! Song & Haidvogel 1994 hybrid S-sigma (T)|
+ ! stretching coefficients for all functions
+ rn_sbot_min = 600.0 ! minimum depth of s-bottom surface (>0) (m)
+ rn_sbot_max = 3600.0 ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+ !!!!!!! Envelop bathymetry
+ rn_rmax = 1.0 ! maximum cut-off r-value allowed (0<r_max<1)
+ !!!!!!! SH94 stretching coefficients (ln_s_sh94 = .true.)
+ rn_theta = 0.0 ! surface control parameter (0<=theta<=20)
+ rn_bb = 0.8 ! stretching with SH94 s-sigma
+/
+!-----------------------------------------------------------------------
+&namclo ! (closed sea : need ln_domclo = .true. in namcfg)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc ! lateral momentum boundary condition (default: NO selection)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif ! AGRIF zoom ("key_agrif")
+!-----------------------------------------------------------------------
+ ln_vert_remap = .true.
+/
+!-----------------------------------------------------------------------
+&namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
diff --git a/tools/DOMAINcfg/tests/DOME/1_namelist_cfg_z180 b/tools/DOMAINcfg/tests/DOME/1_namelist_cfg_z180
new file mode 100644
index 0000000000000000000000000000000000000000..c86f785346fe53707e7e20f548cb03baef56e6d7
--- /dev/null
+++ b/tools/DOMAINcfg/tests/DOME/1_namelist_cfg_z180
@@ -0,0 +1,94 @@
+!! NEMO/OCE : Configuration namelist_cfg used to overwrite defaults value defined in namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE : 1 - Domain & run manager (namrun, namcfg, namdom, namzgr, namzgr_sco )
+!! 2 - diagnostics (namnc4)
+!! 3 - miscellaneous (nammpp, namctl)
+!!
+!! namelist skeleton : egrep -E '(^/ *$|^! *$|^ *$|&nam.*|!---.*|!! .*|!!==.*|!!>>>.*)' namelist_ref > namelist_skl
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun ! parameters of the run
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom ! space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+ ln_read_cfg = .false.
+ nn_bathy = -1
+ ! or compute (2) from external bathymetry
+ jphgr_msh = 2 ! f-plan
+ ppgphi0 = 43.7 ! reference latitude
+ ppe1_m = 5000.0 ! zonal grid-spacing (degrees)
+ ppe2_m = 5000.0 ! meridional grid-spacing (degrees)
+ ppkth = 0.0 ! if =0. assume uniform grid over pphmax meters
+ pphmax = 3600.0 ! Maximum depth
+ rn_e3zps_min= 99999. ! partial step thickness is set larger than the minimum of
+ rn_e3zps_rat= 0.1 ! rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+/
+!-----------------------------------------------------------------------
+&namcfg ! parameters of the configuration
+!-----------------------------------------------------------------------
+ !
+ ln_e3_dep = .true. ! =T : e3=dk[depth] in discret sens.
+ ! ! ===>>> will become the only possibility in v4.0
+ ! ! =F : e3 analytical derivative of depth function
+ ! ! only there for backward compatibility test with v3.6
+ ! ! if ln_e3_dep = T
+ ln_dept_mid = .true. ! =T : set T points in the middle of cells
+ ! !
+ cp_cfg = 'DOME'
+ jp_cfg = 5 ! resolution of the configuration
+ jpidta = 168
+ jpjdta = 104
+ jpkdta = 181 ! number of levels ( >= jpk )
+ Ni0glo = 168
+ Nj0glo = 104
+ jpkglo = 135
+ jperio = 0
+ ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
+ ! in netcdf input files, as the start j-row for reading
+ ln_domclo = .false. ! computation of closed sea masks (see namclo)
+/
+!-----------------------------------------------------------------------
+&namzgr ! vertical coordinate (default: NO selection)
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ ln_zco = .false. ! z-coordinate - full steps
+ ln_zps = .true. ! z-coordinate - partial steps
+ ln_sco = .false. ! s- or hybrid z-s-coordinate
+ ln_isfcav = .false. ! ice shelf cavity (T: see namzgr_isf)
+/
+!-----------------------------------------------------------------------
+&namzgr_isf ! isf cavity geometry definition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzgr_sco ! s-coordinate or hybrid z-s-coordinate (default F)
+!-----------------------------------------------------------------------
+ ln_s_sh94 = .true. ! Song & Haidvogel 1994 hybrid S-sigma (T)|
+ ! stretching coefficients for all functions
+ rn_sbot_min = 600.0 ! minimum depth of s-bottom surface (>0) (m)
+ rn_sbot_max = 3600.0 ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+ !!!!!!! Envelop bathymetry
+ rn_rmax = 1.0 ! maximum cut-off r-value allowed (0<r_max<1)
+ !!!!!!! SH94 stretching coefficients (ln_s_sh94 = .true.)
+ rn_theta = 0.0 ! surface control parameter (0<=theta<=20)
+ rn_bb = 0.8 ! stretching with SH94 s-sigma
+/
+!-----------------------------------------------------------------------
+&namclo ! (closed sea : need ln_domclo = .true. in namcfg)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc ! lateral momentum boundary condition (default: NO selection)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif ! AGRIF zoom ("key_agrif")
+!-----------------------------------------------------------------------
+ ln_vert_remap = .true.
+/
+!-----------------------------------------------------------------------
+&namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
diff --git a/tools/DOMAINcfg/tests/DOME/1_namelist_ref b/tools/DOMAINcfg/tests/DOME/1_namelist_ref
new file mode 120000
index 0000000000000000000000000000000000000000..10614842eabd73c6eb44bfa6f75cd7e69e82f7fd
--- /dev/null
+++ b/tools/DOMAINcfg/tests/DOME/1_namelist_ref
@@ -0,0 +1 @@
+../../namelist_ref
\ No newline at end of file
diff --git a/tools/DOMAINcfg/tests/DOME/AGRIF_FixedGrids.in b/tools/DOMAINcfg/tests/DOME/AGRIF_FixedGrids.in
new file mode 120000
index 0000000000000000000000000000000000000000..bb259d4ffffc45c9d702ad36c51d81cf3e591438
--- /dev/null
+++ b/tools/DOMAINcfg/tests/DOME/AGRIF_FixedGrids.in
@@ -0,0 +1 @@
+../../../../tests/DOME/EXPREF/AGRIF_FixedGrids.in
\ No newline at end of file
diff --git a/tools/DOMAINcfg/tests/DOME/make_domain_cfg.exe b/tools/DOMAINcfg/tests/DOME/make_domain_cfg.exe
new file mode 120000
index 0000000000000000000000000000000000000000..8d81caa2096415e5443d5837091c581ef8fa47d0
--- /dev/null
+++ b/tools/DOMAINcfg/tests/DOME/make_domain_cfg.exe
@@ -0,0 +1 @@
+../../make_domain_cfg.exe
\ No newline at end of file
diff --git a/tools/DOMAINcfg/tests/DOME/namelist_cfg b/tools/DOMAINcfg/tests/DOME/namelist_cfg
new file mode 100644
index 0000000000000000000000000000000000000000..1e870498106b035ccdc95c78bdf9496160387320
--- /dev/null
+++ b/tools/DOMAINcfg/tests/DOME/namelist_cfg
@@ -0,0 +1,94 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE : Configuration namelist_cfg used to overwrite defaults value defined in namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE : 1 - Domain & run manager (namrun, namcfg, namdom, namzgr, namzgr_sco )
+!! 2 - diagnostics (namnc4)
+!! 3 - miscellaneous (nammpp, namctl)
+!!
+!! namelist skeleton : egrep -E '(^/ *$|^! *$|^ *$|&nam.*|!---.*|!! .*|!!==.*|!!>>>.*)' namelist_ref > namelist_skl
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun ! parameters of the run
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom ! space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+ ln_read_cfg = .false.
+ nn_bathy = -1 ! compute analyticaly (=0) or read (=1) the bathymetry file
+ ! or compute (2) from external bathymetry
+ jphgr_msh = 2 ! f-plan
+ ppgphi0 = 43.7 ! reference latitude
+ ppe1_m = 5000.0 ! zonal grid-spacing (degrees)
+ ppe2_m = 5000.0 ! meridional grid-spacing (degrees)
+ ppkth = 0.0 ! if =0. assume uniform grid over pphmax meters
+ pphmax = 3600.0 ! Maximum depth
+ rn_e3zps_min= 99999. ! partial step thickness is set larger than the minimum of
+ rn_e3zps_rat= 0.1 ! rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+/
+!-----------------------------------------------------------------------
+&namcfg ! parameters of the configuration
+!-----------------------------------------------------------------------
+ !
+ ln_e3_dep = .true. ! =T : e3=dk[depth] in discret sens.
+ ! ! ===>>> will become the only possibility in v4.0
+ ! ! =F : e3 analytical derivative of depth function
+ ! ! only there for backward compatibility test with v3.6
+ ! ! if ln_e3_dep = T
+ ln_dept_mid = .true. ! =T : set T points in the middle of cells
+ ! !
+ cp_cfg = "DOME" ! name of the configuration
+ jp_cfg = 5 ! resolution of the configuration
+ jpidta = 402 ! 1st lateral dimension ( >= jpi )
+ jpjdta = 173 ! 2nd " " ( >= jpj )
+ jpkdta = 61 ! number of levels ( >= jpk )
+ Ni0glo = 402 ! 1st dimension of global domain --> i =jpidta
+ Nj0glo = 173 ! 2nd - - --> j =jpjdta
+ jpkglo = 61
+ jperio = 0 ! lateral cond. type (between 0 and 6)
+ ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
+ ! in netcdf input files, as the start j-row for reading
+ ln_domclo = .false. ! computation of closed sea masks (see namclo)
+/
+!-----------------------------------------------------------------------
+&namzgr ! vertical coordinate (default: NO selection)
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ ln_zco = .false. ! z-coordinate - full steps
+ ln_zps = .true. ! z-coordinate - partial steps
+ ln_sco = .false. ! s- or hybrid z-s-coordinate
+ ln_isfcav = .false. ! ice shelf cavity (T: see namzgr_isf)
+/
+!-----------------------------------------------------------------------
+&namzgr_isf ! isf cavity geometry definition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzgr_sco ! s-coordinate or hybrid z-s-coordinate (default F)
+!-----------------------------------------------------------------------
+ ln_s_sh94 = .true. ! Song & Haidvogel 1994 hybrid S-sigma (T)|
+ ! stretching coefficients for all functions
+ rn_sbot_min = 600.0 ! minimum depth of s-bottom surface (>0) (m)
+ rn_sbot_max = 3600.0 ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+ !!!!!!! Envelop bathymetry
+ rn_rmax = 1.0 ! maximum cut-off r-value allowed (0<r_max<1)
+ !!!!!!! SH94 stretching coefficients (ln_s_sh94 = .true.)
+ rn_theta = 0.0 ! surface control parameter (0<=theta<=20)
+ rn_bb = 0.8 ! stretching with SH94 s-sigma
+/
+!-----------------------------------------------------------------------
+&namclo ! (closed sea : need ln_domclo = .true. in namcfg)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc ! lateral momentum boundary condition (default: NO selection)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif ! AGRIF zoom ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
diff --git a/tools/DOMAINcfg/tests/DOME/namelist_ref b/tools/DOMAINcfg/tests/DOME/namelist_ref
new file mode 120000
index 0000000000000000000000000000000000000000..10614842eabd73c6eb44bfa6f75cd7e69e82f7fd
--- /dev/null
+++ b/tools/DOMAINcfg/tests/DOME/namelist_ref
@@ -0,0 +1 @@
+../../namelist_ref
\ No newline at end of file