From c14167e30e2cadd4f3730ab587c3f5c35120734d Mon Sep 17 00:00:00 2001
From: sibylle <sibylle.techene@locean.ipsl.fr>
Date: Fri, 3 Dec 2021 20:19:21 +0100
Subject: [PATCH] RK3 time stepping branch formerly
source:/NEMO/branches/2021/dev_r14318_RK3_stage1 updated on git with main.
SETTE partly tested : problem with AGRIF_DEMO.
---
src/NST/agrif_oce_interp.F90 | 58 +-
src/NST/agrif_oce_sponge.F90 | 11 +-
src/NST/agrif_oce_update.F90 | 29 +-
src/NST/agrif_top_interp.F90 | 25 +-
src/NST/agrif_top_sponge.F90 | 7 +-
src/NST/agrif_top_update.F90 | 7 +-
src/OCE/DIA/diaptr.F90 | 5 +-
src/OCE/DOM/domain.F90 | 22 +-
src/OCE/DOM/domzgr.F90 | 28 +-
src/OCE/DOM/domzgr_substitute.h90 | 1 -
src/OCE/DOM/istate.F90 | 36 +-
src/OCE/DYN/divhor.F90 | 79 ++-
src/OCE/DYN/dynadv.F90 | 23 +-
src/OCE/DYN/dynadv_cen2.F90 | 132 +++--
src/OCE/DYN/dynadv_ubs.F90 | 127 +++--
src/OCE/DYN/dynhpg.F90 | 2 +-
src/OCE/DYN/dynspg.F90 | 13 +-
src/OCE/DYN/dynspg_ts.F90 | 441 +++++++++------
src/OCE/DYN/dynvor.F90 | 97 +++-
src/OCE/DYN/dynzad.F90 | 87 +--
src/OCE/DYN/dynzdf.F90 | 115 ++--
src/OCE/DYN/sshwzv.F90 | 170 +++++-
src/OCE/IOM/iom.F90 | 3 +-
src/OCE/IOM/restart.F90 | 35 +-
src/OCE/LDF/ldftra.F90 | 12 +-
src/OCE/SBC/sbcrnf.F90 | 10 +-
src/OCE/TRA/eosbn2.F90 | 111 +++-
src/OCE/TRA/traadv.F90 | 81 +--
src/OCE/TRA/traadv_fct.F90 | 10 +-
src/OCE/TRA/traadv_mus.F90 | 10 +-
src/OCE/TRA/traatf.F90 | 4 +-
src/OCE/TRA/traatf_qco.F90 | 64 ++-
src/OCE/TRA/traisf.F90 | 77 +--
src/OCE/TRA/traldf_iso.F90 | 8 +-
src/OCE/TRA/tranpc.F90 | 9 +-
src/OCE/TRA/traqsr.F90 | 890 ++++++++++++++++++++++++------
src/OCE/TRA/trasbc.F90 | 167 +++++-
src/OCE/module_example.F90 | 4 +-
src/OCE/nemogcm.F90 | 18 +-
src/OCE/oce.F90 | 6 +-
src/OCE/stp2d.F90 | 277 ++++++++++
src/OCE/stpmlf.F90 | 25 +-
src/OCE/stprk3.F90 | 390 +++++++++++++
src/OCE/stprk3_stg.F90 | 432 +++++++++++++++
src/OFF/dtadyn.F90 | 10 +-
src/OFF/nemogcm.F90 | 3 +-
src/TOP/AGE/trcsms_age.F90 | 15 +-
src/TOP/PISCES/P4Z/p4zche.F90 | 54 +-
src/TOP/PISCES/P4Z/p4zflx.F90 | 9 +-
src/TOP/PISCES/P4Z/p4zlys.F90 | 26 +-
src/TOP/TRP/trcadv.F90 | 46 +-
src/TOP/TRP/trcatf.F90 | 6 +-
src/TOP/TRP/trcrad.F90 | 7 +-
src/TOP/TRP/trcsbc.F90 | 190 ++++++-
src/TOP/TRP/trctrp.F90 | 26 +-
src/TOP/oce_trc.F90 | 1 -
src/TOP/trcbc.F90 | 6 +-
src/TOP/trcini.F90 | 13 +-
src/TOP/trcrst.F90 | 40 +-
src/TOP/trcsms.F90 | 6 +-
src/TOP/trcstp.F90 | 8 +-
src/TOP/trcstp_rk3.F90 | 291 ++++++++++
tests/ISOMIP+/MY_SRC/eosbn2.F90 | 128 ++++-
63 files changed, 4138 insertions(+), 905 deletions(-)
create mode 100644 src/OCE/stp2d.F90
create mode 100644 src/OCE/stprk3.F90
create mode 100644 src/OCE/stprk3_stg.F90
create mode 100644 src/TOP/trcstp_rk3.F90
diff --git a/src/NST/agrif_oce_interp.F90 b/src/NST/agrif_oce_interp.F90
index 114023bff..f50816bba 100644
--- a/src/NST/agrif_oce_interp.F90
+++ b/src/NST/agrif_oce_interp.F90
@@ -53,7 +53,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 14800 2021-05-06 15:42:46Z jchanut $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -155,18 +155,36 @@ CONTAINS
END SUBROUTINE Agrif_istate_ssh
- SUBROUTINE Agrif_tra
+ SUBROUTINE Agrif_tra( kt, kstg )
!!----------------------------------------------------------------------
!! *** ROUTINE Agrif_tra ***
!!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kt
+ INTEGER, OPTIONAL, INTENT(in) :: kstg
+ REAL(wp) :: ztindex
!
IF( Agrif_Root() ) RETURN
!
+ ! Set time index depending on stage in case of RK3 time stepping:
+ IF ( PRESENT( kstg ) ) THEN
+ ztindex = REAL(Agrif_Nbstepint(), wp)
+ IF ( kstg == 1 ) THEN
+ ztindex = ztindex + 1._wp / 3._wp
+ ELSEIF ( kstg == 2 ) THEN
+ ztindex = ztindex + 1._wp / 2._wp
+ ELSEIF ( kstg == 3 ) THEN
+ ztindex = ztindex + 1._wp
+ ENDIF
+ ztindex = ztindex / Agrif_Rhot()
+ ELSE
+ ztindex = REAL(Agrif_Nbstepint()+1, wp) / Agrif_Rhot()
+ ENDIF
+ !
Agrif_SpecialValue = 0._wp
Agrif_UseSpecialValue = .TRUE.
l_vremap = ln_vert_remap
!
- CALL Agrif_Bc_variable( ts_interp_id, procname=interptsn )
+ CALL Agrif_Bc_variable( ts_interp_id, calledweight=ztindex, procname=interptsn )
!
Agrif_UseSpecialValue = .FALSE.
l_vremap = .FALSE.
@@ -174,33 +192,50 @@ CONTAINS
END SUBROUTINE Agrif_tra
- SUBROUTINE Agrif_dyn( kt )
+ SUBROUTINE Agrif_dyn( kt, kstg )
!!----------------------------------------------------------------------
!! *** ROUTINE Agrif_DYN ***
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt
+ INTEGER, OPTIONAL, INTENT(in) :: kstg
!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ibdy1, jbdy1, ibdy2, jbdy2
REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb
+ REAL(wp) :: ztindex
!!----------------------------------------------------------------------
!
IF( Agrif_Root() ) RETURN
!
+ ! Set time index depending on stage in case of RK3 time stepping:
+ IF ( PRESENT( kstg ) ) THEN
+ ztindex = REAL(Agrif_Nbstepint(), wp)
+ IF ( kstg == 1 ) THEN
+ ztindex = ztindex + 1._wp / 3._wp
+ ELSEIF ( kstg == 2 ) THEN
+ ztindex = ztindex + 1._wp / 2._wp
+ ELSEIF ( kstg == 3 ) THEN
+ ztindex = ztindex + 1._wp
+ ENDIF
+ ztindex = ztindex / Agrif_Rhot()
+ ELSE
+ ztindex = REAL(Agrif_Nbstepint()+1, wp) / Agrif_Rhot()
+ ENDIF
+ !
Agrif_SpecialValue = 0.0_wp
Agrif_UseSpecialValue = ln_spc_dyn
l_vremap = ln_vert_remap
!
use_sign_north = .TRUE.
sign_north = -1.0_wp
- CALL Agrif_Bc_variable( un_interp_id, procname=interpun )
- CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn )
+ CALL Agrif_Bc_variable( un_interp_id, calledweight=ztindex, procname=interpun )
+ CALL Agrif_Bc_variable( vn_interp_id, calledweight=ztindex, procname=interpvn )
IF( .NOT.ln_dynspg_ts ) THEN ! Get transports
ubdy(:,:) = 0._wp ; vbdy(:,:) = 0._wp
utint_stage(:,:) = 0 ; vtint_stage(:,:) = 0
- CALL Agrif_Bc_variable( unb_interp_id, procname=interpunb )
- CALL Agrif_Bc_variable( vnb_interp_id, procname=interpvnb )
+ CALL Agrif_Bc_variable( unb_interp_id, calledweight=ztindex, procname=interpunb )
+ CALL Agrif_Bc_variable( vnb_interp_id, calledweight=ztindex, procname=interpvnb )
ENDIF
use_sign_north = .FALSE.
@@ -599,6 +634,13 @@ CONTAINS
!
IF( Agrif_Root() ) RETURN
!
+#if defined key_RK3
+ Agrif_SpecialValue = 0._wp
+ Agrif_UseSpecialValue = .TRUE.
+ CALL Agrif_Bc_variable(sshn_id, procname=interpsshn )
+ Agrif_UseSpecialValue = .FALSE.
+#endif
+ !
ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in the forward case only
!
! Enforce volume conservation if no time refinement:
diff --git a/src/NST/agrif_oce_sponge.F90 b/src/NST/agrif_oce_sponge.F90
index 9cb5b05b6..22e59df51 100644
--- a/src/NST/agrif_oce_sponge.F90
+++ b/src/NST/agrif_oce_sponge.F90
@@ -36,7 +36,7 @@ MODULE agrif_oce_sponge
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/NST 4.0 , NEMO Consortium (2018)
- !! $Id: agrif_oce_sponge.F90 15437 2021-10-22 12:21:20Z jchanut $
+ !! $Id: agrif_oce_sponge.F90 14800 2021-05-06 15:42:46Z jchanut $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -50,8 +50,12 @@ CONTAINS
!!----------------------------------------------------------------------
!
#if defined SPONGE
+#if defined key_RK3
+ zcoef = REAL(Agrif_Nbstepint(), wp)/REAL(Agrif_rhot())
+#else
!! Assume persistence:
zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot())
+#endif
Agrif_SpecialValue = 0._wp
Agrif_UseSpecialValue = .TRUE.
@@ -78,7 +82,12 @@ CONTAINS
!!----------------------------------------------------------------------
!
#if defined SPONGE
+
+#if defined key_RK3
+ zcoef = REAL(Agrif_Nbstepint(), wp)/REAL(Agrif_rhot())
+#else
zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot())
+#endif
Agrif_SpecialValue = 0._wp
Agrif_UseSpecialValue = ln_spc_dyn
diff --git a/src/NST/agrif_oce_update.F90 b/src/NST/agrif_oce_update.F90
index cb8093e6a..cec0ea153 100644
--- a/src/NST/agrif_oce_update.F90
+++ b/src/NST/agrif_oce_update.F90
@@ -40,7 +40,7 @@ MODULE agrif_oce_update
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/NST 4.0 , NEMO Consortium (2018)
- !! $Id: agrif_oce_update.F90 15317 2021-10-01 16:09:36Z jchanut $
+ !! $Id: agrif_oce_update.F90 14800 2021-05-06 15:42:46Z jchanut $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -97,6 +97,7 @@ CONTAINS
CALL Agrif_Update_Variable(vnb_update_id,locupdate1=(/1+nn_shift_bar,-2/),locupdate2=(/ nn_shift_bar,-2/),procname = updateV2d)
# endif
!
+#if ! defined key_RK3
IF ( ln_dynspg_ts .AND. ln_bt_fw ) THEN
! Update time integrated transports
# if ! defined DECAL_FEEDBACK_2D
@@ -107,6 +108,7 @@ CONTAINS
CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1+nn_shift_bar,-2/),locupdate2=(/ nn_shift_bar,-2/),procname = updatevb2b)
# endif
END IF
+#endif
# if ! defined DECAL_FEEDBACK
CALL Agrif_Update_Variable(un_update_id,procname = updateU)
@@ -384,6 +386,7 @@ CONTAINS
ENDDO
ENDDO
+#if ! defined key_RK3
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
! Add asselin part
DO jn = 1,jpts
@@ -402,6 +405,7 @@ CONTAINS
END DO
END DO
ENDIF
+#endif
DO jn = 1,jpts
DO jk = 1, jpkm1
DO jj = j1, j2
@@ -418,7 +422,7 @@ CONTAINS
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 ! defined key_RK3
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
! Add asselin part
DO jn = 1,jpts
@@ -437,6 +441,7 @@ CONTAINS
END DO
END DO
ENDIF
+#endif
DO jn = 1,jpts
DO jk=k1,k2
DO jj=j1,j2
@@ -559,6 +564,7 @@ CONTAINS
DO jk=1,jpk
DO jj=j1,j2
DO ji=i1,i2
+#if ! defined key_RK3
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
zuno = uu(ji,jj,jk,Kmm_a) * e3u(ji,jj,jk,Krhs_a)
@@ -566,6 +572,7 @@ CONTAINS
uu(ji,jj,jk,Kbb_a) = ( zub + rn_atfp * ( zunu - zuno) ) &
& * umask(ji,jj,jk) / e3u(ji,jj,jk,Kbb_a)
ENDIF
+#endif
!
uu(ji,jj,jk,Kmm_a) = tabres_child(ji,jj,jk) * umask(ji,jj,jk)
END DO
@@ -706,6 +713,7 @@ CONTAINS
DO jk=1,jpkm1
DO jj=j1,j2
DO ji=i1,i2
+#if ! defined key_RK3
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
zvno = vv(ji,jj,jk,Kmm_a) * e3v(ji,jj,jk,Krhs_a)
@@ -713,6 +721,7 @@ CONTAINS
vv(ji,jj,jk,Kbb_a) = ( zvb + rn_atfp * ( zvnu - zvno) ) &
& * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kbb_a)
ENDIF
+#endif
!
vv(ji,jj,jk,Kmm_a) = tabres_child(ji,jj,jk) * vmask(ji,jj,jk)
END DO
@@ -782,12 +791,14 @@ CONTAINS
tabres(ji,jj) = tabres(ji,jj) * r1_e2u(ji,jj)
!
! Update barotropic velocities:
+#if ! defined key_RK3
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
zcorr = (tabres(ji,jj) - uu_b(ji,jj,Kmm_a) * hu(ji,jj,Krhs_a)) * r1_hu(ji,jj,Kbb_a)
uu_b(ji,jj,Kbb_a) = uu_b(ji,jj,Kbb_a) + rn_atfp * zcorr * umask(ji,jj,1)
END IF
ENDIF
+#endif
uu_b(ji,jj,Kmm_a) = tabres(ji,jj) * r1_hu(ji,jj,Kmm_a) * umask(ji,jj,1)
!
END DO
@@ -827,12 +838,14 @@ CONTAINS
DO ji=i1,i2
tabres(ji,jj) = tabres(ji,jj) * r1_e1v(ji,jj)
! Update barotropic velocities:
+#if ! defined key_RK3
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
zcorr = (tabres(ji,jj) - vv_b(ji,jj,Kmm_a) * hv(ji,jj,Krhs_a)) * r1_hv(ji,jj,Kbb_a)
vv_b(ji,jj,Kbb_a) = vv_b(ji,jj,Kbb_a) + rn_atfp * zcorr * vmask(ji,jj,1)
END IF
ENDIF
+#endif
vv_b(ji,jj,Kmm_a) = tabres(ji,jj) * r1_hv(ji,jj,Kmm_a) * vmask(ji,jj,1)
!
END DO
@@ -865,6 +878,7 @@ CONTAINS
END DO
END DO
ELSE
+#if ! defined key_RK3
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
DO jj=j1,j2
DO ji=i1,i2
@@ -873,6 +887,7 @@ CONTAINS
END DO
END DO
ENDIF
+#endif
!
DO jj=j1,j2
DO ji=i1,i2
@@ -963,14 +978,18 @@ CONTAINS
DO jj=j1,j2
zcor = rn_Dt * r1_e1e2t(i1 ,jj) * e2u(i1,jj) * (ub2_b(i1,jj)-tabres(i1,jj))
ssh(i1 ,jj,Kmm_a) = ssh(i1 ,jj,Kmm_a) + zcor
+#if ! defined key_RK3
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) ssh(i1 ,jj,Kbb_a) = ssh(i1 ,jj,Kbb_a) + rn_atfp * zcor
+#endif
END DO
ENDIF
IF (eastern_side) THEN
DO jj=j1,j2
zcor = - rn_Dt * r1_e1e2t(i2+1,jj) * e2u(i2,jj) * (ub2_b(i2,jj)-tabres(i2,jj))
ssh(i2+1,jj,Kmm_a) = ssh(i2+1,jj,Kmm_a) + zcor
+#if ! defined key_RK3
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) ssh(i2+1,jj,Kbb_a) = ssh(i2+1,jj,Kbb_a) + rn_atfp * zcor
+#endif
END DO
ENDIF
!
@@ -1051,14 +1070,18 @@ CONTAINS
DO ji=i1,i2
zcor = rn_Dt * r1_e1e2t(ji,j1 ) * e1v(ji,j1 ) * (vb2_b(ji,j1)-tabres(ji,j1))
ssh(ji,j1 ,Kmm_a) = ssh(ji,j1 ,Kmm_a) + zcor
+#if ! defined key_RK3
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) ssh(ji,j1 ,Kbb_a) = ssh(ji,j1,Kbb_a) + rn_atfp * zcor
+#endif
END DO
ENDIF
IF (northern_side) THEN
DO ji=i1,i2
zcor = - rn_Dt * r1_e1e2t(ji,j2+1) * e1v(ji,j2 ) * (vb2_b(ji,j2)-tabres(ji,j2))
ssh(ji,j2+1,Kmm_a) = ssh(ji,j2+1,Kmm_a) + zcor
+#if ! defined key_RK3
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) ssh(ji,j2+1,Kbb_a) = ssh(ji,j2+1,Kbb_a) + rn_atfp * zcor
+#endif
END DO
ENDIF
!
@@ -1204,6 +1227,7 @@ CONTAINS
! 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 ! defined key_RK3
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler) )) THEN
DO jk = 1, jpkm1
DO jj=j1,j2
@@ -1234,6 +1258,7 @@ CONTAINS
END DO
!
ENDIF
+#endif
!
! 2) Updates at NOW time step:
! ----------------------------
diff --git a/src/NST/agrif_top_interp.F90 b/src/NST/agrif_top_interp.F90
index f82ab3864..d6c64aff7 100644
--- a/src/NST/agrif_top_interp.F90
+++ b/src/NST/agrif_top_interp.F90
@@ -30,23 +30,42 @@ MODULE agrif_top_interp
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/NST 4.0 , NEMO Consortium (2018)
- !! $Id: agrif_top_interp.F90 14218 2020-12-18 16:44:52Z jchanut $
+ !! $Id: agrif_top_interp.F90 14800 2021-05-06 15:42:46Z jchanut $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE Agrif_trc
+ SUBROUTINE Agrif_trc( kt, kstg )
!!----------------------------------------------------------------------
!! *** ROUTINE Agrif_trc ***
!!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kt
+ INTEGER, OPTIONAL, INTENT(in) :: kstg
+ !
+ REAL(wp) :: ztindex
!
IF( Agrif_Root() ) RETURN
!
+ ! Set time index depending on stage in case of RK3 time stepping:
+ IF ( PRESENT( kstg ) ) THEN
+ ztindex = REAL(Agrif_Nbstepint(), wp)
+ IF ( kstg == 1 ) THEN
+ ztindex = ztindex + 1._wp / 3._wp
+ ELSEIF ( kstg == 2 ) THEN
+ ztindex = ztindex + 1._wp / 2._wp
+ ELSEIF ( kstg == 3 ) THEN
+ ztindex = ztindex + 1._wp
+ ENDIF
+ ztindex = ztindex / Agrif_Rhot()
+ ELSE
+ ztindex = REAL(Agrif_Nbstepint()+1, wp) / Agrif_Rhot()
+ ENDIF
+ !
Agrif_SpecialValue = 0._wp
Agrif_UseSpecialValue = .TRUE.
l_vremap = ln_vert_remap
!
- CALL Agrif_Bc_variable( trn_id, procname=interptrn )
+ CALL Agrif_Bc_variable( trn_id,calledweight=ztindex, procname=interptrn )
!
Agrif_UseSpecialValue = .FALSE.
l_vremap = .FALSE.
diff --git a/src/NST/agrif_top_sponge.F90 b/src/NST/agrif_top_sponge.F90
index d6d51ab6b..a46b2a979 100644
--- a/src/NST/agrif_top_sponge.F90
+++ b/src/NST/agrif_top_sponge.F90
@@ -33,7 +33,7 @@ MODULE agrif_top_sponge
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/NST 4.0 , NEMO Consortium (2018)
- !! $Id: agrif_top_sponge.F90 15437 2021-10-22 12:21:20Z jchanut $
+ !! $Id: agrif_top_sponge.F90 14800 2021-05-06 15:42:46Z jchanut $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -46,9 +46,12 @@ CONTAINS
!!----------------------------------------------------------------------
!
#if defined SPONGE_TOP
+#if defined key_RK3
+ zcoef = REAL(Agrif_Nbstepint(), wp)/REAL(Agrif_rhot())
+#else
!! Assume persistence:
zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot())
-
+#endif
Agrif_SpecialValue = 0._wp
Agrif_UseSpecialValue = .TRUE.
l_vremap = ln_vert_remap
diff --git a/src/NST/agrif_top_update.F90 b/src/NST/agrif_top_update.F90
index ed73b6bd8..e451da8cf 100644
--- a/src/NST/agrif_top_update.F90
+++ b/src/NST/agrif_top_update.F90
@@ -29,7 +29,7 @@ MODULE agrif_top_update
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/NST 4.0 , NEMO Consortium (2018)
- !! $Id: agrif_top_update.F90 15265 2021-09-16 11:13:13Z jchanut $
+ !! $Id: agrif_top_update.F90 14800 2021-05-06 15:42:46Z jchanut $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -128,7 +128,7 @@ CONTAINS
ENDIF
ENDDO
ENDDO
-
+#if ! defined key_RK3
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
! Add asselin part
DO jn = 1,jptra
@@ -147,6 +147,7 @@ CONTAINS
END DO
END DO
ENDIF
+#endif
DO jn = 1,jptra
DO jk = 1, jpkm1
DO jj = j1, j2
@@ -163,6 +164,7 @@ CONTAINS
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 ! defined key_RK3
IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN
! Add asselin part
DO jn = 1,jptra
@@ -181,6 +183,7 @@ CONTAINS
END DO
END DO
ENDIF
+#endif
DO jn = 1,jptra
DO jk=k1,k2
DO jj=j1,j2
diff --git a/src/OCE/DIA/diaptr.F90 b/src/OCE/DIA/diaptr.F90
index 180a2eb04..e39c894ca 100644
--- a/src/OCE/DIA/diaptr.F90
+++ b/src/OCE/DIA/diaptr.F90
@@ -41,6 +41,7 @@ MODULE diaptr
END INTERFACE
PUBLIC dia_ptr ! call in step module
+ PUBLIC dia_ptr_init ! call in stprk3 module
PUBLIC dia_ptr_hst ! called from tra_ldf/tra_adv routines
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/Salt TRansports(adv, diff, Bolus.)
@@ -65,7 +66,7 @@ MODULE diaptr
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: diaptr.F90 14834 2021-05-11 09:24:44Z hadcv $
+ !! $Id: diaptr.F90 15513 2021-11-15 17:31:29Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -82,7 +83,9 @@ CONTAINS
!
IF( ln_timing ) CALL timing_start('dia_ptr')
+#if ! defined key_RK3
IF( kt == nit000 .AND. ll_init ) CALL dia_ptr_init ! -> will define l_diaptr and nbasin
+#endif
!
IF( l_diaptr ) THEN
! Calculate zonal integrals
diff --git a/src/OCE/DOM/domain.F90 b/src/OCE/DOM/domain.F90
index e53cabbe4..a12102d13 100644
--- a/src/OCE/DOM/domain.F90
+++ b/src/OCE/DOM/domain.F90
@@ -64,7 +64,7 @@ MODULE domain
# include "do_loop_substitute.h90"
!!-------------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: domain.F90 15270 2021-09-17 14:27:55Z smasson $
+ !! $Id: domain.F90 14547 2021-02-25 17:07:15Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!-------------------------------------------------------------------------
CONTAINS
@@ -88,7 +88,6 @@ CONTAINS
!
INTEGER :: ji, jj, jk, jt ! dummy loop indices
INTEGER :: iconf = 0 ! local integers
- REAL(wp):: zrdt
CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))"
INTEGER , DIMENSION(jpi,jpj) :: ik_top , ik_bot ! top and bottom ocean level
REAL(wp), DIMENSION(jpi,jpj) :: z1_hu_0, z1_hv_0
@@ -310,8 +309,27 @@ CONTAINS
ENDIF
!
! set current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3
+#if defined key_RK3
+ rDt = rn_Dt
+ r1_Dt = 1._wp / rDt
+ !
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) ' ===>>> Runge Kutta 3rd order (RK3) : rDt = ', rDt
+ WRITE(numout,*)
+ ENDIF
+ !
+#else
rDt = 2._wp * rn_Dt
r1_Dt = 1._wp / rDt
+ !
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) ' ===>>> Modified Leap-Frog (MLF) : rDt = ', rDt
+ WRITE(numout,*)
+ ENDIF
+ !
+#endif
!
IF( l_SAS .AND. .NOT.ln_linssh ) THEN
CALL ctl_warn( 'SAS requires linear ssh : force ln_linssh = T' )
diff --git a/src/OCE/DOM/domzgr.F90 b/src/OCE/DOM/domzgr.F90
index 229d433fc..9c7594819 100644
--- a/src/OCE/DOM/domzgr.F90
+++ b/src/OCE/DOM/domzgr.F90
@@ -46,7 +46,7 @@ MODULE domzgr
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: domzgr.F90 15556 2021-11-29 15:23:06Z jchanut $
+ !! $Id: domzgr.F90 15157 2021-07-29 08:28:32Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -282,6 +282,19 @@ CONTAINS
CALL iom_get( inum, jpdom_global, 'bottom_level' , z2d ) ! last wet T-points
k_bot(:,:) = NINT( z2d(:,:) )
!
+ IF( iom_varid( inum, 'mbku', ldstop = .FALSE. ) > 0 ) THEN
+ IF(lwp) WRITE(numout,*) ' mbku, mbkv & mbkf read in ', TRIM(cn_domcfg), ' file'
+ CALL iom_get( inum, jpdom_global, 'mbku', z2d )
+ k_bot_u(:,:) = NINT( z2d(:,:) )
+ CALL iom_get( inum, jpdom_global, 'mbkv', z2d )
+ k_bot_v(:,:) = NINT( z2d(:,:) )
+ CALL iom_get( inum, jpdom_global, 'mbkf', z2d )
+ k_bot_f(:,:) = NINT( z2d(:,:) )
+ k_mbkuvf = 1
+ ELSE
+ k_mbkuvf = 0
+ ENDIF
+ !
! !* vertical scale factors
CALL iom_get( inum, jpdom_unknown, 'e3t_1d' , pe3t_1d ) ! 1D reference coordinate
CALL iom_get( inum, jpdom_unknown, 'e3w_1d' , pe3w_1d )
@@ -327,19 +340,6 @@ CONTAINS
ENDIF
ENDIF
!
- IF( iom_varid( inum, 'mbku', ldstop = .FALSE. ) > 0 ) THEN
- IF(lwp) WRITE(numout,*) ' mbku, mbkv & mbkf read in ', TRIM(cn_domcfg), ' file'
- CALL iom_get( inum, jpdom_global, 'mbku', z2d )
- k_bot_u(:,:) = NINT( z2d(:,:) )
- CALL iom_get( inum, jpdom_global, 'mbkv', z2d )
- k_bot_v(:,:) = NINT( z2d(:,:) )
- CALL iom_get( inum, jpdom_global, 'mbkf', z2d )
- k_bot_f(:,:) = NINT( z2d(:,:) )
- k_mbkuvf = 1
- ELSE
- k_mbkuvf = 0
- ENDIF
- !
! reference depth for negative bathy (wetting and drying only)
IF( ll_wd ) CALL iom_get( inum, 'rn_wd_ref_depth' , ssh_ref )
!
diff --git a/src/OCE/DOM/domzgr_substitute.h90 b/src/OCE/DOM/domzgr_substitute.h90
index 4050f04e1..e5d0d81fa 100644
--- a/src/OCE/DOM/domzgr_substitute.h90
+++ b/src/OCE/DOM/domzgr_substitute.h90
@@ -51,4 +51,3 @@
# define gde3w(i,j,k) (gdept_0(i,j,k)-ssh(i,j,Kmm))
#endif
!!----------------------------------------------------------------------
-
diff --git a/src/OCE/DOM/istate.F90 b/src/OCE/DOM/istate.F90
index b825cc5cb..213b79973 100644
--- a/src/OCE/DOM/istate.F90
+++ b/src/OCE/DOM/istate.F90
@@ -50,7 +50,7 @@ MODULE istate
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: istate.F90 15052 2021-06-24 14:39:14Z smasson $
+ !! $Id: istate.F90 14991 2021-06-14 19:52:31Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -136,32 +136,42 @@ CONTAINS
ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones
uu (:,:,:,Kmm) = uu (:,:,:,Kbb)
vv (:,:,:,Kmm) = vv (:,:,:,Kbb)
-
ENDIF
#if defined key_agrif
ENDIF
#endif
!
- ! Initialize "now" and "before" barotropic velocities:
- ! Do it whatever the free surface method, these arrays being eventually used
+ ! Initialize "now" barotropic velocities:
+ ! Do it whatever the free surface method, these arrays being used eventually
!
+!!gm the use of umask & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked
+#if ! defined key_RK3
uu_b(:,:,Kmm) = 0._wp ; vv_b(:,:,Kmm) = 0._wp
- uu_b(:,:,Kbb) = 0._wp ; vv_b(:,:,Kbb) = 0._wp
- !
-!!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk)
vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
- !
- uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk)
- vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk)
END_3D
- !
uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm)
vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm)
+#endif
!
- uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb)
- vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb)
+#if defined key_RK3
+ IF( .NOT. ln_rstart ) THEN
+#endif
+ ! Initialize "before" barotropic velocities. "now" values are always set but
+ ! "before" values may have been read from a restart to ensure restartability.
+ ! In the non-restart or non-RK3 cases they need to be initialised here:
+ uu_b(:,:,Kbb) = 0._wp ; vv_b(:,:,Kbb) = 0._wp
+ DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+ uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk)
+ vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk)
+ END_3D
+ uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb)
+ vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb)
+ !
+#if defined key_RK3
+ ENDIF
+#endif
!
END SUBROUTINE istate_init
diff --git a/src/OCE/DYN/divhor.F90 b/src/OCE/DYN/divhor.F90
index 439144b82..edfccb67d 100644
--- a/src/OCE/DYN/divhor.F90
+++ b/src/OCE/DYN/divhor.F90
@@ -12,6 +12,7 @@ MODULE divhor
!! 3.7 ! 2014-01 (G. Madec) suppression of velocity curl from in-core memory
!! - ! 2014-12 (G. Madec) suppression of cross land advection option
!! - ! 2015-10 (G. Madec) add velocity and rnf flag in argument of div_hor
+ !! 4.5 ! 2015-10 (S. Techene, G. Madec) hdiv replaced by e3divUh
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -35,19 +36,89 @@ MODULE divhor
IMPLICIT NONE
PRIVATE
- PUBLIC div_hor ! routine called by step.F90 and istate.F90
+ ! !! * Interface
+ INTERFACE div_hor
+ MODULE PROCEDURE div_hor_RK3, div_hor_old
+ END INTERFACE
+
+ PUBLIC div_hor ! routine called by ssh_nxt.F90 and istate.F90
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: divhor.F90 15150 2021-07-27 10:38:24Z smasson $
+ !! $Id: divhor.F90 14808 2021-05-07 12:00:45Z jchanut $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE div_hor( kt, Kbb, Kmm )
+ SUBROUTINE div_hor_RK3( kt, Kbb, Kmm, puu, pvv, pe3divUh )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE div_hor_RK3 ***
+ !!
+ !! ** Purpose : compute the horizontal divergence at now time-step
+ !!
+ !! ** Method : the now divergence is computed as :
+ !! hdiv = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
+ !! and correct with runoff inflow (div_rnf) and cross land flow (div_cla)
+ !!
+ !! ** Action : - thickness weighted horizontal divergence of in input velocity (puu,pvv)
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt, Kbb, Kmm ! ocean time-step & time-level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: puu, pvv ! horizontal velocity
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: pe3divUh ! e3t*div[Uh]
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('div_hor_RK3')
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'div_hor_RK3 : thickness weighted horizontal divergence '
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+ hdiv (:,:,:) = 0._wp ! initialize hdiv & pe3divUh for the halos and jpk level at the first time step
+ ENDIF
+ !
+ pe3divUh(:,:,:) = 0._wp !!gm to be applied to the halos only
+ !
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * puu(ji ,jj,jk) &
+ & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * puu(ji-1,jj,jk) &
+ & + e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) * pvv(ji,jj ,jk) &
+ & - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * pvv(ji,jj-1,jk) ) &
+ & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+ END_3D
+ !
+ IF( ln_rnf ) CALL sbc_rnf_div( hdiv, Kmm ) !== + runoffs divergence ==!
+ !
+#if defined key_asminc
+ IF( ln_sshinc .AND. ln_asmiau ) & !== + SSH assimilation increment ==!
+ & CALL ssh_asm_div( kt, Kbb, Kmm, hdiv )
+#endif
+ !
+ IF( ln_isf ) CALL isf_hdiv( kt, Kmm, hdiv ) !== + ice-shelf mass exchange ==!
+ !
+ CALL lbc_lnk( 'divhor', hdiv, 'T', 1._wp ) ! (no sign change)
+ !
+!!gm Patch before suppression of hdiv from all modules that use it
+! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== e3t * Horizontal divergence ==!
+! pe3divUh(ji,jj,jk) = hdiv(ji,jj,jk) * e3t(ji,jj,jk,Kmm)
+! END_3D
+!JC: over whole domain, and after lbclnk on hdiv to prevent from reproducibility issues
+ DO jk=1, jpkm1
+ pe3divUh(:,:,jk) = hdiv(:,:,jk) * e3t(:,:,jk,Kmm)
+ END DO
+!!gm end
+ !
+ !
+ IF( ln_timing ) CALL timing_stop('div_hor_RK3')
+ !
+ END SUBROUTINE div_hor_RK3
+
+
+ SUBROUTINE div_hor_old( kt, Kbb, Kmm )
!!----------------------------------------------------------------------
!! *** ROUTINE div_hor ***
!!
@@ -102,7 +173,7 @@ CONTAINS
! ! needed for ww in sshwzv
IF( ln_timing ) CALL timing_stop('div_hor')
!
- END SUBROUTINE div_hor
+ END SUBROUTINE div_hor_old
!!======================================================================
END MODULE divhor
diff --git a/src/OCE/DYN/dynadv.F90 b/src/OCE/DYN/dynadv.F90
index 1df6b9522..bda2c3a4f 100644
--- a/src/OCE/DYN/dynadv.F90
+++ b/src/OCE/DYN/dynadv.F90
@@ -45,12 +45,12 @@ MODULE dynadv
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: dynadv.F90 14053 2020-12-03 13:48:38Z techene $
+ !! $Id: dynadv.F90 14419 2021-02-09 12:22:16Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE dyn_adv( kt, Kbb, Kmm, puu, pvv, Krhs )
+ SUBROUTINE dyn_adv( kt, Kbb, Kmm, puu, pvv, Krhs, pau, pav, paw, no_zad )
!!---------------------------------------------------------------------
!! *** ROUTINE dyn_adv ***
!!
@@ -63,21 +63,22 @@ CONTAINS
!! it is the relative vorticity which is added to coriolis term
!! (see dynvor module).
!!----------------------------------------------------------------------
- INTEGER , INTENT( in ) :: kt ! ocean time-step index
- INTEGER , INTENT( in ) :: Kbb, Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ INTEGER , INTENT(in ) :: kt , Kbb, Kmm, Krhs ! ocean time step and level indices
+ INTEGER , OPTIONAL , INTENT(in ) :: no_zad ! no vertical advection compotation
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, TARGET, INTENT(in ) :: pau, pav, paw ! advective velocity
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), TARGET, INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum Eq.
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start( 'dyn_adv' )
!
SELECT CASE( n_dynadv ) !== compute advection trend and add it to general trend ==!
- CASE( np_VEC_c2 )
- CALL dyn_keg ( kt, nn_dynkeg, Kmm, puu, pvv, Krhs ) ! vector form : horizontal gradient of kinetic energy
- CALL dyn_zad ( kt, Kmm, puu, pvv, Krhs ) ! vector form : vertical advection
- CASE( np_FLX_c2 )
- CALL dyn_adv_cen2( kt, Kmm, puu, pvv, Krhs ) ! 2nd order centered scheme
+ CASE( np_VEC_c2 ) != vector form =!
+ CALL dyn_keg ( kt, nn_dynkeg , Kmm, puu, pvv, Krhs ) ! horizontal gradient of kinetic energy
+ CALL dyn_zad ( kt , Kmm, puu, pvv, Krhs ) ! vertical advection
+ CASE( np_FLX_c2 ) != flux form =!
+ CALL dyn_adv_cen2( kt , Kmm, puu, pvv, Krhs, pau, pav, paw, no_zad ) ! 2nd order centered scheme
CASE( np_FLX_ubs )
- CALL dyn_adv_ubs ( kt, Kbb, Kmm, puu, pvv, Krhs ) ! 3rd order UBS scheme (UP3)
+ CALL dyn_adv_ubs ( kt , Kbb, Kmm, puu, pvv, Krhs, pau, pav, paw, no_zad ) ! 3rd order UBS scheme (UP3)
END SELECT
!
IF( ln_timing ) CALL timing_stop( 'dyn_adv' )
diff --git a/src/OCE/DYN/dynadv_cen2.F90 b/src/OCE/DYN/dynadv_cen2.F90
index c3cd13226..7fd7f65f5 100644
--- a/src/OCE/DYN/dynadv_cen2.F90
+++ b/src/OCE/DYN/dynadv_cen2.F90
@@ -30,29 +30,36 @@ MODULE dynadv_cen2
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: dynadv_cen2.F90 14834 2021-05-11 09:24:44Z hadcv $
+ !! $Id: dynadv_cen2.F90 14419 2021-02-09 12:22:16Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE dyn_adv_cen2( kt, Kmm, puu, pvv, Krhs )
+ SUBROUTINE dyn_adv_cen2( kt, Kmm, puu, pvv, Krhs, pau, pav, paw, no_zad )
!!----------------------------------------------------------------------
!! *** ROUTINE dyn_adv_cen2 ***
!!
- !! ** Purpose : Compute the now momentum advection trend in flux form
+ !! ** Purpose : Compute the momentum advection trend in flux form
!! and the general trend of the momentum equation.
!!
- !! ** Method : Trend evaluated using now fields (centered in time)
+ !! ** Method : Trend evaluated with a 2nd order centered scheme
+ !! using fields at Kmm time-level.
+ !! In RK3 time stepping case, the optional arguments (pau,pav,paw)
+ !! are present. They are used as advective velocity while
+ !! the advected velocity remains (puu,pvv).
!!
- !! ** Action : (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the now vorticity term trend
+ !! ** Action : (puu,pvv)(:,:,:,Krhs) updated with the advective trend
!!----------------------------------------------------------------------
- INTEGER , INTENT( in ) :: kt ! ocean time-step index
- INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ INTEGER , INTENT(in ) :: kt , Kmm, Krhs ! ocean time-step and level indices
+ INTEGER , OPTIONAL , INTENT(in ) :: no_zad ! no vertical advection computation
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), TARGET, INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, TARGET, INTENT(in ) :: pau, pav, paw ! advective velocity
!
INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfu_t, zfu_f, zfu_uw, zfu
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfv_t, zfv_f, zfv_vw, zfv, zfw
+ REAL(wp) :: zzu, zzv ! local scalars
+ REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfu_t, zfu_f, zfu_uw, zfu
+ REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfv_t, zfv_f, zfv_vw, zfv, zfw
+ REAL(wp), DIMENSION(:,:,:) , POINTER :: zpt_u, zpt_v, zpt_w
!!----------------------------------------------------------------------
!
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
@@ -68,12 +75,22 @@ CONTAINS
zfv_vw(:,:,:) = pvv(:,:,:,Krhs)
ENDIF
!
+ IF( PRESENT( pau ) ) THEN ! RK3: advective velocity (pau,pav,paw) /= advected velocity (puu,pvv,ww)
+ zpt_u => pau(:,:,:)
+ zpt_v => pav(:,:,:)
+ zpt_w => paw(:,:,:)
+ ELSE ! MLF: advective velocity = (puu,pvv,ww)
+ zpt_u => puu(:,:,:,Kmm)
+ zpt_v => pvv(:,:,:,Kmm)
+ zpt_w => ww (:,:,: )
+ ENDIF
+ !
! !== Horizontal advection ==!
!
DO jk = 1, jpkm1 ! horizontal transport
DO_2D( 1, 1, 1, 1 )
- zfu(ji,jj,jk) = 0.25_wp * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm)
- zfv(ji,jj,jk) = 0.25_wp * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm)
+ zfu(ji,jj,jk) = 0.25_wp * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * zpt_u(ji,jj,jk)
+ zfv(ji,jj,jk) = 0.25_wp * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * zpt_v(ji,jj,jk)
END_2D
DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes (at T- and F-point)
zfu_t(ji+1,jj ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) )
@@ -83,11 +100,11 @@ CONTAINS
END_2D
DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes
puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) &
- & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) &
- & / e3u(ji,jj,jk,Kmm)
+ & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) &
+ & / e3u(ji,jj,jk,Kmm)
pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfu_f(ji,jj ,jk) - zfu_f(ji-1,jj,jk) &
- & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) &
- & / e3v(ji,jj,jk,Kmm)
+ & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) &
+ & / e3v(ji,jj,jk,Kmm)
END_2D
END DO
!
@@ -99,42 +116,57 @@ CONTAINS
zfv_t(:,:,:) = pvv(:,:,:,Krhs)
ENDIF
!
- ! !== Vertical advection ==!
- !
- DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero
- zfu_uw(ji,jj,jpk) = 0._wp ; zfv_vw(ji,jj,jpk) = 0._wp
- zfu_uw(ji,jj, 1 ) = 0._wp ; zfv_vw(ji,jj, 1 ) = 0._wp
- END_2D
- IF( ln_linssh ) THEN ! linear free surface: advection through the surface
- DO_2D( 0, 0, 0, 0 )
- zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
- zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
- END_2D
- ENDIF
- DO jk = 2, jpkm1 ! interior advective fluxes
- DO_2D( 0, 1, 0, 1 ) ! 1/4 * Vertical transport
- zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
- END_2D
- DO_2D( 0, 0, 0, 0 )
- zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj ,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
- zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji ,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
+ IF( PRESENT( no_zad ) ) THEN !== No vertical advection ==! (except if linear free surface)
+ ! ==
+ IF( ln_linssh ) THEN ! linear free surface: advection through the surface z=0
+ DO_2D( 0, 0, 0, 0 )
+ zzu = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji+1,jj) * zpt_w(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
+ zzv = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji,jj+1) * zpt_w(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
+ puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) - zzu * r1_e1e2u(ji,jj) &
+ & / e3u(ji,jj,1,Kmm)
+ pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) - zzv * r1_e1e2v(ji,jj) &
+ & / e3v(ji,jj,1,Kmm)
+ END_2D
+ ENDIF
+ !
+ ELSE !== Vertical advection ==!
+ !
+ DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero
+ zfu_uw(ji,jj,jpk) = 0._wp ; zfv_vw(ji,jj,jpk) = 0._wp
+ zfu_uw(ji,jj, 1 ) = 0._wp ; zfv_vw(ji,jj, 1 ) = 0._wp
END_2D
- END DO
- DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence
- puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) &
- & / e3u(ji,jj,jk,Kmm)
- pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) &
- & / e3v(ji,jj,jk,Kmm)
- END_3D
- !
- IF( l_trddyn ) THEN ! trends: send trend to trddyn for diagnostic
- zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
- zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
- CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
+ IF( ln_linssh ) THEN ! linear free surface: advection through the surface z=0
+ DO_2D( 0, 0, 0, 0 )
+ zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji+1,jj) * zpt_w(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
+ zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji,jj+1) * zpt_w(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
+ END_2D
+ ENDIF
+ DO jk = 2, jpkm1 ! interior advective fluxes
+ DO_2D( 0, 1, 0, 1 ) ! 1/4 * Vertical transport
+ zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * zpt_w(ji,jj,jk)
+ END_2D
+ DO_2D( 0, 0, 0, 0 )
+ zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj ,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
+ zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji ,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
+ END_2D
+ END DO
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) &
+ & / e3u(ji,jj,jk,Kmm)
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) &
+ & / e3v(ji,jj,jk,Kmm)
+ END_3D
+ !
+ IF( l_trddyn ) THEN ! trends: send trend to trddyn for diagnostic
+ zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
+ zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
+ CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
+ ENDIF
+ ! ! Control print
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' cen2 adv - Ua: ', mask1=umask, &
+ & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
+ !
ENDIF
- ! ! Control print
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' cen2 adv - Ua: ', mask1=umask, &
- & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
!
END SUBROUTINE dyn_adv_cen2
diff --git a/src/OCE/DYN/dynadv_ubs.F90 b/src/OCE/DYN/dynadv_ubs.F90
index 50f73f6d4..645f6fa80 100644
--- a/src/OCE/DYN/dynadv_ubs.F90
+++ b/src/OCE/DYN/dynadv_ubs.F90
@@ -36,12 +36,12 @@ MODULE dynadv_ubs
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: dynadv_ubs.F90 14834 2021-05-11 09:24:44Z hadcv $
+ !! $Id: dynadv_ubs.F90 14419 2021-02-09 12:22:16Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE dyn_adv_ubs( kt, Kbb, Kmm, puu, pvv, Krhs )
+ SUBROUTINE dyn_adv_ubs( kt, Kbb, Kmm, puu, pvv, Krhs, pau, pav, paw, no_zad )
!!----------------------------------------------------------------------
!! *** ROUTINE dyn_adv_ubs ***
!!
@@ -64,20 +64,26 @@ CONTAINS
!! Default value (hard coded in the begining of the module) are
!! gamma1=1/3 and gamma2=1/32.
!!
- !! ** Action : - (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the 3D advective momentum trends
+ !! In RK3 time stepping case, the optional arguments
+ !! (pau,pav,paw) are present. They are used as advective velocity
+ !! while the advected velocity remains (puu,pvv).
+ !!
+ !! ** Action : (puu,pvv)(:,:,:,Krhs) updated with the advective trend
!!
!! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling.
!!----------------------------------------------------------------------
- INTEGER , INTENT( in ) :: kt ! ocean time-step index
- INTEGER , INTENT( in ) :: Kbb, Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ INTEGER , INTENT(in ) :: kt , Kbb, Kmm, Krhs ! ocean time-step and level indices
+ INTEGER , OPTIONAL , INTENT(in ) :: no_zad ! no vertical advection compotation
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), TARGET, INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, TARGET, INTENT(in ) :: pau, pav, paw ! advective velocity
!
INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: zui, zvj, zfuj, zfvi, zl_u, zl_v ! local scalars
+ REAL(wp) :: zui, zvj, zfuj, zfvi, zl_u, zl_v, zzu, zzv ! local scalars
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfu_t, zfu_f, zfu_uw, zfu
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfv_t, zfv_f, zfv_vw, zfv, zfw
REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) :: zlu_uu, zlu_uv
REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) :: zlv_vv, zlv_vu
+ REAL(wp), DIMENSION(:,:,:), POINTER :: zpt_u, zpt_v, zpt_w
!!----------------------------------------------------------------------
!
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
@@ -102,13 +108,24 @@ CONTAINS
zfu_uw(:,:,:) = puu(:,:,:,Krhs)
zfv_vw(:,:,:) = pvv(:,:,:,Krhs)
ENDIF
+ !
+ IF( PRESENT( pau ) ) THEN ! RK3: advective velocity (pau,pav,paw) /= advected velocity (puu,pvv,ww)
+ zpt_u => pau(:,:,:)
+ zpt_v => pav(:,:,:)
+ zpt_w => paw(:,:,:)
+ ELSE ! MLF: advective velocity = (puu,pvv,ww)
+ zpt_u => puu(:,:,:,Kmm)
+ zpt_v => pvv(:,:,:,Kmm)
+ zpt_w => ww (:,:,: )
+ ENDIF
+ !
! ! =========================== !
DO jk = 1, jpkm1 ! Laplacian of the velocity !
! ! =========================== !
! ! horizontal volume fluxes
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zfu(ji,jj,jk) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm)
- zfv(ji,jj,jk) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm)
+ zfu(ji,jj,jk) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * zpt_u(ji,jj,jk)
+ zfv(ji,jj,jk) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * zpt_v(ji,jj,jk)
END_2D
!
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! laplacian
@@ -157,8 +174,8 @@ CONTAINS
DO jk = 1, jpkm1 ! ====================== !
! ! horizontal volume fluxes
DO_2D( 1, 1, 1, 1 )
- zfu(ji,jj,jk) = 0.25_wp * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm)
- zfv(ji,jj,jk) = 0.25_wp * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm)
+ zfu(ji,jj,jk) = 0.25_wp * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * zpt_u(ji,jj,jk)
+ zfv(ji,jj,jk) = 0.25_wp * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * zpt_v(ji,jj,jk)
END_2D
!
DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes at T- and F-point
@@ -212,42 +229,62 @@ CONTAINS
! ! ==================== !
! ! Vertical advection !
! ! ==================== !
- DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero
- zfu_uw(ji,jj,jpk) = 0._wp
- zfv_vw(ji,jj,jpk) = 0._wp
- zfu_uw(ji,jj, 1 ) = 0._wp
- zfv_vw(ji,jj, 1 ) = 0._wp
- END_2D
- IF( ln_linssh ) THEN ! constant volume : advection through the surface
- DO_2D( 0, 0, 0, 0 )
- zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
- zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
- END_2D
- ENDIF
- DO jk = 2, jpkm1 ! interior fluxes
- DO_2D( 0, 1, 0, 1 )
- zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
- END_2D
- DO_2D( 0, 0, 0, 0 )
- zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
- zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
- END_2D
- END DO
- DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence
- puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) &
- & / e3u(ji,jj,jk,Kmm)
- pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) &
- & / e3v(ji,jj,jk,Kmm)
- END_3D
!
- IF( l_trddyn ) THEN ! save the vertical advection trend for diagnostic
- zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
- zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
- CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
+ ! ! ======================== !
+ IF( PRESENT( no_zad ) ) THEN ! No vertical advection ! (except if linear free surface)
+ ! ! ======================== ! ------
+ !
+ IF( ln_linssh ) THEN ! linear free surface: advection through the surface z=0
+ DO_2D( 0, 0, 0, 0 )
+ zzu = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji+1,jj) * zpt_w(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
+ zzv = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji,jj+1) * zpt_w(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
+ puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) - zzu * r1_e1e2u(ji,jj) &
+ & / e3u(ji,jj,1,Kmm)
+ pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) - zzv * r1_e1e2v(ji,jj) &
+ & / e3v(ji,jj,1,Kmm)
+ END_2D
+ ENDIF
+ ! ! =================== !
+ ELSE ! Vertical advection !
+ ! ! =================== !
+ DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero
+ zfu_uw(ji,jj,jpk) = 0._wp
+ zfv_vw(ji,jj,jpk) = 0._wp
+ zfu_uw(ji,jj, 1 ) = 0._wp
+ zfv_vw(ji,jj, 1 ) = 0._wp
+ END_2D
+ IF( ln_linssh ) THEN ! constant volume : advection through the surface
+ DO_2D( 0, 0, 0, 0 )
+ zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji+1,jj) * zpt_w(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
+ zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji,jj+1) * zpt_w(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
+ END_2D
+ ENDIF
+ DO jk = 2, jpkm1 ! interior fluxes
+ DO_2D( 0, 1, 0, 1 )
+ zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * zpt_w(ji,jj,jk)
+ END_2D
+ DO_2D( 0, 0, 0, 0 )
+ zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
+ zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
+ END_2D
+ END DO
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) &
+ & / e3u(ji,jj,jk,Kmm)
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) &
+ & / e3v(ji,jj,jk,Kmm)
+ END_3D
+ !
+ IF( l_trddyn ) THEN ! save the vertical advection trend for diagnostic
+ zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
+ zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
+ CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
+ ENDIF
+ ! ! Control print
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ubs2 adv - Ua: ', mask1=umask, &
+ & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
+ !
ENDIF
- ! ! Control print
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ubs2 adv - Ua: ', mask1=umask, &
- & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
!
END SUBROUTINE dyn_adv_ubs
diff --git a/src/OCE/DYN/dynhpg.F90 b/src/OCE/DYN/dynhpg.F90
index 3b4ead089..6d129dc6e 100644
--- a/src/OCE/DYN/dynhpg.F90
+++ b/src/OCE/DYN/dynhpg.F90
@@ -83,7 +83,7 @@ MODULE dynhpg
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: dynhpg.F90 15529 2021-11-23 15:00:19Z techene $
+ !! $Id: dynhpg.F90 15157 2021-07-29 08:28:32Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
diff --git a/src/OCE/DYN/dynspg.F90 b/src/OCE/DYN/dynspg.F90
index 24cd9455a..ffd2219a2 100644
--- a/src/OCE/DYN/dynspg.F90
+++ b/src/OCE/DYN/dynspg.F90
@@ -51,12 +51,12 @@ MODULE dynspg
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: dynspg.F90 14225 2020-12-19 14:58:39Z smasson $
+ !! $Id: dynspg.F90 14547 2021-02-25 17:07:15Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE dyn_spg( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa, k_only_ADV )
+ SUBROUTINE dyn_spg( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa )
!!----------------------------------------------------------------------
!! *** ROUTINE dyn_spg ***
!!
@@ -78,10 +78,9 @@ CONTAINS
INTEGER , INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! ocean time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
REAL(wp), DIMENSION(jpi,jpj,jpt) , INTENT(inout) :: pssh, puu_b, pvv_b ! SSH and barotropic velocities at main time levels
- INTEGER , OPTIONAL , INTENT( in ) :: k_only_ADV ! only Advection in the RHS
!
INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: z2dt, zg_2, zintp, zgrho0r, zld ! local scalars
+ REAL(wp) :: zg_2, zintp, zgrho0r, zld ! local scalars
REAL(wp) , DIMENSION(jpi,jpj) :: zpgu, zpgv ! 2D workspace
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpice
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
@@ -150,8 +149,8 @@ CONTAINS
!
IF( ln_wave .and. ln_bern_srfc ) THEN !== Add J terms: depth-independent Bernoulli head
DO_2D( 0, 0, 0, 0 )
- zpgu(ji,jj) = zpgu(ji,jj) + ( bhd_wave(ji+1,jj) - bhd_wave(ji,jj) ) / e1u(ji,jj) !++ bhd_wave from wave model in m2/s2 [BHD parameters in WW3]
- zpgv(ji,jj) = zpgv(ji,jj) + ( bhd_wave(ji,jj+1) - bhd_wave(ji,jj) ) / e2v(ji,jj)
+ zpgu(ji,jj) = zpgu(ji,jj) + ( bhd_wave(ji+1,jj) - bhd_wave(ji,jj) ) * r1_e1u(ji,jj) !++ bhd_wave from wave model in m2/s2 [BHD parameters in WW3]
+ zpgv(ji,jj) = zpgv(ji,jj) + ( bhd_wave(ji,jj+1) - bhd_wave(ji,jj) ) * r1_e2v(ji,jj)
END_2D
ENDIF
!
@@ -166,7 +165,7 @@ CONTAINS
!
SELECT CASE ( nspg ) !== surface pressure gradient computed and add to the general trend ==!
CASE ( np_EXP ) ; CALL dyn_spg_exp( kt, Kmm, puu, pvv, Krhs ) ! explicit
- CASE ( np_TS ) ; CALL dyn_spg_ts ( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa, k_only_ADV ) ! time-splitting
+ CASE ( np_TS ) ; CALL dyn_spg_ts ( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa ) ! time-splitting
END SELECT
!
IF( l_trddyn ) THEN ! save the surface pressure gradient trends for further diagnostics
diff --git a/src/OCE/DYN/dynspg_ts.F90 b/src/OCE/DYN/dynspg_ts.F90
index 06840a712..911cf67f5 100644
--- a/src/OCE/DYN/dynspg_ts.F90
+++ b/src/OCE/DYN/dynspg_ts.F90
@@ -67,6 +67,7 @@ MODULE dynspg_ts
PUBLIC dyn_spg_ts ! called by dyn_spg
PUBLIC dyn_spg_ts_init ! - - dyn_spg_init
+ PUBLIC dyn_drg_init ! called by stp2d
!! Time filtered arrays at baroclinic time step:
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv , vn_adv !: Advection vel. at "now" barocl. step
@@ -79,6 +80,10 @@ MODULE dynspg_ts
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftnw, ftne ! triad of coriolis parameter
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse ! (only used with een vorticity scheme)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshe_rhs ! RHS of ssh Eq.
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: Ue_rhs, Ve_rhs ! RHS of barotropic velocity Eq.
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: CdU_u, CdU_v ! top/bottom stress at u- & v-points
+
REAL(wp) :: r1_12 = 1._wp / 12._wp ! local ratios
REAL(wp) :: r1_8 = 0.125_wp !
REAL(wp) :: r1_4 = 0.25_wp !
@@ -89,7 +94,7 @@ MODULE dynspg_ts
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: dynspg_ts.F90 15489 2021-11-10 09:18:39Z jchanut $
+ !! $Id: dynspg_ts.F90 14747 2021-04-26 08:47:14Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -116,7 +121,7 @@ CONTAINS
END FUNCTION dyn_spg_ts_alloc
- SUBROUTINE dyn_spg_ts( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa, k_only_ADV )
+ SUBROUTINE dyn_spg_ts( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa )
!!----------------------------------------------------------------------
!!
!! ** Purpose : - Compute the now trend due to the explicit time stepping
@@ -144,27 +149,24 @@ CONTAINS
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! ocean time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
- REAL(wp), DIMENSION(jpi,jpj,jpt) , INTENT(inout) :: pssh, puu_b, pvv_b ! SSH and barotropic velocities at main time levels
- INTEGER , OPTIONAL , INTENT( in ) :: k_only_ADV ! only Advection in the RHS
+ REAL(wp), DIMENSION(jpi,jpj ,jpt), INTENT(inout) :: pssh, puu_b, pvv_b ! SSH and barotropic velocities at main time levels
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
LOGICAL :: ll_fw_start ! =T : forward integration
LOGICAL :: ll_init ! =T : special startup of 2d equations
INTEGER :: noffset ! local integers : time offset for bdy update
- REAL(wp) :: r1_Dt_b, z1_hu, z1_hv ! local scalars
- REAL(wp) :: za0, za1, za2, za3 ! - -
+ REAL(wp) :: z1_hu , z1_hv ! local scalars
+ REAL(wp) :: zzsshu, zzsshv ! - -
+ REAL(wp) :: za0, za1, za2, za3 ! - -
REAL(wp) :: zztmp, zldg ! - -
- REAL(wp) :: zhu_bck, zhv_bck, zhdiv ! - -
- REAL(wp) :: zun_save, zvn_save ! - -
+ 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) :: 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
REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v ! top/bottom stress at u- & v-points
REAL(wp), DIMENSION(jpi,jpj) :: zhU, zhV ! fluxes
-!!st#if defined key_qco
-!!st REAL(wp), DIMENSION(jpi, jpj, jpk) :: ze3u, ze3v
-!!st#endif
!
REAL(wp) :: zwdramp ! local scalar - only used if ln_wd_dl = .True.
@@ -174,6 +176,7 @@ CONTAINS
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zcpx, zcpy ! Wetting/Dying gravity filter coef.
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztwdmask, zuwdmask, zvwdmask ! ROMS wetting and drying masks at t,u,v points
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zuwdav2, zvwdav2 ! averages over the sub-steps of zuwdmask and zvwdmask
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d ! 2D workspace
REAL(wp) :: zt0substep ! Time of day at the beginning of the time substep
!!----------------------------------------------------------------------
!
@@ -184,7 +187,6 @@ CONTAINS
zwdramp = r_rn_wdmin1 ! simplest ramp
! zwdramp = 1._wp / (rn_wdmin2 - rn_wdmin1) ! more general ramp
! ! inverse of baroclinic time step
- r1_Dt_b = 1._wp / rDt
!
ll_init = ln_bt_av ! if no time averaging, then no specific restart
ll_fw_start = .FALSE.
@@ -227,17 +229,44 @@ CONTAINS
! -----------------------------------------------------------------------------
! Phase 1 : Coupling between general trend and barotropic estimates (1st step)
! -----------------------------------------------------------------------------
+#if defined key_RK3
+ ! !========================================!
+ ! !== Phase 1 for RK3 time integration ==!
+ ! !========================================!
+ !
+ ! ! Currently, RK3 requires the forward mode
+ IF( kt == nit000 ) THEN
+ IF( .NOT.ln_bt_fw ) CALL ctl_stop( 'dyn_spg_ts: RK3 requires forward mode (ln_bt_fw=T)' )
+ ENDIF
+ !
+ ! ! set values computed in RK3_ssh
+ zssh_frc(:,:) = sshe_rhs(:,:)
+ zu_frc(:,:) = Ue_rhs(:,:)
+ zv_frc(:,:) = Ve_rhs(:,:)
+ zCdU_u (:,:) = CdU_u (:,:)
+ zCdU_v (:,:) = CdU_v (:,:)
+
+!!gm ==>>> !!ts ISSUe her on en discute changer les cas ENS ENE et triad ?
+ IF( kt == nit000 .OR. .NOT. ln_linssh ) CALL dyn_cor_2D_init( Kmm ) ! Set zwz, the barotropic Coriolis force coefficient
+ ! ! recompute zwz = f/depth at every time step for (.NOT.ln_linssh) as the water colomn height changes
+ !
+
+#else
+ ! !========================================!
+ ! !== Phase 1 for MLF time integration ==!
+ ! !========================================!
+ !
!
!
! != zu_frc = 1/H e3*d/dt(Ua) =! (Vertical mean of Ua, the 3D trends)
! ! --------------------------- !
-#if defined key_qco
+# if defined key_qco
zu_frc(:,:) = SUM( e3u_0(:,:,: ) * puu(:,:,:,Krhs) * umask(:,:,:), DIM=3 ) * r1_hu_0(:,:)
zv_frc(:,:) = SUM( e3v_0(:,:,: ) * pvv(:,:,:,Krhs) * vmask(:,:,:), DIM=3 ) * r1_hv_0(:,:)
-#else
+# else
zu_frc(:,:) = SUM( e3u(:,:,:,Kmm) * puu(:,:,:,Krhs) * umask(:,:,:), DIM=3 ) * r1_hu(:,:,Kmm)
zv_frc(:,:) = SUM( e3v(:,:,:,Kmm) * pvv(:,:,:,Krhs) * vmask(:,:,:), DIM=3 ) * r1_hv(:,:,Kmm)
-#endif
+# endif
!
!
! != U(Krhs) => baroclinic trend =! (remove its vertical mean)
@@ -255,29 +284,21 @@ CONTAINS
IF( kt == nit000 .OR. .NOT. ln_linssh ) CALL dyn_cor_2D_init( Kmm ) ! Set zwz, the barotropic Coriolis force coefficient
! ! recompute zwz = f/depth at every time step for (.NOT.ln_linssh) as the water colomn height changes
!
- IF( .NOT. PRESENT(k_only_ADV) ) THEN !* remove the 2D Coriolis trend
- zhU(:,:) = puu_b(:,:,Kmm) * hu(:,:,Kmm) * e2u(:,:) ! now fluxes
- zhV(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:) ! NB: FULL domain : put a value in last row and column
- !
- CALL dyn_cor_2d( ht(:,:), hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV, & ! <<== in
- & zu_trd, zv_trd ) ! ==>> out
- !
- DO_2D( 0, 0, 0, 0 ) ! Remove coriolis term (and possibly spg) from barotropic trend
- zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj)
- zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj)
- END_2D
- ENDIF
+ zhU(:,:) = puu_b(:,:,Kmm) * hu(:,:,Kmm) * e2u(:,:) ! now fluxes
+ zhV(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:) ! NB: FULL domain : put a value in last row and column
+ !
+ CALL dyn_cor_2D( ht(:,:), hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV, & ! <<== in
+ & zu_trd, zv_trd ) ! ==>> out
+ !
+ DO_2D( 0, 0, 0, 0 ) ! Remove coriolis term (and possibly spg) from barotropic trend
+ zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj)
+ zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj)
+ END_2D
!
! != Add bottom stress contribution from baroclinic velocities =!
! ! ----------------------------------------------------------- !
- IF( PRESENT(k_only_ADV) ) THEN !* only Advection in the RHS : provide the barotropic bottom drag coefficients
- DO_2D( 0, 0, 0, 0 )
- zCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )
- zCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )
- END_2D
- ELSE !* remove baroclinic drag AND provide the barotropic drag coefficients
- CALL dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b, pvv_b, zu_frc, zv_frc, zCdU_u, zCdU_v )
- ENDIF
+ CALL dyn_drg_init( Kbb, Kmm, puu , pvv , puu_b , pvv_b , & ! <<= IN
+ & zu_frc, zv_frc, zCdU_u, zCdU_v ) ! =>> OUT
!
! != Add atmospheric pressure forcing =!
! ! ---------------------------------- !
@@ -347,13 +368,18 @@ CONTAINS
!
END IF
!
-#if defined key_asminc
+# if defined key_asminc
! != Add the IAU weighted SSH increment =!
! ! ------------------------------------ !
IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:)
ENDIF
+# endif
+
+ ! !== END of Phase 1 for MLF time integration ==!
#endif
+
+
! != Fill boundary data arrays for AGRIF
! ! ------------------------------------
#if defined key_agrif
@@ -596,7 +622,7 @@ CONTAINS
! zwz array below or triads normally depend on sea level with ln_linssh=F and should be updated
! at each time step. We however keep them constant here for optimization.
! Recall that zhU and zhV hold fluxes at jn+0.5 (extrapolated not backward interpolated)
- CALL dyn_cor_2d( zhtp2_e, zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV, zu_trd, zv_trd )
+ CALL dyn_cor_2D( zhtp2_e, zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV, zu_trd, zv_trd )
!
! Add tidal astronomical forcing if defined
IF ( ln_tide .AND. ln_tide_pot ) THEN
@@ -712,34 +738,94 @@ CONTAINS
sshbb_e(:,:) = sshb_e(:,:)
sshb_e (:,:) = sshn_e(:,:)
sshn_e (:,:) = ssha_e(:,:)
-
- ! !* Sum over whole bt loop
+ !
+ ! !* Sum over whole bt loop (except in weight average)
! ! ----------------------
- za1 = wgtbtp1(jn)
- IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! Sum velocities
- puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:)
- pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:)
- ELSE ! Sum transports
- IF ( .NOT.ln_wd_dl ) THEN
- puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:) * hu_e (:,:)
- pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:) * hv_e (:,:)
- ELSE
- puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:) * hu_e (:,:) * zuwdmask(:,:)
- pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:) * hv_e (:,:) * zvwdmask(:,:)
- END IF
+ IF( ln_bt_av ) THEN
+ za1 = wgtbtp1(jn)
+ IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! Sum velocities
+ puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:)
+ pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:)
+ ELSE ! Sum transports
+ IF ( .NOT.ln_wd_dl ) THEN
+ puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:) * hu_e (:,:)
+ pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:) * hv_e (:,:)
+ ELSE
+ puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:) * hu_e (:,:) * zuwdmask(:,:)
+ pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:) * hv_e (:,:) * zvwdmask(:,:)
+ ENDIF
+ ENDIF
+ ! ! Sum sea level
+ pssh(:,:,Kaa) = pssh(:,:,Kaa) + za1 * ssha_e(:,:)
ENDIF
- ! ! Sum sea level
- pssh(:,:,Kaa) = pssh(:,:,Kaa) + za1 * ssha_e(:,:)
-
+ !
! ! ==================== !
END DO ! end loop !
! ! ==================== !
+
+
! -----------------------------------------------------------------------------
! Phase 3. update the general trend with the barotropic trend
! -----------------------------------------------------------------------------
!
- ! Set advection velocity correction:
- IF (ln_bt_fw) THEN
+ IF(.NOT.ln_bt_av ) THEN !* Update Kaa barotropic external mode
+ puu_b(:,:,Kaa) = ua_e (:,:)
+ pvv_b(:,:,Kaa) = va_e (:,:)
+ pssh (:,:,Kaa) = ssha_e(:,:)
+ ENDIF
+
+#if defined key_RK3
+ ! !* RK3 case
+ !
+ IF(.NOT.ln_dynadv_vec .AND. ln_bt_av ) THEN ! at this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points
+ !
+# if defined key_qcoTest_FluxForm
+ ! ! 'key_qcoTest_FluxForm' : simple ssh average
+ DO_2D( 0, 0, 0, 0 )
+ zzsshu = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji+1,jj ,Kaa) ) * ssumask(ji,jj)
+ zzsshv = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji ,jj+1,Kaa) ) * ssvmask(ji,jj)
+ !
+ ! ! Save barotropic velocities (not transport)
+ puu_b(ji,jj,Kaa) = puu_b(ji,jj,Kaa) / ( hu_0(ji,jj) + zzsshu + 1._wp - ssumask(ji,jj) )
+ pvv_b(ji,jj,Kaa) = pvv_b(ji,jj,Kaa) / ( hv_0(ji,jj) + zzsshv + 1._wp - ssvmask(ji,jj) )
+ END_2D
+# else
+ DO_2D( 0, 0, 0, 0 )
+ zzsshu = r1_2 * r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj) * pssh(ji ,jj,Kaa) &
+ & + e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) * ssumask(ji,jj)
+ zzsshv = r1_2 * r1_e1e2v(ji,jj) * ( e1e2t(ji,jj ) * pssh(ji,jj ,Kaa) &
+ & + e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) * ssvmask(ji,jj)
+ !
+ ! ! Save barotropic velocities (not transport)
+ puu_b(ji,jj,Kaa) = puu_b(ji,jj,Kaa) / ( hu_0(ji,jj) + zzsshu + 1._wp - ssumask(ji,jj) )
+ pvv_b(ji,jj,Kaa) = pvv_b(ji,jj,Kaa) / ( hv_0(ji,jj) + zzsshv + 1._wp - ssvmask(ji,jj) )
+ END_2D
+# endif
+ !
+ CALL lbc_lnk_multi( 'dynspg_ts', puu_b, 'U', -1._wp, pvv_b, 'V', -1._wp ) ! Boundary conditions
+ !
+ ENDIF
+ !
+ ! advective transport from N to N+1 (i.e. Kbb to Kaa)
+ ub2_b(:,:) = un_adv(:,:) ! Save integrated transport for next computation (NOT USED)
+ vb2_b(:,:) = vn_adv(:,:)
+ !
+ IF( iom_use("ubar") ) THEN ! RK3 single first: hu[N+1/2] = 1/2 ( hu[N] + hu[N+1] )
+ ALLOCATE( z2d(jpi,jpj) )
+ z2d(:,:) = 2._wp / ( hu_e(:,:) + hu(:,:,Kbb) + 1._wp - ssumask(:,:) )
+ CALL iom_put( "ubar", un_adv(:,:)*z2d(:,:) ) ! barotropic i-current
+ z2d(:,:) = 2._wp / ( hv_e(:,:) + hv(:,:,Kbb) + 1._wp - ssvmask(:,:) )
+ CALL iom_put( "vbar", vn_adv(:,:)*z2d(:,:) ) ! barotropic i-current
+ DEALLOCATE( z2d )
+ ENDIF
+ !
+ ! !== END Phase 3 for RK3 (forward mode) ==!
+
+#else
+ ! !* MLF case
+ !
+ ! Set advective velocity correction:
+ IF( ln_bt_fw ) THEN
IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zun_save = un_adv(ji,jj)
@@ -759,44 +845,53 @@ CONTAINS
vn_bf(:,:) = 0._wp
ub2_b(:,:) = un_adv(:,:) ! Save integrated transport for next computation
vb2_b(:,:) = vn_adv(:,:)
- END IF
+ ENDIF
ENDIF
-
-
!
! Update barotropic trend:
IF( ln_dynadv_vec .OR. ln_linssh ) THEN
DO jk=1,jpkm1
- puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) ) * r1_Dt_b
- pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) ) * r1_Dt_b
+ puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) ) * r1_Dt
+ pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) ) * r1_Dt
END DO
ELSE
- ! At this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points
-#if defined key_qcoTest_FluxForm
- ! ! 'key_qcoTest_FluxForm' : simple ssh average
- DO_2D( 1, 0, 1, 0 )
- zsshu_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji+1,jj ,Kaa) ) * ssumask(ji,jj)
- zsshv_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji ,jj+1,Kaa) ) * ssvmask(ji,jj)
- END_2D
-#else
- DO_2D( 1, 0, 1, 0 )
- zsshu_a(ji,jj) = r1_2 * r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj) * pssh(ji ,jj,Kaa) &
- & + e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) * ssumask(ji,jj)
- zsshv_a(ji,jj) = r1_2 * r1_e1e2v(ji,jj) * ( e1e2t(ji,jj ) * pssh(ji,jj ,Kaa) &
- & + e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) * ssvmask(ji,jj)
- END_2D
-#endif
- CALL lbc_lnk( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
- !
- DO jk=1,jpkm1
- puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) &
- & * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt_b
- pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) &
- & * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt_b
- END DO
- ! Save barotropic velocities not transport:
- puu_b(:,:,Kaa) = puu_b(:,:,Kaa) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) )
- pvv_b(:,:,Kaa) = pvv_b(:,:,Kaa) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) )
+ IF(.NOT.ln_bt_av ) THEN ! (puu_b,pvv_b)_Kaa is a velocity (hu,hv)_Kaa = (hu_e,hv_e)
+ !
+ DO jk=1,jpkm1
+ puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) &
+ & * ( puu_b(:,:,Kaa)*hu_e(:,:) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt
+ pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) &
+ & * ( pvv_b(:,:,Kaa)*hv_e(:,:) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt
+ END DO
+ !
+ ELSE ! at this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points
+ !
+# if defined key_qcoTest_FluxForm
+ ! ! 'key_qcoTest_FluxForm' : simple ssh average
+ DO_2D( 1, 0, 1, 0 )
+ zsshu_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji+1,jj ,Kaa) ) * ssumask(ji,jj)
+ zsshv_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji ,jj+1,Kaa) ) * ssvmask(ji,jj)
+ END_2D
+# else
+ DO_2D( 1, 0, 1, 0 )
+ zsshu_a(ji,jj) = r1_2 * r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj) * pssh(ji ,jj,Kaa) &
+ & + e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) * ssumask(ji,jj)
+ zsshv_a(ji,jj) = r1_2 * r1_e1e2v(ji,jj) * ( e1e2t(ji,jj ) * pssh(ji,jj ,Kaa) &
+ & + e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) * ssvmask(ji,jj)
+ END_2D
+# endif
+ CALL lbc_lnk( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
+ !
+ DO jk=1,jpkm1
+ puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) &
+ & * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt
+ pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) &
+ & * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt
+ END DO
+ ! Save barotropic velocities not transport:
+ puu_b(:,:,Kaa) = puu_b(:,:,Kaa) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) )
+ pvv_b(:,:,Kaa) = pvv_b(:,:,Kaa) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) )
+ ENDIF
ENDIF
@@ -806,18 +901,21 @@ CONTAINS
pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) + vn_adv(:,:)*r1_hv(:,:,Kmm) - pvv_b(:,:,Kmm) ) * vmask(:,:,jk)
END DO
- IF ( ln_wd_dl .and. ln_wd_dl_bc) THEN
+ IF( ln_wd_dl .AND. ln_wd_dl_bc) THEN
DO jk = 1, jpkm1
puu(:,:,jk,Kmm) = ( un_adv(:,:)*r1_hu(:,:,Kmm) &
- & + zuwdav2(:,:)*(puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm)) ) * umask(:,:,jk)
+ & + zuwdav2(:,:)*(puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm)) ) * umask(:,:,jk)
pvv(:,:,jk,Kmm) = ( vn_adv(:,:)*r1_hv(:,:,Kmm) &
- & + zvwdav2(:,:)*(pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm)) ) * vmask(:,:,jk)
+ & + zvwdav2(:,:)*(pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm)) ) * vmask(:,:,jk)
END DO
- END IF
-
-
+ ENDIF
+
CALL iom_put( "ubar", un_adv(:,:)*r1_hu(:,:,Kmm) ) ! barotropic i-current
CALL iom_put( "vbar", vn_adv(:,:)*r1_hv(:,:,Kmm) ) ! barotropic i-current
+
+ ! !== END Phase 3 for MLF time integration ==!
+#endif
+
!
#if defined key_agrif
! Save time integrated fluxes during child grid integration
@@ -845,80 +943,80 @@ CONTAINS
!
END SUBROUTINE dyn_spg_ts
-
- SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2)
+
+ SUBROUTINE ts_wgt( ll_av, ll_fw, Kpit, zwgt1, zwgt2)
!!---------------------------------------------------------------------
!! *** ROUTINE ts_wgt ***
!!
!! ** Purpose : Set time-splitting weights for temporal averaging (or not)
!!----------------------------------------------------------------------
- LOGICAL, INTENT(in) :: ll_av ! temporal averaging=.true.
- LOGICAL, INTENT(in) :: ll_fw ! forward time splitting =.true.
- INTEGER, INTENT(inout) :: jpit ! cycle length
- REAL(wp), DIMENSION(3*nn_e), INTENT(inout) :: zwgt1, & ! Primary weights
- zwgt2 ! Secondary weights
-
- INTEGER :: jic, jn, ji ! temporary integers
- REAL(wp) :: za1, za2
+ LOGICAL, INTENT(in ) :: ll_av ! temporal averaging=.true.
+ LOGICAL, INTENT(in ) :: ll_fw ! forward time splitting =.true.
+ INTEGER, INTENT(inout) :: Kpit ! cycle length
+ !!
+ INTEGER :: jic, jn, ji ! local integers
+ REAL(wp) :: za1, za2 ! loca scalars
+ REAL(wp), DIMENSION(3*nn_e), INTENT(inout) :: zwgt1, zwgt2 ! Primary & Secondary weights
!!----------------------------------------------------------------------
-
+ !
zwgt1(:) = 0._wp
zwgt2(:) = 0._wp
-
- ! Set time index when averaged value is requested
- IF (ll_fw) THEN
- jic = nn_e
- ELSE
- jic = 2 * nn_e
+ !
+ ! !== Set time index when averaged value is requested ==!
+ IF (ll_fw) THEN ; jic = nn_e
+ ELSE ; jic = 2 * nn_e
ENDIF
-
- ! Set primary weights:
- IF (ll_av) THEN
- ! Define simple boxcar window for primary weights
- ! (width = nn_e, centered around jic)
- SELECT CASE ( nn_bt_flt )
- CASE( 0 ) ! No averaging
- zwgt1(jic) = 1._wp
- jpit = jic
-
- CASE( 1 ) ! Boxcar, width = nn_e
- DO jn = 1, 3*nn_e
- za1 = ABS(float(jn-jic))/float(nn_e)
- IF (za1 < 0.5_wp) THEN
- zwgt1(jn) = 1._wp
- jpit = jn
- ENDIF
- ENDDO
-
- CASE( 2 ) ! Boxcar, width = 2 * nn_e
- DO jn = 1, 3*nn_e
- za1 = ABS(float(jn-jic))/float(nn_e)
- IF (za1 < 1._wp) THEN
- zwgt1(jn) = 1._wp
- jpit = jn
- ENDIF
- ENDDO
- CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt' )
+ !
+ ! !== Set primary weights ==!
+ !
+ IF (ll_av) THEN != Define simple boxcar window for primary weights
+ ! ! (width = nn_e, centered around jic)
+ SELECT CASE( nn_bt_flt )
+ !
+ CASE( 0 ) ! No averaging
+ zwgt1(jic) = 1._wp
+ Kpit = jic
+ !
+ CASE( 1 ) ! Boxcar, width = nn_e
+ DO jn = 1, 3*nn_e
+ za1 = ABS( REAL( jn-jic, wp) ) / REAL( nn_e, wp )
+ IF( za1 < 0.5_wp ) THEN
+ zwgt1(jn) = 1._wp
+ Kpit = jn
+ ENDIF
+ END DO
+ !
+ CASE( 2 ) ! Boxcar, width = 2 * nn_e
+ DO jn = 1, 3*nn_e
+ za1 = ABS(REAL( jn-jic, wp) ) / REAL( nn_e, wp )
+ IF( za1 < 1._wp ) THEN
+ zwgt1(jn) = 1._wp
+ Kpit = jn
+ ENDIF
+ END DO
+ !
+ CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt' )
+ !
END SELECT
- ELSE ! No time averaging
+ ELSE != No time averaging
zwgt1(jic) = 1._wp
- jpit = jic
+ Kpit = jic
ENDIF
-
- ! Set secondary weights
- DO jn = 1, jpit
- DO ji = jn, jpit
- zwgt2(jn) = zwgt2(jn) + zwgt1(ji)
- END DO
+ !
+ ! !== Set secondary weights ==!
+ DO jn = 1, Kpit
+ DO ji = jn, Kpit
+ zwgt2(jn) = zwgt2(jn) + zwgt1(ji)
+ END DO
END DO
-
- ! Normalize weigths:
- za1 = 1._wp / SUM(zwgt1(1:jpit))
- za2 = 1._wp / SUM(zwgt2(1:jpit))
- DO jn = 1, jpit
- zwgt1(jn) = zwgt1(jn) * za1
- zwgt2(jn) = zwgt2(jn) * za2
+ !
+ ! !== Normalize weigths ==!
+ za1 = 1._wp / SUM( zwgt1(1:Kpit) )
+ za2 = 1._wp / SUM( zwgt2(1:Kpit) )
+ DO jn = 1, Kpit
+ zwgt1(jn) = zwgt1(jn) * za1
+ zwgt2(jn) = zwgt2(jn) * za2
END DO
!
END SUBROUTINE ts_wgt
@@ -1034,14 +1132,13 @@ CONTAINS
ELSE
IF(lwp) WRITE(numout,*) ' ln_ts_auto=.false.: Use nn_e in namelist nn_e = ', nn_e
ENDIF
-
+ !
IF(ln_bt_av) THEN
IF(lwp) WRITE(numout,*) ' ln_bt_av =.true. ==> Time averaging over nn_e time steps is on '
ELSE
IF(lwp) WRITE(numout,*) ' ln_bt_av =.false. => No time averaging of barotropic variables '
ENDIF
!
- !
IF(ln_bt_fw) THEN
IF(lwp) WRITE(numout,*) ' ln_bt_fw=.true. => Forward integration of barotropic variables '
ELSE
@@ -1099,7 +1196,8 @@ CONTAINS
!! To remove this approximation, copy lines below inside barotropic loop
!! and update depths at T- points (ht) at each barotropic time step
!!
- !! Compute zwz = f / ( height of the water colomn )
+ !! Compute zwz = f/h (potential planetary voricity)
+ !! Compute ftne, ftnw, ftse, ftsw (triad of potential planetary voricity)
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: Kmm ! Time index
INTEGER :: ji ,jj, jk ! dummy loop indices
@@ -1149,13 +1247,13 @@ CONTAINS
END_2D
!
END SELECT
-
- END SUBROUTINE dyn_cor_2d_init
+ !
+ END SUBROUTINE dyn_cor_2D_init
- SUBROUTINE dyn_cor_2d( pht, phu, phv, punb, pvnb, zhU, zhV, zu_trd, zv_trd )
+ SUBROUTINE dyn_cor_2D( pht, phu, phv, punb, pvnb, zhU, zhV, zu_trd, zv_trd )
!!---------------------------------------------------------------------
- !! *** ROUTINE dyn_cor_2d ***
+ !! *** ROUTINE dyn_cor_2D ***
!!
!! ** Purpose : Compute u and v coriolis trends
!!----------------------------------------------------------------------
@@ -1298,11 +1396,13 @@ CONTAINS
!!
!! ** Purpose :
!!----------------------------------------------------------------------
- INTEGER :: ji ,jj ! dummy loop indices
- LOGICAL :: ll_tmp1, ll_tmp2
REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pshn
REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zcpx, zcpy
+ !
+ INTEGER :: ji ,jj ! dummy loop indices
+ LOGICAL :: ll_tmp1, ll_tmp2
!!----------------------------------------------------------------------
+ !
DO_2D( 0, 0, 0, 0 )
ll_tmp1 = MIN( pshn(ji,jj) , pshn(ji+1,jj) ) > &
& MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. &
@@ -1341,7 +1441,7 @@ CONTAINS
zcpy(ji,jj) = 0._wp
ENDIF
END_2D
-
+ !
END SUBROUTINE wad_spg
@@ -1385,15 +1485,13 @@ CONTAINS
! !== BOTTOM stress contribution from baroclinic velocities ==!
!
IF( ln_bt_fw ) THEN ! FORWARD integration: use NOW bottom baroclinic velocities
-
DO_2D( 0, 0, 0, 0 )
ikbu = mbku(ji,jj)
ikbv = mbkv(ji,jj)
zu_i(ji,jj) = puu(ji,jj,ikbu,Kmm) - puu_b(ji,jj,Kmm)
zv_i(ji,jj) = pvv(ji,jj,ikbv,Kmm) - pvv_b(ji,jj,Kmm)
END_2D
- ELSE ! CENTRED integration: use BEFORE bottom baroclinic velocities
-
+ ELSE ! CENTRED integration: use BEFORE bottom baroclinic velocities
DO_2D( 0, 0, 0, 0 )
ikbu = mbku(ji,jj)
ikbv = mbkv(ji,jj)
@@ -1411,7 +1509,6 @@ CONTAINS
& r1_hv(ji,jj,Kmm) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp )
END_2D
ELSE ! use "unclipped" drag (even if explicit friction is used in 3D calculation)
-
DO_2D( 0, 0, 0, 0 )
pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj)
pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj)
@@ -1423,15 +1520,13 @@ CONTAINS
IF( ln_isfcav.OR.ln_drgice_imp ) THEN
!
IF( ln_bt_fw ) THEN ! FORWARD integration: use NOW top baroclinic velocity
-
DO_2D( 0, 0, 0, 0 )
iktu = miku(ji,jj)
iktv = mikv(ji,jj)
zu_i(ji,jj) = puu(ji,jj,iktu,Kmm) - puu_b(ji,jj,Kmm)
zv_i(ji,jj) = pvv(ji,jj,iktv,Kmm) - pvv_b(ji,jj,Kmm)
END_2D
- ELSE ! CENTRED integration: use BEFORE top baroclinic velocity
-
+ ELSE ! CENTRED integration: use BEFORE top baroclinic velocity
DO_2D( 0, 0, 0, 0 )
iktu = miku(ji,jj)
iktv = mikv(ji,jj)
@@ -1439,9 +1534,7 @@ CONTAINS
zv_i(ji,jj) = pvv(ji,jj,iktv,Kbb) - pvv_b(ji,jj,Kbb)
END_2D
ENDIF
- !
- ! ! use "unclipped" top drag (even if explicit friction is used in 3D calculation)
-
+ ! ! use "unclipped" top drag (even if explicit friction is used in 3D calculation)
DO_2D( 0, 0, 0, 0 )
pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj)
pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj)
@@ -1451,6 +1544,7 @@ CONTAINS
!
END SUBROUTINE dyn_drg_init
+
SUBROUTINE ts_bck_interp( jn, ll_init, & ! <== in
& za0, za1, za2, za3 ) ! ==> out
!!----------------------------------------------------------------------
@@ -1488,6 +1582,5 @@ CONTAINS
ENDIF
END SUBROUTINE ts_bck_interp
-
!!======================================================================
END MODULE dynspg_ts
diff --git a/src/OCE/DYN/dynvor.F90 b/src/OCE/DYN/dynvor.F90
index 6d85a14ae..0dde705b2 100644
--- a/src/OCE/DYN/dynvor.F90
+++ b/src/OCE/DYN/dynvor.F90
@@ -50,6 +50,10 @@ MODULE dynvor
IMPLICIT NONE
PRIVATE
+
+ INTERFACE dyn_vor
+ MODULE PROCEDURE dyn_vor_3D, dyn_vor_RK3
+ END INTERFACE
PUBLIC dyn_vor ! routine called by step.F90
PUBLIC dyn_vor_init ! routine called by nemogcm.F90
@@ -73,8 +77,9 @@ MODULE dynvor
INTEGER, PUBLIC, PARAMETER :: np_EEN = 4 ! EEN scheme
INTEGER, PUBLIC, PARAMETER :: np_MIX = 5 ! MIX scheme
- INTEGER :: ncor, nrvm, ntot ! choice of calculated vorticity
- ! ! associated indices:
+ ! !: choice of calculated vorticity
+ INTEGER, PUBLIC :: ncor, nrvm, ntot ! Coriolis, relative vorticity, total vorticity
+ ! ! associated indices:
INTEGER, PUBLIC, PARAMETER :: np_COR = 1 ! Coriolis (planetary)
INTEGER, PUBLIC, PARAMETER :: np_RVO = 2 ! relative vorticity
INTEGER, PUBLIC, PARAMETER :: np_MET = 3 ! metric term
@@ -98,12 +103,12 @@ MODULE dynvor
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: dynvor.F90 14834 2021-05-11 09:24:44Z hadcv $
+ !! $Id: dynvor.F90 14547 2021-02-25 17:07:15Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
-
- SUBROUTINE dyn_vor( kt, Kmm, puu, pvv, Krhs )
+
+ SUBROUTINE dyn_vor_3D( kt, Kmm, puu, pvv, Krhs )
!!----------------------------------------------------------------------
!!
!! ** Purpose : compute the lateral ocean tracer physics.
@@ -120,7 +125,7 @@ CONTAINS
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
!!----------------------------------------------------------------------
!
- IF( ln_timing ) CALL timing_start('dyn_vor')
+ IF( ln_timing ) CALL timing_start('dyn_vor_3D')
!
IF( l_trddyn ) THEN !== trend diagnostics case : split the added trend in two parts ==!
!
@@ -208,9 +213,85 @@ CONTAINS
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' vor - Ua: ', mask1=umask, &
& tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
!
- IF( ln_timing ) CALL timing_stop('dyn_vor')
+ IF( ln_timing ) CALL timing_stop('dyn_vor_3D')
+ !
+ END SUBROUTINE dyn_vor_3D
+
+
+ SUBROUTINE dyn_vor_RK3( kt, Kmm, puu, pvv, Krhs, knoco )
+ !!----------------------------------------------------------------------
+ !!
+ !! ** Purpose : compute the lateral ocean tracer physics.
+ !!
+ !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now vorticity term trend
+ !! - save the trends in (ztrdu,ztrdv) in 2 parts (relative
+ !! and planetary vorticity trends) and send them to trd_dyn
+ !! for futher diagnostics (l_trddyn=T)
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocity field and RHS of momentum equation
+ INTEGER , INTENT(in ) :: knoco ! specified vorticity trend (= np_MET or np_RVO)
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('dyn_vor_RK3')
+ !
+ ! !== total vorticity trend added to the general trend ==!
+ !!st WARNING 22/02 !!!!!!!! stoke drift or not stoke drift ? => bar to do later !!!
+ !! stoke drift a garder pas vortex force a priori !!
+ !! ATTENTION déja appelé avec Kbb !!
+
+ !
+ SELECT CASE ( nvor_scheme ) !== vorticity trend added to the general trend ==!
+ CASE( np_ENT ) !* energy conserving scheme (T-pts)
+ CALL vor_enT( kt, Kmm, knoco, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend
+ IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN
+ CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend
+ ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN
+ CALL vor_enT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force
+ ENDIF
+ CASE( np_EET ) !* energy conserving scheme (een scheme using e3t)
+ CALL vor_eeT( kt, Kmm, knoco, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend
+ IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN
+ CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend
+ ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN
+ CALL vor_eeT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force
+ ENDIF
+ CASE( np_ENE ) !* energy conserving scheme
+ CALL vor_ene( kt, Kmm, knoco, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend
+ IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN
+ CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend
+ ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN
+ CALL vor_ene( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force
+ ENDIF
+ CASE( np_ENS ) !* enstrophy conserving scheme
+ CALL vor_ens( kt, Kmm, knoco, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend
+
+ IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN
+ CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend
+ ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN
+ CALL vor_ens( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force
+ ENDIF
+ CASE( np_MIX ) !* mixed ene-ens scheme
+ CALL vor_ens( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! relative vorticity or metric trend (ens)
+ IF( ln_stcor ) CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend
+ IF( ln_vortex_force ) CALL vor_ens( kt, Kmm, nrvm, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add vortex force
+ CASE( np_EEN ) !* energy and enstrophy conserving scheme
+ CALL vor_een( kt, Kmm, knoco, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend
+ IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN
+ CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend
+ ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN
+ CALL vor_een( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force
+ ENDIF
+ END SELECT
+ !
+ ! ! print sum trends (used for debugging)
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' vor - Ua: ', mask1=umask, &
+ & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
+ !
+ IF( ln_timing ) CALL timing_stop('dyn_vor_RK3')
!
- END SUBROUTINE dyn_vor
+ END SUBROUTINE dyn_vor_RK3
SUBROUTINE vor_enT( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
diff --git a/src/OCE/DYN/dynzad.F90 b/src/OCE/DYN/dynzad.F90
index 5e6a59ded..5433b956f 100644
--- a/src/OCE/DYN/dynzad.F90
+++ b/src/OCE/DYN/dynzad.F90
@@ -3,8 +3,9 @@ MODULE dynzad
!! *** MODULE dynzad ***
!! Ocean dynamics : vertical advection trend
!!======================================================================
- !! History : OPA ! 1991-01 (G. Madec) Original code
- !! NEMO 0.5 ! 2002-07 (G. Madec) Free form, F90
+ !! History : OPA ! 1991-01 (G. Madec) Original code
+ !! NEMO 0.5 ! 2002-07 (G. Madec) Free form, F90
+ !! 4.5 ! 2021-01 (S. Techene, G. Madec) memory optimization
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -32,7 +33,7 @@ MODULE dynzad
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: dynzad.F90 14834 2021-05-11 09:24:44Z hadcv $
+ !! $Id: dynzad.F90 14428 2021-02-10 18:12:36Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -53,15 +54,14 @@ CONTAINS
!! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the vert. momentum adv. trends
!! - Send the trends to trddyn for diagnostics (l_trddyn=T)
!!----------------------------------------------------------------------
- INTEGER , INTENT( in ) :: kt ! ocean time-step inedx
- INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ INTEGER , INTENT(in ) :: kt, Kmm, Krhs ! ocean time-step & time-level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: zua, zva ! local scalars
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zww
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwuw, zwvw
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv
+ REAL(wp) :: zWf, zWfi, zzWfu, zzWdzU ! local scalars
+ REAL(wp) :: zWfj, zzWfv, zzWdzV ! - -
+ REAL(wp), DIMENSION(A2D(0)) :: zWdzU, zWdzV ! 2D inner workspace
+ REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv ! 3D workspace
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dyn_zad')
@@ -72,44 +72,53 @@ CONTAINS
IF(lwp) WRITE(numout,*) 'dyn_zad : 2nd order vertical advection scheme'
ENDIF
ENDIF
-
+ !
IF( l_trddyn ) THEN ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends
ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )
ztrdu(:,:,:) = puu(:,:,:,Krhs)
ztrdv(:,:,:) = pvv(:,:,:,Krhs)
ENDIF
-
- DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical
- IF( ln_vortex_force ) THEN ! vertical fluxes
- DO_2D( 0, 1, 0, 1 )
- zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) )
- END_2D
- ELSE
- DO_2D( 0, 1, 0, 1 )
- zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
- END_2D
+ !
+ ! !== vertical momentum advection ==! at u- and v-points
+ !
+ zWdzU(A2D(0)) = 0._wp ! set surface (jk=1) vertical advection to zero
+ zWdzV(A2D(0)) = 0._wp
+ !
+ DO_3D( 0, 0, 0, 0 , 1, jpk-2 ) != surface to jpk-2 vertical advection
+ ! ! vertical transport at jk+1 uw/vw-level (x2): 2*mi/j[e1e2t*(We)]
+ IF( ln_vortex_force ) THEN ! We = ww+wsd
+ zWf = e1e2t(ji ,jj ) * ( ww(ji ,jj ,jk+1) + wsd(ji ,jj ,jk+1) )
+ zWfi = e1e2t(ji+1,jj ) * ( ww(ji+1,jj ,jk+1) + wsd(ji+1,jj ,jk+1) )
+ zWfj = e1e2t(ji ,jj+1) * ( ww(ji ,jj+1,jk+1) + wsd(ji ,jj+1,jk+1) )
+ ELSE ! We = ww
+ zWf = e1e2t(ji ,jj ) * ww(ji ,jj ,jk+1)
+ zWfi = e1e2t(ji+1,jj ) * ww(ji+1,jj ,jk+1)
+ zWfj = e1e2t(ji ,jj+1) * ww(ji ,jj+1,jk+1)
ENDIF
- DO_2D( 0, 0, 0, 0 ) ! vertical momentum advection at w-point
- zwuw(ji,jj,jk) = ( zww(ji+1,jj ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) )
- zwvw(ji,jj,jk) = ( zww(ji ,jj+1) + zww(ji,jj) ) * ( pvv(ji,jj,jk-1,Kmm) - pvv(ji,jj,jk,Kmm) )
- END_2D
- END DO
+ zzWfu = zWfi + zWf ! averaging at uw- and vw-points (x2)
+ zzWfv = zWfj + zWf
+ ! ! vertical advection at jk+1 uw-level (x4): zzWfu/v*dk+1[u/v]
+ zzWdzU = zzWfu * ( puu(ji,jj,jk,Kmm) - puu(ji,jj,jk+1,Kmm) )
+ zzWdzV = zzWfv * ( pvv(ji,jj,jk,Kmm) - pvv(ji,jj,jk+1,Kmm) )
+ !
+ ! ! vertical advection at jk u/v-level
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - 0.25_wp * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) &
+ & * ( zWdzU(ji,jj) + zzWdzU )
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - 0.25_wp * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) &
+ & * ( zWdzV(ji,jj) + zzWdzV )
+ !
+ zWdzU(ji,jj) = zzWdzU ! save for next level computation
+ zWdzV(ji,jj) = zzWdzV
+ END_3D
!
- ! Surface and bottom advective fluxes set to zero
- DO_2D( 0, 0, 0, 0 )
- zwuw(ji,jj, 1 ) = 0._wp
- zwvw(ji,jj, 1 ) = 0._wp
- zwuw(ji,jj,jpk) = 0._wp
- zwvw(ji,jj,jpk) = 0._wp
+ jk = jpkm1
+ DO_2D( 0, 0, 0, 0 ) != bottom vertical advection at jpkm1
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - 0.25_wp * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) &
+ & * zWdzU(ji,jj)
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - 0.25_wp * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) &
+ & * zWdzV(ji,jj)
END_2D
!
- DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Vertical momentum advection at u- and v-points
- puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) &
- & / e3u(ji,jj,jk,Kmm)
- pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) &
- & / e3v(ji,jj,jk,Kmm)
- END_3D
-
IF( l_trddyn ) THEN ! save the vertical advection trends for diagnostic
ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:)
ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:)
diff --git a/src/OCE/DYN/dynzdf.F90 b/src/OCE/DYN/dynzdf.F90
index d8046188c..ebd277062 100644
--- a/src/OCE/DYN/dynzdf.F90
+++ b/src/OCE/DYN/dynzdf.F90
@@ -44,7 +44,7 @@ MODULE dynzdf
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: dynzdf.F90 14834 2021-05-11 09:24:44Z hadcv $
+ !! $Id: dynzdf.F90 14547 2021-02-25 17:07:15Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -73,14 +73,14 @@ CONTAINS
INTEGER , INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! ocean time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
- INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: iku, ikv ! local integers
- REAL(wp) :: zzwi, ze3ua, zdt ! local scalars
- REAL(wp) :: zzws, ze3va ! - -
- REAL(wp) :: z1_e3ua, z1_e3va ! - -
- REAL(wp) :: zWu , zWv ! - -
- REAL(wp) :: zWui, zWvi ! - -
- REAL(wp) :: zWus, zWvs ! - -
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ INTEGER :: iku, ikv ! local integers
+ REAL(wp) :: zzwi, ze3ua, zDt_2 ! local scalars
+ REAL(wp) :: zzws, ze3va ! - -
+ REAL(wp) :: z1_e3ua, z1_e3va ! - -
+ REAL(wp) :: zWu , zWv ! - -
+ REAL(wp) :: zWui, zWvi ! - -
+ REAL(wp) :: zWus, zWvs ! - -
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwd, zws ! 3D workspace
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv ! - -
!!---------------------------------------------------------------------
@@ -98,6 +98,9 @@ CONTAINS
ENDIF
ENDIF
ENDIF
+ !
+ zDt_2 = rDt * 0.5_wp
+ !
! !* explicit top/bottom drag case
IF( .NOT.ln_drgimp ) CALL zdf_drg_exp( kt, Kmm, puu(:,:,:,Kbb), pvv(:,:,:,Kbb), puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add top/bottom friction trend to (puu(Kaa),pvv(Kaa))
!
@@ -143,8 +146,8 @@ CONTAINS
& + r_vvl * e3u(ji,jj,iku,Kaa)
ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) &
& + r_vvl * e3v(ji,jj,ikv,Kaa)
- puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + rDt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua
- pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va
+ puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + zDt_2 *( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua
+ pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + zDt_2 *( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va
END_2D
IF( ln_isfcav.OR.ln_drgice_imp ) THEN ! Ocean cavities (ISF)
DO_2D( 0, 0, 0, 0 )
@@ -154,8 +157,8 @@ CONTAINS
& + r_vvl * e3u(ji,jj,iku,Kaa)
ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) &
& + r_vvl * e3v(ji,jj,ikv,Kaa)
- puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + rDt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua
- pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + rDt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va
+ puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + zDt_2 *( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua
+ pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + zDt_2 *( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va
END_2D
END IF
ENDIF
@@ -163,47 +166,46 @@ CONTAINS
! !== Vertical diffusion on u ==!
!
! !* Matrix construction
- zdt = rDt * 0.5
IF( ln_zad_Aimp ) THEN !!
SELECT CASE( nldf_dyn )
CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu)
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) &
& + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point
- zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) &
+ zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) &
& / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk )
- zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) ) &
+ zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) ) &
& / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
zWui = ( wi(ji,jj,jk ) + wi(ji+1,jj,jk ) ) / ze3ua
zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
- zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp )
- zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
+ zwi(ji,jj,jk) = zzwi + zDt_2 * MIN( zWui, 0._wp )
+ zws(ji,jj,jk) = zzws - zDt_2 * MAX( zWus, 0._wp )
+ zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zDt_2 * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
END_3D
CASE DEFAULT ! iso-level lateral mixing
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & ! after scale factor at U-point
& + r_vvl * e3u(ji,jj,jk,Kaa)
- zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) &
+ zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) &
& / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk )
- zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) &
+ zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) &
& / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
zWui = ( wi(ji,jj,jk ) + wi(ji+1,jj,jk ) ) / ze3ua
zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua
- zwi(ji,jj,jk) = zzwi + zdt * MIN( zWui, 0._wp )
- zws(ji,jj,jk) = zzws - zdt * MAX( zWus, 0._wp )
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zdt * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
+ zwi(ji,jj,jk) = zzwi + zDt_2 * MIN( zWui, 0._wp )
+ zws(ji,jj,jk) = zzws - zDt_2 * MAX( zWus, 0._wp )
+ zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zDt_2 * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
END_3D
END SELECT
DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions
zwi(ji,jj,1) = 0._wp
ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) &
& + r_vvl * e3u(ji,jj,1,Kaa)
- zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji ,jj,2) ) &
+ zzws = - zDt_2 * ( avm(ji+1,jj,2) + avm(ji ,jj,2) ) &
& / ( ze3ua * e3uw(ji,jj,2,Kmm) ) * wumask(ji,jj,2)
zWus = ( wi(ji ,jj,2) + wi(ji+1,jj,2) ) / ze3ua
- zws(ji,jj,1 ) = zzws - zdt * MAX( zWus, 0._wp )
- zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWus, 0._wp ) )
+ zws(ji,jj,1 ) = zzws - zDt_2 * MAX( zWus, 0._wp )
+ zwd(ji,jj,1 ) = 1._wp - zzws - zDt_2 * ( MIN( zWus, 0._wp ) )
END_2D
ELSE
SELECT CASE( nldf_dyn )
@@ -211,9 +213,9 @@ CONTAINS
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) &
& + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point
- zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) &
+ zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) &
& / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk )
- zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) ) &
+ zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) ) &
& / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
zwi(ji,jj,jk) = zzwi
zws(ji,jj,jk) = zzws
@@ -223,9 +225,9 @@ CONTAINS
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) &
& + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point
- zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) &
+ zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) &
& / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk )
- zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) &
+ zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) &
& / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
zwi(ji,jj,jk) = zzwi
zws(ji,jj,jk) = zzws
@@ -250,7 +252,7 @@ CONTAINS
iku = mbku(ji,jj) ! ocean bottom level at u- and v-points
ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) &
& + r_vvl * e3u(ji,jj,iku,Kaa) ! after scale factor at T-point
- zwd(ji,jj,iku) = zwd(ji,jj,iku) - rDt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua
+ zwd(ji,jj,iku) = zwd(ji,jj,iku) - zDt_2 *( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua
END_2D
IF ( ln_isfcav.OR.ln_drgice_imp ) THEN ! top friction (always implicit)
DO_2D( 0, 0, 0, 0 )
@@ -258,7 +260,7 @@ CONTAINS
iku = miku(ji,jj) ! ocean top level at u- and v-points
ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) &
& + r_vvl * e3u(ji,jj,iku,Kaa) ! after scale factor at T-point
- zwd(ji,jj,iku) = zwd(ji,jj,iku) - rDt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua
+ zwd(ji,jj,iku) = zwd(ji,jj,iku) - zDt_2 *( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua
END_2D
END IF
ENDIF
@@ -285,7 +287,7 @@ CONTAINS
DO_2D( 0, 0, 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==!
ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) &
& + r_vvl * e3u(ji,jj,1,Kaa)
- puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + rDt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) &
+ puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + zDt_2 * ( utau_b(ji,jj) + utau(ji,jj) ) &
& / ( ze3ua * rho0 ) * umask(ji,jj,1)
END_2D
DO_3D( 0, 0, 0, 0, 2, jpkm1 )
@@ -302,47 +304,46 @@ CONTAINS
! !== Vertical diffusion on v ==!
!
! !* Matrix construction
- zdt = rDt * 0.5
IF( ln_zad_Aimp ) THEN !!
SELECT CASE( nldf_dyn )
CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzv)
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) &
& + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point
- zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) &
+ zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) &
& / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk )
- zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) ) &
+ zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) ) &
& / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
zWvi = ( wi(ji,jj,jk ) + wi(ji,jj+1,jk ) ) / ze3va
zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
- zwi(ji,jj,jk) = zzwi + zdt * MIN( zWvi, 0._wp )
- zws(ji,jj,jk) = zzws - zdt * MAX( zWvs, 0._wp )
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
+ zwi(ji,jj,jk) = zzwi + zDt_2 * MIN( zWvi, 0._wp )
+ zws(ji,jj,jk) = zzws - zDt_2 * MAX( zWvs, 0._wp )
+ zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zDt_2 * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
END_3D
CASE DEFAULT ! iso-level lateral mixing
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) &
& + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point
- zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) &
+ zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) &
& / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk )
- zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) &
+ zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) &
& / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
zWvi = ( wi(ji,jj,jk ) + wi(ji,jj+1,jk ) ) / ze3va
zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va
- zwi(ji,jj,jk) = zzwi + zdt * MIN( zWvi, 0._wp )
- zws(ji,jj,jk) = zzws - zdt * MAX( zWvs, 0._wp )
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zdt * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
+ zwi(ji,jj,jk) = zzwi + zDt_2 * MIN( zWvi, 0._wp )
+ zws(ji,jj,jk) = zzws - zDt_2 * MAX( zWvs, 0._wp )
+ zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zDt_2 * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
END_3D
END SELECT
DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions
zwi(ji,jj,1) = 0._wp
ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) &
& + r_vvl * e3v(ji,jj,1,Kaa)
- zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) &
+ zzws = - zDt_2 * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) &
& / ( ze3va * e3vw(ji,jj,2,Kmm) ) * wvmask(ji,jj,2)
zWvs = ( wi(ji,jj ,2) + wi(ji,jj+1,2) ) / ze3va
- zws(ji,jj,1 ) = zzws - zdt * MAX( zWvs, 0._wp )
- zwd(ji,jj,1 ) = 1._wp - zzws - zdt * ( MIN( zWvs, 0._wp ) )
+ zws(ji,jj,1 ) = zzws - zDt_2 * MAX( zWvs, 0._wp )
+ zwd(ji,jj,1 ) = 1._wp - zzws - zDt_2 * ( MIN( zWvs, 0._wp ) )
END_2D
ELSE
SELECT CASE( nldf_dyn )
@@ -350,9 +351,9 @@ CONTAINS
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) &
& + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point
- zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) &
+ zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) &
& / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk )
- zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) ) &
+ zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) ) &
& / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
zwi(ji,jj,jk) = zzwi
zws(ji,jj,jk) = zzws
@@ -362,9 +363,9 @@ CONTAINS
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) &
& + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point
- zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) &
+ zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) &
& / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk )
- zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) &
+ zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) &
& / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
zwi(ji,jj,jk) = zzwi
zws(ji,jj,jk) = zzws
@@ -388,14 +389,14 @@ CONTAINS
ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points)
ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) &
& + r_vvl * e3v(ji,jj,ikv,Kaa) ! after scale factor at T-point
- zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va
+ zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - zDt_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va
END_2D
IF ( ln_isfcav.OR.ln_drgice_imp ) THEN
DO_2D( 0, 0, 0, 0 )
ikv = mikv(ji,jj) ! (first wet ocean u- and v-points)
ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) &
& + r_vvl * e3v(ji,jj,ikv,Kaa) ! after scale factor at T-point
- zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - rDt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / ze3va
+ zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - zDt_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / ze3va
END_2D
ENDIF
ENDIF
@@ -422,7 +423,7 @@ CONTAINS
DO_2D( 0, 0, 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==!
ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) &
& + r_vvl * e3v(ji,jj,1,Kaa)
- pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + rDt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) &
+ pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + zDt_2*( vtau_b(ji,jj) + vtau(ji,jj) ) &
& / ( ze3va * rho0 ) * vmask(ji,jj,1)
END_2D
DO_3D( 0, 0, 0, 0, 2, jpkm1 )
@@ -437,8 +438,8 @@ CONTAINS
END_3D
!
IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics
- ztrdu(:,:,:) = ( puu(:,:,:,Kaa) - puu(:,:,:,Kbb) ) / rDt - ztrdu(:,:,:)
- ztrdv(:,:,:) = ( pvv(:,:,:,Kaa) - pvv(:,:,:,Kbb) ) / rDt - ztrdv(:,:,:)
+ ztrdu(:,:,:) = ( puu(:,:,:,Kaa) - puu(:,:,:,Kbb) )*r1_Dt - ztrdu(:,:,:)
+ ztrdv(:,:,:) = ( pvv(:,:,:,Kaa) - pvv(:,:,:,Kbb) )*r1_Dt - ztrdv(:,:,:)
CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt, Kmm )
DEALLOCATE( ztrdu, ztrdv )
ENDIF
diff --git a/src/OCE/DYN/sshwzv.F90 b/src/OCE/DYN/sshwzv.F90
index bbe83c8c2..4c0b9778a 100644
--- a/src/OCE/DYN/sshwzv.F90
+++ b/src/OCE/DYN/sshwzv.F90
@@ -16,7 +16,9 @@ MODULE sshwzv
!!----------------------------------------------------------------------
!! ssh_nxt : after ssh
!! ssh_atf : time filter the ssh arrays
- !! wzv : compute now vertical velocity
+ !! wzv : generic interface of vertical velocity calculation
+ !! wzv_MLF : MLF: compute NOW vertical velocity
+ !! wzv_RK3 : RK3: Compute a vertical velocity
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and tracers variables
USE isf_oce ! ice shelf
@@ -43,6 +45,10 @@ MODULE sshwzv
IMPLICIT NONE
PRIVATE
+ ! !! * Interface
+ INTERFACE wzv
+ MODULE PROCEDURE wzv_MLF, wzv_RK3
+ END INTERFACE
PUBLIC ssh_nxt ! called by step.F90
PUBLIC wzv ! called by step.F90
@@ -54,7 +60,7 @@ MODULE sshwzv
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: sshwzv.F90 15150 2021-07-27 10:38:24Z smasson $
+ !! $Id: sshwzv.F90 14618 2021-03-19 14:42:32Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -76,10 +82,11 @@ CONTAINS
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! time level index
REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) :: pssh ! sea-surface height
- !
+ !
INTEGER :: ji, jj, jk ! dummy loop index
REAL(wp) :: zcoef ! local scalar
REAL(wp), DIMENSION(jpi,jpj) :: zhdiv ! 2D workspace
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('ssh_nxt')
@@ -91,12 +98,11 @@ CONTAINS
ENDIF
!
zcoef = 0.5_wp * r1_rho0
-
! !------------------------------!
! ! After Sea Surface Height !
! !------------------------------!
IF(ln_wd_il) THEN
- CALL wad_lmt(pssh(:,:,Kbb), zcoef * (emp_b(:,:) + emp(:,:)), rDt, Kmm, uu, vv )
+ CALL wad_lmt( pssh(:,:,Kbb), zcoef * (emp_b(:,:) + emp(:,:)), rDt, Kmm, uu, vv )
ENDIF
CALL div_hor( kt, Kbb, Kmm ) ! Horizontal divergence
@@ -136,10 +142,10 @@ CONTAINS
!
END SUBROUTINE ssh_nxt
-
- SUBROUTINE wzv( kt, Kbb, Kmm, Kaa, pww )
+
+ SUBROUTINE wzv_MLF( kt, Kbb, Kmm, Kaa, pww )
!!----------------------------------------------------------------------
- !! *** ROUTINE wzv ***
+ !! *** ROUTINE wzv_MLF ***
!!
!! ** Purpose : compute the now vertical velocity
!!
@@ -160,12 +166,12 @@ CONTAINS
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zhdiv
!!----------------------------------------------------------------------
!
- IF( ln_timing ) CALL timing_start('wzv')
+ IF( ln_timing ) CALL timing_start('wzv_MLF')
!
IF( kt == nit000 ) THEN
IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'wzv : now vertical velocity '
- IF(lwp) WRITE(numout,*) '~~~~~ '
+ IF(lwp) WRITE(numout,*) 'wzv_MLF : now vertical velocity '
+ IF(lwp) WRITE(numout,*) '~~~~~~~'
!
pww(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all)
ENDIF
@@ -198,7 +204,7 @@ CONTAINS
& - e3t(ji,jj,jk,Kbb) ) ) * tmask(ji,jj,jk)
END_3D
! IF( ln_vvl_layer ) pww(:,:,:) = 0.e0
- DEALLOCATE( zhdiv )
+ DEALLOCATE( zhdiv )
! !=================================!
ELSEIF( ln_linssh ) THEN !== linear free surface cases ==!
! !=================================!
@@ -209,9 +215,15 @@ CONTAINS
ELSE !== Quasi-Eulerian vertical coordinate ==! ('key_qco')
! !==========================================!
DO_3DS( nn_hls-1, nn_hls, nn_hls-1, nn_hls, jpkm1, 1, -1 ) ! integrate from the bottom the hor. divergence
+#if defined key_qco
+!!gm slightly faster
+ pww(ji,jj,jk) = pww(ji,jj,jk+1) - ( e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk) &
+ & + r1_Dt * e3t_0(ji,jj,jk) * ( r3t(ji,jj,Kaa) - r3t(ji,jj,Kbb) ) ) * tmask(ji,jj,jk)
+#else
pww(ji,jj,jk) = pww(ji,jj,jk+1) - ( e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk) &
& + r1_Dt * ( e3t(ji,jj,jk,Kaa) &
& - e3t(ji,jj,jk,Kbb) ) ) * tmask(ji,jj,jk)
+#endif
END_3D
ENDIF
@@ -263,9 +275,139 @@ CONTAINS
ENDIF
#endif
!
- IF( ln_timing ) CALL timing_stop('wzv')
+ IF( ln_timing ) CALL timing_stop('wzv_MLF')
+ !
+ END SUBROUTINE wzv_MLF
+
+
+ SUBROUTINE wzv_RK3( kt, Kbb, Kmm, Kaa, puu, pvv, pww )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE wzv_RK3 ***
+ !!
+ !! ** Purpose : compute the now vertical velocity
+ !!
+ !! ** Method : - Using the incompressibility hypothesis, the vertical
+ !! velocity is computed by integrating the horizontal divergence
+ !! from the bottom to the surface minus the scale factor evolution.
+ !! The boundary conditions are w=0 at the bottom (no flux) and.
+ !!
+ !! ** action : pww : now vertical velocity
+ !!
+ !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! time step
+ INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! time level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: puu, pvv ! horizontal velocity at Kmm
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pww ! vertical velocity at Kmm
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zhdiv
+ REAL(wp) , DIMENSION(jpi,jpj,jpk) :: ze3div
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('wzv_RK3')
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'wzv_RK3 : now vertical velocity '
+ IF(lwp) WRITE(numout,*) '~~~~~ '
+ !
+ pww(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all)
+ ENDIF
+ !
+ CALL div_hor( kt, Kbb, Kmm, puu, pvv, ze3div )
+ ! !------------------------------!
+ ! ! Now Vertical Velocity !
+ ! !------------------------------!
+ !
+ ! !===============================!
+ IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN !== z_tilde and layer cases ==!
+ ! !===============================!
+ ALLOCATE( zhdiv(jpi,jpj,jpk) )
+ !
+ DO jk = 1, jpkm1
+ ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t)
+ ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way)
+ DO_2D( 0, 0, 0, 0 )
+ zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )
+ END_2D
+ END DO
+ CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp) ! - ML - Perhaps not necessary: not used for horizontal "connexions"
+ ! ! Is it problematic to have a wrong vertical velocity in boundary cells?
+ ! ! Same question holds for hdiv. Perhaps just for security
+ DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence
+ ! computation of w
+ pww(:,:,jk) = pww(:,:,jk+1) - ( ze3div(:,:,jk) + zhdiv(:,:,jk) &
+ & + r1_Dt * ( e3t(:,:,jk,Kaa) &
+ & - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk)
+ END DO
+ ! IF( ln_vvl_layer ) pww(:,:,:) = 0.e0
+ DEALLOCATE( zhdiv )
+ ! !=================================!
+ ELSEIF( ln_linssh ) THEN !== linear free surface cases ==!
+ ! !=================================!
+ DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence
+ pww(:,:,jk) = pww(:,:,jk+1) - ze3div(:,:,jk)
+ END DO
+ ! !==========================================!
+ ELSE !== Quasi-Eulerian vertical coordinate ==! ('key_qco')
+ ! !==========================================!
+ DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence
+ ! ! NB: [e3t[a] -e3t[b] ]=e3t_0*[r3t[a]-r3t[b]]
+ pww(:,:,jk) = pww(:,:,jk+1) - ( ze3div(:,:,jk) &
+ & + r1_Dt * e3t_0(:,:,jk) * ( r3t(:,:,Kaa) - r3t(:,:,Kbb) ) ) * tmask(:,:,jk)
+ END DO
+ ENDIF
+
+ IF( ln_bdy ) THEN
+ DO jk = 1, jpkm1
+ pww(:,:,jk) = pww(:,:,jk) * bdytmask(:,:)
+ END DO
+ ENDIF
+ !
+#if defined key_agrif
+ IF( .NOT. AGRIF_Root() ) THEN
+ !
+ ! Mask vertical velocity at first/last columns/row
+ ! inside computational domain (cosmetic)
+ DO jk = 1, jpkm1
+ IF( lk_west ) THEN ! --- West --- !
+ DO ji = mi0(2+nn_hls), mi1(2+nn_hls)
+ DO jj = 1, jpj
+ pww(ji,jj,jk) = 0._wp
+ END DO
+ END DO
+ ENDIF
+ IF( lk_east ) THEN ! --- East --- !
+ DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls)
+ DO jj = 1, jpj
+ pww(ji,jj,jk) = 0._wp
+ END DO
+ END DO
+ ENDIF
+ IF( lk_south ) THEN ! --- South --- !
+ DO jj = mj0(2+nn_hls), mj1(2+nn_hls)
+ DO ji = 1, jpi
+ pww(ji,jj,jk) = 0._wp
+ END DO
+ END DO
+ ENDIF
+ IF( lk_north ) THEN ! --- North --- !
+ DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls)
+ DO ji = 1, jpi
+ pww(ji,jj,jk) = 0._wp
+ END DO
+ END DO
+ ENDIF
+ !
+ END DO
+ !
+ ENDIF
+#endif
+ !
+ IF( ln_timing ) CALL timing_stop('wzv_RK3')
!
- END SUBROUTINE wzv
+ END SUBROUTINE wzv_RK3
SUBROUTINE ssh_atf( kt, Kbb, Kmm, Kaa, pssh )
diff --git a/src/OCE/IOM/iom.F90 b/src/OCE/IOM/iom.F90
index 336385b3f..c683e2f41 100644
--- a/src/OCE/IOM/iom.F90
+++ b/src/OCE/IOM/iom.F90
@@ -55,6 +55,7 @@ MODULE iom
#else
LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag
#endif
+ LOGICAL, PUBLIC :: l_iom = .TRUE. !: RK3 iom flag prevent writing at stage 1&2
PUBLIC iom_init, iom_init_closedef, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var
PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put
PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val
@@ -98,7 +99,7 @@ MODULE iom
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: iom.F90 15033 2021-06-21 10:24:45Z smasson $
+ !! $Id: iom.F90 15512 2021-11-15 17:22:03Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
diff --git a/src/OCE/IOM/restart.F90 b/src/OCE/IOM/restart.F90
index 13a2fcff2..0aec277c7 100644
--- a/src/OCE/IOM/restart.F90
+++ b/src/OCE/IOM/restart.F90
@@ -49,7 +49,7 @@ MODULE restart
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: restart.F90 15141 2021-07-23 14:20:12Z smasson $
+ !! $Id: restart.F90 15027 2021-06-19 08:14:22Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -167,7 +167,10 @@ CONTAINS
CALL iom_rstput( kt, nitrst, numrow, 'tb' , ts(:,:,:,jp_tem,Kbb) )
CALL iom_rstput( kt, nitrst, numrow, 'sb' , ts(:,:,:,jp_sal,Kbb) )
!
-#if ! defined key_RK3
+#if defined key_RK3
+ CALL iom_rstput( kt, nitrst, numrow, 'uu_b' , uu_b(:,: ,Kbb) ) ! before fields
+ CALL iom_rstput( kt, nitrst, numrow, 'vv_b' , vv_b(:,: ,Kbb) ) ! before fields
+#else
CALL iom_rstput( kt, nitrst, numrow, 'sshn', ssh(:,: ,Kmm) ) ! now fields
CALL iom_rstput( kt, nitrst, numrow, 'un' , uu(:,:,: ,Kmm) )
CALL iom_rstput( kt, nitrst, numrow, 'vn' , vv(:,:,: ,Kmm) )
@@ -281,10 +284,12 @@ CONTAINS
#if defined key_RK3
! !* Read Kbb fields (NB: in RK3 Kmm = Kbb = Nbb)
IF(lwp) WRITE(numout,*) ' Kbb u, v and T-S fields read in the restart file'
- CALL iom_get( numror, jpdom_auto, 'ub', uu(:,:,: ,Kbb), cd_type = 'U', psgn = -1._wp )
- CALL iom_get( numror, jpdom_auto, 'vb', vv(:,:,: ,Kbb), cd_type = 'V', psgn = -1._wp )
- CALL iom_get( numror, jpdom_auto, 'tb', ts(:,:,:,jp_tem,Kbb) )
- CALL iom_get( numror, jpdom_auto, 'sb', ts(:,:,:,jp_sal,Kbb) )
+ CALL iom_get( numror, jpdom_auto, 'ub' , uu(:,:,: ,Kbb), cd_type = 'U', psgn = -1._wp )
+ CALL iom_get( numror, jpdom_auto, 'vb' , vv(:,:,: ,Kbb), cd_type = 'V', psgn = -1._wp )
+ CALL iom_get( numror, jpdom_auto, 'tb' , ts(:,:,:,jp_tem,Kbb) )
+ CALL iom_get( numror, jpdom_auto, 'sb' , ts(:,:,:,jp_sal,Kbb) )
+ CALL iom_get( numror, jpdom_auto, 'uu_b' , uu_b(:,: ,Kbb), cd_type = 'U', psgn = -1._wp )
+ CALL iom_get( numror, jpdom_auto, 'vv_b' , vv_b(:,: ,Kbb), cd_type = 'V', psgn = -1._wp )
#else
! !* Read Kmm fields (MLF only)
IF(lwp) WRITE(numout,*) ' Kmm u, v and T-S fields read in the restart file'
@@ -312,15 +317,10 @@ CONTAINS
IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
CALL iom_get( numror, jpdom_auto, 'rhop' , rhop ) ! now potential density
ELSE
-#if defined key_qco
- ALLOCATE( zgdept(jpi,jpj,jpk) )
- DO jk = 1, jpk
- zgdept(:,:,jk) = gdept(:,:,jk,Kmm)
- END DO
- CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, zgdept )
- DEALLOCATE( zgdept )
+#if defined key_RK3
+ CALL eos( ts, Kbb, rhop )
#else
- CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) )
+ CALL eos( ts, Kmm, rhop )
#endif
ENDIF
ENDIF
@@ -413,13 +413,10 @@ CONTAINS
!
ENDIF
!
-#if defined key_RK3
- ssh(:,:,Kmm) = 0._wp !* RK3: set Kmm to 0 for AGRIF
-#else
- ssh(:,:,Kmm) = ssh(:,:,Kbb) !* MLF: set now values from to before ones
-#endif
+ ssh(:,:,Kmm) = ssh(:,:,Kbb) !* set now values from to before ones
ENDIF
!
+!JC: line below ???
! !==========================!
ssh(:,:,Kaa) = 0._wp !== Set to 0 for AGRIF ==!
! !==========================!
diff --git a/src/OCE/LDF/ldftra.F90 b/src/OCE/LDF/ldftra.F90
index 26f529a02..67cfd73dc 100644
--- a/src/OCE/LDF/ldftra.F90
+++ b/src/OCE/LDF/ldftra.F90
@@ -67,6 +67,8 @@ MODULE ldftra
! != Use/diagnose eiv =!
LOGICAL , PUBLIC :: ln_ldfeiv !: eddy induced velocity flag
LOGICAL , PUBLIC :: ln_ldfeiv_dia !: diagnose & output eiv streamfunction and velocity (IOM)
+ LOGICAL , PUBLIC :: l_ldfeiv_dia !: RK3: modified w.r.t. kstg diagnose & output eiv streamfunction and velocity flag
+
! != Coefficients =!
INTEGER , PUBLIC :: nn_aei_ijk_t !: choice of time/space variation of the eiv coeff.
REAL(wp), PUBLIC :: rn_Ue !: lateral diffusive velocity [m/s]
@@ -97,7 +99,7 @@ MODULE ldftra
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: ldftra.F90 15093 2021-07-06 16:20:39Z clem $
+ !! $Id: ldftra.F90 15512 2021-11-15 17:22:03Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -768,7 +770,11 @@ CONTAINS
END_3D
!
! ! diagnose the eddy induced velocity and associated heat transport
+#if defined key_RK3
+ IF( l_ldfeiv_dia .AND. cdtype == 'TRA' ) CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm )
+#else
IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm )
+#endif
!
END SUBROUTINE ldf_eiv_trp
@@ -867,7 +873,7 @@ CONTAINS
CALL iom_put( "veiv_heattr" , zztmp * zw2d ) ! heat transport in j-direction
CALL iom_put( "veiv_heattr3d", zztmp * zw3d ) ! heat transport in j-direction
!
- IF( iom_use( 'sophteiv' ) ) CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d )
+ IF( iom_use( 'sophteiv' ) .AND. l_diaptr ) CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d )
!
zztmp = 0.5_wp * 0.5
IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN
@@ -891,7 +897,7 @@ CONTAINS
CALL iom_put( "veiv_salttr" , zztmp * zw2d ) ! salt transport in j-direction
CALL iom_put( "veiv_salttr3d", zztmp * zw3d ) ! salt transport in j-direction
!
- IF( iom_use( 'sopsteiv' ) ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d )
+ IF( iom_use( 'sopsteiv' ) .AND. l_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d )
!
!
END SUBROUTINE ldf_eiv_dia
diff --git a/src/OCE/SBC/sbcrnf.F90 b/src/OCE/SBC/sbcrnf.F90
index 753bc673c..785ba0d96 100644
--- a/src/OCE/SBC/sbcrnf.F90
+++ b/src/OCE/SBC/sbcrnf.F90
@@ -74,7 +74,7 @@ MODULE sbcrnf
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: sbcrnf.F90 15190 2021-08-13 12:52:50Z gsamson $
+ !! $Id: sbcrnf.F90 14993 2021-06-14 22:35:18Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -206,13 +206,13 @@ CONTAINS
REAL(wp) :: zfact ! local scalar
!!----------------------------------------------------------------------
!
- zfact = 0.5_wp
+ zfact = 0.5_wp * r1_rho0
!
IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==!
IF( ln_linssh ) THEN !* constant volume case : just apply the runoff input flow
DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls )
DO jk = 1, nk_rnf(ji,jj)
- phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj)
+ phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact / h_rnf(ji,jj)
END DO
END_2D
ELSE !* variable volume case
@@ -224,7 +224,7 @@ CONTAINS
END_2D
DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) ! apply the runoff input flow
DO jk = 1, nk_rnf(ji,jj)
- phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj)
+ phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact / h_rnf(ji,jj)
END DO
END_2D
ENDIF
@@ -233,7 +233,7 @@ CONTAINS
h_rnf (ji,jj) = e3t(ji,jj,1,Kmm) ! update h_rnf to be depth of top box
END_2D
DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls )
- phdivn(ji,jj,1) = phdivn(ji,jj,1) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / e3t(ji,jj,1,Kmm)
+ phdivn(ji,jj,1) = phdivn(ji,jj,1) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact / e3t(ji,jj,1,Kmm)
END_2D
ENDIF
!
diff --git a/src/OCE/TRA/eosbn2.F90 b/src/OCE/TRA/eosbn2.F90
index d04597777..a5439195a 100644
--- a/src/OCE/TRA/eosbn2.F90
+++ b/src/OCE/TRA/eosbn2.F90
@@ -55,7 +55,7 @@ MODULE eosbn2
! !! * Interface
INTERFACE eos
- MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d
+ MODULE PROCEDURE eos_insitu_New, eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d
END INTERFACE
!
INTERFACE eos_rab
@@ -183,11 +183,118 @@ MODULE eosbn2
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: eosbn2.F90 15136 2021-07-23 10:07:28Z smasson $
+ !! $Id: eosbn2.F90 14547 2021-02-25 17:07:15Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
+ SUBROUTINE eos_insitu_New( pts, Knn, prd )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE eos_insitu ***
+ !!
+ !! ** Purpose : Compute the in situ density (ratio rho/rho0) from
+ !! potential temperature and salinity using an equation of state
+ !! selected in the nameos namelist
+ !!
+ !! ** Method : prd(t,s,z) = ( rho(t,s,z) - rho0 ) / rho0
+ !! with prd in situ density anomaly no units
+ !! t TEOS10: CT or EOS80: PT Celsius
+ !! s TEOS10: SA or EOS80: SP TEOS10: g/kg or EOS80: psu
+ !! z depth meters
+ !! rho in situ density kg/m^3
+ !! rho0 reference density kg/m^3
+ !!
+ !! ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z).
+ !! Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celsius, sa=35.5 g/kg
+ !!
+ !! ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z).
+ !! Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celsius, sp=35.5 psu
+ !!
+ !! ln_seos : simplified equation of state
+ !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rho0
+ !! linear case function of T only: rn_alpha<>0, other coefficients = 0
+ !! linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0
+ !! Vallis like equation: use default values of coefficients
+ !!
+ !! ** Action : compute prd , the in situ density (no units)
+ !!
+ !! References : Roquet et al, Ocean Modelling, in preparation (2014)
+ !! Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006
+ !! TEOS-10 Manual, 2010
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(:,:,:,:,:), INTENT(in ) :: pts ! T-S
+ INTEGER , INTENT(in ) :: Knn ! time-level
+ REAL(wp), DIMENSION(:,:,: ), INTENT( out) :: prd ! in situ density
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zt , zh , zs , ztm ! local scalars
+ REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('eos-insitu')
+ !
+ SELECT CASE( neos )
+ !
+ CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
+ !
+ DO_3D(nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ !
+ zh = gdept(ji,jj,jk,Knn) * r1_Z0 ! depth
+ zt = pts (ji,jj,jk,jp_tem,Knn) * r1_T0 ! temperature
+ zs = SQRT( ABS( pts(ji,jj,jk,jp_sal,Knn) + rdeltaS ) * r1_S0 ) ! square root salinity
+ ztm = tmask(ji,jj,jk) ! tmask
+ !
+ zn3 = EOS013*zt &
+ & + EOS103*zs+EOS003
+ !
+ zn2 = (EOS022*zt &
+ & + EOS112*zs+EOS012)*zt &
+ & + (EOS202*zs+EOS102)*zs+EOS002
+ !
+ zn1 = (((EOS041*zt &
+ & + EOS131*zs+EOS031)*zt &
+ & + (EOS221*zs+EOS121)*zs+EOS021)*zt &
+ & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt &
+ & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+ !
+ zn0 = (((((EOS060*zt &
+ & + EOS150*zs+EOS050)*zt &
+ & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
+ & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
+ & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
+ & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
+ & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+ !
+ zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+ !
+ prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked)
+ !
+ END_3D
+ !
+ CASE( np_seos ) !== simplified EOS ==!
+ !
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ zt = pts (ji,jj,jk,jp_tem,Knn) - 10._wp
+ zs = pts (ji,jj,jk,jp_sal,Knn) - 35._wp
+ zh = gdept(ji,jj,jk,Knn)
+ ztm = tmask(ji,jj,jk)
+ !
+ zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt &
+ & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs &
+ & - rn_nu * zt * zs
+ !
+ prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked)
+ END_3D
+ !
+ END SELECT
+ !
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', kdim=jpk )
+ !
+ IF( ln_timing ) CALL timing_stop('eos-insitu')
+ !
+ END SUBROUTINE eos_insitu_New
+
+
SUBROUTINE eos_insitu( pts, prd, pdep )
!!
REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
diff --git a/src/OCE/TRA/traadv.F90 b/src/OCE/TRA/traadv.F90
index aa9d4de26..a55ffff58 100644
--- a/src/OCE/TRA/traadv.F90
+++ b/src/OCE/TRA/traadv.F90
@@ -9,6 +9,7 @@ MODULE traadv
!! 3.7 ! 2014-05 (G. Madec) Add 2nd/4th order cases for CEN and FCT schemes
!! - ! 2014-12 (G. Madec) suppression of cross land advection option
!! 3.6 ! 2015-06 (E. Clementi) Addition of Stokes drift in case of wave coupling
+ !! 4.5 ! 2021-04 (G. Madec, S. Techene) add advective velocities as optional arguments
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -43,7 +44,7 @@ MODULE traadv
IMPLICIT NONE
PRIVATE
- PUBLIC tra_adv ! called by step.F90
+ PUBLIC tra_adv ! called by step.F90, stpmlf.F90 and stprk3_stg.F90
PUBLIC tra_adv_init ! called by nemogcm.F90
! !!* Namelist namtra_adv *
@@ -58,43 +59,45 @@ MODULE traadv
INTEGER :: nn_ubs_v ! =2/4 : vertical choice of the order of UBS scheme
LOGICAL :: ln_traadv_qck ! QUICKEST scheme flag
- INTEGER, PUBLIC :: nadv ! choice of the type of advection scheme
+ INTEGER :: nadv ! choice of the type of advection scheme
! ! associated indices:
- INTEGER, PARAMETER, PUBLIC :: np_NO_adv = 0 ! no T-S advection
- INTEGER, PARAMETER, PUBLIC :: np_CEN = 1 ! 2nd/4th order centered scheme
- INTEGER, PARAMETER, PUBLIC :: np_FCT = 2 ! 2nd/4th order Flux Corrected Transport scheme
- INTEGER, PARAMETER, PUBLIC :: np_MUS = 3 ! MUSCL scheme
- INTEGER, PARAMETER, PUBLIC :: np_UBS = 4 ! 3rd order Upstream Biased Scheme
- INTEGER, PARAMETER, PUBLIC :: np_QCK = 5 ! QUICK scheme
+ INTEGER, PARAMETER :: np_NO_adv = 0 ! no T-S advection
+ INTEGER, PARAMETER :: np_CEN = 1 ! 2nd/4th order centered scheme
+ INTEGER, PARAMETER :: np_FCT = 2 ! 2nd/4th order Flux Corrected Transport scheme
+ INTEGER, PARAMETER :: np_MUS = 3 ! MUSCL scheme
+ INTEGER, PARAMETER :: np_UBS = 4 ! 3rd order Upstream Biased Scheme
+ INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: traadv.F90 15073 2021-07-02 14:20:14Z clem $
+ !! $Id: traadv.F90 15514 2021-11-16 08:58:22Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE tra_adv( kt, Kbb, Kmm, pts, Krhs )
+ SUBROUTINE tra_adv( kt, Kbb, Kmm, pts, Krhs, pau, pav, paw )
!!----------------------------------------------------------------------
!! *** ROUTINE tra_adv ***
!!
!! ** Purpose : compute the ocean tracer advection trend.
!!
- !! ** Method : - Update (uu(:,:,:,Krhs),vv(:,:,:,Krhs)) with the advection term following nadv
+ !! ** Method : - Update ts(Krhs) with the advective trend following nadv
!!----------------------------------------------------------------------
- INTEGER , INTENT(in) :: kt ! ocean time-step index
- INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, TARGET, INTENT(in ) :: pau, pav, paw ! advective velocity
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt) , INTENT(inout) :: pts ! active tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk ! dummy loop index
+ REAL(wp), DIMENSION(:,:,:), POINTER :: zptu, zptv, zptw
! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zvv, zww ! 3D workspace
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds
+ REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zvv, zww ! 3D workspace
+ REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds
! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
- LOGICAL :: lskip
+ LOGICAL :: lskip
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('tra_adv')
@@ -114,23 +117,35 @@ CONTAINS
lskip = .TRUE.
ENDIF
ENDIF
+ !
IF( .NOT. lskip ) THEN
- ! !== effective transport ==!
+ ! !== effective advective transport ==!
+ !
+ IF( PRESENT( pau ) ) THEN ! RK3: advective velocity (pau,pav,paw) /= advected velocity (uu,vv,ww)
+ zptu => pau(:,:,:)
+ zptv => pav(:,:,:)
+ zptw => paw(:,:,:)
+ ELSE ! MLF: advective velocity = (uu,vv,ww)
+ zptu => uu(:,:,:,Kmm)
+ zptv => vv(:,:,:,Kmm)
+ zptw => ww(:,:,: )
+ ENDIF
+ !
IF( ln_wave .AND. ln_sdw ) THEN
DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
- zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * ( uu(ji,jj,jk,Kmm) + usd(ji,jj,jk) )
- zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * ( vv(ji,jj,jk,Kmm) + vsd(ji,jj,jk) )
+ zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * ( zptu(ji,jj,jk) + usd(ji,jj,jk) )
+ zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * ( zptv(ji,jj,jk) + vsd(ji,jj,jk) )
END_3D
DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
- zww(ji,jj,jk) = e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) )
+ zww(ji,jj,jk) = e1e2t(ji,jj) * ( zptw(ji,jj,jk) + wsd(ji,jj,jk) )
END_3D
ELSE
DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
- zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) ! eulerian transport only
- zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm)
+ zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * zptu(ji,jj,jk) ! eulerian transport only
+ zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * zptv(ji,jj,jk)
END_3D
DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
- zww(ji,jj,jk) = e1e2t(ji,jj) * ww(ji,jj,jk)
+ zww(ji,jj,jk) = e1e2t(ji,jj) * zptw(ji,jj,jk)
END_3D
ENDIF
!
@@ -142,7 +157,7 @@ CONTAINS
ENDIF
!
DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
- zuu(ji,jj,jpk) = 0._wp ! no transport trough the bottom
+ zuu(ji,jj,jpk) = 0._wp ! no transport trough the bottom
zvv(ji,jj,jpk) = 0._wp
zww(ji,jj,jpk) = 0._wp
END_2D
@@ -153,15 +168,17 @@ CONTAINS
IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm ) ! add the mle transport (if necessary)
!
! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
- IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile
- CALL iom_put( "uocetr_eff", zuu ) ! output effective transport
- CALL iom_put( "vocetr_eff", zvv )
- CALL iom_put( "wocetr_eff", zww )
+ IF( l_iom ) THEN
+ IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile
+ CALL iom_put( "uocetr_eff", zuu ) ! output effective transport
+ CALL iom_put( "vocetr_eff", zvv )
+ CALL iom_put( "wocetr_eff", zww )
+ ENDIF
ENDIF
!
!!gm ???
! TEMP: [tiling] This copy-in not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
- CALL dia_ptr( kt, Kmm, zvv(A2D(nn_hls),:) ) ! diagnose the effective MSF
+ IF( l_diaptr ) CALL dia_ptr( kt, Kmm, zvv(A2D(nn_hls),:) ) ! diagnose the effective MSF
!!gm ???
!
@@ -245,8 +262,8 @@ CONTAINS
WRITE(numout,*) ' Namelist namtra_adv : chose a advection scheme for tracers'
WRITE(numout,*) ' No advection on T & S ln_traadv_OFF = ', ln_traadv_OFF
WRITE(numout,*) ' centered scheme ln_traadv_cen = ', ln_traadv_cen
- WRITE(numout,*) ' horizontal 2nd/4th order nn_cen_h = ', nn_fct_h
- WRITE(numout,*) ' vertical 2nd/4th order nn_cen_v = ', nn_fct_v
+ WRITE(numout,*) ' horizontal 2nd/4th order nn_cen_h = ', nn_cen_h
+ WRITE(numout,*) ' vertical 2nd/4th order nn_cen_v = ', nn_cen_v
WRITE(numout,*) ' Flux Corrected Transport scheme ln_traadv_fct = ', ln_traadv_fct
WRITE(numout,*) ' horizontal 2nd/4th order nn_fct_h = ', nn_fct_h
WRITE(numout,*) ' vertical 2nd/4th order nn_fct_v = ', nn_fct_v
diff --git a/src/OCE/TRA/traadv_fct.F90 b/src/OCE/TRA/traadv_fct.F90
index 500a46d80..e66936ade 100644
--- a/src/OCE/TRA/traadv_fct.F90
+++ b/src/OCE/TRA/traadv_fct.F90
@@ -48,7 +48,7 @@ MODULE traadv_fct
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: traadv_fct.F90 14857 2021-05-12 16:47:25Z hadcv $
+ !! $Id: traadv_fct.F90 15512 2021-11-15 17:22:03Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -106,10 +106,10 @@ CONTAINS
l_hst = .FALSE.
l_ptr = .FALSE.
ll_zAimp = .FALSE.
- IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
- IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.
- IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
- & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
+ IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+ IF( l_diaptr .AND. cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.
+ IF( l_iom .AND. cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+ & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
!
ENDIF
diff --git a/src/OCE/TRA/traadv_mus.F90 b/src/OCE/TRA/traadv_mus.F90
index 42db0c909..4c4b0437c 100644
--- a/src/OCE/TRA/traadv_mus.F90
+++ b/src/OCE/TRA/traadv_mus.F90
@@ -49,7 +49,7 @@ MODULE traadv_mus
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: traadv_mus.F90 15139 2021-07-23 12:52:21Z smasson $
+ !! $Id: traadv_mus.F90 15512 2021-11-15 17:22:03Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -121,10 +121,10 @@ CONTAINS
l_trd = .FALSE.
l_hst = .FALSE.
l_ptr = .FALSE.
- IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
- IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.
- IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
- & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
+ IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+ IF( l_diaptr .AND. cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.
+ IF( l_iom .AND. cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+ & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
ENDIF
!
DO jn = 1, kjpt !== loop over the tracers ==!
diff --git a/src/OCE/TRA/traatf.F90 b/src/OCE/TRA/traatf.F90
index 12b280fc3..855e2cbc3 100644
--- a/src/OCE/TRA/traatf.F90
+++ b/src/OCE/TRA/traatf.F90
@@ -60,7 +60,7 @@ MODULE traatf
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: traatf.F90 15004 2021-06-16 10:33:18Z mathiot $
+ !! $Id: traatf.F90 14800 2021-05-06 15:42:46Z jchanut $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -106,7 +106,7 @@ CONTAINS
! Update after tracer on domain lateral boundaries
!
#if defined key_agrif
- CALL Agrif_tra ! AGRIF zoom boundaries
+ CALL Agrif_tra( kt ) ! AGRIF zoom boundaries
#endif
! ! local domain boundaries (T-point, unchanged sign)
CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp )
diff --git a/src/OCE/TRA/traatf_qco.F90 b/src/OCE/TRA/traatf_qco.F90
index 2b6333683..57034bd06 100644
--- a/src/OCE/TRA/traatf_qco.F90
+++ b/src/OCE/TRA/traatf_qco.F90
@@ -1,7 +1,7 @@
MODULE traatf_qco
!!======================================================================
!! *** MODULE traatf_qco ***
- !! Ocean active tracers: Asselin time filtering for temperature and salinity
+ !! Ocean active tracers: MLF, Asselin time filtering for temperature and salinity
!!======================================================================
!! History : OPA ! 1991-11 (G. Madec) Original code
!! 7.0 ! 1993-03 (M. Guyon) symetrical conditions
@@ -16,34 +16,39 @@ MODULE traatf_qco
!! 3.1 ! 2009-02 (G. Madec, R. Benshila) re-introduce the vvl option
!! 3.3 ! 2010-04 (M. Leclair, G. Madec) semi-implicit hpg with asselin filter + modified LF-RA
!! - ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA
- !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename tranxt.F90 -> traatfLF.F90. Now only does time filtering.
+ !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename tranxt.F90 -> traatf.F90. Now only does time filtering.
+ !! 4.2 ! 2020-06 (S. Techene, G. Madec) qco version of traatf.F90
!!----------------------------------------------------------------------
-
+#if defined key_RK3
+ !!----------------------------------------------------------------------
+ !! 'key_RK3' EMPTY MODULE 3rd order Runge-Kutta
+ !!----------------------------------------------------------------------
+#else
!!----------------------------------------------------------------------
!! tra_atf : time filtering on tracers
!! tra_atf_fix : time filtering on tracers : fixed volume case
!! tra_atf_vvl : time filtering on tracers : variable volume case
!!----------------------------------------------------------------------
- USE oce ! ocean dynamics and tracers variables
- USE dom_oce ! ocean space and time domain variables
- USE sbc_oce ! surface boundary condition: ocean
- USE sbcrnf ! river runoffs
- USE isf_oce ! ice shelf melting
- USE zdf_oce ! ocean vertical mixing
- USE domvvl ! variable volume
- USE trd_oce ! trends: ocean variables
- USE trdtra ! trends manager: tracers
- USE traqsr ! penetrative solar radiation (needed for nksr)
- USE phycst ! physical constant
- USE ldftra ! lateral physics : tracers
- USE ldfslp ! lateral physics : slopes
- USE bdy_oce , ONLY : ln_bdy
- USE bdytra ! open boundary condition (bdy_tra routine)
+ USE oce ! ocean dynamics and tracers variables
+ USE dom_oce ! ocean space and time domain variables
+ USE sbc_oce ! surface boundary condition: ocean
+ USE sbcrnf ! river runoffs
+ USE isf_oce ! ice shelf melting
+ USE zdf_oce ! ocean vertical mixing
+ USE domvvl ! variable volume
+ USE trd_oce ! trends: ocean variables
+ USE trdtra ! trends manager: tracers
+ USE traqsr ! penetrative solar radiation (needed for nksr)
+ USE phycst ! physical constant
+ USE ldftra ! lateral physics : tracers
+ USE ldfslp ! lateral physics : slopes
+ USE bdy_oce , ONLY: ln_bdy
+ USE bdytra ! open boundary condition (bdy_tra routine)
!
- USE in_out_manager ! I/O manager
- USE lbclnk ! ocean lateral boundary conditions (or mpp link)
- USE prtctl ! Print control
- USE timing ! Timing
+ USE in_out_manager ! I/O manager
+ USE lbclnk ! ocean lateral boundary conditions (or mpp link)
+ USE prtctl ! Print control
+ USE timing ! Timing
IMPLICIT NONE
PRIVATE
@@ -57,7 +62,7 @@ MODULE traatf_qco
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: traatf_qco.F90 14433 2021-02-11 08:06:49Z smasson $
+ !! $Id: traatf_qco.F90 15028 2021-06-19 08:53:10Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -197,7 +202,8 @@ CONTAINS
!
DO jn = 1, kjpt
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+!!st DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
ztn = pt(ji,jj,jk,jn,Kmm)
ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb) ! time laplacian on tracers
!
@@ -256,13 +262,14 @@ CONTAINS
!
IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) ) THEN
ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) )
- ztrd_atf(:,:,:,:) = 0.0_wp
+ ztrd_atf(:,:,:,:) = 0._wp
ENDIF
zfact = 1._wp / p2dt
zfact1 = rn_atfp * p2dt
zfact2 = zfact1 * r1_rho0
DO jn = 1, kjpt
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+!!st DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
ze3t_b = e3t(ji,jj,jk,Kbb)
ze3t_n = e3t(ji,jj,jk,Kmm)
ze3t_a = e3t(ji,jj,jk,Kaa)
@@ -286,7 +293,7 @@ CONTAINS
! solar penetration (temperature only)
IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) &
& ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )
- !
+ !
!
IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) &
& ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &
@@ -364,6 +371,7 @@ CONTAINS
ENDIF
!
END SUBROUTINE tra_atf_qco_lf
-
+#endif
+
!!======================================================================
END MODULE traatf_qco
diff --git a/src/OCE/TRA/traisf.F90 b/src/OCE/TRA/traisf.F90
index 0abba863e..7f43285b9 100644
--- a/src/OCE/TRA/traisf.F90
+++ b/src/OCE/TRA/traisf.F90
@@ -1,13 +1,15 @@
MODULE traisf
- !!==============================================================================
- !! *** MODULE traisf ***
+ !!======================================================================
+ !! *** MODULE traisf ***
!! Ocean active tracers: ice shelf boundary condition
- !!==============================================================================
- !! History : 4.0 ! 2019-09 (P. Mathiot) original file
+ !!======================================================================
+ !! History : 4.0 ! 2019-09 (P. Mathiot) original file
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! tra_isf : update the tracer trend at ocean surface
+ !! isf_mlt : temperature trend due to the ice shelf melting
+ !! isf_cpl : T-S trend due to the ice shelf coupling
!!----------------------------------------------------------------------
USE isf_oce ! Ice shelf variables
USE par_oce , ONLY : nijtile, ntile, ntsi, ntei, ntsj, ntej
@@ -31,18 +33,18 @@ MODULE traisf
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE tra_isf ( kt, Kmm, pts, Krhs )
- !!----------------------------------------------------------------------
+ SUBROUTINE tra_isf( kt, Kmm, pts, Krhs )
+ !!-------------------------------------------------------------------
!! *** ROUTINE tra_isf ***
!!
!! ** Purpose : Compute the temperature trend due to the ice shelf melting (qhoce + qhc)
!!
!! ** Action : - update pts(:,:,:,:,Krhs) for cav, par and cpl case
- !!----------------------------------------------------------------------
+ !!-------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time step
INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
- !!----------------------------------------------------------------------
+ !!-------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('tra_isf')
!
@@ -55,10 +57,10 @@ CONTAINS
ENDIF
!
! cavity case
- IF ( ln_isfcav_mlt ) CALL tra_isf_mlt(misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, risf_cav_tsc, risf_cav_tsc_b, pts(:,:,:,:,Krhs))
+ IF ( ln_isfcav_mlt ) CALL isf_mlt(misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, risf_cav_tsc, risf_cav_tsc_b, pts(:,:,:,:,Krhs))
!
! parametrisation case
- IF ( ln_isfpar_mlt ) CALL tra_isf_mlt(misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, risf_par_tsc, risf_par_tsc_b, pts(:,:,:,:,Krhs))
+ IF ( ln_isfpar_mlt ) CALL isf_mlt(misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, risf_par_tsc, risf_par_tsc_b, pts(:,:,:,:,Krhs))
!
! ice sheet coupling case
IF ( ln_isfcpl ) THEN
@@ -69,11 +71,11 @@ CONTAINS
! half of it at nit000+1 (leap frog time step).
! in accordance to this, the heat content flux due to injected water need to be added in the temperature and salt trend
! at time step nit000 and nit000+1
- IF ( kt == nit000 ) CALL tra_isf_cpl(Kmm, risfcpl_tsc , pts(:,:,:,:,Krhs))
- IF ( kt == nit000+1) CALL tra_isf_cpl(Kmm, risfcpl_tsc*0.5_wp, pts(:,:,:,:,Krhs))
+ IF ( kt == nit000 ) CALL isf_cpl(Kmm, risfcpl_tsc , pts(:,:,:,:,Krhs))
+ IF ( kt == nit000+1) CALL isf_cpl(Kmm, risfcpl_tsc*0.5_wp, pts(:,:,:,:,Krhs))
!
! ensure 0 trend due to unconservation of the ice shelf coupling
- IF ( ln_isfcpl_cons ) CALL tra_isf_cpl(Kmm, risfcpl_cons_tsc, pts(:,:,:,:,Krhs))
+ IF ( ln_isfcpl_cons ) CALL isf_cpl(Kmm, risfcpl_cons_tsc, pts(:,:,:,:,Krhs))
!
END IF
!
@@ -87,25 +89,25 @@ CONTAINS
IF( ln_timing ) CALL timing_stop('tra_isf')
!
END SUBROUTINE tra_isf
- !
- SUBROUTINE tra_isf_mlt(ktop, kbot, phtbl, pfrac, ptsc, ptsc_b, pts)
+
+
+ SUBROUTINE isf_mlt( ktop, kbot, phtbl, pfrac, ptsc, ptsc_b, pts )
!!----------------------------------------------------------------------
- !! *** ROUTINE tra_isf_mlt ***
+ !! *** ROUTINE isf_mlt ***
!!
!! *** Purpose : Compute the temperature trend due to the ice shelf melting (qhoce + qhc) for cav or par case
!!
!! *** Action :: Update pts(:,:,:,:,Krhs) with the surface boundary condition trend
!!
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts
- !!----------------------------------------------------------------------
- INTEGER , DIMENSION(jpi,jpj) , INTENT(in ) :: ktop , kbot
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: phtbl, pfrac
- REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: ptsc , ptsc_b
- !!----------------------------------------------------------------------
- INTEGER :: ji,jj,jk ! loop index
- INTEGER :: ikt, ikb ! top and bottom level of the tbl
- REAL(wp), DIMENSION(A2D(nn_hls)) :: ztc ! total ice shelf tracer trend
+ INTEGER , DIMENSION(jpi,jpj) , INTENT(in ) :: ktop , kbot
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: phtbl, pfrac
+ REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT(in ) :: ptsc , ptsc_b
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts
+ !!
+ INTEGER :: ji,jj,jk ! dummy loop index
+ INTEGER :: ikt, ikb ! top and bottom level of the tbl
+ REAL(wp), DIMENSION(A2D(nn_hls)) :: ztc ! total ice shelf tracer trend
!!----------------------------------------------------------------------
!
! compute 2d total trend due to isf
@@ -129,21 +131,21 @@ CONTAINS
!
END_2D
!
- END SUBROUTINE tra_isf_mlt
- !
- SUBROUTINE tra_isf_cpl( Kmm, ptsc, ptsa )
+ END SUBROUTINE isf_mlt
+
+
+ SUBROUTINE isf_cpl( Kmm, ptsc, ptsa )
!!----------------------------------------------------------------------
- !! *** ROUTINE tra_isf_cpl ***
+ !! *** ROUTINE isf_cpl ***
!!
!! *** Action :: Update pts(:,:,:,:,Krhs) with the ice shelf coupling trend
!!
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: ptsa
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: Kmm ! ocean time level index
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: ptsc
- !!----------------------------------------------------------------------
- INTEGER :: ji, jj, jk
+ INTEGER , INTENT(in ) :: Kmm ! ocean time-level index
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: ptsc
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: ptsa
+ !!
+ INTEGER :: ji, jj, jk ! dummy loop index
!!----------------------------------------------------------------------
!
DO_3D( 0, 0, 0, 0, 1, jpk )
@@ -151,6 +153,7 @@ CONTAINS
ptsa(ji,jj,jk,jp_sal) = ptsa(ji,jj,jk,jp_sal) + ptsc(ji,jj,jk,jp_sal) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
END_3D
!
- END SUBROUTINE tra_isf_cpl
- !
+ END SUBROUTINE isf_cpl
+
+ !!======================================================================
END MODULE traisf
diff --git a/src/OCE/TRA/traldf_iso.F90 b/src/OCE/TRA/traldf_iso.F90
index d91b67eab..f93bf2dcd 100644
--- a/src/OCE/TRA/traldf_iso.F90
+++ b/src/OCE/TRA/traldf_iso.F90
@@ -44,7 +44,7 @@ MODULE traldf_iso
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: traldf_iso.F90 14834 2021-05-11 09:24:44Z hadcv $
+ !! $Id: traldf_iso.F90 15512 2021-11-15 17:22:03Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -155,9 +155,9 @@ CONTAINS
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
l_hst = .FALSE.
l_ptr = .FALSE.
- IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) ) l_ptr = .TRUE.
- IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
- & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
+ IF( l_diaptr .AND. cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) ) l_ptr = .TRUE.
+ IF( l_iom .AND. cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+ & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
ENDIF
!
! Define pt_rhs halo points for multi-point haloes in bilaplacian case
diff --git a/src/OCE/TRA/tranpc.F90 b/src/OCE/TRA/tranpc.F90
index d1e9c1c79..495ca30b1 100644
--- a/src/OCE/TRA/tranpc.F90
+++ b/src/OCE/TRA/tranpc.F90
@@ -39,7 +39,7 @@ MODULE tranpc
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: tranpc.F90 14834 2021-05-11 09:24:44Z hadcv $
+ !! $Id: tranpc.F90 14547 2021-02-25 17:07:15Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -68,7 +68,7 @@ CONTAINS
INTEGER :: jiter, ikbot, ikp, ikup, ikdown, ilayer, ik_low ! local integers
LOGICAL :: l_bottom_reached, l_column_treated
REAL(wp) :: zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z
- REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_rDt
+ REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw
REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp ! acceptance criteria for neutrality (N2==0)
REAL(wp), DIMENSION( jpk ) :: zvn2 ! vertical profile of N2 at 1 given point...
REAL(wp), DIMENSION( jpk,jpts) :: zvts, zvab ! vertical profile of T & S , and alpha & betaat 1 given point
@@ -302,9 +302,8 @@ CONTAINS
END_2D
!
IF( l_trdtra ) THEN ! send the Non penetrative mixing trends for diagnostic
- z1_rDt = 1._wp / (2._wp * rn_Dt)
- ztrdt(:,:,:) = ( pts(:,:,:,jp_tem,Kaa) - ztrdt(:,:,:) ) * z1_rDt
- ztrds(:,:,:) = ( pts(:,:,:,jp_sal,Kaa) - ztrds(:,:,:) ) * z1_rDt
+ ztrdt(:,:,:) = ( pts(:,:,:,jp_tem,Kaa) - ztrdt(:,:,:) ) * r1_Dt
+ ztrds(:,:,:) = ( pts(:,:,:,jp_sal,Kaa) - ztrds(:,:,:) ) * r1_Dt
CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_npc, ztrdt )
CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_npc, ztrds )
DEALLOCATE( ztrdt, ztrds )
diff --git a/src/OCE/TRA/traqsr.F90 b/src/OCE/TRA/traqsr.F90
index 5f9c8e94e..7e76160a1 100644
--- a/src/OCE/TRA/traqsr.F90
+++ b/src/OCE/TRA/traqsr.F90
@@ -12,10 +12,16 @@ MODULE traqsr
!! 3.6 ! 2012-05 (C. Rousset) store attenuation coef for use in ice model
!! 3.6 ! 2015-12 (O. Aumont, J. Jouanno, C. Ethe) use vertical profile of chlorophyll
!! 3.7 ! 2015-11 (G. Madec, A. Coward) remove optimisation for fix volume
+ !! 4.0 ! 2020-11 (A. Coward) optimisation
+ !! 4.5 ! 2021-03 (G. Madec) further optimisation + adaptation for RK3
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! tra_qsr : temperature trend due to the penetration of solar radiation
+ !! qsr_RGBc : IR + RGB light penetration with Chlorophyll data case
+ !! qsr_RGB : IR + RGB light penetration with constant Chlorophyll case
+ !! qsr_2BD : 2 bands (InfraRed + Visible light) case
+ !! qsr_ext_lev : level of extinction for each bands
!! tra_qsr_init : initialization of the qsr penetration
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and active tracers
@@ -52,16 +58,25 @@ MODULE traqsr
REAL(wp), PUBLIC :: rn_si0 !: very near surface depth of extinction (RGB & 2 bands)
REAL(wp), PUBLIC :: rn_si1 !: deepest depth of extinction (water type I) (2 bands)
!
- INTEGER , PUBLIC :: nksr !: levels below which the light cannot penetrate (depth larger than 391 m)
-
INTEGER, PARAMETER :: np_RGB = 1 ! R-G-B light penetration with constant Chlorophyll
INTEGER, PARAMETER :: np_RGBc = 2 ! R-G-B light penetration with Chlorophyll data
INTEGER, PARAMETER :: np_2BD = 3 ! 2 bands light penetration
INTEGER, PARAMETER :: np_BIO = 4 ! bio-model light penetration
!
- INTEGER :: nqsr ! user choice of the type of light penetration
- REAL(wp) :: xsi0r ! inverse of rn_si0
- REAL(wp) :: xsi1r ! inverse of rn_si1
+ INTEGER :: nqsr ! user choice of the type of light penetration
+ INTEGER :: nc_rgb ! RGB with cst Chlorophyll: index associated with the chosen Chl value
+ !
+ ! ! extinction level
+ INTEGER :: nk0 !: IR (depth larger ~12 m)
+ INTEGER :: nkV !: Visible light (depth larger than ~840 m)
+ INTEGER :: nkR, nkG, nkB !: RGB (depth larger than ~100 m, ~470 m, ~1700 m, resp.)
+ !
+ INTEGER, PUBLIC :: nksr !: =nkV, i.e. maximum level of light extinction (used in traatf(_qco).F90)
+ !
+ ! ! inverse of attenuation length
+ REAL(wp) :: r1_si0 ! all schemes : infrared = 1/rn_si0
+ REAL(wp) :: r1_si1 ! 2 band : mean RGB = 1/rn_si1
+ REAL(wp) :: r1_LR, r1_LG, r1_LB ! RGB with constant Chl (np_RGB)
!
REAL(wp) , PUBLIC, DIMENSION(3,61) :: rkrgb ! tabulated attenuation coefficients for RGB absorption
TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read)
@@ -71,7 +86,7 @@ MODULE traqsr
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: traqsr.F90 14834 2021-05-11 09:24:44Z hadcv $
+ !! $Id: traqsr.F90 15157 2021-07-29 08:28:32Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -84,38 +99,20 @@ CONTAINS
!! penetration and add it to the general temperature trend.
!!
!! ** Method : The profile of the solar radiation within the ocean is defined
- !! through 2 wavebands (rn_si0,rn_si1) or 3 wavebands (RGB) and a ratio rn_abs
- !! Considering the 2 wavebands case:
- !! I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) )
- !! The temperature trend associated with the solar radiation penetration
- !! is given by : zta = 1/e3t dk[ I ] / (rho0*Cp)
- !! At the bottom, boudary condition for the radiation is no flux :
- !! all heat which has not been absorbed in the above levels is put
- !! in the last ocean level.
+ !! through 2 wavebands (rn_si0,rn_si1) or 3 wavebands (RGB) or computed by
+ !! the biogeochemical model
!! The computation is only done down to the level where
- !! I(k) < 1.e-15 W/m2 (i.e. over the top nksr levels) .
+ !! I(k) < 1.e-15 W/m2 (i.e. over the top nk levels) .
!!
- !! ** Action : - update ta with the penetrative solar radiation trend
+ !! ** Action : - update ts(jp_tem) with the penetrative solar radiation trend
!! - send trend for further diagnostics (l_trdtra=T)
- !!
- !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
- !! Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
- !! Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
!!----------------------------------------------------------------------
- INTEGER, INTENT(in ) :: kt ! ocean time-step
- INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
+ INTEGER, INTENT(in ) :: kt, Kmm, Krhs ! ocean time-step and time-level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: irgb ! local integers
- REAL(wp) :: zchl, zcoef, z1_2 ! local scalars
- REAL(wp) :: zc0 , zc1 , zc2 , zc3 ! - -
- REAL(wp) :: zzc0, zzc1, zzc2, zzc3 ! - -
- REAL(wp) :: zz0 , zz1 , ze3t, zlui ! - -
- REAL(wp) :: zCb, zCmax, zpsi, zpsimax, zrdpsi, zCze
- REAL(wp) :: zlogc, zlogze, zlogCtot, zlogCze
- REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ze0, ze1, ze2, ze3
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, zetot, ztmp3d
+ REAL(wp) :: z1_2, ze3t ! local scalars
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, zetot
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('tra_qsr')
@@ -128,10 +125,13 @@ CONTAINS
ENDIF
ENDIF
!
- IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend
+ IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend
ALLOCATE( ztrdt(jpi,jpj,jpk) )
ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
ENDIF
+ !
+#if ! defined key_RK3
+ ! ! MLF only : heat content trend due to Qsr flux (qsr_hc)
!
! !-----------------------------------!
! ! before qsr induced heat content !
@@ -155,142 +155,69 @@ CONTAINS
qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk)
END_3D
ENDIF
+#endif
+
+ ! !----------------------------!
+ SELECT CASE( nqsr ) ! qsr induced heat content !
+ ! !----------------------------!
!
- ! !--------------------------------!
- SELECT CASE( nqsr ) ! now qsr induced heat content !
- ! !--------------------------------!
- !
- CASE( np_BIO ) !== bio-model fluxes ==!
- !
- DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr )
- qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) )
- END_3D
- !
- CASE( np_RGB , np_RGBc ) !== R-G-B fluxes ==!
- !
- ALLOCATE( ze0 (A2D(nn_hls)) , ze1 (A2D(nn_hls)) , &
- & ze2 (A2D(nn_hls)) , ze3 (A2D(nn_hls)) , &
- & ztmp3d(A2D(nn_hls),nksr + 1) )
- !
- IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll
- IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only for the full domain
- IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE. ) ! Use full domain
- CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step
- IF( ln_tile ) CALL dom_tile_start( ldhold=.TRUE. ) ! Revert to tile domain
- ENDIF
- !
- ! Separation in R-G-B depending on the surface Chl
- ! perform and store as many of the 2D calculations as possible
- ! before the 3D loop (use the temporary 2D arrays to replace the
- ! most expensive calculations)
- !
- DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
- ! zlogc = log(zchl)
- zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) )
- ! zc1 : log(zCze) = log (1.12 * zchl**0.803)
- zc1 = 0.113328685307 + 0.803 * zlogc
- ! zc2 : log(zCtot) = log(40.6 * zchl**0.459)
- zc2 = 3.703768066608 + 0.459 * zlogc
- ! zc3 : log(zze) = log(568.2 * zCtot**(-0.746))
- zc3 = 6.34247346942 - 0.746 * zc2
- ! IF( log(zze) > log(102.) ) log(zze) = log(200.0 * zCtot**(-0.293))
- IF( zc3 > 4.62497281328 ) zc3 = 5.298317366548 - 0.293 * zc2
- !
- ze0(ji,jj) = zlogc ! ze0 = log(zchl)
- ze1(ji,jj) = EXP( zc1 ) ! ze1 = zCze
- ze2(ji,jj) = 1._wp / ( 0.710 + zlogc * ( 0.159 + zlogc * 0.021 ) ) ! ze2 = 1/zdelpsi
- ze3(ji,jj) = EXP( - zc3 ) ! ze3 = 1/zze
- END_2D
-
-!
- DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr + 1 )
- ! zchl = ALOG( ze0(ji,jj) )
- zlogc = ze0(ji,jj)
- !
- zCb = 0.768 + zlogc * ( 0.087 - zlogc * ( 0.179 + zlogc * 0.025 ) )
- zCmax = 0.299 - zlogc * ( 0.289 - zlogc * 0.579 )
- zpsimax = 0.6 - zlogc * ( 0.640 - zlogc * ( 0.021 + zlogc * 0.115 ) )
- ! zdelpsi = 0.710 + zlogc * ( 0.159 + zlogc * 0.021 )
- !
- zCze = ze1(ji,jj)
- zrdpsi = ze2(ji,jj) ! 1/zdelpsi
- zpsi = ze3(ji,jj) * gdepw(ji,jj,jk,Kmm) ! gdepw/zze
- !
- ! NB. make sure zchl value is such that: zchl = MIN( 10. , MAX( 0.03, zchl ) )
- zchl = MIN( 10. , MAX( 0.03, zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) * zrdpsi )**2 ) ) ) )
- ! Convert chlorophyll value to attenuation coefficient look-up table index
- ztmp3d(ji,jj,jk) = 41 + 20.*LOG10(zchl) + 1.e-15
- END_3D
- ELSE !* constant chlorophyll
- zchl = 0.05
- ! NB. make sure constant value is such that:
- zchl = MIN( 10. , MAX( 0.03, zchl ) )
- ! Convert chlorophyll value to attenuation coefficient look-up table index
- zlui = 41 + 20.*LOG10(zchl) + 1.e-15
- DO jk = 1, nksr + 1
- ztmp3d(:,:,jk) = zlui
- END DO
- ENDIF
- !
- zcoef = ( 1. - rn_abs ) / 3._wp !* surface equi-partition in R-G-B
- DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
- ze0(ji,jj) = rn_abs * qsr(ji,jj)
- ze1(ji,jj) = zcoef * qsr(ji,jj)
- ze2(ji,jj) = zcoef * qsr(ji,jj)
- ze3(ji,jj) = zcoef * qsr(ji,jj)
- ! store the surface SW radiation; re-use the surface ztmp3d array
- ! since the surface attenuation coefficient is not used
- ztmp3d(ji,jj,1) = qsr(ji,jj)
- END_2D
- !
- ! !* interior equi-partition in R-G-B depending on vertical profile of Chl
- DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr + 1 )
- ze3t = e3t(ji,jj,jk-1,Kmm)
- irgb = NINT( ztmp3d(ji,jj,jk) )
- zc0 = ze0(ji,jj) * EXP( - ze3t * xsi0r )
- zc1 = ze1(ji,jj) * EXP( - ze3t * rkrgb(1,irgb) )
- zc2 = ze2(ji,jj) * EXP( - ze3t * rkrgb(2,irgb) )
- zc3 = ze3(ji,jj) * EXP( - ze3t * rkrgb(3,irgb) )
- ze0(ji,jj) = zc0
- ze1(ji,jj) = zc1
- ze2(ji,jj) = zc2
- ze3(ji,jj) = zc3
- ztmp3d(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk)
- END_3D
- !
- DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr ) !* now qsr induced heat content
- qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) )
- END_3D
+ CASE( np_RGBc ) ; CALL qsr_RGBc( kt, Kmm, pts, Krhs ) !== R-G-B fluxes using chlorophyll data ==! with Morel &Berthon (1989) vertical profile
!
- DEALLOCATE( ze0 , ze1 , ze2 , ze3 , ztmp3d )
+ CASE( np_RGB ) ; CALL qsr_RGB ( kt, Kmm, pts, Krhs ) !== R-G-B fluxes with constant chlorophyll ==!
!
- CASE( np_2BD ) !== 2-bands fluxes ==!
+ CASE( np_2BD ) ; CALL qsr_2BD ( Kmm, pts, Krhs ) !== 2-bands fluxes ==!
!
- zz0 = rn_abs * r1_rho0_rcp ! surface equi-partition in 2-bands
- zz1 = ( 1. - rn_abs ) * r1_rho0_rcp
- DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr ) !* now qsr induced heat content
- zc0 = zz0 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi1r )
- zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r )
- qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) )
+ CASE( np_BIO ) !== bio-model fluxes ==!
+ DO_3D( 0, 0, 0, 0, 1, nkV )
+#if defined key_RK3
+ ! !- RK3 : temperature trend at jk t-level
+ ze3t = e3t(ji,jj,jk,Kmm)
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) / ze3t
+#else
+ ! !- MLF : heat content trend due to Qsr flux (qsr_hc)
+ qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) )
+#endif
END_3D
+ ! !- sea-ice : store the 1st level attenuation coefficient
+ WHERE( etot3(A2D(0),1) /= 0._wp ) ; fraqsr_1lev(A2D(0)) = 1._wp - etot3(A2D(0),2) / etot3(A2D(0),1)
+ ELSEWHERE ; fraqsr_1lev(A2D(0)) = 1._wp
+ END WHERE
!
END SELECT
!
- ! !-----------------------------!
- ! ! update to the temp. trend !
- ! !-----------------------------!
+#if defined key_RK3
+ ! ! RK3 : diagnostics/output
+ IF( l_trdtra .OR. iom_use('qsr3d') ) THEN ! qsr diagnostics
+ ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+ ! ! qsr tracers trends saved for diagnostics
+ IF( l_trdtra ) CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt )
+ IF( iom_use('qsr3d') ) THEN ! qsr distribution
+ DO jk = nkV, 1, -1
+ ztrdt(:,:,jk) = ztrdt(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp
+ END DO
+ CALL iom_put( 'qsr3d', ztrdt ) ! 3D distribution of shortwave Radiation
+ ENDIF
+ DEALLOCATE( ztrdt )
+ ENDIF
+#else
+ ! ! MLF : add the temperature trend
DO_3D( 0, 0, 0, 0, 1, nksr )
pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) &
& + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) &
& / e3t(ji,jj,jk,Kmm)
END_3D
!
+!!st7-2
! sea-ice: store the 1st ocean level attenuation coefficient
DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
IF( qsr(ji,jj) /= 0._wp ) THEN ; fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) )
ELSE ; fraqsr_1lev(ji,jj) = 1._wp
ENDIF
END_2D
+ ! !===>>> CAUTION: lbc_lnk is required on fraqsr_lev since sea ice computes on the full domain
+ ! ! otherwise restartability and reproducibility are broken
+ CALL lbc_lnk( 'tra_qsr', fraqsr_1lev(:,:), 'T', 1._wp )
+!!st CALL lbc_lnk( 'tra_qsr', qsr_hc(:,:,:), 'T', 1._wp )
!
IF( iom_use('qsr3d') ) THEN ! output the shortwave Radiation distribution
ALLOCATE( zetot(A2D(nn_hls),jpk) )
@@ -301,6 +228,13 @@ CONTAINS
CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation
DEALLOCATE( zetot )
ENDIF
+ !
+ IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics
+ ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+ CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt )
+ DEALLOCATE( ztrdt )
+ ENDIF
+#endif
!
IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile
IF( lrst_oce ) THEN ! write in the ocean restart file
@@ -309,11 +243,6 @@ CONTAINS
ENDIF
ENDIF
!
- IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics
- ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
- CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt )
- DEALLOCATE( ztrdt )
- ENDIF
! ! print mean trends (used for debugging)
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' qsr - Ta: ', mask1=tmask, clinfo3='tra-ta' )
!
@@ -322,6 +251,568 @@ CONTAINS
END SUBROUTINE tra_qsr
+ SUBROUTINE qsr_RGBc( kt, Kmm, pts, Krhs )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE qsr_RGBc ***
+ !!
+ !! ** Purpose : Red-Green-Blue solar radiation using chlorophyll data
+ !!
+ !! ** Method : The profile of the solar radiation within the ocean is defined
+ !! through 2 wavebands (rn_si0,rn_si1) or 3 wavebands (RGB) and a ratio rn_abs
+ !! Considering the 2 wavebands case:
+ !! I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) )
+ !! The temperature trend associated with the solar radiation penetration
+ !! is given by : zta = 1/e3t dk[ I ] / (rho0*Cp)
+ !! At the bottom, boudary condition for the radiation is no flux :
+ !! all heat which has not been absorbed in the above levels is put
+ !! in the last ocean level.
+ !! The computation is only done down to the level where
+ !! I(k) < 1.e-15 W/m2 (i.e. over the top nk levels) .
+ !!
+ !! ** Action : - update ta with the penetrative solar radiation trend
+ !! - send trend for further diagnostics (l_trdtra=T)
+ !!
+ !! Reference : Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
+ !! Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in ) :: kt, Kmm, Krhs ! ocean time-step and time-level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
+ !!
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ INTEGER :: irgb ! local integer
+ REAL(wp) :: zc1 , zc2 , zc3, zchl ! local scalars
+ REAL(wp) :: zze0, zzeR, zzeG, zzeB, zzeT ! - -
+ REAL(wp) :: zz0 , zz1 , ze3t ! - -
+ REAL(wp) :: zCb, zCmax, zpsi, zpsimax, zrdpsi, zCze ! - -
+ REAL(wp) :: zlogc, zlogze, zlogCtot, zlogCze ! - -
+ REAL(wp), DIMENSION(A2D(0) ) :: ze0, zeR, zeG, zeB, zeT
+ REAL(wp), DIMENSION(A2D(0),0:3) :: zc
+ !!----------------------------------------------------------------------
+ !
+ !
+ ! !===========================================!
+ ! !== R-G-B fluxes using chlorophyll data ==! with Morel &Berthon (1989) vertical profile
+ ! !===================================****====!
+ !
+ ! != Chlorophyll data =!
+ !
+ IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only for the full domain
+ IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain
+ CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step
+ IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) ! Revert to tile domain
+ ENDIF
+ !
+ DO_2D( 0, 0, 0, 0 ) ! pre-calculated expensive coefficient
+ zlogc = LOG( MAX( 0.03_wp, MIN( sf_chl(1)%fnow(ji,jj,1) ,10._wp ) ) ) ! zlogc = log(zchl) with 0.03 <= Chl >= 10.
+ zc1 = 0.113328685307 + 0.803 * zlogc ! zc1 : log(zCze) = log (1.12 * zchl**0.803)
+ zc2 = 3.703768066608 + 0.459 * zlogc ! zc2 : log(zCtot) = log(40.6 * zchl**0.459)
+ zc3 = 6.34247346942 - 0.746 * zc2 ! zc3 : log(zze) = log(568.2 * zCtot**(-0.746))
+ IF( zc3 > 4.62497281328 ) zc3 = 5.298317366548 - 0.293 * zc2 ! IF(log(zze)>log(102)) log(zze) = log(200*zCtot**(-0.293))
+ !
+ zc(ji,jj,0) = zlogc ! ze(0) = log(zchl)
+ zc(ji,jj,1) = EXP( zc1 ) ! ze(1) = zCze
+ zc(ji,jj,2) = 1._wp / ( 0.710 + zlogc * ( 0.159 + zlogc * 0.021 ) ) ! ze(2) = 1/zdelpsi
+ zc(ji,jj,3) = EXP( - zc3 ) ! ze(3) = 1/zze
+ END_2D
+ !
+ ! != surface light =!
+ !
+ zz0 = rn_abs ! Infrared absorption
+ zz1 = ( 1._wp - rn_abs ) / 3._wp ! R-G-B equi-partition
+ !
+ DO_2D( 0, 0, 0, 0 ) ! surface light
+ ze0(ji,jj) = zz0 * qsr(ji,jj) ; zeR(ji,jj) = zz1 * qsr(ji,jj) ! IR ; Red
+ zeG(ji,jj) = zz1 * qsr(ji,jj) ; zeB(ji,jj) = zz1 * qsr(ji,jj) ! Green ; Blue
+ zeT(ji,jj) = qsr(ji,jj) ! Total
+ END_2D
+ !
+ ! != interior light =!
+ !
+ DO jk = 1, nk0 !* near surface layers *! (< ~12 meters : IR + RGB )
+ DO_2D( 0, 0, 0, 0 )
+ ! !- inverse of RGB attenuation lengths
+ zlogc = zc(ji,jj,0)
+ zCb = 0.768 + zlogc * ( 0.087 - zlogc * ( 0.179 + zlogc * 0.025 ) )
+ zCmax = 0.299 - zlogc * ( 0.289 - zlogc * 0.579 )
+ zpsimax = 0.6 - zlogc * ( 0.640 - zlogc * ( 0.021 + zlogc * 0.115 ) )
+ ! zdelpsi = 0.710 + zlogc * ( 0.159 + zlogc * 0.021 )
+ zCze = zc(ji,jj,1)
+ zrdpsi = zc(ji,jj,2) ! 1/zdelpsi
+!!st05 zpsi = zc(ji,jj,3) * gdepw(ji,jj,jk,Kmm) ! gdepw/zze
+ zpsi = zc(ji,jj,3) * gdepw(ji,jj,jk+1,Kmm) ! gdepw/zze
+ ! ! make sure zchl value is such that: 0.03 < zchl < 10.
+ zchl = MAX( 0.03_wp , MIN( zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) * zrdpsi )**2 ) ) , 10._wp ) )
+ ! ! Convert chlorophyll value to attenuation coefficient
+ irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) ! look-up table index
+ ! Red ! Green ! Blue
+ r1_LR = rkrgb(3,irgb) ; r1_LG = rkrgb(2,irgb) ; r1_LB = rkrgb(1,irgb)
+ !
+ ! !- fluxes at jk+1 w-level
+ ze3t = e3t(ji,jj,jk,Kmm)
+ zze0 = ze0(ji,jj) * EXP( - ze3t*r1_si0 ) ; zzeR = zeR(ji,jj) * EXP( - ze3t*r1_LR ) ! IR ; Red at jk+1 w-level
+ zzeG = zeG(ji,jj) * EXP( - ze3t*r1_LG ) ; zzeB = zeB(ji,jj) * EXP( - ze3t*r1_LB ) ! Green ; Blue - -
+ zzeT = ( zze0 + zzeB + zzeG + zzeR ) * wmask(ji,jj,jk+1) ! Total - -
+!!st01 zzeT = ( zze0 + zzeR + zzeG + zzeB ) * wmask(ji,jj,jk+1) ! Total - -
+ !
+#if defined key_RK3
+ ! !- RK3 : temperature trend at jk t-level
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + r1_rho0_rcp * ( zeT(ji,jj) - zzeT ) / ze3t
+#else
+ ! !- MLF : heat content trend due to Qsr flux (qsr_hc)
+ qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zeT(ji,jj) - zzeT )
+#endif
+ ze0(ji,jj) = zze0 ; zeR(ji,jj) = zzeR ! IR ; Red store at jk+1 w-level
+ zeG(ji,jj) = zzeG ; zeB(ji,jj) = zzeB ! Green ; Blue - - -
+ zeT(ji,jj) = zzeT ! total - - -
+ END_2D
+ !
+ END DO
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*) 'nk0+1= ', nk0+1, ' qsr IR max = ' , MAXVAL(ze0(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(ze0(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nk0+1, ' qsr R max = ' , MAXVAL(zeR(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeR(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nk0+1, ' qsr G max = ' , MAXVAL(zeG(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeG(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nk0+1, ' qsr B max = ' , MAXVAL(zeB(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeB(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nk0+1, ' qsr T max = ' , MAXVAL(zeT(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeT(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ ENDIF
+ !
+ DO jk = nk0+1, nkR !* down to Red extinction *! (< ~71 meters : RGB , IR removed from calculation)
+ DO_2D( 0, 0, 0, 0 )
+ ! !- inverse of RGB attenuation lengths
+ zlogc = zc(ji,jj,0)
+ zCb = 0.768 + zlogc * ( 0.087 - zlogc * ( 0.179 + zlogc * 0.025 ) )
+ zCmax = 0.299 - zlogc * ( 0.289 - zlogc * 0.579 )
+ zpsimax = 0.6 - zlogc * ( 0.640 - zlogc * ( 0.021 + zlogc * 0.115 ) )
+ ! zdelpsi = 0.710 + zlogc * ( 0.159 + zlogc * 0.021 )
+ zCze = zc(ji,jj,1)
+ zrdpsi = zc(ji,jj,2) ! 1/zdelpsi
+ zpsi = zc(ji,jj,3) * gdepw(ji,jj,jk+1,Kmm) ! gdepw/zze
+!!st05 zpsi = zc(ji,jj,3) * gdepw(ji,jj,jk,Kmm) ! gdepw/zze
+ ! ! make sure zchl value is such that: 0.03 < zchl < 10.
+ zchl = MAX( 0.03_wp , MIN( zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) * zrdpsi )**2 ) ) , 10._wp ) )
+ ! ! Convert chlorophyll value to attenuation coefficient
+ irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) ! look-up table index
+ ! Red ! Green ! Blue
+ r1_LR = rkrgb(3,irgb) ; r1_LG = rkrgb(2,irgb) ; r1_LB = rkrgb(1,irgb)
+ !
+ ! !- fluxes at jk+1 w-level
+ ze3t = e3t(ji,jj,jk,Kmm)
+ zzeR = zeR(ji,jj) * EXP( - ze3t*r1_LR ) ! Red at jk+1 w-level
+ zzeG = zeG(ji,jj) * EXP( - ze3t*r1_LG ) ; zzeB = zeB(ji,jj) * EXP( - ze3t*r1_LB ) ! Green ; Blue - -
+ zzeT = ( zzeR + zzeG + zzeB ) * wmask(ji,jj,jk+1) ! Total - -
+ !
+#if defined key_RK3
+ ! !- RK3 : temperature trend at jk t-level
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + r1_rho0_rcp * ( zeT(ji,jj) - zzeT ) / ze3t
+#else
+ ! !- MLF : heat content trend due to Qsr flux (qsr_hc)
+ qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zeT(ji,jj) - zzeT )
+#endif
+ zeR(ji,jj) = zzeR ! Red store at jk+1 w-level
+ zeG(ji,jj) = zzeG ; zeB(ji,jj) = zzeB ! Green ; Blue - - -
+ zeT(ji,jj) = zzeT ! total - - -
+ END_2D
+ END DO
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*) 'nkR+1= ', nkR+1, ' qsr R max = ' , MAXVAL(zeR(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeR(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nkR+1, ' qsr G max = ' , MAXVAL(zeG(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeG(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nkR+1, ' qsr B max = ' , MAXVAL(zeB(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeB(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nkR+1, ' qsr T max = ' , MAXVAL(zeT(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeT(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ ENDIF
+ !
+ DO jk = nkR+1, nkG !* down to Green extinction *! (< ~350 m : GB , IR+R removed from calculation)
+ DO_2D( 0, 0, 0, 0 )
+ ! !- inverse of RGB attenuation lengths
+ zlogc = zc(ji,jj,0)
+ zCb = 0.768 + zlogc * ( 0.087 - zlogc * ( 0.179 + zlogc * 0.025 ) )
+ zCmax = 0.299 - zlogc * ( 0.289 - zlogc * 0.579 )
+ zpsimax = 0.6 - zlogc * ( 0.640 - zlogc * ( 0.021 + zlogc * 0.115 ) )
+ ! zdelpsi = 0.710 + zlogc * ( 0.159 + zlogc * 0.021 )
+ zCze = zc(ji,jj,1)
+ zrdpsi = zc(ji,jj,2) ! 1/zdelpsi
+ zpsi = zc(ji,jj,3) * gdepw(ji,jj,jk+1,Kmm) ! gdepw/zze
+!!st05 zpsi = zc(ji,jj,3) * gdepw(ji,jj,jk,Kmm) ! gdepw/zze
+ ! ! make sure zchl value is such that: 0.03 < zchl < 10.
+ zchl = MAX( 0.03_wp , MIN( zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) * zrdpsi )**2 ) ) , 10._wp ) )
+ ! ! Convert chlorophyll value to attenuation coefficient
+ irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) ! look-up table index
+ ! Green ! Blue
+ r1_LG = rkrgb(2,irgb) ; r1_LB = rkrgb(1,irgb)
+ !
+ ! !- fluxes at jk+1 w-level
+ ze3t = e3t(ji,jj,jk,Kmm)
+ zzeG = zeG(ji,jj) * EXP( - ze3t * r1_LG ) ; zzeB = zeB(ji,jj) * EXP( - ze3t * r1_LB ) ! Green ; Blue
+ zzeT = ( zzeG + zzeB ) * wmask(ji,jj,jk+1) ! Total - -
+#if defined key_RK3
+ ! !- RK3 : temperature trend at jk t-level
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + r1_rho0_rcp * ( zeT(ji,jj) - zzeT ) / ze3t
+#else
+ ! !- MLF : heat content trend due to Qsr flux (qsr_hc)
+ qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zeT(ji,jj) - zzeT )
+#endif
+ zeG(ji,jj) = zzeG ; zeB(ji,jj) = zzeB ! Green ; Blue store at jk+1 w-level
+ zeT(ji,jj) = zzeT ! total - - -
+ END_2D
+ END DO
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*) 'nkG+1= ', nkG+1, ' qsr G max = ' , MAXVAL(zeG(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeG(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nkG+1, ' qsr B max = ' , MAXVAL(zeB(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeB(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nkG+1, ' qsr T max = ' , MAXVAL(zeT(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeT(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ ENDIF
+ !
+ DO jk = nkG+1, nkB !* down to Blue extinction *! (< ~1300 m : B , IR+RG removed from calculation)
+ DO_2D( 0, 0, 0, 0 )
+ ! !- inverse of RGB attenuation lengths
+ zlogc = zc(ji,jj,0)
+ zCb = 0.768 + zlogc * ( 0.087 - zlogc * ( 0.179 + zlogc * 0.025 ) )
+ zCmax = 0.299 - zlogc * ( 0.289 - zlogc * 0.579 )
+ zpsimax = 0.6 - zlogc * ( 0.640 - zlogc * ( 0.021 + zlogc * 0.115 ) )
+ ! zdelpsi = 0.710 + zlogc * ( 0.159 + zlogc * 0.021 )
+ zCze = zc(ji,jj,1)
+ zrdpsi = zc(ji,jj,2) ! 1/zdelpsi
+ zpsi = zc(ji,jj,3) * gdepw(ji,jj,jk+1,Kmm) ! gdepw/zze
+!!st05 zpsi = zc(ji,jj,3) * gdepw(ji,jj,jk,Kmm) ! gdepw/zze
+ ! ! make sure zchl value is such that: 0.03 < zchl < 10.
+ zchl = MAX( 0.03_wp , MIN( zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) * zrdpsi )**2 ) ) , 10._wp ) )
+ ! ! Convert chlorophyll value to attenuation coefficient
+ irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) ! look-up table index
+ r1_LB = rkrgb(1,irgb) ! Blue
+ !
+ ! !- fluxes at jk+1 w-level
+ ze3t = e3t(ji,jj,jk,Kmm)
+ zzeB = zeB(ji,jj) * EXP( - ze3t * r1_LB ) ! Blue
+ zzeT = ( zzeB ) * wmask(ji,jj,jk+1) ! Total - -
+#if defined key_RK3
+ ! !- RK3 : temperature trend at jk t-level
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + r1_rho0_rcp * ( zeT(ji,jj) - zzeT ) / ze3t
+#else
+ ! !- MLF : heat content trend due to Qsr flux (qsr_hc)
+ qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zeT(ji,jj) - zzeT )
+#endif
+ zeB(ji,jj) = zzeB ! Blue store at jk+1 w-level
+ zeT(ji,jj) = zzeT ! total - - -
+ END_2D
+ END DO
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*) 'nkB+1= ', nkB+1, ' qsr T max = ' , MAXVAL(zeT), ' W/m2' , MAXVAL(zeT(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)), ' K/s'
+ ENDIF
+ !
+ END SUBROUTINE qsr_RGBc
+
+
+ SUBROUTINE qsr_RGB( kt, Kmm, pts, Krhs )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE qsr_RGB ***
+ !!
+ !! ** Purpose : Red-Green-Blue solar radiation with constant chlorophyll
+ !!
+ !! ** Method : The profile of the solar radiation within the ocean is defined
+ !! through 2 wavebands (rn_si0,rn_si1) or 1 (rn_si0,rn_abs) + 3 wavebands (RGB)
+ !! At the bottom, boudary condition for the radiation is no flux :
+ !! all heat which has not been absorbed in the above levels is put
+ !! in the last ocean level.
+ !! For each band, the computation is only done down to the level where
+ !! I(k) < 1.e-15 W/m2 (i.e. over the top nk levels) .
+ !!
+ !! ** Action : - update ta with the penetrative solar radiation trend
+ !! - send trend for further diagnostics (l_trdtra=T)
+ !!
+ !! Reference : Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
+ !! Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in ) :: kt, Kmm, Krhs ! ocean time-step and time-level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
+ !!
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zze0, zzeR, zzeG, zzeB, zzeT ! - -
+ REAL(wp) :: zz0 , zz1 , ze3t ! - -
+ REAL(wp), DIMENSION(A2D(0)) :: ze0, zeR, zeG, zeB, zeT
+ !!----------------------------------------------------------------------
+ !
+ !
+ ! !==============================================!
+ ! !== R-G-B fluxes with constant chlorophyll ==!
+ ! !======================********================!
+ !
+ ! != surface light =!
+ !
+ zz0 = rn_abs ! Infrared absorption
+ zz1 = ( 1._wp - rn_abs ) / 3._wp ! surface equi-partition in R-G-B
+ !
+ DO_2D( 0, 0, 0, 0 ) ! surface light
+ ze0(ji,jj) = zz0 * qsr(ji,jj) ; zeR(ji,jj) = zz1 * qsr(ji,jj) ! IR ; Red
+ zeG(ji,jj) = zz1 * qsr(ji,jj) ; zeB(ji,jj) = zz1 * qsr(ji,jj) ! Green ; Blue
+ zeT(ji,jj) = qsr(ji,jj) ! Total
+ END_2D
+ !
+ ! != interior light =!
+ !
+ DO jk = 1, nk0 !* near surface layers *! (< ~12 meters : IR + RGB )
+ DO_2D( 0, 0, 0, 0 )
+ ze3t = e3t(ji,jj,jk,Kmm)
+ zze0 = ze0(ji,jj) * EXP( - ze3t * r1_si0 ) ; zzeR = zeR(ji,jj) * EXP( - ze3t * r1_LR ) ! IR ; Red at jk+1 w-level
+ zzeG = zeG(ji,jj) * EXP( - ze3t * r1_LG ) ; zzeB = zeB(ji,jj) * EXP( - ze3t * r1_LB ) ! Green ; Blue - -
+ zzeT = ( zze0 + zzeB + zzeG + zzeR ) * wmask(ji,jj,jk+1) ! Total - -
+!!st7-9 zzeT = ( zze0 + zzeR + zzeG + zzeB ) * wmask(ji,jj,jk+1) ! Total - -
+#if defined key_RK3
+ ! ! RK3 : temperature trend at jk t-level
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + r1_rho0_rcp * ( zeT(ji,jj) - zzeT ) / ze3t
+#else
+ ! ! MLF : heat content trend due to Qsr flux (qsr_hc)
+ qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zeT(ji,jj) - zzeT )
+#endif
+ ze0(ji,jj) = zze0 ; zeR(ji,jj) = zzeR ! IR ; Red store at jk+1 w-level
+ zeG(ji,jj) = zzeG ; zeB(ji,jj) = zzeB ! Green ; Blue - - -
+ zeT(ji,jj) = zzeT ! total - - -
+ END_2D
+!!stbug IF( jk == 1 ) THEN !* sea-ice *! store the 1st level attenuation coeff.
+!!stbug WHERE( qsr(A2D(0)) /= 0._wp ) ; fraqsr_1lev(A2D(0)) = 1._wp - zeT(A2D(0)) / qsr(A2D(0))
+!!stbug ELSEWHERE ; fraqsr_1lev(A2D(0)) = 1._wp
+!!stbug END WHERE
+!!stbug ENDIF
+ END DO
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*) 'nk0+1= ', nk0+1, ' qsr IR max = ' , MAXVAL(ze0(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(ze0(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nk0+1, ' qsr R max = ' , MAXVAL(zeR(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeR(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nk0+1, ' qsr G max = ' , MAXVAL(zeG(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeG(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nk0+1, ' qsr B max = ' , MAXVAL(zeB(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeB(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nk0+1, ' qsr T max = ' , MAXVAL(zeT(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeT(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ ENDIF
+ !
+ DO jk = nk0+1, nkR !* down to Red extinction *! (< ~71 meters : RGB , IR removed from calculation)
+ DO_2D( 0, 0, 0, 0 )
+ ze3t = e3t(ji,jj,jk,Kmm)
+ zzeR = zeR(ji,jj) * EXP( - ze3t * r1_LR ) ! Red at jk+1 w-level
+ zzeG = zeG(ji,jj) * EXP( - ze3t * r1_LG ) ; zzeB = zeB(ji,jj) * EXP( - ze3t * r1_LB ) ! Green ; Blue - -
+ zzeT = ( zzeB + zzeG + zzeR ) * wmask(ji,jj,jk+1) ! Total - -
+!!st7-11 zzeT = ( zzeR + zzeG + zzeB ) * wmask(ji,jj,jk+1) ! Total - -
+#if defined key_RK3
+ ! ! RK3 : temperature trend at jk t-level
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + r1_rho0_rcp * ( zeT(ji,jj) - zzeT ) / ze3t
+#else
+ ! ! MLF : heat content trend due to Qsr flux (qsr_hc)
+ qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zeT(ji,jj) - zzeT )
+#endif
+ zeR(ji,jj) = zzeR ! Red store at jk+1 w-level
+ zeG(ji,jj) = zzeG ; zeB(ji,jj) = zzeB ! Green ; Blue - - -
+ zeT(ji,jj) = zzeT ! total - - -
+ END_2D
+ END DO
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*) 'nkR+1= ', nkR+1, ' qsr R max = ' , MAXVAL(zeR(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeR(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nkR+1, ' qsr G max = ' , MAXVAL(zeG(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeG(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nkR+1, ' qsr B max = ' , MAXVAL(zeB(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeB(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nkR+1, ' qsr T max = ' , MAXVAL(zeT(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeT(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ ENDIF
+ !
+ DO jk = nkR+1, nkG !* down to Green extinction *! (< ~350 m : GB , IR+R removed from calculation)
+ DO_2D( 0, 0, 0, 0 )
+ ze3t = e3t(ji,jj,jk,Kmm)
+ zzeG = zeG(ji,jj) * EXP( - ze3t * r1_LG ) ; zzeB = zeB(ji,jj) * EXP( - ze3t * r1_LB ) ! Green ; Blue at jk+1 w-level
+ zzeT = ( zzeG + zzeB ) * wmask(ji,jj,jk+1) ! Total - -
+#if defined key_RK3
+ ! ! RK3 : temperature trend at jk t-level
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + r1_rho0_rcp * ( zeT(ji,jj) - zzeT ) / ze3t
+#else
+ ! ! MLF : heat content trend due to Qsr flux (qsr_hc)
+ qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zeT(ji,jj) - zzeT )
+#endif
+ zeG(ji,jj) = zzeG ; zeB(ji,jj) = zzeB ! Green ; Blue store at jk+1 w-level
+ zeT(ji,jj) = zzeT ! total - - -
+ END_2D
+ END DO
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*) 'nkG+1= ', nkG+1, ' qsr G max = ' , MAXVAL(zeG(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeG(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nkG+1, ' qsr B max = ' , MAXVAL(zeB(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeB(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ IF(lwp) WRITE(numout,*) ' ', nkG+1, ' qsr T max = ' , MAXVAL(zeT(:,:)*wmask(:,:,jk)), ' W/m2' , MAXVAL(zeT(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)*wmask(:,:,jk)), ' K/s'
+ ENDIF
+ !
+ DO jk = nkG+1, nkB !* down to Blue extinction *! (< ~1300 m : B , IR+RG removed from calculation)
+ DO_2D( 0, 0, 0, 0 )
+ ze3t = e3t(ji,jj,jk,Kmm)
+ zzeB = zeB(ji,jj) * EXP( - ze3t * r1_LB ) ! Blue at jk+1 w-level
+ zzeT = ( zzeB ) * wmask(ji,jj,jk+1) ! Total - -
+#if defined key_RK3
+ ! ! RK3 : temperature trend at jk t-level
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + r1_rho0_rcp * ( zeT(ji,jj) - zzeT ) / ze3t
+#else
+ ! ! MLF : heat content trend due to Qsr flux (qsr_hc)
+ qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zeT(ji,jj) - zzeT )
+#endif
+ zeB(ji,jj) = zzeB ! Blue store at jk+1 w-level
+ zeT(ji,jj) = zzeT ! total - - -
+ END_2D
+ END DO
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*) 'nkB+1= ', nkB+1, ' qsr T max = ' , MAXVAL(zeT), ' W/m2' , MAXVAL(zeT(:,:)*r1_rho0_rcp/e3t(:,:,nk0+1,Kmm)), ' K/s'
+ ENDIF
+ !
+ END SUBROUTINE qsr_RGB
+
+
+ SUBROUTINE qsr_2BD( Kmm, pts, Krhs )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE qsr_2BD ***
+ !!
+ !! ** Purpose : 2 bands (IR+visible) solar radiation with constant chlorophyll
+ !!
+ !! ** Method : The profile of the solar radiation within the ocean is defined
+ !! through 2 wavebands (rn_si0,rn_si1) a ratio rn_abs for IR absorbtion.
+ !! Considering the 2 wavebands case:
+ !! I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) )
+ !! The temperature trend associated with the solar radiation penetration
+ !! is given by : zta = 1/e3t dk[ I ] / (rho0*Cp)
+ !! At the bottom, boudary condition for the radiation is no flux :
+ !! all heat which has not been absorbed in the above levels is put
+ !! in the last ocean level.
+ !! The computation is only done down to the level where
+ !! I(k) < 1.e-15 W/m2 (i.e. over the top nk levels) .
+ !!
+ !! ** Action : - update ta with the penetrative solar radiation trend
+ !! - send trend for further diagnostics (l_trdtra=T)
+ !!
+ !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
+ !! Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
+ !! Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in ) :: Kmm, Krhs ! ocean time-step and time-level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
+ !!
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zzatt ! - -
+ REAL(wp) :: zz0 , zz1 , ze3t ! - -
+ REAL(wp), DIMENSION(A2D(0)) :: zatt
+ !!----------------------------------------------------------------------
+ !
+ ! !======================!
+ ! !== 2-bands fluxes ==!
+ ! !======================!
+ !
+ zz0 = rn_abs * r1_rho0_rcp ! surface equi-partition in 2-bands
+ zz1 = ( 1._wp - rn_abs ) * r1_rho0_rcp
+ !
+ zatt(A2D(0)) = r1_rho0_rcp !* surface value *!
+ !
+ DO_2D( 0, 0, 0, 0 )
+ zatt(ji,jj) = ( zz0 * EXP( -gdepw(ji,jj,1,Kmm)*r1_si0 ) + zz1 * EXP( -gdepw(ji,jj,1,Kmm)*r1_si1 ) )
+ END_2D
+ !
+!!st IF(lwp) WRITE(numout,*) 'level = ', 1, ' qsr max = ' , MAXVAL(zatt)*rho0_rcp, ' W/m2', ' qsr min = ' , MINVAL(zatt)*rho0_rcp, ' W/m2'
+ !
+ DO jk = 1, nk0 !* near surface layers *! (< ~14 meters : IR + visible light )
+ DO_2D( 0, 0, 0, 0 )
+ ze3t = e3t(ji,jj,jk,Kmm) ! light attenuation at jk+1 w-level (divided by rho0_rcp)
+ zzatt = ( zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*r1_si0 ) &
+ & + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*r1_si1 ) ) * wmask(ji,jj,jk+1)
+#if defined key_RK3
+ ! ! RK3 : temperature trend at jk t-level
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + qsr(ji,jj) * ( zatt(ji,jj) - zzatt ) / ze3t
+#else
+ ! ! MLF : heat content trend due to Qsr flux (qsr_hc)
+ qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zatt(ji,jj) - zzatt )
+#endif
+ zatt(ji,jj) = zzatt ! save for the next level computation
+ END_2D
+!!stbug ! !* sea-ice *! store the 1st level attenuation coeff.
+!!stbug IF( jk == 1 ) fraqsr_1lev(A2D(0)) = 1._wp - zatt(A2D(0)) * rho0_rcp
+ END DO
+!!st IF(lwp) WRITE(numout,*) 'nk0+1= ', nk0+1, ' qsr max = ' , MAXVAL(zatt*qsr)*rho0_rcp, ' W/m2' , MAXVAL(zatt*qsr/e3t(:,:,nk0+1,Kmm)), ' K/s'
+ !
+ DO jk = nk0+1, nkV !* deeper layers *! (visible light only)
+ DO_2D( 0, 0, 0, 0 )
+ ze3t = e3t(ji,jj,jk,Kmm) ! light attenuation at jk+1 w-level (divided by rho0_rcp)
+ zzatt = ( zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*r1_si1 ) ) * wmask(ji,jj,jk+1)
+#if defined key_RK3
+ ! ! RK3 : temperature trend at jk t-level
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + qsr(ji,jj) * ( zatt(ji,jj) - zzatt ) / ze3t
+#else
+ ! ! MLF : heat content trend due to Qsr flux (qsr_hc)
+ qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zatt(ji,jj) - zzatt )
+#endif
+ zatt(ji,jj) = zzatt ! save for the next level computation
+ END_2D
+ END DO
+ !
+!!st IF(lwp) WRITE(numout,*) 'nkV+1= ', nkV+1, ' qsr max = ' , MAXVAL(zatt*qsr)*rho0_rcp, ' W/m2' , MAXVAL(zatt*qsr/e3t(:,:,nkV+1,Kmm)), ' K/s'
+ END SUBROUTINE qsr_2bd
+
+
+ FUNCTION qsr_ext_lev( pL, pfr ) RESULT( klev )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE trc_oce_ext_lev ***
+ !!
+ !! ** Purpose : compute the maximum level of light penetration
+ !!
+ !! ** Method : the function provides the level at which irradiance, I,
+ !! has a negligible effect on temperature.
+ !! T(n+1)-T(n) = ∆t dk[I] / ( rho0 Cp e3t_k )
+ !! I(k) has a negligible effect on temperature at level k if:
+ !! ∆t I(k) / ( rho0*Cp*e3t_k ) <= 1.e-15 °C
+ !! with I(z) = Qsr*pfr*EXP(-z/L), therefore :
+ !! z >= L * LOG( 1.e-15 * rho0*Cp*e3t_k / ( ∆t*Qsr*pfr ) )
+ !! with Qsr being the maximum normal surface irradiance at sea
+ !! level (~1000 W/m2).
+ !! # pL is the longest depth of extinction:
+ !! - pL = 23.00 m (2 bands case)
+ !! - pL = 48.24 m (3 bands case: blue waveband & 0.03 mg/m2 for the chlorophyll)
+ !! # pfr is the fraction of solar radiation which penetrates,
+ !! considering Qsr=1000 W/m2 and rn_abs = 0.58:
+ !! - Qsr*pfr0 = Qsr * rn_abs = 580 W/m2 (top absorbtion)
+ !! - Qsr*pfr1 = Qsr * (1-rn_abs) = 420 W/m2 (2 bands case)
+ !! - Qsr*pfr1 = Qsr * (1-rn_abs)/3 = 140 W/m2 (3 bands case & equi-partition)
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER :: klev ! result: maximum level of light penetration
+ REAL(wp), INTENT(in) :: pL ! depth of extinction
+ REAL(wp), INTENT(in) :: pfr ! frac. solar radiation which penetrates
+ !
+ INTEGER :: jk ! dummy loop index
+ REAL(wp) :: zcoef ! local scalar
+ REAL(wp) :: zhext ! deepest depth until which light penetrates
+ REAL(wp) :: ze3t , zdw ! max( e3t_k ) and min( w-depth_k+1 )
+ REAL(wp) :: zprec = 10.e-15_wp ! required precision
+ REAL(wp) :: zQmax= 1000._wp ! maximum normal surface irradiance at sea level (W/m2)
+ !!----------------------------------------------------------------------
+ !
+ zQmax = 1000._wp ! maximum normal surface irradiance at sea level (W/m2)
+ !
+ zcoef = zprec * rho0_rcp / ( rDt * zQmax * pfr)
+ !
+ IF( ln_zco .OR. ln_zps ) THEN ! z- or zps coordinate (use 1D ref vertcial coordinate)
+ klev = jpkm1 ! Level of light extinction zco / zps
+ DO jk = jpkm1, 1, -1
+ zdw = gdepw_1d(jk+1) ! max w-depth at jk+1 level
+ ze3t = e3t_1d(jk ) ! minimum e3t at jk level
+ zhext = - pL * LOG( zcoef * ze3t ) ! extinction depth
+ IF( zdw >= zhext ) klev = jk ! last T-level reached by Qsr
+ END DO
+ ELSE ! s- or s-z- coordinate (use 3D vertical coordinate)
+ klev = jpkm1 ! Level of light extinction
+ DO jk = jpkm1, 1, -1 !
+ IF( SUM( tmask(:,:,jk) ) > 0 ) THEN ! ocean point at that level
+ zdw = MAXVAL( gdepw_0(:,:,jk+1) * wmask(:,:,jk) ) ! max w-depth at jk+1 level
+ ze3t = MINVAL( e3t_0(:,:,jk ) , mask=(wmask(:,:,jk+1)==1) ) ! minimum e3t at jk level
+ zhext = - pL * LOG( zcoef * ze3t ) ! extinction depth
+ IF( zdw >= zhext ) klev = jk ! last T-level reached by Qsr
+ ELSE ! only land point at level jk
+ klev = jk ! local domain sea-bed level
+ ENDIF
+ END DO
+ CALL mpp_max('tra_qsr', klev) ! needed for reproducibility !!st may be modified to avoid this comm.
+ ! !!st use ssmask to remove the comm ?
+ ENDIF
+ !
+!!st IF(lwp) WRITE(numout,*) ' level of e3t light extinction = ', klev, ' ref depth = ', gdepw_1d(klev+1), ' m'
+ END FUNCTION qsr_ext_lev
+
+
SUBROUTINE tra_qsr_init
!!----------------------------------------------------------------------
!! *** ROUTINE tra_qsr_init ***
@@ -340,9 +831,9 @@ CONTAINS
!! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
!!----------------------------------------------------------------------
INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: ios, irgb, ierror, ioptio ! local integer
- REAL(wp) :: zz0, zc0 , zc1, zcoef ! local scalars
- REAL(wp) :: zz1, zc2 , zc3, zchl ! - -
+ INTEGER :: ios, ierror, ioptio ! local integer
+ REAL(wp) :: zLB, zLG, zLR ! local scalar
+ REAL(wp) :: zVlp, zchl ! - -
!
CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files
TYPE(FLD_N) :: sn_chl ! informations about the chlorofyl field to be read
@@ -353,12 +844,11 @@ CONTAINS
!
READ ( numnam_ref, namtra_qsr, IOSTAT = ios, ERR = 901)
901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in reference namelist' )
- !
- READ ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 )
+ READ ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902)
902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist' )
IF(lwm) WRITE ( numond, namtra_qsr )
!
- IF(lwp) THEN ! control print
+ IF(lwp) THEN !** control print **!
WRITE(numout,*)
WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation'
WRITE(numout,*) '~~~~~~~~~~~~'
@@ -368,12 +858,12 @@ CONTAINS
WRITE(numout,*) ' bio-model light penetration ln_qsr_bio = ', ln_qsr_bio
WRITE(numout,*) ' RGB : Chl data (=1) or cst value (=0) nn_chldta = ', nn_chldta
WRITE(numout,*) ' RGB & 2 bands: fraction of light (rn_si1) rn_abs = ', rn_abs
- WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0
- WRITE(numout,*) ' 2 bands: longest depth of extinction rn_si1 = ', rn_si1
+ WRITE(numout,*) ' RGB & 2 bands: shortess attenuation depth rn_si0 = ', rn_si0
+ WRITE(numout,*) ' 2 bands: longest attenuation depth rn_si1 = ', rn_si1
WRITE(numout,*)
ENDIF
!
- ioptio = 0 ! Parameter control
+ ioptio = 0 !** Parameter control **!
IF( ln_qsr_rgb ) ioptio = ioptio + 1
IF( ln_qsr_2bd ) ioptio = ioptio + 1
IF( ln_qsr_bio ) ioptio = ioptio + 1
@@ -386,21 +876,50 @@ CONTAINS
IF( ln_qsr_2bd ) nqsr = np_2BD
IF( ln_qsr_bio ) nqsr = np_BIO
!
- ! ! Initialisation
- xsi0r = 1._wp / rn_si0
- xsi1r = 1._wp / rn_si1
+ ! !** Initialisation **!
+ !
+ ! !== Infrared attenuation ==! (all schemes)
+ ! !============================!
+ !
+ r1_si0 = 1._wp / rn_si0 ! inverse of infrared attenuation length
+ !
+ nk0 = qsr_ext_lev( rn_si0, rn_abs ) ! level of light extinction
+ !
+ IF(lwp) WRITE(numout,*) ' ==>>> Infrared light attenuation'
+ IF(lwp) WRITE(numout,*) ' level of infrared extinction = ', nk0, ' ref depth = ', gdepw_1d(nk0+1), ' m'
+ IF(lwp) WRITE(numout,*)
!
SELECT CASE( nqsr )
!
- CASE( np_RGB , np_RGBc ) !== Red-Green-Blue light penetration ==!
+ CASE( np_RGBc, np_RGB ) !== Red-Green-Blue light attenuation ==! (Chl data or constant)
+ ! !========================================!
!
- IF(lwp) WRITE(numout,*) ' ==>>> R-G-B light penetration '
+ IF( nqsr == np_RGB ) THEN ; zchl = 0.05 ! constant Chl value
+ ELSE ; zchl = 0.03 ! minimum Chl value
+ ENDIF
+ zchl = MAX( 0.03_wp , MIN( zchl , 10._wp) ) ! NB. make sure that chosen value verifies: 0.03 < zchl < 10
+ nc_rgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) ! Convert Chl value to attenuation coefficient look-up table index
!
CALL trc_oce_rgb( rkrgb ) ! tabulated attenuation coef.
!
- nksr = trc_oce_ext_lev( r_si2, 33._wp ) ! level of light extinction
+ zVlp = ( 1._wp - rn_abs ) / 3._wp ! visible light equi-partition
+ !
+ ! 1 / length ! attenuation length ! attenuation level
+ r1_LR = rkrgb(3,nc_rgb) ; zLR = 1._wp / r1_LR ; nkR = qsr_ext_lev( zLR, zVlp ) ! Red
+ r1_LG = rkrgb(2,nc_rgb) ; zLG = 1._wp / r1_LG ; nkG = qsr_ext_lev( zLG, zVlp ) ! Green
+ r1_LB = rkrgb(1,nc_rgb) ; zLB = 1._wp / r1_LB ; nkB = qsr_ext_lev( zLB, zVlp ) ! Blue
+ !
+ nkV = nkB ! maximum level of light penetration
!
- IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
+ IF( nqsr == np_RGB ) THEN
+ IF(lwp) WRITE(numout,*) ' ==>>> RGB: light attenuation with a constant Chlorophyll = ', zchl
+ ELSE
+ IF(lwp) WRITE(numout,*) ' ==>>> RGB: light attenuation using Chlorophyll data with min(Chl) = ', zchl
+ ENDIF
+ IF(lwp) WRITE(numout,*) ' level of Red extinction = ', nkR, ' ref depth = ', gdepw_1d(nkR+1), ' m'
+ IF(lwp) WRITE(numout,*) ' level of Green extinction = ', nkG, ' ref depth = ', gdepw_1d(nkG+1), ' m'
+ IF(lwp) WRITE(numout,*) ' level of Blue extinction = ', nkB, ' ref depth = ', gdepw_1d(nkB+1), ' m'
+ IF(lwp) WRITE(numout,*)
!
IF( nqsr == np_RGBc ) THEN ! Chl data : set sf_chl structure
IF(lwp) WRITE(numout,*) ' ==>>> Chlorophyll read in a file'
@@ -408,22 +927,23 @@ CONTAINS
IF( ierror > 0 ) THEN
CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' ) ; RETURN
ENDIF
- ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1) )
+ ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1) )
IF( sn_chl%ln_tint ) ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
! ! fill sf_chl with sn_chl and control print
- CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init', &
+ CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init', &
& 'Solar penetration function of read chlorophyll', 'namtra_qsr' , no_print )
ENDIF
- IF( nqsr == np_RGB ) THEN ! constant Chl
- IF(lwp) WRITE(numout,*) ' ==>>> Constant Chlorophyll concentration = 0.05'
- ENDIF
!
- CASE( np_2BD ) !== 2 bands light penetration ==!
+ CASE( np_2BD ) !== 2 bands light attenuation (IR+ visible light) ==!
+ !
!
- IF(lwp) WRITE(numout,*) ' ==>>> 2 bands light penetration'
+ r1_si1 = 1._wp / rn_si1 ! inverse of visible light attenuation
+ zVlp = ( 1._wp - rn_abs ) ! visible light partition
+ nkV = qsr_ext_lev( rn_si1, zVlp ) ! level of visible light extinction
!
- nksr = trc_oce_ext_lev( rn_si1, 100._wp ) ! level of light extinction
- IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
+ IF(lwp) WRITE(numout,*) ' ==>>> 2 bands attenuation (Infrared + Visible light) '
+ IF(lwp) WRITE(numout,*) ' level of visible light extinction = ', nkV, ' ref depth = ', gdepw_1d(nkV+1), ' m'
+ IF(lwp) WRITE(numout,*)
!
CASE( np_BIO ) !== BIO light penetration ==!
!
@@ -432,15 +952,19 @@ CONTAINS
!
CALL trc_oce_rgb( rkrgb ) ! tabulated attenuation coef.
!
- nksr = trc_oce_ext_lev( r_si2, 33._wp ) ! level of light extinction
+ nkV = trc_oce_ext_lev( r_si2, 33._wp ) ! maximum level of light extinction
!
- IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
+ IF(lwp) WRITE(numout,*) ' level of light extinction = ', nkV, ' ref depth = ', gdepw_1d(nkV+1), ' m'
!
END SELECT
!
- qsr_hc(:,:,:) = 0._wp ! now qsr heat content set to zero where it will not be computed
+ nksr = nkV ! name of max level of light extinction used in traatf(_qco).F90
+ !
+#if ! defined key_RK3
+ qsr_hc(:,:,:) = 0._wp ! MLF : now qsr heat content set to zero where it will not be computed
+#endif
!
- ! 1st ocean level attenuation coefficient (used in sbcssm)
+ ! ! Sea-ice : 1st ocean level attenuation coefficient (used in sbcssm)
IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
CALL iom_get( numror, jpdom_auto, 'fraqsr_1lev' , fraqsr_1lev )
ELSE
diff --git a/src/OCE/TRA/trasbc.F90 b/src/OCE/TRA/trasbc.F90
index 556be0c26..b23c60629 100644
--- a/src/OCE/TRA/trasbc.F90
+++ b/src/OCE/TRA/trasbc.F90
@@ -38,14 +38,15 @@ MODULE trasbc
IMPLICIT NONE
PRIVATE
- PUBLIC tra_sbc ! routine called by step.F90
+ PUBLIC tra_sbc ! routine called by step.F90
+ PUBLIC tra_sbc_RK3 ! routine called by stprk3_stg.F90
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: trasbc.F90 14834 2021-05-11 09:24:44Z hadcv $
+ !! $Id: trasbc.F90 15379 2021-10-15 09:05:45Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -221,6 +222,168 @@ CONTAINS
IF( ln_timing ) CALL timing_stop('tra_sbc')
!
END SUBROUTINE tra_sbc
+
+
+ SUBROUTINE tra_sbc_RK3 ( kt, Kmm, pts, Krhs, kstg )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE tra_sbc_RK3 ***
+ !!
+ !! ** Purpose : Compute the tracer surface boundary condition trend of
+ !! (flux through the interface, concentration/dilution effect)
+ !! and add it to the general trend of tracer equations.
+ !!
+ !! ** Method : The (air+ice)-sea flux has two components:
+ !! (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface);
+ !! (2) Fwe , tracer carried with the water that is exchanged with air+ice.
+ !! The input forcing fields (emp, rnf, sfx) contain Fext+Fwe,
+ !! they are simply added to the tracer trend (ts(Krhs)).
+ !! In linear free surface case (ln_linssh=T), the volume of the
+ !! ocean does not change with the water exchanges at the (air+ice)-sea
+ !! interface. Therefore another term has to be added, to mimic the
+ !! concentration/dilution effect associated with water exchanges.
+ !!
+ !! ** Action : - Update ts(Krhs) with the surface boundary condition trend
+ !! - send trends to trdtra module for further diagnostics(l_trdtra=T)
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt, Kmm, Krhs ! ocean time-step and time-level indices
+ INTEGER , INTENT(in ) :: kstg ! RK3 stage index
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer Eq.
+ !
+ INTEGER :: ji, jj, jk, jn ! dummy loop indices
+ REAL(wp) :: z1_rho0_e3t, zdep, ztim ! local scalar
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('tra_sbc_RK3')
+ !
+ IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'tra_sbc_RK3 : TRAcer Surface Boundary Condition'
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+ ENDIF
+ !
+ IF( l_trdtra ) THEN !* Save ta and sa trends
+ ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
+ ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
+ ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
+ ENDIF
+ !
+ ENDIF
+ !
+
+!!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
+ IF( .NOT.ln_traqsr .AND. kstg == 1) THEN ! no solar radiation penetration
+ DO_2D( 0, 0, 0, 0 )
+ qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) ! total heat flux in qns
+ qsr(ji,jj) = 0._wp ! qsr set to zero
+ END_2D
+ ENDIF
+
+ !----------------------------------------
+ ! EMP, SFX and QNS effects
+ !----------------------------------------
+ ! !== update tracer trend ==!
+ SELECT CASE( kstg )
+ !
+ CASE( 1 , 2 ) != stage 1 and 2 =! only in non linear ssh
+ !
+ IF( .NOT.ln_linssh ) THEN !* only heat and salt fluxes associated with mass fluxes
+ DO_2D( 0, 0, 0, 0 )
+ z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
+ pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) - emp(ji,jj)*pts(ji,jj,1,jp_tem,Kmm) * z1_rho0_e3t
+ pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) - emp(ji,jj)*pts(ji,jj,1,jp_sal,Kmm) * z1_rho0_e3t
+ END_2D
+ ENDIF
+ !
+ CASE( 3 )
+ !
+ IF( ln_linssh ) THEN !* linear free surface
+ DO_2D( 0, 0, 0, 0 )
+ z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
+ pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + ( r1_rcp * qns(ji,jj) & ! non solar heat flux
+ & + emp(ji,jj)*pts(ji,jj,1,jp_tem,Kmm) ) * z1_rho0_e3t ! add concentration/dilution effect due to constant volume cell
+ pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + ( sfx(ji,jj) & ! salt flux due to freezing/melting
+ & + emp(ji,jj)*pts(ji,jj,1,jp_sal,Kmm) ) * z1_rho0_e3t ! add concentration/dilution effect due to constant volume cell
+ END_2D
+ IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile
+ IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
+ IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
+ ENDIF
+ ELSE
+ DO_2D( 0, 0, 0, 0 )
+ z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
+ pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + r1_rcp * qns(ji,jj) * z1_rho0_e3t
+ pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + sfx(ji,jj) * z1_rho0_e3t
+ END_2D
+ ENDIF
+ END SELECT
+ !
+ !
+ !----------------------------------------
+ ! River Runoff effects
+ !----------------------------------------
+ !
+ IF( ln_rnf ) THEN ! input of heat and salt due to river runoff
+ DO_2D( 0, 0, 0, 0 )
+ IF( rnf(ji,jj) /= 0._wp ) THEN
+ zdep = 1._wp / h_rnf(ji,jj)
+ DO jk = 1, nk_rnf(ji,jj)
+ pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + rnf_tsc(ji,jj,jp_tem) * zdep
+ IF( ln_rnf_sal ) pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) + rnf_tsc(ji,jj,jp_sal) * zdep
+ END DO
+ ENDIF
+ END_2D
+ ENDIF
+ !
+ IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile
+ IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst
+ IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss
+ ENDIF
+
+#if defined key_asminc
+ !
+ !----------------------------------------
+ ! Assmilation effects
+ !----------------------------------------
+ !
+ IF( ln_sshinc .AND. kstg == 3 ) THEN ! input of heat and salt due to assimilation
+ !
+ IF( ln_linssh ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm)
+ pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim
+ pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + pts(ji,jj,1,jp_sal,Kmm) * ztim
+ END_2D
+ ELSE
+ DO_2D( 0, 0, 0, 0 )
+ ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) )
+ pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim
+ pts(ji,jj,:,jp_sal,Krhs) = pts(ji,jj,:,jp_sal,Krhs) + pts(ji,jj,:,jp_sal,Kmm) * ztim
+ END_2D
+ ENDIF
+ !
+ ENDIF
+ !
+#endif
+ !
+ IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics
+ IF( ntile == 0 .OR. ntile == nijtile ) THEN
+ ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+ ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
+ CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt )
+ CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds )
+ DEALLOCATE( ztrdt , ztrds )
+ ENDIF
+ ENDIF
+ !
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc - Ta: ', mask1=tmask, &
+ & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
+ !
+ IF( ln_timing ) CALL timing_stop('tra_sbc_RK3')
+ !
+ END SUBROUTINE tra_sbc_RK3
!!======================================================================
END MODULE trasbc
diff --git a/src/OCE/module_example.F90 b/src/OCE/module_example.F90
index 80c10ce05..2620b2efc 100644
--- a/src/OCE/module_example.F90
+++ b/src/OCE/module_example.F90
@@ -54,7 +54,7 @@ MODULE exampl
# include "exampl_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: module_example.F90 14842 2021-05-11 13:17:26Z acc $
+ !! $Id: module_example.F90 14941 2021-06-03 11:42:27Z acc $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -144,7 +144,7 @@ CONTAINS
!! ** Action : ...
!!----------------------------------------------------------------------
INTEGER :: ji, jj, jk, jit ! dummy loop indices
- INTEGER :: ios ! Local integer output status for namelist read
+ INTEGER :: ios ! Local integer output status for namelist read
!!
NAMELIST/namexa/ exa_v1, exa_v2, nexa_0, sn_ex
!!----------------------------------------------------------------------
diff --git a/src/OCE/nemogcm.F90 b/src/OCE/nemogcm.F90
index efd52491e..dc97bf36a 100644
--- a/src/OCE/nemogcm.F90
+++ b/src/OCE/nemogcm.F90
@@ -65,7 +65,11 @@ MODULE nemogcm
USE ice_domain_size, only: nx_global, ny_global
#endif
#if defined key_qco || defined key_linssh
+# if defined key_RK3
+ USE stprk3
+# else
USE stpmlf ! NEMO time-stepping (stp_MLF routine)
+# endif
#else
USE step ! NEMO time-stepping (stp routine)
#endif
@@ -91,7 +95,7 @@ MODULE nemogcm
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: nemogcm.F90 15267 2021-09-17 09:04:34Z smasson $
+ !! $Id: nemogcm.F90 15532 2021-11-24 11:47:32Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -153,7 +157,11 @@ CONTAINS
DO WHILE( istp <= nitend .AND. nstop == 0 )
!
# if defined key_qco || defined key_linssh
+# if defined key_RK3
+ CALL stp_RK3
+# else
CALL stp_MLF
+# endif
# else
CALL stp
# endif
@@ -174,7 +182,11 @@ CONTAINS
ENDIF
!
# if defined key_qco || defined key_linssh
+# if defined key_RK3
+ CALL stp_RK3( istp )
+# else
CALL stp_MLF( istp )
+# endif
# else
CALL stp ( istp )
# endif
@@ -470,7 +482,11 @@ CONTAINS
CALL isf_init( Nbb, Nnn, Naa )
#if defined key_top
! ! Passive tracers
+# if defined key_RK3
+ CALL trc_init( Nbb, Nbb, Naa )
+# else
CALL trc_init( Nbb, Nnn, Naa )
+# endif
#endif
IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing
diff --git a/src/OCE/oce.F90 b/src/OCE/oce.F90
index 5c8e630d5..0ad62c9de 100644
--- a/src/OCE/oce.F90
+++ b/src/OCE/oce.F90
@@ -20,8 +20,8 @@ MODULE oce
!! dynamics and tracer fields
!! --------------------------
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uu , vv !: horizontal velocities [m/s]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ww !: vertical velocity [m/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:), TARGET :: uu , vv !: horizontal velocities [m/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) , TARGET :: ww !: vertical velocity [m/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wi !: vertical vel. (adaptive-implicit) [m/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv !: horizontal divergence [s-1]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: ts !: 4D T-S fields [Celsius,psu]
@@ -75,7 +75,7 @@ MODULE oce
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: oce.F90 15556 2021-11-29 15:23:06Z jchanut $
+ !! $Id: oce.F90 14381 2021-02-03 12:36:25Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
diff --git a/src/OCE/stp2d.F90 b/src/OCE/stp2d.F90
new file mode 100644
index 000000000..d865a9685
--- /dev/null
+++ b/src/OCE/stp2d.F90
@@ -0,0 +1,277 @@
+MODULE stp2d
+ !!======================================================================
+ !! *** MODULE stp2d ***
+ !! Time-stepping : manager of the ocean, tracer and ice time stepping
+ !! using a 3rd order Rung Kuta with fixed or quasi-eulerian coordinate
+ !!======================================================================
+ !! History : 4.5 ! 2021-01 (S. Techene, G. Madec, N. Ducousso, F. Lemarie) Original code
+ !! NEMO
+ !!----------------------------------------------------------------------
+#if defined key_qco || defined key_linssh
+ !!----------------------------------------------------------------------
+ !! 'key_qco' Quasi-Eulerian vertical coordinate
+ !! OR
+ !! 'key_linssh Fixed in time vertical coordinate
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! stp_2D : RK3 case
+ !!----------------------------------------------------------------------
+ USE step_oce ! time stepping used modules
+ USE domqco ! quasi-eulerian coordinate (dom_qco_r3c routine)
+ USE dynadv_cen2 ! centred flux form advection (dyn_adv_cen2 routine)
+ USE dynadv_ubs ! UBS flux form advection (dyn_adv_ubs routine)
+ USE dynkeg ! kinetic energy gradient (dyn_keg routine)
+ USE dynspg_ts ! 2D mode integration
+ USE sbc_ice , ONLY : snwice_mass, snwice_mass_b
+ USE sbcapr ! surface boundary condition: atmospheric pressure
+ USE sbcwave, ONLY : bhd_wave
+#if defined key_agrif
+ USE agrif_oce_interp
+ USE agrif_oce_sponge
+#endif
+
+ PRIVATE
+
+ PUBLIC stp_2D ! called by nemogcm.F90
+ REAL (wp) :: r1_2 = 0.5_wp
+
+ !! * Substitutions
+# include "do_loop_substitute.h90"
+# include "domzgr_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: step.F90 12377 2020-02-12 14:39:06Z acc $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE stp_2D( kt, Kbb, Kmm, Kaa, Krhs )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE stp_2D ***
+ !!
+ !! ** Purpose : - Compute sea-surface height and barotropic velocity at Kaa
+ !! in single 1st RK3.
+ !!
+ !! ** Method : -1- Compute the 3D to 2D forcing
+ !! * Momentum (Ue,Ve)_rhs :
+ !! 3D to 2D dynamics, i.e. the vertical sum of :
+ !! - Hor. adv. : KEG + RVO in vector form
+ !! : ADV_h + MET in flux form
+ !! - LDF Lateral mixing
+ !! - HPG Hor. pressure gradient
+ !! External forcings
+ !! - baroclinic drag
+ !! - wind
+ !! - atmospheric pressure
+ !! - snow+ice load
+ !! - surface wave load
+ !! * ssh (sshe_rhs) :
+ !! Net column average freshwater flux
+ !!
+ !! -2- Solve the external mode Eqs. using sub-time step
+ !! by a call to dyn_spg_ts (will be renamed dyn_2D or stp_2D)
+ !!
+ !! ** action : ssh : N+1 sea surface height (Kaa=N+1)
+ !! (uu_b,vv_b) : N+1 barotropic velocity
+ !! (un_adv,vn_adv): barotropic transport from N to N+1
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kt, Kbb, Kmm, Kaa, Krhs ! ocean time-step and time-level indices
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zg_2, zintp, zgrho0r, zld, zztmp ! local scalars
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpice ! 2D workspace
+ !! ---------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('stp_2D')
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'stp_2D : barotropic field in single first '
+ IF(lwp) WRITE(numout,*) '~~~~~~'
+ ENDIF
+ !
+ IF( ln_linssh ) THEN !== Compute ww(:,:,1) ==! (needed for momentum advection)
+!!gm only in Flux Form, Vector Form dzU_z=0 assumed to be zero
+!!gm ww(k=1) = div_h(uu_b) ==> modif dans dynadv <<<=== TO BE DONE
+ ENDIF
+
+ ALLOCATE( sshe_rhs(jpi,jpj) , Ue_rhs(jpi,jpj) , Ve_rhs(jpi,jpj) , CdU_u(jpi,jpj) , CdU_v(jpi,jpj) )
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! RHS of barotropic momentum Eq.
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+ ! !======================================!
+ ! !== Dynamics 2D RHS from 3D trends ==! (HADV + LDF + HPG) (No Coriolis trend)
+ ! !======================================!
+
+ uu(:,:,:,Krhs) = 0._wp ! set dynamics trends to zero
+ vv(:,:,:,Krhs) = 0._wp
+
+ SELECT CASE( n_dynadv ) !* compute horizontal advection only *!
+ CASE( np_VEC_c2 ) !- vector form ( HADV = KEG + VOR )
+ CALL dyn_keg( kt, nn_dynkeg, Kbb, uu, vv, Krhs ) ! grad_h(KE)
+ CALL dyn_vor( kt, Kbb, uu, vv, Krhs, np_RVO ) ! relative vorticity
+ CASE( np_FLX_c2 ) !- flux form ( HADV = ADV_h + MET )
+ CALL dyn_adv_cen2( kt , Kbb, uu, vv, Krhs, no_zad = 1 ) ! 2nd order centered scheme
+ CALL dyn_vor ( kt , Kbb, uu, vv, Krhs, np_MET ) ! metric term
+ CASE( np_FLX_ubs )
+ CALL dyn_adv_ubs ( kt , Kbb, Kbb, uu, vv, Krhs, no_zad = 1) ! 3rd order UBS scheme (UP3)
+ CALL dyn_vor ( kt , Kbb, uu, vv, Krhs, np_MET ) ! metric term
+ END SELECT
+ !
+ ! !* lateral viscosity *!
+ CALL dyn_ldf( kt, Kbb, Kbb, uu, vv, Krhs )
+#if defined key_agrif
+ IF(.NOT. Agrif_Root() ) THEN !* AGRIF: sponge *!
+ CALL Agrif_Sponge_dyn
+ ENDIF
+#endif
+ !
+ ! !* hydrostatic pressure gradient *!
+ CALL eos ( ts , Kbb, rhd ) ! in situ density anomaly at Kbb
+ CALL dyn_hpg( kt , Kbb , uu, vv, Krhs ) ! horizontal gradient of Hydrostatic pressure
+ !
+ ! !* vertical averaging *!
+ Ue_rhs(:,:) = SUM( e3u_0(:,:,:) * uu(:,:,:,Krhs) * umask(:,:,:), DIM=3 ) * r1_hu_0(:,:)
+ Ve_rhs(:,:) = SUM( e3v_0(:,:,:) * vv(:,:,:,Krhs) * vmask(:,:,:), DIM=3 ) * r1_hv_0(:,:)
+ !
+ !
+ ! !===========================!
+ ! !== external 2D forcing ==!
+ ! !===========================!
+ !
+ ! !* baroclinic drag forcing *! (also provide the barotropic drag coeff.)
+ !
+ CALL dyn_drg_init( Kbb, Kbb, uu, vv, uu_b, vv_b, Ue_rhs, Ve_rhs, CdU_u, CdU_v )
+ !
+ ! !* wind forcing *!
+!!st ATTENTION stoke drift !!
+ IF( ln_bt_fw ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu(ji,jj,Kbb)
+ Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + r1_rho0 * vtau(ji,jj) * r1_hv(ji,jj,Kbb)
+ END_2D
+ ELSE
+ zztmp = r1_rho0 * r1_2
+ DO_2D( 0, 0, 0, 0 )
+ Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu(ji,jj,Kbb)
+ Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv(ji,jj,Kbb)
+ END_2D
+ ENDIF
+ !
+ ! !* atmospheric pressure forcing *!
+ IF( ln_apr_dyn ) THEN
+ IF( ln_bt_fw ) THEN ! FORWARD integration: use kt+1/2 pressure (NOW+1/2)
+ DO_2D( 0, 0, 0, 0 )
+ Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj)
+ Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj)
+ END_2D
+ ELSE ! CENTRED integration: use kt-1/2 + kt+1/2 pressure (NOW)
+ zztmp = grav * r1_2
+ DO_2D( 0, 0, 0, 0 )
+ Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + zztmp * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) &
+ & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj)
+ Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + zztmp * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) &
+ & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj)
+ END_2D
+ ENDIF
+ ENDIF
+ !
+ ! !* snow+ice load *! (embedded sea ice)
+ IF( ln_ice_embd ) THEN
+ ALLOCATE( zpice(jpi,jpj) )
+ zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc )
+ zgrho0r = - grav * r1_rho0
+ zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zgrho0r
+ DO_2D( 0, 0, 0, 0 )
+ Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+ Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
+ END_2D
+ DEALLOCATE( zpice )
+ ENDIF
+ !
+ ! !* surface wave load *! (Bernoulli head)
+ !
+ IF( ln_wave .AND. ln_bern_srfc ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + ( bhd_wave(ji+1,jj) - bhd_wave(ji,jj) ) * r1_e1u(ji,jj) !++ bhd_wave from wave model in m2/s2 [BHD parameters in WW3]
+ Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + ( bhd_wave(ji,jj+1) - bhd_wave(ji,jj) ) * r1_e1u(ji,jj)
+ END_2D
+ ENDIF
+ !
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! RHS of see surface height Eq.
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ !
+ ! !== Net water flux forcing ==! (applied to a water column)
+ !
+ IF (ln_bt_fw) THEN ! FORWARD integration: use kt+1/2 fluxes (NOW+1/2)
+ sshe_rhs(:,:) = 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
+ sshe_rhs(:,:) = zztmp * ( emp(:,:) + emp_b(:,:) &
+ & - rnf(:,:) - rnf_b(:,:) &
+ & + fwfisf_cav(:,:) + fwfisf_cav_b(:,:) &
+ & + fwfisf_par(:,:) + fwfisf_par_b(:,:) )
+ ENDIF
+ !
+ ! !== Stokes drift divergence ==! (if exist)
+ !
+ IF( ln_sdw ) sshe_rhs(:,:) = sshe_rhs(:,:) + div_sd(:,:)
+ !
+ !
+ ! !== ice sheet coupling ==!
+ !
+ IF( ln_isf .AND. ln_isfcpl ) THEN
+ IF( ln_rstart .AND. kt == nit000 ) sshe_rhs(:,:) = sshe_rhs(:,:) + risfcpl_ssh(:,:)
+ IF( ln_isfcpl_cons ) sshe_rhs(:,:) = sshe_rhs(:,:) + risfcpl_cons_ssh(:,:)
+ ENDIF
+ !
+#if defined key_asminc
+ ! !== Add the IAU weighted SSH increment ==!
+ !
+ IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) sshe_rhs(:,:) = sshe_rhs(:,:) - ssh_iau(:,:)
+#endif
+ !
+#if defined key_agrif
+ ! !== AGRIF : fill boundary data arrays (on both )
+ IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt )
+#endif
+ !
+ !
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! Compute ssh and (uu_b,vv_b) at N+1 (Kaa)
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+ ! using a split-explicit time integration in forward mode
+ ! ( ABM3-AM4 time-integration Shchepetkin et al. OM2005) with temporal diffusion (Demange et al. JCP2019) )
+
+ CALL dyn_spg_ts( kt, Kbb, Kbb, Krhs, uu, vv, ssh, uu_b, vv_b, Kaa ) ! time-splitting
+
+
+ DEALLOCATE( sshe_rhs , Ue_rhs , Ve_rhs , CdU_u , CdU_v )
+
+!!gm this is useless I guess : RK3, done in each stages
+!
+! IF( ln_dynspg_ts ) THEN ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Krhs)
+! ! as well as vertical scale factors and vertical velocity need to be updated
+! CALL div_hor ( kstp, Kbb, Kmm ) ! Horizontal divergence (2nd call in time-split case)
+! IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Kaa), r3t(:,:,Kaa), r3u(:,:,Kaa), r3v(:,:,Kaa), r3f(:,:) ) ! update ssh/h_0 ratio at t,u,v,f pts
+! ENDIF
+!!gm
+ !
+ IF( ln_timing ) CALL timing_stop('stp_2D')
+ !
+ END SUBROUTINE stp_2D
+
+
+#else
+ !!----------------------------------------------------------------------
+ !! default option EMPTY MODULE qco not activated
+ !!----------------------------------------------------------------------
+#endif
+
+ !!======================================================================
+END MODULE stp2d
diff --git a/src/OCE/stpmlf.F90 b/src/OCE/stpmlf.F90
index 76ffa0449..9c59c9e7e 100644
--- a/src/OCE/stpmlf.F90
+++ b/src/OCE/stpmlf.F90
@@ -34,7 +34,8 @@ MODULE stpmlf
!! 4.1 ! 2019-08 (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme
!! 4.x ! 2020-08 (S. Techene, G. Madec) quasi eulerian coordinate time stepping
!!----------------------------------------------------------------------
-#if defined key_qco || defined key_linssh
+#if ! defined key_RK3
+# if defined key_qco || defined key_linssh
!!----------------------------------------------------------------------
!! 'key_qco' Quasi-Eulerian vertical coordinate
!! OR
@@ -91,8 +92,8 @@ CONTAINS
!! -7- Compute the diagnostics variables (rd,N2, hdiv,w)
!! -8- Outputs and diagnostics
!!----------------------------------------------------------------------
- INTEGER :: ji, jj, jk, jtile ! dummy loop indice
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zgdept
+ INTEGER :: ji, jj, jk, jn, jtile ! dummy loop indice
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zgdept
!! ---------------------------------------------------------------------
#if defined key_agrif
IF( nstop > 0 ) RETURN ! avoid to go further if an error was detected during previous time step (child grid)
@@ -281,7 +282,6 @@ CONTAINS
IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning
ENDIF
-
!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
! cool skin
!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -316,11 +316,17 @@ CONTAINS
!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
! Active tracers
!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- ts(:,:,:,:,Nrhs) = 0._wp ! set tracer trends to zero
- IF( ln_tile ) CALL dom_tile_start ! [tiling] TRA tiling loop (1)
+ IF( ln_tile ) CALL dom_tile_start ! [tiling] TRA tiling loop (1)
+
DO jtile = 1, nijtile
- IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+ IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile )
+
+ DO jn = 1, jpts
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ ts(ji,jj,jk,jn,Nrhs) = 0._wp ! set tracer trends to zero
+ END_3D
+ END DO
IF( lk_asminc .AND. ln_asmiau .AND. &
& ln_trainc ) CALL tra_asm_inc( kstp, Nbb, Nnn, ts, Nrhs ) ! apply tracer assimilation increment
@@ -542,7 +548,7 @@ CONTAINS
! Update after tracer and velocity on domain lateral boundaries
!
# if defined key_agrif
- CALL Agrif_tra !* AGRIF zoom boundaries
+ CALL Agrif_tra( kt ) !* AGRIF zoom boundaries
CALL Agrif_dyn( kt )
# endif
! ! local domain boundaries (T-point, unchanged sign)
@@ -566,10 +572,11 @@ CONTAINS
!
END SUBROUTINE finalize_lbc
-#else
+# else
!!----------------------------------------------------------------------
!! default option EMPTY MODULE qco not activated
!!----------------------------------------------------------------------
+# endif
#endif
!!======================================================================
diff --git a/src/OCE/stprk3.F90 b/src/OCE/stprk3.F90
new file mode 100644
index 000000000..9b68d341f
--- /dev/null
+++ b/src/OCE/stprk3.F90
@@ -0,0 +1,390 @@
+MODULE stprk3
+ !!======================================================================
+ !! *** MODULE stpRK3 ***
+ !! Time-stepping : manager of the ocean, tracer and ice time stepping
+ !! using a 3rd order Rung Kuta with fixed or quasi-eulerian coordinate
+ !!======================================================================
+ !! History : 4.5 ! 2021-01 (S. Techene, G. Madec, N. Ducousso, F. Lemarie) Original code
+ !! NEMO
+ !!----------------------------------------------------------------------
+#if defined key_qco || defined key_linssh
+ !!----------------------------------------------------------------------
+ !! 'key_qco' Quasi-Eulerian vertical coordinate
+ !! OR
+ !! 'key_linssh Fixed in time vertical coordinate
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! stp_RK3 : NEMO 3rd order Runge-Kutta time-stepping
+ !!----------------------------------------------------------------------
+ USE step_oce ! time stepping used modules
+ USE domqco ! quasi-eulerian coordinate (dom_qco_r3c routine)
+ USE stprk3_stg ! RK3 stages
+ USE stp2d ! external mode solver
+ USE dynspg_ts, ONLY: un_adv, vn_adv ! updated Kmm barotropic transport
+ USE trd_oce ! trends: ocean variables
+ USE diaptr
+ USE ldftra
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC stp_RK3 ! called by nemogcm.F90
+
+ ! !** time level indices **!
+ INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs !: used by nemo_init
+
+ !! * Substitutions
+# include "do_loop_substitute.h90"
+# include "domzgr_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: step.F90 12377 2020-02-12 14:39:06Z acc $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+#if defined key_agrif
+ RECURSIVE SUBROUTINE stp_RK3( )
+ INTEGER :: kstp ! ocean time-step index
+#else
+ SUBROUTINE stp_RK3( kstp )
+ INTEGER, INTENT(in) :: kstp ! ocean time-step index
+#endif
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE stp_RK3 ***
+ !!
+ !! ** Purpose : - Time stepping of OCE (momentum and active tracer Eqs.) (RK3)
+ !! - Time stepping of SI3 (dynamic and thermodynamic Eqs.) (FBS)
+ !! - Time stepping of TRC (passive tracer Eqs.)
+ !!
+ !! ** Method : -1- Update forcings and data
+ !! -2- Update ocean physics
+ !! -3- Compute the after (Naa) ssh and velocity
+ !! -4- diagnostics and output at Now (Nnn)
+ !! -4- Compute the after (Naa) T-S
+ !! -5- Update now
+ !! -6- Update the horizontal velocity
+ !! -7- Compute the diagnostics variables (rd,N2, hdiv,w)
+ !! -8- Outputs and diagnostics
+ !!----------------------------------------------------------------------
+ INTEGER :: ji, jj, jk, jtile ! dummy loop indice
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zgdept
+ !! ---------------------------------------------------------------------
+#if defined key_agrif
+ IF( nstop > 0 ) RETURN ! avoid to go further if an error was detected during previous time step (child grid)
+ kstp = nit000 + Agrif_Nb_Step()
+ Kbb_a = Nbb ; Kmm_a = Nnn ; Krhs_a = Nrhs ! agrif_oce module copies of time level indices
+ IF( lk_agrif_debug ) THEN
+ IF( Agrif_Root() .AND. lwp) WRITE(*,*) '---'
+ IF(lwp) WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint()
+ ENDIF
+ IF( kstp == nit000 + 1 ) lk_agrif_fstep = .FALSE.
+# if defined key_xios
+ IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context )
+# endif
+#endif
+ !
+ IF( ln_timing ) CALL timing_start('stp_RK3')
+ !
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! update I/O and calendar
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ !
+ IF( kstp == nit000 ) THEN ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS)
+ CALL iom_init( cxios_context, ld_closedef=.FALSE. ) ! for model grid (including possible AGRIF zoom)
+ IF( lk_diamlr ) CALL dia_mlr_iom_init ! with additional setup for multiple-linear-regression analysis
+ CALL dia_ptr_init ! called here since it uses iom_use
+ CALL iom_init_closedef
+ IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" ) ! for coarse grid
+ ENDIF
+ IF( kstp == nitrst .AND. lwxios ) THEN
+ CALL iom_swap( cw_ocerst_cxt )
+ CALL iom_init_closedef( cw_ocerst_cxt )
+ CALL iom_setkt( kstp - nit000 + 1, cw_ocerst_cxt )
+#if defined key_top
+ CALL iom_swap( cw_toprst_cxt )
+ CALL iom_init_closedef( cw_toprst_cxt )
+ CALL iom_setkt( kstp - nit000 + 1, cw_toprst_cxt )
+#endif
+ ENDIF
+#if defined key_si3
+ IF( kstp + nn_fsbc - 1 == nitrst .AND. lwxios ) THEN
+ CALL iom_swap( cw_icerst_cxt )
+ CALL iom_init_closedef( cw_icerst_cxt )
+ CALL iom_setkt( kstp - nit000 + 1, cw_icerst_cxt )
+ ENDIF
+#endif
+ IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init)
+ CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell IOM we are at time step kstp
+ IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" ) ! tell IOM we are at time step kstp
+
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! Update external forcing (tides, open boundaries, ice shelf interaction and surface boundary condition (including sea-ice)
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ IF( ln_tide ) CALL tide_update( kstp ) ! update tide potential
+ IF( ln_apr_dyn ) CALL sbc_apr ( kstp ) ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib)
+ IF( ln_bdy ) CALL bdy_dta ( kstp, Nbb ) ! update dynamic & tracer data at open boundaries
+ IF( ln_isf ) CALL isf_stp ( kstp, Nbb ) ! update iceshelf geometry
+ CALL sbc ( kstp, Nbb, Nbb ) ! Sea Boundary Condition (including sea-ice)
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! Update stochastic parameters and random T/S fluctuations
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ IF( ln_sto_eos ) CALL sto_par( kstp ) ! Stochastic parameters
+ IF( ln_sto_eos ) CALL sto_pts( ts(:,:,:,:,Nnn) ) ! Random T/S fluctuations
+
+!!gm ocean physic computed at stage 3 ?
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! Ocean physics update
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ ! THERMODYNAMICS
+!!gm only Before is needed for bn2 and rab (except at stage 3 for n2)
+!!gm issue with Nnn used in rad(Nbb)
+ CALL eos_rab( ts(:,:,:,:,Nbb), rab_b, Nbb ) ! before local thermal/haline expension ratio at T-points
+!!st CALL eos_rab( ts(:,:,:,:,Nnn), rab_n, Nnn ) ! now local thermal/haline expension ratio at T-points
+ CALL bn2 ( ts(:,:,:,:,Nbb), rab_b, rn2b, Nbb ) ! before Brunt-Vaisala frequency
+!!st CALL bn2 ( ts(:,:,:,:,Nnn), rab_n, rn2, Nnn ) ! now Brunt-Vaisala frequency
+!!gm
+ rab_n = rab_b
+ rn2 = rn2b
+!!gm sh2 computed at the end of the time-step
+!!gm or call zdf_phy at the end !
+ ! VERTICAL PHYSICS
+!!st CALL zdf_phy( kstp, Nbb, Nnn, Nrhs ) ! vertical physics update (top/bot drag, avt, avs, avm + MLD)
+ CALL zdf_phy( kstp, Nbb, Nbb, Nrhs ) ! vertical physics update (top/bot drag, avt, avs, avm + MLD)
+!!gm
+ ! LATERAL PHYSICS
+ !
+ IF( l_ldfslp ) THEN ! slope of lateral mixing
+!!gm gdep
+ CALL eos( ts(:,:,:,:,Nbb), rhd, gdept_0(:,:,:) ) ! before in situ density
+
+ IF( ln_zps .AND. .NOT. ln_isfcav) &
+ & CALL zps_hde ( kstp, Nbb, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv, & ! Partial steps: before horizontal gradient
+ & rhd, gru , grv ) ! of t, s, rd at the last ocean level
+
+ IF( ln_zps .AND. ln_isfcav) &
+ & CALL zps_hde_isf( kstp, Nbb, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF)
+ & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the first ocean level
+ IF( ln_traldf_triad ) THEN
+ CALL ldf_slp_triad( kstp, Nbb, Nbb ) ! before slope for triad operator
+ ELSE
+ CALL ldf_slp ( kstp, rhd, rn2b, Nbb, Nbb ) ! before slope for standard operator
+ ENDIF
+ ENDIF
+ ! ! eddy diffusivity coeff.
+ IF( l_ldftra_time .OR. l_ldfeiv_time ) CALL ldf_tra( kstp, Nbb, Nbb ) ! and/or eiv coeff.
+ IF( l_ldfdyn_time ) CALL ldf_dyn( kstp, Nbb ) ! eddy viscosity coeff.
+
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! RK3 : single first external mode computation
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+ CALL stp_2D( kstp, Nbb, Nbb, Naa, Nrhs ) ! out: ssh, (uu_b,vv_b) and (un_adv,vn_adv) at Naa
+
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! RK3 time integration
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+ CALL rk3_dia( kstp, 0 ) ! Diagnostics switched off for stage 1 & 2
+ !
+ ! Stage 1 :
+ CALL stp_RK3_stg( 1, kstp, Nbb, Nbb, Nrhs, Naa )
+ !
+ Nrhs = Nnn ; Nnn = Naa ; Naa = Nrhs ! Swap: Nbb unchanged, Nnn <==> Naa
+ !
+ ! Stage 2 :
+ CALL stp_RK3_stg( 2, kstp, Nbb, Nnn, Nrhs, Naa )
+ !
+ Nrhs = Nnn ; Nnn = Naa ; Naa = Nrhs ! Swap: Nbb unchanged, Nnn <==> Naa
+ !
+ ! Stage 3 :
+ CALL rk3_dia( kstp, 1 ) ! Diagnostics switched on for stage 3
+ !
+ CALL stp_RK3_stg( 3, kstp, Nbb, Nnn, Nrhs, Naa )
+ !
+ Nrhs = Nbb ; Nbb = Naa ; Naa = Nrhs ! Swap: Nnn unchanged, Nbb <==> Naa
+
+ ! Swap time levels
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! diagnostics and outputs
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+!==>>> at Nbb no more Nnn
+
+ IF( ln_diacfl ) CALL dia_cfl ( kstp, Nbb ) ! Courant number diagnostics
+ CALL dia_hth ( kstp, Nbb ) ! Thermocline depth (20 degres isotherm depth)
+ IF( ln_diadct ) CALL dia_dct ( kstp, Nbb ) ! Transports
+!!st CALL dia_ar5 ( kstp, Nbb ) ! ar5 diag
+ CALL dia_ptr ( kstp, Nbb ) ! Poleward adv/ldf TRansports diagnostics
+ CALL dia_wri ( kstp, Nbb ) ! ocean model: outputs
+ IF( ln_crs ) CALL crs_fld ( kstp, Nbb ) ! ocean model: online field coarsening & output
+ IF( lk_diadetide ) CALL dia_detide( kstp ) ! Weights computation for daily detiding of model diagnostics
+ IF( lk_diamlr ) CALL dia_mlr ! Update time used in multiple-linear-regression analysis
+
+!!====>>>> to be modified for RK3
+! IF( ln_floats ) CALL flo_stp ( kstp, Nbb, Nnn ) ! drifting Floats
+! IF( ln_diahsb ) CALL dia_hsb ( kstp, Nbb, Nnn ) ! - ML - global conservation diagnostics
+!!st
+ IF( ln_diahsb ) CALL dia_hsb ( kstp, Nbb, Nbb ) ! - ML - global conservation diagnostics
+!!st
+
+!!gm : This does not only concern the dynamics ==>>> add a new title
+!!gm2: why ouput restart before AGRIF update?
+!!
+!!jc: That would be better, but see comment above
+!!
+!!====>>>> to be modified for RK3
+ IF( lrst_oce ) CALL rst_write ( kstp, Nbb, Nnn ) ! write output ocean restart file
+ IF( ln_sto_eos ) CALL sto_rst_write( kstp ) ! write restart file for stochastic parameters
+
+#if defined key_agrif
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! AGRIF recursive integration
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ Kbb_a = Nbb; Kmm_a = Nbb; Krhs_a = Nrhs ! agrif_oce module copies of time level indices
+ CALL Agrif_Integrate_ChildGrids( stp_RK3 ) ! allows to finish all the Child Grids before updating
+
+#endif
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! Control
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ CALL stp_ctl ( kstp, Nbb )
+#if defined key_agrif
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! AGRIF update
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) &
+ & CALL Agrif_update_all( ) ! Update all components
+
+#endif
+ IF( ln_diaobs .AND. nstop == 0 ) &
+ & CALL dia_obs( kstp, Nnn ) ! obs-minus-model (assimilation) diags (after dynamics update)
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! File manipulation at the end of the first time step
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ IF( kstp == nit000 ) THEN ! 1st time step only
+ CALL iom_close( numror ) ! close input ocean restart file
+ IF( lrxios ) CALL iom_context_finalize( cr_ocerst_cxt )
+ IF(lwm) CALL FLUSH ( numond ) ! flush output namelist oce
+ IF(lwm .AND. numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice (if exist)
+ ENDIF
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! Coupled mode
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ IF( lk_oasis .AND. nstop == 0 ) CALL sbc_cpl_snd( kstp, Nbb, Nnn ) ! coupled mode : field exchanges
+ !
+#if defined key_xios
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! Finalize contextes if end of simulation or error detected
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ IF( kstp == nitend .OR. nstop > 0 ) THEN
+ CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
+ IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) !
+ ENDIF
+#endif
+ !
+ IF( ln_timing ) CALL timing_stop('stp_RK3')
+ !
+ END SUBROUTINE stp_RK3
+
+
+ SUBROUTINE mlf_baro_corr( Kmm, Kaa, puu, pvv )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE mlf_baro_corr ***
+ !!
+ !! ** Purpose : Finalize after horizontal velocity.
+ !!
+ !! ** Method : * Ensure after velocities transport matches time splitting
+ !! estimate (ln_dynspg_ts=T)
+ !!
+ !! ** Action : puu(Kmm),pvv(Kmm) updated now horizontal velocity (ln_bt_fw=F)
+ !! puu(Kaa),pvv(Kaa) after horizontal velocity
+ !!----------------------------------------------------------------------
+ USE dynspg_ts, ONLY : un_adv, vn_adv ! updated Kmm barotropic transport
+ !!
+ INTEGER , INTENT(in ) :: Kmm, Kaa ! before and after time level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocities
+ !
+ INTEGER :: jk ! dummy loop indices
+ REAL(wp), DIMENSION(jpi,jpj) :: zue, zve
+ !!----------------------------------------------------------------------
+
+ ! Ensure below that barotropic velocities match time splitting estimate
+ ! Compute actual transport and replace it with ts estimate at "after" time step
+ zue(:,:) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1)
+ zve(:,:) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1)
+ DO jk = 2, jpkm1
+ zue(:,:) = zue(:,:) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)
+ zve(:,:) = zve(:,:) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)
+ END DO
+ DO jk = 1, jpkm1
+ puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) - zue(:,:) * r1_hu(:,:,Kaa) + uu_b(:,:,Kaa) ) * umask(:,:,jk)
+ pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) - zve(:,:) * r1_hv(:,:,Kaa) + vv_b(:,:,Kaa) ) * vmask(:,:,jk)
+ END DO
+ !
+!!st IF( .NOT.ln_bt_fw ) THEN
+!!st ! Remove advective velocity from "now velocities"
+!!st ! prior to asselin filtering
+!!st ! In the forward case, this is done below after asselin filtering
+!!st ! so that asselin contribution is removed at the same time
+!!st DO jk = 1, jpkm1
+!!st puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm) + uu_b(:,:,Kmm) )*umask(:,:,jk)
+!!st pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm) + vv_b(:,:,Kmm) )*vmask(:,:,jk)
+!!st END DO
+!!st ENDIF
+ !
+ END SUBROUTINE mlf_baro_corr
+
+
+ SUBROUTINE rk3_dia( kstp, kswitch )
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kstp ! ocean time-step index
+ INTEGER, INTENT(in) :: kswitch ! on/off = 1/0
+ !!
+ LOGICAL, SAVE :: ll_trddyn, ll_trdtrc, ll_trdtra ! call trd at stage 3 only
+ LOGICAL, SAVE :: ll_diaptr, ll_ldfeiv_dia
+ !!----------------------------------------------------------------------
+ !
+ IF( kstp == nit000 ) THEN ! save diagnotic logical
+ ll_trdtra = l_trdtra
+ ll_trdtrc = l_trdtrc
+ ll_trddyn = l_trddyn
+ ll_diaptr = l_diaptr
+ ll_ldfeiv_dia = l_ldfeiv_dia
+ ENDIF
+ !
+ SELECT CASE( kswitch )
+ CASE ( 1 ) ! diagnostic activated (on)
+ l_trdtra = ll_trdtra
+ l_trdtrc = ll_trdtrc
+ l_trddyn = ll_trddyn
+ l_diaptr = ll_diaptr
+ l_ldfeiv_dia = ll_ldfeiv_dia
+ CASE ( 0 ) ! diagnostic desactivated (off)
+ l_trdtra = .FALSE.
+ l_trdtrc = .FALSE.
+ l_trddyn = .FALSE.
+ l_diaptr = .FALSE.
+ l_ldfeiv_dia = .FALSE.
+ END SELECT
+ !
+ END SUBROUTINE rk3_dia
+
+#else
+ !!----------------------------------------------------------------------
+ !! default option EMPTY MODULE qco not activated
+ !!----------------------------------------------------------------------
+#endif
+
+ !!======================================================================
+END MODULE stprk3
diff --git a/src/OCE/stprk3_stg.F90 b/src/OCE/stprk3_stg.F90
new file mode 100644
index 000000000..4ac8e54b5
--- /dev/null
+++ b/src/OCE/stprk3_stg.F90
@@ -0,0 +1,432 @@
+MODULE stprk3_stg
+ !!======================================================================
+ !! *** MODULE stprk3_stg ***
+ !! Time-stepping : manager of the ocean, tracer and ice time stepping
+ !! using a 3rd order Runge-Kutta with fixed or quasi-eulerian coordinate
+ !!======================================================================
+ !! History : 4.5 ! 2021-01 (S. Techene, G. Madec, N. Ducousso, F. Lemarie) Original code
+ !! NEMO
+ !!----------------------------------------------------------------------
+#if defined key_qco || defined key_linssh
+ !!----------------------------------------------------------------------
+ !! 'key_qco' Quasi-Eulerian vertical coordinate
+ !! OR
+ !! 'key_linssh Fixed in time vertical coordinate
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! stp_RK3_stg : NEMO 3rd order Runge-Kutta stage with qco or linssh
+ !!----------------------------------------------------------------------
+ USE step_oce ! time stepping used modules
+ USE domqco ! quasi-eulerian coordinate (dom_qco_r3c routine)
+ USE dynspg_ts, ONLY: un_adv , vn_adv ! advective transport from N to N+1
+ USE bdydyn ! ocean open boundary conditions (define bdy_dyn)
+# if defined key_top
+ USE trc ! ocean passive tracers variables
+ USE trcadv ! passive tracers advection (trc_adv routine)
+ USE trcsms ! passive tracers source and sink
+ USE trctrp ! passive tracers transport
+ USE trcsbc ! passive tracers surface boundary condition !!st WARNING USELESS TO BE REMOVED
+ USE trcbdy ! passive tracers transport open boundary
+ USE trcstp_rk3
+# endif
+# if defined key_agrif
+ USE agrif_oce_interp
+# endif
+
+ !
+ USE prtctl ! print control
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC stp_RK3_stg ! called by nemogcm.F90
+
+ REAL(wp) :: r1_2 = 1._wp / 2._wp
+ REAL(wp) :: r1_3 = 1._wp / 3._wp
+ REAL(wp) :: r2_3 = 2._wp / 3._wp
+
+ REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssha ! sea-surface height at N+1
+ REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_b, va_b ! barotropic velocity at N+1
+
+ !! * Substitutions
+# include "do_loop_substitute.h90"
+# include "domzgr_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+ !! $Id: step.F90 12377 2020-02-12 14:39:06Z acc $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE stp_RK3_stg( kstg, kstp, Kbb, Kmm, Krhs, Kaa )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE stp_RK3_stg ***
+ !!
+ !! ** Purpose : - stage of RK3 time stepping of OCE and TOP
+ !!
+ !! ** Method : input: computed in dynspg_ts
+ !! ssh shea surface height at N+1 (oce.F90)
+ !! (uu_b,vv_b) barotropic velocity at N, N+1 (oce.F90)
+ !! (un_adv,vn_adv) barotropic transport from N to N+1 (dynspg_ts.F90)
+ !! ,
+ !! -1- set ssh(Naa) (Naa=N+1/3, N+1/2, or N)
+ !! -2- set the advective velocity (zadU,zaV)
+ !! -4- Compute the after (Naa) T-S
+ !! -5- Update now
+ !! -6- Update the horizontal velocity
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kstg ! RK3 stage
+ INTEGER, INTENT(in) :: kstp, Kbb, Kmm, Krhs, Kaa ! ocean time-step and time-level indices
+ !
+ INTEGER :: ji, jj, jk, jn, jtile ! dummy loop indices
+ REAL(wp) :: ze3Tb, ze3Sb, z1_e3t ! local scalars
+ REAL(wp) :: ze3Tr, ze3Sr ! - -
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zaU, zaV ! advective horizontal velocity
+ REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb ! advective transport
+ !! ---------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('stp_RK3_stg')
+ !
+ IF( kstp == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'stp_RK3_stg : Runge Kutta 3rd order at stage ', kstg
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+ ENDIF
+ !
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! ssh, uu_b, vv_b, and ssh/h0 at Kaa
+ ! 3D advective velocity at Kmm
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ !
+ SELECT CASE( kstg )
+ ! !---------------!
+ CASE ( 1 ) !== Stage 1 ==! Kbb = Kmm = N ; Kaa = N+1/3
+ ! !---------------!
+ !
+ ALLOCATE( ssha(jpi,jpj) , ua_b(jpi,jpj) , va_b(jpi,jpj) )
+ !
+ rDt = r1_3 * rn_Dt ! set time-step : rn_Dt/3
+ r1_Dt = 1._wp / rDt
+ !
+ ssha(:,:) = ssh (:,:,Kaa) ! save ssh, uu_b, vv_b at N+1 (computed in dynspg_ts)
+ ua_b(:,:) = uu_b(:,:,Kaa)
+ va_b(:,:) = vv_b(:,:,Kaa)
+ ! ! interpolated ssh and (uu_b,vv_b) at Kaa (N+1/3)
+ ssh (:,:,Kaa) = r2_3 * ssh (:,:,Kbb) + r1_3 * ssha(:,:)
+ uu_b(:,:,Kaa) = r2_3 * uu_b(:,:,Kbb) + r1_3 * ua_b(:,:)
+ vv_b(:,:,Kaa) = r2_3 * vv_b(:,:,Kbb) + r1_3 * va_b(:,:)
+ !
+ ! !---------------!
+ CASE ( 2 ) !== Stage 2 ==! Kbb = N ; Kmm = N+1/3 ; Kaa = N+1/2
+ ! !---------------!
+ !
+ rDt = r1_2 * rn_Dt ! set time-step : rn_Dt/2
+ r1_Dt = 1._wp / rDt
+ !
+ ! ! set ssh and (uu_b,vv_b) at N+1/2 (Kaa)
+ ssh (:,:,Kaa) = r1_2 * ( ssh (:,:,Kbb) + ssha(:,:) )
+ uu_b(:,:,Kaa) = r1_2 * ( uu_b(:,:,Kbb) + ua_b(:,:) )
+ vv_b(:,:,Kaa) = r1_2 * ( vv_b(:,:,Kbb) + va_b(:,:) )
+ !
+ ! !---------------!
+ CASE ( 3 ) !== Stage 3 ==! Kbb = N ; Kmm = N+1/2 ; Kaa = N+1
+ ! !---------------!
+ !
+ rDt = rn_Dt ! set time-step : rn_Dt
+ r1_Dt = 1._wp / rDt
+ !
+ ssh (:,:,Kaa) = ssha(:,:) ! recover ssh and (uu_b,vv_b) at N + 1
+ uu_b(:,:,Kaa) = ua_b(:,:)
+ vv_b(:,:,Kaa) = va_b(:,:)
+ !
+ DEALLOCATE( ssha , ua_b , va_b )
+ !
+ END SELECT
+ !
+ ! !== ssh/h0 ratio at Kaa ==!
+ !
+ IF( .NOT.lk_linssh ) CALL dom_qco_r3c( ssh(:,:,Kaa), r3t(:,:,Kaa), r3u(:,:,Kaa), r3v(:,:,Kaa), r3f(:,:) ) ! "after" ssh/h_0 ratio at t,u,v-column
+ !
+ !
+ ! !== advective velocity at Kmm ==!
+ !
+ ! !- horizontal components -! (zaU,zaV)
+ zub(:,:) = un_adv(:,:)*r1_hu(:,:,Kmm) - uu_b(:,:,Kmm) ! barotropic velocity correction
+ zvb(:,:) = vn_adv(:,:)*r1_hv(:,:,Kmm) - vv_b(:,:,Kmm)
+ DO jk = 1, jpkm1 ! horizontal advective velocity
+ zaU(:,:,jk) = uu(:,:,jk,Kmm) + zub(:,:)*umask(:,:,jk)
+ zaV(:,:,jk) = vv(:,:,jk,Kmm) + zvb(:,:)*vmask(:,:,jk)
+ END DO
+ ! !- vertical components -! ww
+ CALL wzv ( kstp, Kbb, Kmm, Kaa, zaU, zaV, ww ) ! ww cross-level velocity
+
+!!st IF( ln_zad_Aimp ) CALL wAimp( kstp, ww, wi ) ! Adaptive-implicit vertical advection partitioning
+ ! !==>>> implicite for stages 1 & 2 ????
+ !
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! RHS of ocean dynamics : ADV + VOR/COR + HPG (+ ASM ) <<<=== Question: Stokes drift ?
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ !
+ uu(:,:,:,Krhs) = 0._wp ! set dynamics trends to zero
+ vv(:,:,:,Krhs) = 0._wp
+ !
+!===>>>>>> Modify dyn_adv_... dyn_keg routines so that Krhs to zero useless
+ ! ! advection (VF or FF) ==> RHS
+ CALL dyn_adv( kstp, Kbb, Kmm , uu, vv, Krhs, zaU, zaV, ww )
+ ! ! Coriolis / vorticity ==> RHS
+ CALL dyn_vor( kstp, Kmm , uu, vv, Krhs )
+ !
+!!gm à appeler que pour ln_zad_Aimp=T et en ne faisant que wi par zdf
+!! ! ZAD (implicit part) ==> RHS
+!! CALL dyn_zdf ( kstp, Kbb, Kmm, Krhs, uu, vv, Kaa )
+
+!===>>>>>> Modify dyn_hpg & dyn_hpg_... routines : rhd computed in dyn_hpg and pass in argument to dyn_hpg_...
+
+!!st IF( kstg == 3 ) THEN
+! CALL eos ( ts(:,:,:,:,Kmm), rhd, rhop, gdept_0 ) ! now in situ density for hpg computation
+! ELSE
+ CALL eos ( ts, Kmm, rhd ) ! Kmm in situ density anomaly for hpg computation
+! ENDIF
+
+!!gm end
+ CALL dyn_hpg( kstp, Kmm , uu, vv, Krhs )
+ !
+!!gm ===>>>>>> Probably useless since uu_b(Kaa) will be imposed at the end of stage 1 and 2
+! but may be necessary in stage 3 due to implicite in dynzdf.
+! except if my idea for the matrice construction is OK !
+! ! ! grad_h of ps ==> RHS
+! DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+! uu(ji,jj,jk,Krhs) = uu(ji,jj,jk,Krhs) - grav * ( ssh(ji+1,jj ,Kmm) - ssh(ji,jj,Kmm) )
+! vv(ji,jj,jk,Krhs) = vv(ji,jj,jk,Krhs) - grav * ( ssh(ji ,jj+1,Kmm) - ssh(ji,jj,Kmm) )
+! END_3D
+!!gm
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! RHS of tracers : ADV only using (zaU,zaV,ww)
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+# if defined key_top
+ !
+ ! !== Passive Tracer ==!
+ !
+ SELECT CASE( kstg )
+ ! !-------------------!
+ CASE ( 1 , 2 ) !== Stage 1 & 2 ==! stg1: Kbb = N ; Kaa = N+1/3
+ ! !-------------------! stg2: Kbb = N ; Kmm = N+1/3 ; Kaa = N+1/2
+ !
+ IF( kstg == 1 ) THEN
+ CALL trc_stp_start( kstp, Kbb, Kmm, Krhs, Kaa )
+ ENDIF
+ !
+ IF(.NOT. ln_trcadv_mus ) THEN
+ !
+ DO jn = 1, jptra
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ tr(ji,jj,jk,jn,Krhs) = 0._wp ! set tracer trends to zero
+ END_3D
+ END DO
+ ! !== advection of passive tracers ==!
+ rDt_trc = rDt
+ !
+ CALL trc_sbc_RK3( kstp, Kmm, tr, Krhs, kstg ) ! surface boundary condition
+ !
+ CALL trc_adv ( kstp, Kbb, Kmm, tr, Krhs, zaU, zaV, ww ) ! horizontal & vertical advection
+ !
+ ! !== time integration ==! ∆t = rn_Dt/3 (stg1) or rn_Dt/2 (stg2)
+ DO jn = 1, jptra
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ ze3Tb = e3t(ji,jj,jk,Kbb) * tr(ji,jj,jk,jn,Kbb )
+ ze3Tr = e3t(ji,jj,jk,Kmm) * tr(ji,jj,jk,jn,Krhs)
+ z1_e3t= 1._wp / e3t(ji,jj,jk, Kaa)
+ tr(ji,jj,jk,jn,Kaa) = ( ze3Tb + rDt * ze3Tr*tmask(ji,jj,jk) ) * z1_e3t
+ END_3D
+ END DO
+ !
+!!st need a lnc lkn at stage 1 & 2 otherwise tr@Kmm will not be usable in trc_adv
+ CALL lbc_lnk( 'stprk3_stg', tr(:,:,:,:,Kaa), 'T', 1._wp )
+
+ ENDIF
+ ! !---------------!
+ CASE ( 3 ) !== Stage 3 ==! add all RHS terms but advection (=> Kbb only)
+ ! !---------------!
+ !
+ DO jn = 1, jptra
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ tr(ji,jj,jk,jn,Krhs) = 0._wp ! set tracer trends to zero
+ END_3D
+ END DO
+ ! !== advection of passive tracers ==!
+ rDt_trc = rDt
+ !
+ CALL trc_sbc_RK3( kstp, Kmm, tr, Krhs, kstg ) ! surface boundary condition
+ !
+ CALL trc_adv ( kstp, Kbb, Kmm, tr, Krhs, zaU, zaV, ww ) ! horizontal & vertical advection
+ !
+ CALL trc_sms ( kstp, Kbb, Kbb, Krhs ) ! tracers: sinks and sources
+ CALL trc_trp ( kstp, Kbb, Kmm, Krhs, Kaa ) ! transport of passive tracers (without advection)
+ !
+ !
+ CALL trc_stp_end( kstp, Kbb, Kmm, Kaa )
+ !
+ END SELECT
+# endif
+
+ ! !== T-S Tracers ==!
+
+!===>>>>>> Modify tra_adv_... routines so that Krhs to zero useless
+ DO jn = 1, jpts
+!!st does not work due to lbc_lnk north fold : need to be merged with the trunk LBC pb changes for the namelist
+!! DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+!! ts(ji,jj,jk,jn,Krhs) = 0._wp ! set tracer trends to zero
+!! END_3D
+ ts(:,:,:,jn,Krhs) = 0._wp
+ END DO
+
+!===>>> CAUTION here may be without GM velocity but stokes drift required ! 0 barotropic divergence for GM != 0 barotropic divergence for SD
+!!st consistence 2D / 3D - flux de masse
+ CALL tra_adv( kstp, Kbb, Kmm, ts, Krhs, zaU, zaV, ww ) ! hor. + vert. advection ==> RHS
+
+!===>>>>>> stg1&2: Verify the necessity of these trends (we may need it as there are in the RHS of dynspg_ts ?)
+!!gm ====>>>> needed for heat and salt fluxes associated with mass/volume flux
+ CALL tra_sbc_RK3( kstp, Kmm, ts, Krhs, kstg ) ! surface boundary condition
+
+ IF( ln_isf ) CALL tra_isf ( kstp, Kmm, ts, Krhs ) ! ice shelf heat flux
+ IF( ln_traqsr ) CALL tra_qsr ( kstp, Kmm, ts, Krhs ) ! penetrative solar radiation qsr
+!!gm
+
+ !
+!!gm ===>>>>>> Verify the necessity of these trends at stages 1 and 2
+! (we may need it as they are in the RHS of dynspg_ts ?)
+! IF( lk_asminc .AND. ln_asmiau ) THEN ! apply assimilation increment
+! IF( ln_dyninc ) CALL dyn_asm_inc( kstp, Kbb, Kmm, uu, vv, Krhs ) ! dynamics ==> RHS
+! IF( ln_trainc ) CALL tra_asm_inc( kstp, Kbb, Kmm, ts , Krhs ) ! tracers ==> RHS
+! ENDIF
+!!gm end Verif
+
+ !
+ SELECT CASE( kstg )
+ ! !-------------------!
+ CASE ( 1 , 2 ) !== Stage 1 & 2 ==! stg1: Kbb = N ; Kaa = N+1/3
+ ! !-------------------! stg2: Kbb = N ; Kmm = N+1/3 ; Kaa = N+1/2
+ !
+ ! !== time integration ==! ∆t = rn_Dt/3 (stg1) or rn_Dt/2 (stg2)
+ IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ uu(ji,jj,jk,Kaa) = ( uu(ji,jj,jk,Kbb) + rDt * uu(ji,jj,jk,Krhs) ) * umask(ji,jj,jk)
+ vv(ji,jj,jk,Kaa) = ( vv(ji,jj,jk,Kbb) + rDt * vv(ji,jj,jk,Krhs) ) * vmask(ji,jj,jk)
+ END_3D
+ ELSE ! applied on thickness weighted velocity
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ uu(ji,jj,jk,Kaa) = ( e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb ) &
+ & + rDt * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Krhs) ) &
+ & / e3u(ji,jj,jk,Kaa) * umask(ji,jj,jk)
+ vv(ji,jj,jk,Kaa) = ( e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb ) &
+ & + rDt * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Krhs) ) &
+ & / e3v(ji,jj,jk,Kaa) * vmask(ji,jj,jk)
+ END_3D
+ ENDIF
+ !
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ ze3Tb = e3t(ji,jj,jk,Kbb) * ts(ji,jj,jk,jp_tem,Kbb )
+ ze3Sb = e3t(ji,jj,jk,Kbb) * ts(ji,jj,jk,jp_sal,Kbb )
+ ze3Tr = e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Krhs)
+ ze3Sr = e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Krhs)
+ z1_e3t= 1._wp / e3t(ji,jj,jk, Kaa)
+ ts(ji,jj,jk,jp_tem,Kaa) = ( ze3Tb + rDt * ze3Tr*tmask(ji,jj,jk) ) * z1_e3t
+ ts(ji,jj,jk,jp_sal,Kaa) = ( ze3Sb + rDt * ze3Sr*tmask(ji,jj,jk) ) * z1_e3t
+ END_3D
+ !
+ !
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=uu(:,:,:,Kaa), clinfo1='stp stg - Ua: ', mask1=umask, &
+ & tab3d_2=vv(:,:,:,Kaa), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
+ !
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Kaa), clinfo1='stp stg - Ta: ', mask1=tmask, &
+ & tab3d_2=ts(:,:,:,jp_sal,Kaa), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
+ !
+ ! !---------------!
+ CASE ( 3 ) !== Stage 3 ==! add all remaining RHS terms
+ ! !---------------!
+ !
+ ! !== complete the momentum RHS ==! except ZDF (implicit)
+ ! ! lateral mixing ==> RHS
+ CALL dyn_ldf( kstp, Kbb, Kmm, uu, vv, Krhs )
+ ! ! OSMOSIS non-local velocity fluxes ==> RHS
+ IF( ln_zdfosm ) CALL dyn_osm( kstp, Kmm, uu, vv, Krhs )
+ !
+ IF( ln_bdy ) THEN ! bdy damping trends ==> RHS
+ CALL bdy_dyn3d_dmp ( kstp, Kbb, uu, vv, Krhs )
+ CALL bdy_tra_dmp ( kstp, Kbb, ts , Krhs )
+ ENDIF
+
+# if defined key_agrif
+ IF(.NOT. Agrif_Root() ) THEN ! AGRIF: sponge ==> momentum and tracer RHS
+ CALL Agrif_Sponge_dyn
+ CALL Agrif_Sponge_tra
+ ENDIF
+# endif
+ ! !== complete the tracers RHS ==! except ZDF (implicit)
+ ! !* T-S Tracer *!
+ !
+ CALL tra_ldf( kstp, Kbb, Kmm, ts, Krhs ) ! lateral mixing
+ IF( ln_trabbc ) CALL tra_bbc( kstp, Kmm, ts, Krhs ) ! bottom heat flux
+ IF( ln_trabbl ) CALL tra_bbl( kstp, Kbb, Kmm, ts, Krhs ) ! advective (and/or diffusive) bottom boundary layer scheme
+ IF( ln_tradmp ) CALL tra_dmp( kstp, Kbb, Kmm, ts, Krhs ) ! internal damping trends
+
+ IF( ln_zdfmfc ) CALL tra_mfc( kstp, Kbb, ts, Krhs ) ! Mass Flux Convection
+ IF( ln_zdfosm ) THEN
+ CALL tra_osm( kstp, Kmm, ts, Krhs ) ! OSMOSIS non-local tracer fluxes ==> RHS
+ IF( lrst_oce ) CALL osm_rst( kstp, Kmm, 'WRITE' ) ! write OSMOSIS outputs + ww (so must do here) to restarts
+ ENDIF
+ !
+ ! !== DYN & TRA time integration + ZDF ==! ∆t = rDt
+ !
+ CALL dyn_zdf( kstp, Kbb, Kmm, Krhs, uu, vv, Kaa ) ! vertical diffusion and time integration
+ CALL tra_zdf( kstp, Kbb, Kmm, Krhs, ts , Kaa ) ! vertical mixing and after tracer fields
+ IF( ln_zdfnpc ) CALL tra_npc( kstp, Kmm, Krhs, ts , Kaa ) ! update after fields by non-penetrative convection
+ !
+ END SELECT
+ ! !== correction of the barotropic (all stages) ==! at Kaa = N+1/3, N+1/2 or N+1
+ ! ! barotropic velocity correction
+ zub(A2D(0)) = uu_b(A2D(0),Kaa) - SUM( e3u_0(A2D(0),:)*uu(A2D(0),:,Kaa), 3 ) * r1_hu_0(A2D(0))
+ zvb(A2D(0)) = vv_b(A2D(0),Kaa) - SUM( e3v_0(A2D(0),:)*vv(A2D(0),:,Kaa), 3 ) * r1_hv_0(A2D(0))
+ !
+ DO jk = 1, jpkm1 ! corrected horizontal velocity
+ uu(:,:,jk,Kaa) = uu(:,:,jk,Kaa) + zub(:,:)*umask(:,:,jk)
+ vv(:,:,jk,Kaa) = vv(:,:,jk,Kaa) + zvb(:,:)*vmask(:,:,jk)
+ END DO
+!!st pourquoi ne pas mettre A2D(0) ici ?
+
+
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! Set boundary conditions
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ !
+# if defined key_agrif
+ CALL Agrif_tra( kstp, kstg ) !* AGRIF zoom boundaries
+ CALL Agrif_dyn( kstp, kstg )
+# endif
+ ! !* local domain boundaries (T-point, unchanged sign)
+ CALL lbc_lnk_multi( 'stp_RK3_stg', uu(:,:,:, Kaa), 'U', -1., vv(:,:,: ,Kaa), 'V', -1. &
+ & , ts(:,:,:,jp_tem,Kaa), 'T', 1., ts(:,:,:,jp_sal,Kaa), 'T', 1. )
+ !
+ ! !* BDY open boundaries
+ IF( ln_bdy ) THEN
+ CALL bdy_tra( kstp, Kbb, ts, Kaa )
+ IF( ln_dynspg_exp ) CALL bdy_dyn( kstp, Kbb, uu, vv, Kaa )
+ IF( ln_dynspg_ts ) CALL bdy_dyn( kstp, Kbb, uu, vv, Kaa, dyn3d_only=.true. )
+ ENDIF
+ !
+ IF( ln_timing ) CALL timing_stop('stp_RK3_stg')
+ !
+ END SUBROUTINE stp_RK3_stg
+
+#else
+ !!----------------------------------------------------------------------
+ !! default option EMPTY MODULE qco not activated
+ !!----------------------------------------------------------------------
+#endif
+
+ !!======================================================================
+END MODULE stprk3_stg
diff --git a/src/OFF/dtadyn.F90 b/src/OFF/dtadyn.F90
index a1b1045d0..05b74c768 100644
--- a/src/OFF/dtadyn.F90
+++ b/src/OFF/dtadyn.F90
@@ -101,7 +101,7 @@ MODULE dtadyn
!!----------------------------------------------------------------------
!! NEMO/OFF 4.0 , NEMO Consortium (2018)
- !! $Id: dtadyn.F90 15090 2021-07-06 14:25:18Z cetlod $
+ !! $Id: dtadyn.F90 15532 2021-11-24 11:47:32Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -175,7 +175,7 @@ CONTAINS
ENDIF
ENDIF
!
- CALL eos ( ts(:,:,:,:,Kmm), rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+ CALL eos ( ts(:,:,:,:,Kmm), rhd, gdept_0(:,:,:) ) ! In any case, we need rhd
CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) ! now local thermal/haline expension ratio at T-points
CALL bn2 ( ts(:,:,:,:,Kmm), rab_n, rn2, Kmm ) ! before Brunt-Vaisala frequency need for zdfmxl
@@ -192,7 +192,7 @@ CONTAINS
ENDIF
!
!
- CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+ CALL eos( ts(:,:,:,:,Kmm), rhd, gdept_0(:,:,:) ) ! In any case, we need rhd
!
IF(sn_cfctl%l_prtctl) THEN ! print control
CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' tn - : ', mask1=tmask, kdim=jpk )
@@ -667,7 +667,7 @@ CONTAINS
!!---------------------------------------------------------------------
!
IF( l_ldfslp .AND. .NOT.ln_c1d ) THEN ! Computes slopes (here avt is used as workspace)
- CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) )
+ CALL eos ( pts, rhd, gdept_0(:,:,:) )
CALL eos_rab( pts, rab_n, Kmm ) ! now local thermal/haline expension ratio at T-points
CALL bn2 ( pts, rab_n, rn2, Kmm ) ! now Brunt-Vaisala
@@ -725,7 +725,7 @@ CONTAINS
ts(:,:,:,jp_tem,Kmm) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) ! temperature
ts(:,:,:,jp_sal,Kmm) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity
!
- CALL eos ( ts(:,:,:,:,Kmm), rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+ CALL eos ( ts(:,:,:,:,Kmm), rhd, gdept_0(:,:,:) ) ! In any case, we need rhd
IF(sn_cfctl%l_prtctl) THEN ! print control
CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' tn - : ', mask1=tmask, kdim=jpk )
diff --git a/src/OFF/nemogcm.F90 b/src/OFF/nemogcm.F90
index 73713236f..9cffd0190 100644
--- a/src/OFF/nemogcm.F90
+++ b/src/OFF/nemogcm.F90
@@ -82,7 +82,7 @@ MODULE nemogcm
!!----------------------------------------------------------------------
!! NEMO/OFF 4.0 , NEMO Consortium (2018)
- !! $Id: nemogcm.F90 15446 2021-10-26 14:34:38Z cetlod $
+ !! $Id: nemogcm.F90 14255 2021-01-04 11:35:00Z cetlod $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -517,7 +517,6 @@ CONTAINS
ts (:,:,:,:,Kmm) = 0._wp ! !
!
rhd (:,:,:) = 0.e0
- rhop (:,:,:) = 0.e0
rn2 (:,:,:) = 0.e0
!
END SUBROUTINE istate_init
diff --git a/src/TOP/AGE/trcsms_age.F90 b/src/TOP/AGE/trcsms_age.F90
index dec67f35f..a8283edf6 100644
--- a/src/TOP/AGE/trcsms_age.F90
+++ b/src/TOP/AGE/trcsms_age.F90
@@ -31,7 +31,7 @@ MODULE trcsms_age
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trcsms_age.F90 14173 2020-12-15 12:44:07Z cetlod $
+ !! $Id: trcsms_age.F90 15193 2021-08-13 13:18:24Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -51,14 +51,17 @@ CONTAINS
!
IF( ln_timing ) CALL timing_start('trc_sms_age')
!
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' trc_sms_age: AGE model'
- IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+ IF( kt == nittrc000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' trc_sms_age: AGE model'
+ IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+ ENDIF
+#if ! defined key_RK3
IF( l_1st_euler .OR. ln_top_euler ) THEN
tr(:,:,:,jp_age,Kbb) = tr(:,:,:,jp_age,Kmm)
ENDIF
-
+#endif
DO jk = 1, nla_age
tr(:,:,jk,jp_age,Krhs) = rn_age_kill_rate * tr(:,:,jk,jp_age,Kbb)
@@ -71,7 +74,7 @@ CONTAINS
tr(:,:,jk,jp_age,Krhs) = tmask(:,:,jk) * rryear
END DO
!
- IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends
+ IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends
!
IF( ln_timing ) CALL timing_stop('trc_sms_age')
!
diff --git a/src/TOP/PISCES/P4Z/p4zche.F90 b/src/TOP/PISCES/P4Z/p4zche.F90
index 95c07d05d..46b003a5e 100644
--- a/src/TOP/PISCES/P4Z/p4zche.F90
+++ b/src/TOP/PISCES/P4Z/p4zche.F90
@@ -11,6 +11,7 @@ MODULE p4zche
!! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90
!! ! 2011-02 (J. Simeon, J.Orr ) update O2 solubility constants
!! 3.6 ! 2016-03 (O. Aumont) Change chemistry to MOCSY standards
+ !! 4.2 ! 2020 (J. ORR ) rhop is replaced by "in situ density" rhd
!!----------------------------------------------------------------------
!! p4z_che : Sea water chemistry computed following OCMIP protocol
!!----------------------------------------------------------------------
@@ -134,7 +135,7 @@ MODULE p4zche
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: p4zche.F90 15459 2021-10-29 08:19:18Z cetlod $
+ !! $Id: p4zche.F90 15532 2021-11-24 11:47:32Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -194,9 +195,21 @@ CONTAINS
zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35.
! ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980)
! ! AND FOR THE ATMOSPHERE FOR NON IDEAL GAS
+ ! J. ORR: The previous code has been modified. It computed CO2 solubility in mol/(kg*atm), then converted that to mol/(L*atm).
+ ! But Weiss (1974) provides sets of coefficients for each of those 2 units.
+ ! Thus I have changed the code to use the coefficients for mol*L/atm.
+ ! Hence I've eliminated using the conversion (which used the variable rhop)
+ ! OLD - Coefficients for CO2 soulbility in mol/(kg*atm) (Weiss,1974, Table 1, column 2)
+ !zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel &
+ !& + 0.0047036e-4*ztkel**2)
+ ! NEW - Coefficients for CO2 soulbility in mol/(L*atm) (Weiss, 1974, Table 1, column 1)
zcek1 = 9050.69/ztkel - 58.0931 + 22.2940 * LOG(zt) + zsal*(0.027766 - 0.00025888*ztkel &
- & + 0.0050578e-4*ztkel**2)
- chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 ! mol/(L atm)
+ & + 0.0050578e-4*ztkel**2)
+ !
+ ! OLD: chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 * rhop(ji,jj,1) / 1000. ! mol/(L atm)
+ ! The units indicated in the above line are wrong. They are actually "mol/(L*uatm)"
+ ! NEW:
+ chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 ! mol/(L * uatm)
chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3
chemc(ji,jj,3) = 57.7 - 0.118*ztkel
END_2D
@@ -444,15 +457,16 @@ CONTAINS
INTEGER :: ji, jj, jk
REAL(wp) :: zca1, zba1
REAL(wp) :: zd, zsqrtd, zhmin
- REAL(wp) :: za2, za1, za0
+ REAL(wp) :: za2, za1, za0, zrhd
REAL(wp) :: p_dictot, p_bortot, p_alkcb
!!---------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('ahini_for_at')
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
- p_alkcb = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn)
- p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn)
+ zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
+ p_alkcb = tr(ji,jj,jk,jptal,Kbb) * zrhd
+ p_dictot = tr(ji,jj,jk,jpdic,Kbb) * zrhd
p_bortot = borat(ji,jj,jk)
IF (p_alkcb <= 0.) THEN
p_hini(ji,jj,jk) = 1.e-3
@@ -501,11 +515,16 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup
INTEGER, INTENT(in) :: Kbb ! time level indices
+ INTEGER :: ji, jj, jk
+ REAL(wp) :: zrhd
- p_alknw_inf(:,:,:) = -tr(:,:,:,jppo4,Kbb) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:) &
- & - fluorid(:,:,:)
- p_alknw_sup(:,:,:) = (2. * tr(:,:,:,jpdic,Kbb) + 2. * tr(:,:,:,jppo4,Kbb) + tr(:,:,:,jpsil,Kbb) ) &
- & * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:)
+ DO_3D( 1, 1, 1, 1, 1, jpk )
+ zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
+ p_alknw_inf(ji,jj,jk) = -tr(ji,jj,jk,jppo4,Kbb) * zrhd - sulfat(ji,jj,jk) &
+ & - fluorid(ji,jj,jk)
+ p_alknw_sup(ji,jj,jk) = (2. * tr(ji,jj,jk,jpdic,Kbb) + 2. * tr(ji,jj,jk,jppo4,Kbb) + tr(ji,jj,jk,jpsil,Kbb) ) &
+ & * zrhd + borat(ji,jj,jk)
+ END_3D
END SUBROUTINE anw_infsup
@@ -535,7 +554,7 @@ CONTAINS
REAL(wp) :: znumer_so4, zdnumer_so4, zdenom_so4, zalk_so4, zdalk_so4
REAL(wp) :: znumer_flu, zdnumer_flu, zdenom_flu, zalk_flu, zdalk_flu
REAL(wp) :: zalk_wat, zdalk_wat
- REAL(wp) :: zfact, p_alktot, zdic, zbot, zpt, zst, zft, zsit
+ REAL(wp) :: zrhd, p_alktot, zdic, zbot, zpt, zst, zft, zsit
LOGICAL :: l_exitnow
REAL(wp), PARAMETER :: pz_exp_threshold = 1.0
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin
@@ -550,7 +569,8 @@ CONTAINS
! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
IF (rmask(ji,jj,jk) == 1.) THEN
- p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn)
+ zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
+ p_alktot = tr(ji,jj,jk,jptal,Kbb) * zrhd
aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk)
zh_ini = p_hini(ji,jj,jk)
@@ -579,12 +599,12 @@ CONTAINS
DO jn = 1, jp_maxniter_atgen
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
IF (rmask(ji,jj,jk) == 1.) THEN
- zfact = rhop(ji,jj,jk) / 1000. + rtrn
- p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact
- zdic = tr(ji,jj,jk,jpdic,Kbb) / zfact
+ zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
+ p_alktot = tr(ji,jj,jk,jptal,Kbb) * zrhd
+ zdic = tr(ji,jj,jk,jpdic,Kbb) * zrhd
zbot = borat(ji,jj,jk)
- zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r
- zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact
+ zpt = tr(ji,jj,jk,jppo4,Kbb) * zrhd * po4r
+ zsit = tr(ji,jj,jk,jpsil,Kbb) * zrhd
zst = sulfat (ji,jj,jk)
zft = fluorid(ji,jj,jk)
aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk)
diff --git a/src/TOP/PISCES/P4Z/p4zflx.F90 b/src/TOP/PISCES/P4Z/p4zflx.F90
index 36940fd92..051985ba2 100644
--- a/src/TOP/PISCES/P4Z/p4zflx.F90
+++ b/src/TOP/PISCES/P4Z/p4zflx.F90
@@ -9,6 +9,7 @@ MODULE p4zflx
!! 1.0 ! 2004 (O. Aumont) modifications
!! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90
!! ! 2011-02 (J. Simeon, J. Orr) Include total atm P correction
+ !! 4.2 ! 2020 (J. ORR ) rhop is replaced by "in situ density" rhd
!!----------------------------------------------------------------------
!! p4z_flx : CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE
!! p4z_flx_init : Read the namelist
@@ -56,7 +57,7 @@ MODULE p4zflx
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: p4zflx.F90 15459 2021-10-29 08:19:18Z cetlod $
+ !! $Id: p4zflx.F90 15532 2021-11-24 11:47:32Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -77,7 +78,7 @@ CONTAINS
!
INTEGER :: ji, jj, jm, iind, iindm1
REAL(wp) :: ztc, ztc2, ztc3, ztc4, zws, zkgwan
- REAL(wp) :: zfld, zflu, zfld16, zflu16, zfact
+ REAL(wp) :: zfld, zflu, zfld16, zflu16, zrhd
REAL(wp) :: zvapsw, zsal, zfco2, zxc2, xCO2approx, ztkel, zfugcoeff
REAL(wp) :: zph, zdic, zsch_o2, zsch_co2
REAL(wp) :: zyr_dec, zdco2dt
@@ -111,9 +112,9 @@ CONTAINS
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! DUMMY VARIABLES FOR DIC, H+, AND BORATE
- zfact = rhop(ji,jj,1) / 1000. + rtrn
+ zrhd = rhd(ji,jj,1) + 1._wp
zdic = tr(ji,jj,1,jpdic,Kbb)
- zph = MAX( hi(ji,jj,1), 1.e-10 ) / zfact
+ zph = MAX( hi(ji,jj,1), 1.e-10 ) / ( zrhd + rtrn )
! CALCULATE [H2CO3]
zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2)
END_2D
diff --git a/src/TOP/PISCES/P4Z/p4zlys.F90 b/src/TOP/PISCES/P4Z/p4zlys.F90
index df54a757d..007835e17 100644
--- a/src/TOP/PISCES/P4Z/p4zlys.F90
+++ b/src/TOP/PISCES/P4Z/p4zlys.F90
@@ -11,6 +11,7 @@ MODULE p4zlys
!! ! 2011-02 (J. Simeon, J. Orr) Calcon salinity dependence
!! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Improvment of calcite dissolution
!! 3.6 ! 2015-05 (O. Aumont) PISCES quota
+ !! 4.2 ! 2020 (J. ORR ) rhop is replaced by "in situ density" rhd
!!----------------------------------------------------------------------
!! p4z_lys : Compute the CaCO3 dissolution
!! p4z_lys_init : Read the namelist parameters
@@ -32,13 +33,17 @@ MODULE p4zlys
REAL(wp), PUBLIC :: nca !: order of reaction for calcite dissolution
INTEGER :: rmtss ! number of seconds per month
- REAL(wp) :: calcon = 1.03E-2 ! mean calcite concentration [Ca2+] in sea water [mole/kg solution]
-
+
+ !! * Module variables
+ REAL(wp) :: calcon = 1.03E-2 !: mean calcite concentration [Ca2+] in sea water [mole/kg solution]
+ ! J. ORR: Made consistent with mocsy's choice based on literature review from Munhoven
+! REAL(wp) :: calcon = 1.0287E-2 !: mean calcite concentration [Ca2+] in sea water [mole/kg solution]
+
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: p4zlys.F90 15287 2021-09-24 11:11:02Z cetlod $
+ !! $Id: p4zlys.F90 15532 2021-11-24 11:47:32Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
@@ -58,7 +63,7 @@ CONTAINS
INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices
!
INTEGER :: ji, jj, jk, jn
- REAL(wp) :: zdispot, zfact, zcalcon
+ REAL(wp) :: zdispot, zrhd, zcalcon
REAL(wp) :: zomegaca, zexcess, zexcess0, zkd
CHARACTER (len=25) :: charout
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zco3, zcaldiss, zhinit, zhi, zco3sat
@@ -66,7 +71,8 @@ CONTAINS
!
IF( ln_timing ) CALL timing_start('p4z_lys')
!
- zhinit (:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn )
+
+ zhinit (:,:,:) = hi(:,:,:) / ( rhd(:,:,:) + 1._wp )
!
! -------------------------------------------
! COMPUTE [CO3--] and [H+] CONCENTRATIONS
@@ -76,7 +82,7 @@ CONTAINS
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
zco3(ji,jj,jk) = tr(ji,jj,jk,jpdic,Kbb) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2 &
& + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn )
- hi (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000.
+ hi (ji,jj,jk) = zhi(ji,jj,jk) * ( rhd(ji,jj,jk) + 1._wp )
END_3D
! ---------------------------------------------------------
@@ -88,11 +94,11 @@ CONTAINS
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
! DEVIATION OF [CO3--] FROM SATURATION VALUE
- ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units
+ ! Salinity dependance in zomegaca and divide by rhd to have good units
zcalcon = calcon * ( salinprac(ji,jj,jk) / 35._wp )
- zfact = rhop(ji,jj,jk) / 1000._wp
- zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn )
- zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zfact / ( zcalcon + rtrn )
+ zrhd = rhd(ji,jj,jk) + 1._wp
+ zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zrhd + rtrn )
+ zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zrhd / ( zcalcon + rtrn )
! SET DEGREE OF UNDER-/SUPERSATURATION
excess(ji,jj,jk) = 1._wp - zomegaca
diff --git a/src/TOP/TRP/trcadv.F90 b/src/TOP/TRP/trcadv.F90
index c6ceff31d..86776d878 100644
--- a/src/TOP/TRP/trcadv.F90
+++ b/src/TOP/TRP/trcadv.F90
@@ -7,6 +7,7 @@ MODULE trcadv
!! 3.0 ! 2010-06 (C. Ethe) Adapted to passive tracers
!! 3.7 ! 2014-05 (G. Madec, C. Ethe) Add 2nd/4th order cases for CEN and FCT schemes
!! 4.0 ! 2017-09 (G. Madec) remove vertical time-splitting option
+ !! 4.5 ! 2021-08 (G. Madec, S. Techene) add advective velocities as optional arguments
!!----------------------------------------------------------------------
#if defined key_top
!!----------------------------------------------------------------------
@@ -35,7 +36,7 @@ MODULE trcadv
IMPLICIT NONE
PRIVATE
- PUBLIC trc_adv ! called by trctrp.F90
+ PUBLIC trc_adv ! called by trctrp.F90 and stprk3_stg.F90
PUBLIC trc_adv_ini ! called by trcini.F90
! !!* Namelist namtrc_adv *
@@ -44,7 +45,7 @@ MODULE trcadv
INTEGER :: nn_cen_h, nn_cen_v ! =2/4 : horizontal and vertical choices of the order of CEN scheme
LOGICAL :: ln_trcadv_fct ! FCT scheme flag
INTEGER :: nn_fct_h, nn_fct_v ! =2/4 : horizontal and vertical choices of the order of FCT scheme
- LOGICAL :: ln_trcadv_mus ! MUSCL scheme flag
+ LOGICAL, PUBLIC :: ln_trcadv_mus ! MUSCL scheme flag
LOGICAL :: ln_mus_ups ! use upstream scheme in vivcinity of river mouths
LOGICAL :: ln_trcadv_ubs ! UBS scheme flag
INTEGER :: nn_ubs_v ! =2/4 : vertical choice of the order of UBS scheme
@@ -58,31 +59,35 @@ MODULE trcadv
INTEGER, PARAMETER :: np_MUS = 3 ! MUSCL scheme
INTEGER, PARAMETER :: np_UBS = 4 ! 3rd order Upstream Biased Scheme
INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme
-
+
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trcadv.F90 15073 2021-07-02 14:20:14Z clem $
+ !! $Id: trcadv.F90 15510 2021-11-15 15:33:37Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs )
+ SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs, pau, pav, paw )
!!----------------------------------------------------------------------
!! *** ROUTINE trc_adv ***
!!
!! ** Purpose : compute the ocean tracer advection trend.
!!
- !! ** Method : - Update after tracers (tr(Krhs)) with the advection term following nadv
+ !! ** Method : - Update tr(Krhs) with the advective trend following nadv
!!----------------------------------------------------------------------
- INTEGER , INTENT(in) :: kt ! ocean time-step index
- INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, TARGET, INTENT(in ) :: pau, pav, paw ! advective velocity
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt) , INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk ! dummy loop index
CHARACTER (len=22) :: charout
+ REAL(wp), DIMENSION(:,:,:), POINTER :: zptu, zptv, zptw
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuu, zvv, zww ! effective velocity
!!----------------------------------------------------------------------
!
@@ -105,21 +110,32 @@ CONTAINS
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
zww(ji,jj,jpk) = 0._wp
END_2D
+ !
+ IF( PRESENT( pau ) ) THEN ! RK3: advective velocity (pau,pav,paw) /= advected velocity (uu,vv,ww)
+ zptu => pau(:,:,:)
+ zptv => pav(:,:,:)
+ zptw => paw(:,:,:)
+ ELSE ! MLF: advective velocity = (uu,vv,ww)
+ zptu => uu(:,:,:,Kmm)
+ zptv => vv(:,:,:,Kmm)
+ zptw => ww(:,:,: )
+ ENDIF
+ !
IF( ln_wave .AND. ln_sdw ) THEN
DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) ! eulerian transport + Stokes Drift
- zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * ( uu(ji,jj,jk,Kmm) + usd(ji,jj,jk) )
- zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * ( vv(ji,jj,jk,Kmm) + vsd(ji,jj,jk) )
+ zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * ( zptu(ji,jj,jk) + usd(ji,jj,jk) )
+ zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * ( zptv(ji,jj,jk) + vsd(ji,jj,jk) )
END_3D
DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
- zww(ji,jj,jk) = e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) )
+ zww(ji,jj,jk) = e1e2t(ji,jj) * ( zptw(ji,jj,jk) + wsd(ji,jj,jk) )
END_3D
ELSE
DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
- zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) ! eulerian transport
- zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm)
+ zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * zptu(ji,jj,jk) ! eulerian transport
+ zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * zptv(ji,jj,jk)
END_3D
DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
- zww(ji,jj,jk) = e1e2t(ji,jj) * ww(ji,jj,jk)
+ zww(ji,jj,jk) = e1e2t(ji,jj) * zptw(ji,jj,jk)
END_3D
ENDIF
!
diff --git a/src/TOP/TRP/trcatf.F90 b/src/TOP/TRP/trcatf.F90
index ea202b338..9a2f4e2ed 100644
--- a/src/TOP/TRP/trcatf.F90
+++ b/src/TOP/TRP/trcatf.F90
@@ -20,7 +20,7 @@ MODULE trcatf
!! 3.3 ! 2010-06 (C. Ethe, G. Madec) Merge TRA-TRC
!! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename trcnxt.F90 -> trcatf.F90. Now only does time filtering.
!!----------------------------------------------------------------------
-#if defined key_top
+#if defined key_top && ! defined key_RK3
!!----------------------------------------------------------------------
!! 'key_top' TOP models
!!----------------------------------------------------------------------
@@ -57,7 +57,7 @@ MODULE trcatf
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trcatf.F90 15090 2021-07-06 14:25:18Z cetlod $
+ !! $Id: trcatf.F90 15373 2021-10-14 17:01:57Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -99,7 +99,7 @@ CONTAINS
ENDIF
!
#if defined key_agrif
- CALL Agrif_trc ! AGRIF zoom boundaries
+ CALL Agrif_trc( kt ) ! AGRIF zoom boundaries
#endif
! Update after tracer on domain lateral boundaries
CALL lbc_lnk( 'trcatf', ptr(:,:,:,:,Kaa), 'T', 1._wp )
diff --git a/src/TOP/TRP/trcrad.F90 b/src/TOP/TRP/trcrad.F90
index 92578a8a8..21766f4ba 100644
--- a/src/TOP/TRP/trcrad.F90
+++ b/src/TOP/TRP/trcrad.F90
@@ -34,7 +34,7 @@ MODULE trcrad
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trcrad.F90 13324 2020-07-17 19:47:48Z acc $
+ !! $Id: trcrad.F90 15561 2021-11-30 13:25:02Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -148,9 +148,14 @@ CONTAINS
IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
zs2rdt = 1. / ( 2. * rn_Dt )
!
+#if ! defined key_RK3
DO jt = 1,2 ! Loop over time indices since exactly the same fix is applied to "now" and "after" fields
IF( jt == 1 ) itime = Kbb
IF( jt == 2 ) itime = Kmm
+#else
+ DO jt = 1,1 ! Loop over time indices since exactly the same fix is applied to "now" and "after" fields
+ IF( jt == 1 ) itime = Kmm
+#endif
IF( PRESENT( cpreserv ) ) THEN !== total tracer concentration is preserved ==!
!
diff --git a/src/TOP/TRP/trcsbc.F90 b/src/TOP/TRP/trcsbc.F90
index b97f13599..f817b677b 100644
--- a/src/TOP/TRP/trcsbc.F90
+++ b/src/TOP/TRP/trcsbc.F90
@@ -16,9 +16,9 @@ MODULE trcsbc
!! trc_sbc : update the tracer trend at ocean surface
!!----------------------------------------------------------------------
USE par_trc ! need jptra, number of passive tracers
- USE oce_trc ! ocean dynamics and active tracers variables
- USE trc ! ocean passive tracers variables
- USE prtctl ! Print control for debbuging
+ USE oce_trc ! ocean dynamics and active tracers variables
+ USE trc ! ocean passive tracers variables
+ USE prtctl ! Print control for debbuging
USE iom
USE trd_oce
USE trdtra
@@ -26,14 +26,15 @@ MODULE trcsbc
IMPLICIT NONE
PRIVATE
- PUBLIC trc_sbc ! routine called by step.F90
+ PUBLIC trc_sbc ! routine called by trctrp.F90
+ PUBLIC trc_sbc_RK3 ! routine called by stprk3_stg.F90
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trcsbc.F90 15394 2021-10-18 10:55:29Z cetlod $
+ !! $Id: trcsbc.F90 15532 2021-11-24 11:47:32Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -210,6 +211,185 @@ CONTAINS
!
END SUBROUTINE trc_sbc
+
+ SUBROUTINE trc_sbc_RK3 ( kt, Kmm, ptr, Krhs, kstg )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE trc_sbc_RK3 ***
+ !!
+ !! ** Purpose : Compute the tracer surface boundary condition trend of
+ !! (concentration/dilution effect) and add it to the general
+ !! trend of tracer equations.
+ !!
+ !! ** Method :
+ !! * concentration/dilution effect:
+ !! The surface freshwater flux modify the ocean volume
+ !! and thus the concentration of a tracer as :
+ !! tr(Krhs) = tr(Krhs) + emp * tr(Kmm) / e3t_ for k=1
+ !! where emp, the surface freshwater budget (evaporation minus
+ !! precipitation ) given in kg/m2/s is divided
+ !! by 1035 kg/m3 (density of ocean water) to obtain m/s.
+ !!
+ !! ** Action : - Update the 1st level of tr(:,:,:,:,Krhs) with the trend associated
+ !! with the tracer surface boundary condition
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt, Kmm, Krhs ! ocean time-step and time-level indices
+ INTEGER , INTENT(in ) :: kstg ! RK3 stage index
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation
+ !
+ INTEGER :: ji, jj, jn ! dummy loop indices
+ REAL(wp) :: z1_rho0_e3t ! local scalars
+ REAL(wp) :: zftra, zdtra, ztfx ! - -
+ CHARACTER (len=22) :: charout
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrtrd
+ !!---------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('trc_sbc_RK3')
+ !
+ IF( kt == nittrc000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'trc_sbc_RK3 : Passive tracers surface boundary condition'
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+ ENDIF
+ !
+!!st note that trc_sbc can be removed only re-use in atf (not relevant for RK3)
+ SELECT CASE( kstg )
+ !
+ CASE( 1 , 2 ) != stage 1 and 2 =! only in non linear ssh
+ !
+ IF( .NOT.ln_linssh ) THEN !* only passive tracer fluxes associated with mass fluxes
+ ! ! no passive tracer concentration modification due to ssh variation
+!!st emp includes fmm see iceupdate.F90
+!!not sure about trc_i case... (1)
+ DO jn = 1, jptra
+ DO_2D( 0, 0, 0, 0 ) !!st WHY 1 : exterior here ?
+ z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
+ ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) - emp(ji,jj) * ptr(ji,jj,1,jn,Kmm) * z1_rho0_e3t
+ END_2D
+ END DO
+ !
+ ENDIF
+ !
+ CASE( 3 )
+ !
+ ! Allocate temporary workspace
+ IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
+ !
+ DO jn = 1, jptra
+ IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends
+ END DO
+ !
+ IF( ln_linssh ) THEN !* linear free surface (add concentration/dilution effect artificially since no volume variation)
+ !
+ SELECT CASE ( nn_ice_tr )
+ !
+ CASE ( -1 ) ! No tracers in sea ice (null concentration in sea ice)
+ !
+ DO jn = 1, jptra
+ DO_2D( 0, 0, 0, 0 )
+ z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
+ ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + emp(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm)
+ END_2D
+ END DO
+ !
+ CASE ( 0 ) ! Same concentration in sea ice and in the ocean fmm contribution to concentration/dilution effect has to be removed
+ !
+ DO jn = 1, jptra
+ DO_2D( 0, 0, 0, 1 )
+ z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
+ ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( emp(ji,jj) - fmmflx(ji,jj) ) * r1_rho0 * ptr(ji,jj,1,jn,Kmm)
+ END_2D
+ END DO
+ !
+ CASE ( 1 ) ! Specific treatment of sea ice fluxes with an imposed concentration in sea ice !!st TODO : check Christian new implementation
+ !
+ DO jn = 1, jptra
+ DO_2D( 0, 0, 0, 0 )
+ z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
+ ! tracer flux at the ice/ocean interface (tracer/m2/s)
+ zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice
+ ! ! only used in the levitating sea ice case
+ ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux
+ ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux
+ ztfx = zftra ! net tracer flux
+ !
+ zdtra = r1_rho0 * ( ztfx + ( emp(ji,jj) - fmmflx(ji,jj) ) * ptr(ji,jj,1,jn,Kmm) )
+ IF ( zdtra < 0. ) THEN
+ zdtra = MAX(zdtra, -ptr(ji,jj,1,jn,Kmm) * e3t(ji,jj,1,Kmm) / rDt_trc ) ! avoid negative concentrations to arise
+ ENDIF
+ ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + zdtra
+ END_2D
+ END DO
+ !
+ END SELECT
+ !
+ ELSE !* non linear free surface (concentration/dilution effect due to volume variation)
+ !
+ SELECT CASE ( nn_ice_tr )
+ ! CASE ( -1 ) natural concentration/dilution effect due to volume variation : nothing to do
+ !
+ CASE ( 0 ) ! Same concentration in sea ice and in the ocean : correct concentration/dilution effect due to "freezing - melting"
+ !
+ DO jn = 1, jptra
+ DO_2D( 0, 0, 0, 1 )
+ z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
+ ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) - fmmflx(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm)
+ END_2D
+ END DO
+ !
+ CASE ( 1 ) ! Specific treatment of sea ice fluxes with an imposed concentration in sea ice
+ !
+ DO jn = 1, jptra
+ DO_2D( 0, 0, 0, 0 )
+ ! tracer flux at the ice/ocean interface (tracer/m2/s)
+ zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice
+ ! ! only used in the levitating sea ice case
+ ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux
+ ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux
+ ztfx = zftra ! net tracer flux
+ !
+ zdtra = r1_rho0 * ( ztfx - fmmflx(ji,jj) * ptr(ji,jj,1,jn,Kmm) )
+ IF ( zdtra < 0. ) THEN
+ zdtra = MAX(zdtra, -ptr(ji,jj,1,jn,Kmm) * e3t(ji,jj,1,Kmm) / rDt_trc ) ! avoid negative concentrations to arise
+ ENDIF
+ ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + zdtra
+ END_2D
+ END DO
+ !
+ END SELECT
+ !
+ ENDIF
+ !
+ !
+!!st useless trc_sbc only in the interior even in MLF case CALL lbc_lnk( 'trcsbc', sbc_trc(:,:,:), 'T', 1.0_wp )
+ ! Concentration dilution effect on tracers due to evaporation & precipitation
+ DO jn = 1, jptra
+ !
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'trc_sbc_RK3 : Runge Kutta 3rd order at stage ', kstg, jn
+ IF(lwp) WRITE(numout,*)
+ !
+ IF( l_trdtrc ) THEN
+ ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:)
+ CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_nsr, ztrtrd )
+ END IF
+ !
+ END DO
+ !
+ IF( l_trdtrc ) DEALLOCATE( ztrtrd )
+ !
+ END SELECT
+ !
+ IF( sn_cfctl%l_prttrc ) THEN
+ WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_info( charout, cdcomp = 'top' )
+ CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' )
+ ENDIF
+ !
+ IF( ln_timing ) CALL timing_stop('trc_sbc_RK3')
+ !
+ END SUBROUTINE trc_sbc_RK3
+
+
#else
!!----------------------------------------------------------------------
!! Dummy module : NO passive tracer
diff --git a/src/TOP/TRP/trctrp.F90 b/src/TOP/TRP/trctrp.F90
index 71315392a..e01298e1a 100644
--- a/src/TOP/TRP/trctrp.F90
+++ b/src/TOP/TRP/trctrp.F90
@@ -5,6 +5,7 @@ MODULE trctrp
!!======================================================================
!! History : 1.0 ! 2004-03 (C. Ethe) Original code
!! 3.3 ! 2010-07 (C. Ethe) Merge TRA-TRC
+ !! 4.x ! 2021-08 (S. Techene, G. Madec) Adapt for RK3 time-stepping
!!----------------------------------------------------------------------
#if defined key_top
!!----------------------------------------------------------------------
@@ -37,11 +38,11 @@ MODULE trctrp
IMPLICIT NONE
PRIVATE
- PUBLIC trc_trp ! called by trc_stp
+ PUBLIC trc_trp ! called by trc_stp and stprk3_stg
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trctrp.F90 15023 2021-06-18 14:35:25Z gsamson $
+ !! $Id: trctrp.F90 15373 2021-10-14 17:01:57Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
@@ -71,7 +72,9 @@ CONTAINS
ENDIF
ENDIF
!
+#if ! defined key_RK3
CALL trc_sbc ( kt, Kmm, tr, Krhs ) ! surface boundary condition
+#endif
IF( ln_trcbc .AND. lltrcbc .AND. kt /= nit000 ) &
CALL trc_bc ( kt, Kmm, tr, Krhs ) ! tracers: surface and lateral Boundary Conditions
IF( ln_trcais ) CALL trc_ais ( kt, Kmm, tr, Krhs ) ! tracers from Antarctic Ice Sheet (icb, isf)
@@ -81,10 +84,25 @@ CONTAINS
#if defined key_agrif
IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc ! tracers sponge
#endif
- CALL trc_adv ( kt, Kbb, Kmm, tr, Krhs ) ! horizontal & vertical advection
+#if ! defined key_RK3
+ ! ! MLF only: add the advection trend to the RHS
+ CALL trc_adv ( kt, Kbb, Kmm, tr, Krhs ) ! horizontal & vertical advection
+#endif
CALL trc_ldf ( kt, Kbb, Kmm, tr, Krhs ) ! lateral mixing
CALL trc_zdf ( kt, Kbb, Kmm, Krhs, tr, Kaa ) ! vert. mixing & after tracer ==> after
- CALL trc_atf ( kt, Kbb, Kmm, Kaa , tr ) ! time filtering of "now" tracer fields
+#if defined key_RK3
+ ! ! RK3: only manage lateral boundary
+# if defined key_agrif
+ CALL Agrif_trc ( kt ) ! AGRIF zoom boundaries
+# endif
+ ! ! Update after tracer on domain lateral boundaries
+ CALL lbc_lnk( 'stprk3_stg', tr(:,:,:,:,Kaa), 'T', 1._wp )
+ !
+ IF( ln_bdy ) CALL trc_bdy ( kt, Kbb, Kmm, Kaa )
+#else
+ ! ! MLF: apply Asselin time filter and manage lateral boundary
+ CALL trc_atf ( kt, Kbb, Kmm, Kaa , tr ) ! time filtering of "now" tracer fields
+#endif
!
! Subsequent calls use the filtered values: Kmm and Kaa
! These are used explicitly here since time levels will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp
diff --git a/src/TOP/oce_trc.F90 b/src/TOP/oce_trc.F90
index 4439665d1..7745fc713 100644
--- a/src/TOP/oce_trc.F90
+++ b/src/TOP/oce_trc.F90
@@ -42,7 +42,6 @@ MODULE oce_trc
USE oce , ONLY : vv => vv !: j-horizontal velocity (m s-1)
USE oce , ONLY : ww => ww !: vertical velocity (m s-1)
USE oce , ONLY : ts => ts !: 4D array contaning ( tn, sn )
- USE oce , ONLY : rhop => rhop !: potential volumic mass (kg m-3)
USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rho0)/rho0 (no units)
USE oce , ONLY : hdiv => hdiv !: horizontal divergence (1/s)
USE oce , ONLY : ssh => ssh !: sea surface height at t-point [m]
diff --git a/src/TOP/trcbc.F90 b/src/TOP/trcbc.F90
index 924a6f076..fc829d8db 100644
--- a/src/TOP/trcbc.F90
+++ b/src/TOP/trcbc.F90
@@ -50,7 +50,7 @@ MODULE trcbc
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trcbc.F90 15446 2021-10-26 14:34:38Z cetlod $
+ !! $Id: trcbc.F90 15511 2021-11-15 15:46:44Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -416,7 +416,11 @@ CONTAINS
IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN
DO_2D( 0, 0, 0, 1 )
DO jk = 1, nk_rnf(ji,jj)
+#if defined key_RK3
+ zrnf = rnf(ji,jj) * r1_rho0 / h_rnf(ji,jj)
+#else
zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rho0 / h_rnf(ji,jj)
+#endif
ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + (ptr(ji,jj,jk,jn,Kmm) * zrnf)
END DO
END_2D
diff --git a/src/TOP/trcini.F90 b/src/TOP/trcini.F90
index 5e5ba0eb3..5953dd54b 100644
--- a/src/TOP/trcini.F90
+++ b/src/TOP/trcini.F90
@@ -35,7 +35,7 @@ MODULE trcini
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trcini.F90 15446 2021-10-26 14:34:38Z cetlod $
+ !! $Id: trcini.F90 15514 2021-11-16 08:58:22Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -244,6 +244,15 @@ CONTAINS
!
IF( ln_trcdta ) CALL trc_dta_ini( jptra ) ! set initial tracers values
!
+ tr(:,:,:,:,Kaa) = 0._wp
+ !
+ IF( ln_trcbc .AND. lltrcbc ) THEN
+ CALL trc_bc_ini ( jptra, Kmm ) ! set tracers Boundary Conditions
+ CALL trc_bc ( nit000, Kmm, tr, Kaa ) ! tracers: surface and lateral Boundary Conditions
+ ENDIF
+ !
+ IF( ln_trcais ) CALL trc_ais_ini ! set tracers from Antarctic Ice Sheet
+ !
IF( ln_rsttr ) THEN ! restart from a file
!
CALL trc_rst_read( Kbb, Kmm )
@@ -264,8 +273,6 @@ CONTAINS
!
ENDIF
!
- tr(:,:,:,:,Kaa) = 0._wp
- !
IF( ln_trcbc .AND. lltrcbc ) THEN
CALL trc_bc_ini ( jptra, Kmm ) ! set tracers Boundary Conditions
CALL trc_bc ( nit000, Kmm, tr, Kaa ) ! tracers: surface and lateral Boundary Conditions
diff --git a/src/TOP/trcrst.F90 b/src/TOP/trcrst.F90
index 40a0d964d..05179e6e4 100644
--- a/src/TOP/trcrst.F90
+++ b/src/TOP/trcrst.F90
@@ -7,6 +7,7 @@ MODULE trcrst
!! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90
!! - ! 2005-10 (C. Ethe) print control
!! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture
+ !! 4.x ! 2021-08 (S. Techene, G. Madec) RK3 time-stepping only deals with before read/write
!!----------------------------------------------------------------------
#if defined key_top
!!----------------------------------------------------------------------
@@ -36,7 +37,7 @@ MODULE trcrst
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trcrst.F90 14239 2020-12-23 08:57:16Z smasson $
+ !! $Id: trcrst.F90 15321 2021-10-04 10:24:15Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -129,44 +130,53 @@ CONTAINS
IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
! READ prognostic variables and computes diagnostic variable
- DO jn = 1, jptra
+#if ! defined key_RK3
+ DO jn = 1, jptra ! MLF only : Now time step
CALL iom_get( numrtr, jpdom_auto, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) )
END DO
-
- DO jn = 1, jptra
+#endif
+ DO jn = 1, jptra ! RK3 and MLF : Before time step
CALL iom_get( numrtr, jpdom_auto, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) )
END DO
!
IF(.NOT.lrxios) CALL iom_delay_rst( 'READ', 'TOP', numrtr ) ! read only TOP delayed global communication variables
END SUBROUTINE trc_rst_read
- SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Krhs )
+
+ SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Kaa )
!!----------------------------------------------------------------------
!! *** trc_rst_wri ***
!!
!! ** purpose : write passive tracer fields in restart files
!!----------------------------------------------------------------------
INTEGER, INTENT( in ) :: kt ! ocean time-step index
- INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level indices
+ INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices
!!
INTEGER :: jn
!!----------------------------------------------------------------------
!
CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rn_Dt ) ! passive tracer time step (= ocean time step)
! prognostic variables
- ! --------------------
- DO jn = 1, jptra
- CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) )
+ ! --------------------
+#if defined key_RK3
+ DO jn = 1, jptra ! MLF : After time step (before the swap) put in TRN
+ CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kaa) )
END DO
-
- DO jn = 1, jptra
- CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) )
+ DO jn = 1, jptra ! RK3 : After time step (before the swap) put in TRB
+ CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kaa) )
END DO
-
+#else
+ DO jn = 1, jptra ! MLF : After time step (before the swap) put in TRN
+ CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kaa) )
+ END DO
+ DO jn = 1, jptra ! MLF : Now time step (before the swap) put in TRB
+ CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kmm) )
+ END DO
+#endif
IF( .NOT. lwxios ) CALL iom_delay_rst( 'WRITE', 'TOP', numrtw ) ! save only TOP delayed global communication variables
IF( kt == nitrst ) THEN
- CALL trc_rst_stat( Kmm, Krhs ) ! statistics
+ CALL trc_rst_stat( Kaa, Kbb ) ! statistics Kaa et Kbb
IF(lwxios) THEN
CALL iom_context_finalize( cw_toprst_cxt )
iom_file(numrtw)%nfid = 0
@@ -394,7 +404,7 @@ CONTAINS
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trcrst.F90 14239 2020-12-23 08:57:16Z smasson $
+ !! $Id: trcrst.F90 15321 2021-10-04 10:24:15Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!======================================================================
END MODULE trcrst
diff --git a/src/TOP/trcsms.F90 b/src/TOP/trcsms.F90
index b31abe68b..51ad94ba1 100644
--- a/src/TOP/trcsms.F90
+++ b/src/TOP/trcsms.F90
@@ -28,7 +28,7 @@ MODULE trcsms
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trcsms.F90 13286 2020-07-09 15:48:29Z smasson $
+ !! $Id: trcsms.F90 15373 2021-10-14 17:01:57Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -58,7 +58,11 @@ CONTAINS
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
WRITE(charout, FMT="('sms ')")
CALL prt_ctl_info( charout, cdcomp = 'top' )
+#if defined key_RK3
+ CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm )
+#else
CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm )
+#endif
ENDIF
!
IF( ln_timing ) CALL timing_stop('trc_sms')
diff --git a/src/TOP/trcstp.F90 b/src/TOP/trcstp.F90
index 380924186..506081c53 100644
--- a/src/TOP/trcstp.F90
+++ b/src/TOP/trcstp.F90
@@ -29,7 +29,7 @@ MODULE trcstp
IMPLICIT NONE
PRIVATE
- PUBLIC trc_stp ! called by step
+ PUBLIC trc_stp ! called by step or stpmlf
LOGICAL :: llnew ! ???
REAL(wp) :: rdt_sampl ! ???
@@ -40,7 +40,7 @@ MODULE trcstp
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
- !! $Id: trcstp.F90 15446 2021-10-26 14:34:38Z cetlod $
+ !! $Id: trcstp.F90 15191 2021-08-13 13:09:12Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -115,7 +115,9 @@ CONTAINS
IF(lrxios) CALL iom_context_finalize( cr_toprst_cxt )
IF(lwm) CALL FLUSH( numont ) ! flush namelist output
ENDIF
- IF( lrst_trc ) CALL trc_rst_wri ( kt, Kmm, Kaa, Kbb ) ! write tracer restart file
+ IF( lrst_trc ) CALL trc_rst_wri ( kt, Kbb, Kmm, Kaa ) ! write tracer restart file
+! IF( lrst_trc ) CALL trc_rst_wri ( kt, Kmm, Kaa, Kbb ) ! write tracer restart file
+
IF( lk_trdmxl_trc ) CALL trd_mxl_trc ( kt, Kaa ) ! trends: Mixed-layer
!
IF( ln_top_euler ) THEN
diff --git a/src/TOP/trcstp_rk3.F90 b/src/TOP/trcstp_rk3.F90
new file mode 100644
index 000000000..450d4b5ed
--- /dev/null
+++ b/src/TOP/trcstp_rk3.F90
@@ -0,0 +1,291 @@
+MODULE trcstp_rk3
+ !!======================================================================
+ !! *** MODULE trcstp_rk3 ***
+ !! Time-stepping : time loop of opa for passive tracer
+ !!======================================================================
+ !! History : 1.0 ! 2004-03 (C. Ethe) Original
+ !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme
+ !! 4.x ! 2021-08 (S. Techene, G. Madec) preparation and finalisation for RK3 time-stepping only
+ !!----------------------------------------------------------------------
+#if defined key_top
+ !!----------------------------------------------------------------------
+ !! trc_stp_start : prepare passive tracer system time-stepping
+ !! trc_stp_end : finalise passive tracer system time-stepping
+ !!----------------------------------------------------------------------
+ USE par_trc ! need jptra, number of passive tracers
+ USE oce_trc ! ocean dynamics and active tracers variables
+ USE sbc_oce
+ USE trc
+ USE trctrp ! passive tracers transport
+ USE trcsms ! passive tracers sources and sinks
+ USE trcwri
+ USE trcrst
+ USE trdtrc_oce
+ USE trdmxl_trc
+ USE sms_pisces, ONLY : ln_check_mass
+ !
+ USE prtctl ! Print control for debbuging
+ USE iom !
+ USE in_out_manager !
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC trc_stp_start ! called by stprk3_stg
+ PUBLIC trc_stp_end ! called by stprk3_stg
+
+ LOGICAL :: llnew ! ???
+ LOGICAL :: l_trcstat ! flag for tracer statistics
+ REAL(wp) :: rdt_sampl ! ???
+ INTEGER :: nb_rec_per_day, ktdcy ! ???
+ REAL(wp) :: rsecfst, rseclast ! ???
+ REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step
+
+# include "domzgr_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/TOP 4.0 , NEMO Consortium (2018)
+ !! $Id: trcstp.F90 14086 2020-12-04 11:37:14Z cetlod $
+ !! Software governed by the CeCILL license (see ./LICENSE)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE trc_stp_start( kt, Kbb, Kmm, Krhs, Kaa )
+ !!-------------------------------------------------------------------
+ !! *** ROUTINE trc_stp_start ***
+ !!
+ !! ** Purpose : Prepare time loop of opa for passive tracer
+ !!
+ !! ** Method : Compute the passive tracers trends
+ !! Update the passive tracers
+ !! Manage restart file
+ !!-------------------------------------------------------------------
+ INTEGER, INTENT( in ) :: kt ! ocean time-step index
+ INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices
+ !
+ INTEGER :: jk, jn ! dummy loop indices
+ CHARACTER (len=25) :: charout !
+ !!-------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('trc_stp_start')
+ !
+ l_trcstat = ( sn_cfctl%l_trcstat ) .AND. &
+ & ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
+ !
+ IF( kt == nittrc000 ) CALL trc_stp_ctl ! control
+ IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer
+ !
+ IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution
+ DO jk = 1, jpk
+ cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
+ END DO
+ IF( l_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) ) &
+ & areatot = glob_sum( 'trcstp', cvol(:,:,:) )
+ ENDIF
+ !
+ IF( l_trcdm2dc ) CALL trc_mean_qsr( kt )
+ !
+ IF(sn_cfctl%l_prttrc) THEN
+ WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
+ CALL prt_ctl_info( charout, cdcomp = 'top' )
+ ENDIF
+ !
+ CALL trc_rst_opn ( kt ) ! Open tracer restart file
+ IF( lrst_trc ) CALL trc_rst_cal ( kt, 'WRITE' ) ! calendar
+ !
+ IF( ln_timing ) CALL timing_stop('trc_stp_start')
+ !
+ END SUBROUTINE trc_stp_start
+
+
+ SUBROUTINE trc_stp_end( kt, Kbb, Kmm, Kaa )
+ !!-------------------------------------------------------------------
+ !! *** ROUTINE trc_stp_end ***
+ !!
+ !! ** Purpose : Finalise time loop of opa for passive tracer
+ !!
+ !! ** Method : Write restart and outputs
+ !!-------------------------------------------------------------------
+ INTEGER, INTENT( in ) :: kt ! ocean time-step index
+ INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices
+ !
+ INTEGER :: jk, jn ! dummy loop indices
+ REAL(wp):: ztrai ! local scalar
+ CHARACTER (len=25) :: charout !
+ !!-------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('trc_stp_end')
+ !
+ !
+ ! Note passive tracers have been time-filtered in trc_trp but the time level
+ ! indices will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp. Subsequent calls here
+ ! anticipate this update which will be: Nrhs= Nbb ; Nbb = Nnn ; Nnn = Naa ; Naa = Nrhs
+ ! and use the filtered levels explicitly.
+ !
+ IF( kt == nittrc000 ) THEN
+ CALL iom_close( numrtr ) ! close input tracer restart file
+ IF(lrxios) CALL iom_context_finalize( cr_toprst_cxt )
+ IF(lwm) CALL FLUSH( numont ) ! flush namelist output
+ ENDIF
+ IF( lrst_trc ) CALL trc_rst_wri ( kt, Kbb, Kmm, Kaa ) ! write tracer restart file
+ IF( lk_trdmxl_trc ) CALL trd_mxl_trc ( kt, Kaa ) ! trends: Mixed-layer
+ !
+ IF (l_trcstat) THEN
+ ztrai = 0._wp ! content of all tracers
+ DO jn = 1, jptra
+ ztrai = ztrai + glob_sum( 'trcstp_rk3', tr(:,:,:,jn,Kaa) * cvol(:,:,:) ) !!st cvol@Kmm weird !!
+ END DO
+ IF( lwm ) WRITE(numstr,9300) kt, ztrai / areatot
+ ENDIF
+ !
+9300 FORMAT(i10,D23.16)
+ !
+ CALL trc_wri ( kt, Kaa ) ! output of passive tracers with iom I/O manager before time level swap
+ !
+ IF( ln_timing ) CALL timing_stop('trc_stp_end')
+ !
+ END SUBROUTINE trc_stp_end
+
+
+ SUBROUTINE trc_stp_ctl
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE trc_stp_ctl ***
+ !! ** Purpose : Control + ocean volume
+ !!----------------------------------------------------------------------
+ !
+ ! Define logical parameter ton control dirunal cycle in TOP
+ l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 .AND. ncpl_qsr_freq /= 0 )
+ l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline
+ !
+ IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &
+ & 'Computation of a daily mean shortwave for some biogeochemical models ' )
+ !
+ END SUBROUTINE trc_stp_ctl
+
+
+ SUBROUTINE trc_mean_qsr( kt )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE trc_mean_qsr ***
+ !!
+ !! ** Purpose : Compute daily mean qsr for biogeochemical model in case
+ !! of diurnal cycle
+ !!
+ !! ** Method : store in TOP the qsr every hour ( or every time-step if the latter
+ !! is greater than 1 hour ) and then, compute the mean with
+ !! a moving average over 24 hours.
+ !! In coupled mode, the sampling is done at every coupling frequency
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT( in ) :: kt ! ocean time-step index
+ !
+ INTEGER :: jn ! dummy loop indices
+ REAL(wp) :: zkt, zrec ! local scalars
+ CHARACTER(len=1) :: cl1 ! 1 character
+ CHARACTER(len=2) :: cl2 ! 2 characters
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('trc_mean_qsr')
+ !
+ IF( kt == nittrc000 ) THEN
+ IF( ln_cpl ) THEN
+ rdt_sampl = rday / ncpl_qsr_freq
+ nb_rec_per_day = ncpl_qsr_freq
+ ELSE
+ rdt_sampl = MAX( 3600., rn_Dt )
+ nb_rec_per_day = INT( rday / rdt_sampl )
+ ENDIF
+ !
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_day
+ WRITE(numout,*)
+ ENDIF
+ !
+ ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
+ !
+ ! !* Restart: read in restart file
+ IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 &
+ & .AND. iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0 &
+ & .AND. iom_varid( numrtr, 'ktdcy' , ldstop = .FALSE. ) > 0 &
+ & .AND. iom_varid( numrtr, 'nrdcy' , ldstop = .FALSE. ) > 0 ) THEN
+ CALL iom_get( numrtr, 'ktdcy', zkt )
+ rsecfst = INT( zkt ) * rn_Dt
+ IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s '
+ CALL iom_get( numrtr, jpdom_auto, 'qsr_mean', qsr_mean ) ! A mean of qsr
+ CALL iom_get( numrtr, 'nrdcy', zrec ) ! Number of record per days
+ IF( INT( zrec ) == nb_rec_per_day ) THEN
+ DO jn = 1, nb_rec_per_day
+ IF( jn <= 9 ) THEN
+ WRITE(cl1,'(i1)') jn
+ CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) ) ! A mean of qsr
+ ELSE
+ WRITE(cl2,'(i2.2)') jn
+ CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) ! A mean of qsr
+ ENDIF
+ END DO
+ ELSE
+ DO jn = 1, nb_rec_per_day
+ qsr_arr(:,:,jn) = qsr_mean(:,:)
+ END DO
+ ENDIF
+ ELSE !* no restart: set from nit000 values
+ IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean set to nit000 values'
+ rsecfst = kt * rn_Dt
+ !
+ qsr_mean(:,:) = qsr(:,:)
+ DO jn = 1, nb_rec_per_day
+ qsr_arr(:,:,jn) = qsr_mean(:,:)
+ END DO
+ ENDIF
+ !
+ ENDIF
+ !
+ rseclast = kt * rn_Dt
+ !
+ llnew = ( rseclast - rsecfst ) >= rdt_sampl ! new shortwave to store
+ IF( llnew ) THEN
+ ktdcy = kt
+ IF( lwp .AND. kt < nittrc000 + 100 ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', ktdcy, &
+ & ' time = ', rseclast/3600.,'hours '
+ rsecfst = rseclast
+ DO jn = 1, nb_rec_per_day - 1
+ qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
+ END DO
+ qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
+ qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
+ ENDIF
+ !
+ IF( lrst_trc ) THEN !* Write the mean of qsr in restart file
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file kt =', kt
+ IF(lwp) WRITE(numout,*) '~~~~~~~'
+ zkt = REAL( ktdcy, wp )
+ zrec = REAL( nb_rec_per_day, wp )
+ CALL iom_rstput( kt, nitrst, numrtw, 'ktdcy', zkt )
+ CALL iom_rstput( kt, nitrst, numrtw, 'nrdcy', zrec )
+ DO jn = 1, nb_rec_per_day
+ IF( jn <= 9 ) THEN
+ WRITE(cl1,'(i1)') jn
+ CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )
+ ELSE
+ WRITE(cl2,'(i2.2)') jn
+ CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )
+ ENDIF
+ END DO
+ CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) )
+ ENDIF
+ !
+ IF( ln_timing ) CALL timing_stop('trc_mean_qsr')
+ !
+ END SUBROUTINE trc_mean_qsr
+
+#else
+ !!----------------------------------------------------------------------
+ !! Default key NO passive tracers
+ !!----------------------------------------------------------------------
+CONTAINS
+ SUBROUTINE trc_stp( kt ) ! Empty routine
+ WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
+ END SUBROUTINE trc_stp
+#endif
+
+ !!======================================================================
+END MODULE trcstp_rk3
diff --git a/tests/ISOMIP+/MY_SRC/eosbn2.F90 b/tests/ISOMIP+/MY_SRC/eosbn2.F90
index ad447ad14..b83d87e14 100644
--- a/tests/ISOMIP+/MY_SRC/eosbn2.F90
+++ b/tests/ISOMIP+/MY_SRC/eosbn2.F90
@@ -16,7 +16,7 @@ MODULE eosbn2
!! 3.0 ! 2006-08 (G. Madec) add tfreez function (now eos_fzp function)
!! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA
!! - ! 2010-10 (G. Nurser, G. Madec) add alpha/beta used in ldfslp
- !! 3.7 ! 2012-03 (F. Roquet, G. Madec) add primitive of alpha and beta used in PE computation
+ !! 3.7 ! 2012-0 3 (F. Roquet, G. Madec) add primitive of alpha and beta used in PE computation
!! - ! 2012-05 (F. Roquet) add Vallis and original JM95 equation of state
!! - ! 2013-04 (F. Roquet, G. Madec) add eos_rab, change bn2 computation and reorganize the module
!! - ! 2014-09 (F. Roquet) add TEOS-10, S-EOS, and modify EOS-80
@@ -55,7 +55,7 @@ MODULE eosbn2
! !! * Interface
INTERFACE eos
- MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d
+ MODULE PROCEDURE eos_insitu_New, eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d
END INTERFACE
!
INTERFACE eos_rab
@@ -190,6 +190,130 @@ MODULE eosbn2
!!----------------------------------------------------------------------
CONTAINS
+ SUBROUTINE eos_insitu_New( pts, Knn, prd )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE eos_insitu_New ***
+ !!
+ !! ** Purpose : Compute the in situ density (ratio rho/rho0) from
+ !! potential temperature and salinity using an equation of state
+ !! selected in the nameos namelist
+ !!
+ !! ** Method : prd(t,s,z) = ( rho(t,s,z) - rho0 ) / rho0
+ !! with prd in situ density anomaly no units
+ !! t TEOS10: CT or EOS80: PT Celsius
+ !! s TEOS10: SA or EOS80: SP TEOS10: g/kg or EOS80: psu
+ !! z depth meters
+ !! rho in situ density kg/m^3
+ !! rho0 reference density kg/m^3
+ !!
+ !! ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z).
+ !! Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celsius, sa=35.5 g/kg
+ !!
+ !! ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z).
+ !! Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celsius, sp=35.5 psu
+ !!
+ !! ln_seos : simplified equation of state
+ !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rho0
+ !! linear case function of T only: rn_alpha<>0, other coefficients = 0
+ !! linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0
+ !! Vallis like equation: use default values of coefficients
+ !!
+ !! ln_leos : linear ISOMIP equation of state
+ !! prd(t,s,z) = ( -a0*(T-T0) + b0*(S-S0) ) / rho0
+ !! setup for ISOMIP linear eos
+ !!
+ !! ** Action : compute prd , the in situ density (no units)
+ !!
+ !! References : Roquet et al, Ocean Modelling, in preparation (2014)
+ !! Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006
+ !! TEOS-10 Manual, 2010
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(:,:,:,:,:), INTENT(in ) :: pts ! T-S
+ INTEGER , INTENT(in ) :: Knn ! time-level
+ REAL(wp), DIMENSION(:,:,: ), INTENT( out) :: prd ! in situ density
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zt , zh , zs , ztm ! local scalars
+ REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('eos-insitu')
+ !
+ SELECT CASE( neos )
+ !
+ CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
+ !
+ DO_3D(nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ !
+ zh = gdept(ji,jj,jk,Knn) * r1_Z0 ! depth
+ zt = pts (ji,jj,jk,jp_tem,Knn) * r1_T0 ! temperature
+ zs = SQRT( ABS( pts(ji,jj,jk,jp_sal,Knn) + rdeltaS ) * r1_S0 ) ! square root salinity
+ ztm = tmask(ji,jj,jk) ! tmask
+ !
+ zn3 = EOS013*zt &
+ & + EOS103*zs+EOS003
+ !
+ zn2 = (EOS022*zt &
+ & + EOS112*zs+EOS012)*zt &
+ & + (EOS202*zs+EOS102)*zs+EOS002
+ !
+ zn1 = (((EOS041*zt &
+ & + EOS131*zs+EOS031)*zt &
+ & + (EOS221*zs+EOS121)*zs+EOS021)*zt &
+ & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt &
+ & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+ !
+ zn0 = (((((EOS060*zt &
+ & + EOS150*zs+EOS050)*zt &
+ & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
+ & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
+ & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
+ & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
+ & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+ !
+ zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+ !
+ prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked)
+ !
+ END_3D
+ !
+ CASE( np_seos ) !== simplified EOS ==!
+ !
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ zt = pts (ji,jj,jk,jp_tem,Knn) - 10._wp
+ zs = pts (ji,jj,jk,jp_sal,Knn) - 35._wp
+ zh = gdept(ji,jj,jk,Knn)
+ ztm = tmask(ji,jj,jk)
+ !
+ zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt &
+ & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs &
+ & - rn_nu * zt * zs
+ !
+ prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked)
+ END_3D
+ !
+ CASE( np_leos ) !== linear ISOMIP EOS ==!
+ !
+ DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+ zt = pts (ji,jj,jk,jp_tem,Knn) - (-1._wp)
+ zs = pts (ji,jj,jk,jp_sal,Knn) - 34.2_wp
+ zh = gdept(ji,jj,jk, Knn)
+ ztm = tmask(ji,jj,jk)
+ !
+ zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs )
+ !
+ prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked)
+ END_3D
+ !
+ END SELECT
+ !
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', kdim=jpk )
+ !
+ IF( ln_timing ) CALL timing_stop('eos-insitu')
+ !
+ END SUBROUTINE eos_insitu_New
+
+
SUBROUTINE eos_insitu( pts, prd, pdep )
!!
REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
--
GitLab