diff --git a/src/OCE/TRA/trabbl.F90 b/src/OCE/TRA/trabbl.F90 index df82587f2f2e87d32267a669f0d5b5b9cc356bed..71ccf284170581efed99358325d0bde8b8b35987 100644 --- a/src/OCE/TRA/trabbl.F90 +++ b/src/OCE/TRA/trabbl.F90 @@ -55,8 +55,6 @@ MODULE trabbl REAL(wp), PUBLIC :: rn_ahtbbl !: along slope bbl diffusive coefficient [m2/s] REAL(wp), PUBLIC :: rn_gambbl !: lateral coeff. for bottom boundary layer scheme [s] - LOGICAL , PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport - REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: utr_bbl , vtr_bbl ! u- (v-) transport in the bottom boundary layer REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: ahu_bbl , ahv_bbl ! masked diffusive bbl coeff. at u & v-pts @@ -117,8 +115,6 @@ CONTAINS ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) ENDIF - IF( l_bbl ) CALL bbl( kt, nit000, 'TRA', Kbb, Kmm ) !* bbl coef. and transport (only if not already done in trcbbl) - IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl ! CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) @@ -289,7 +285,7 @@ CONTAINS END SUBROUTINE tra_bbl_adv - SUBROUTINE bbl( kt, kit000, cdtype, Kbb, Kmm ) + SUBROUTINE bbl( kt, kit000, Kbb, Kmm ) !!---------------------------------------------------------------------- !! *** ROUTINE bbl *** !! @@ -317,7 +313,6 @@ CONTAINS !!---------------------------------------------------------------------- INTEGER , INTENT(in ) :: kt ! ocean time-step index INTEGER , INTENT(in ) :: kit000 ! first time step index - CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level index ! INTEGER :: ji, jj ! dummy loop indices @@ -333,7 +328,7 @@ CONTAINS IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile IF( kt == kit000 ) THEN IF(lwp) WRITE(numout,*) - IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype + IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients' IF(lwp) WRITE(numout,*) '~~~~~~~~~~' ENDIF ENDIF @@ -479,8 +474,6 @@ CONTAINS 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambbl in configuration namelist' ) IF(lwm) WRITE ( numond, nambbl ) ! - l_bbl = .TRUE. !* flag to compute bbl coef and transport - ! IF(lwp) THEN !* Parameter control and print WRITE(numout,*) WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation' diff --git a/src/OCE/step.F90 b/src/OCE/step.F90 index ff2759f8c9abfc5bd28d1eb1b36d3e3a00d526f1..35bbfc7e8e219689d13795da5830a1a4ed20120b 100644 --- a/src/OCE/step.F90 +++ b/src/OCE/step.F90 @@ -207,6 +207,10 @@ CONTAINS IF( l_ldftra_time .OR. l_ldfeiv_time ) CALL ldf_tra( kstp, Nbb, Nnn ) ! and/or eiv coeff. IF( l_ldfdyn_time ) CALL ldf_dyn( kstp, Nbb ) ! eddy viscosity coeff. + ! BBL coefficients + ! + IF( ln_trabbl ) CALL bbl( kstp, nit000, Nbb, Nnn ) ! BBL diffusion coefficients and transports + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ! Ocean dynamics : hdiv, ssh, e3, u, v, w !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< diff --git a/src/OCE/stpmlf.F90 b/src/OCE/stpmlf.F90 index 21bea529fe1880adb237ed2e837645c189559e56..f20dc3e5df907e2e9724e0540c40dc7eca52bd48 100644 --- a/src/OCE/stpmlf.F90 +++ b/src/OCE/stpmlf.F90 @@ -210,6 +210,10 @@ CONTAINS IF( l_ldftra_time .OR. l_ldfeiv_time ) CALL ldf_tra( kstp, Nbb, Nnn ) ! and/or eiv coeff. IF( l_ldfdyn_time ) CALL ldf_dyn( kstp, Nbb ) ! eddy viscosity coeff. + ! BBL coefficients + ! + IF( ln_trabbl ) CALL bbl( kstp, nit000, Nbb, Nnn ) ! BBL diffusion coefficients and transports + !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ! Ocean dynamics : hdiv, ssh, e3, u, v, w !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< diff --git a/src/TOP/TRP/trcbbl.F90 b/src/TOP/TRP/trcbbl.F90 index 5e9d2c93728c0ab42faf5938ff81a7b5a53731c8..77b48a1a97051861cd39df3ab84ca024ce269407 100644 --- a/src/TOP/TRP/trcbbl.F90 +++ b/src/TOP/TRP/trcbbl.F90 @@ -55,11 +55,6 @@ CONTAINS ! IF( ln_timing ) CALL timing_start('trc_bbl') ! - IF( .NOT. l_offline ) THEN - CALL bbl( kt, nittrc000, 'TRC', Kbb, Kmm ) ! Online coupling with dynamics : Computation of bbl coef and bbl transport - l_bbl = .FALSE. ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files - ENDIF - IF( l_trdtrc ) THEN ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends ztrtrd(:,:,:,:) = ptr(:,:,:,:,Krhs) diff --git a/src/TOP/trcrst.F90 b/src/TOP/trcrst.F90 index a62402184840376dfb0cebe757bb1c85c3de2ceb..71c766a1e37bccdb0d5556dd7e0df329c5eb366a 100644 --- a/src/TOP/trcrst.F90 +++ b/src/TOP/trcrst.F90 @@ -361,7 +361,7 @@ CONTAINS ENDIF ! DO jk = 1, jpk - zvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Krhs) * tmask(:,:,jk) + zvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) END DO ! DO jn = 1, jptra diff --git a/src/TOP/trcstp.F90 b/src/TOP/trcstp.F90 index 5d448290a0d187c226a88d3556c96cc77e9e68b4..15c8d3e3351adb852fda5ba76dd6018554b023cb 100644 --- a/src/TOP/trcstp.F90 +++ b/src/TOP/trcstp.F90 @@ -58,6 +58,7 @@ CONTAINS INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices ! INTEGER :: jk, jn ! dummy loop indices + INTEGER :: ibb ! local time-level index REAL(wp):: ztrai ! local scalar LOGICAL :: ll_trcstat ! local logical CHARACTER (len=25) :: charout ! @@ -65,8 +66,10 @@ CONTAINS ! IF( ln_timing ) CALL timing_start('trc_stp') ! + ibb = Kbb ! default "before" time-level index IF( l_1st_euler .OR. ln_top_euler ) THEN ! at nittrc000 rDt_trc = rn_Dt ! = rn_Dt (use or restarting with Euler time stepping) + ibb = Kmm ! time-level index used to substitute the "before" with the "now" time level ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1 rDt_trc = 2. * rn_Dt ! = 2 rn_Dt (leapfrog) ENDIF @@ -100,9 +103,9 @@ CONTAINS CALL trc_rst_opn ( kt ) ! Open tracer restart file IF( lrst_trc ) CALL trc_rst_cal ( kt, 'WRITE' ) ! calendar CALL trc_wri ( kt, Kmm ) ! output of passive tracers with iom I/O manager - CALL trc_sms ( kt, Kbb, Kmm, Krhs ) ! tracers: sinks and sources + CALL trc_sms ( kt, ibb, Kmm, Krhs ) ! tracers: sinks and sources #if ! defined key_sed_off - CALL trc_trp ( kt, Kbb, Kmm, Krhs, Kaa ) ! transport of passive tracers + CALL trc_trp ( kt, ibb, Kmm, Krhs, Kaa ) ! transport of passive tracers #endif ! ! Note passive tracers have been time-filtered in trc_trp but the time level @@ -124,7 +127,7 @@ CONTAINS tr(:,:,:,:,Kmm) = tr(:,:,:,:,Kaa) ENDIF ! - IF( lrst_trc ) CALL trc_rst_wri( kt, Kmm, Kaa, Kbb ) ! write tracer restart file + IF( lrst_trc ) CALL trc_rst_wri( kt, Kmm, Kaa, ibb ) ! write tracer restart file ! IF (ll_trcstat) THEN ztrai = 0._wp ! content of all tracers