Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
No results found
Show changes
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 1827 additions and 351 deletions
src/OCE/TRA/eosbn2.F90
View file @ da31f855
......@@ -53,7 +53,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
......@@ -181,11 +181,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]
......
src/OCE/TRA/traadv.F90
View file @ da31f855
......@@ -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
......
src/OCE/TRA/traadv_fct.F90
View file @ da31f855
......@@ -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
......
src/OCE/TRA/traadv_mus.F90
View file @ da31f855
......@@ -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 ==!
......
src/OCE/TRA/traatf.F90
View file @ da31f855
......@@ -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 )
......@@ -268,6 +268,10 @@ CONTAINS
ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) )
ztrd_atf(:,:,:,:) = 0.0_wp
ENDIF
!
!!st variables only computed in the interior by traqsr
IF( ll_traqsr ) CALL lbc_lnk( 'traatf', qsr_hc_b(:,:,:) , 'T', 1.0_wp, qsr_hc(:,:,:) , 'T', 1.0_wp )
!
zfact = 1._wp / p2dt
zfact1 = rn_atfp * p2dt
zfact2 = zfact1 * r1_rho0
......
src/OCE/TRA/traatf_qco.F90
View file @ da31f855
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
src/OCE/TRA/traisf.F90
View file @ da31f855
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
src/OCE/TRA/traldf_iso.F90
View file @ da31f855
......@@ -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
......@@ -145,19 +145,14 @@ CONTAINS
IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype
IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
ENDIF
!
DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
akz (ji,jj,jk) = 0._wp
ah_wslp2(ji,jj,jk) = 0._wp
END_3D
ENDIF
!
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
......
src/OCE/TRA/traldf_triad.F90
View file @ da31f855
......@@ -147,11 +147,6 @@ CONTAINS
!!----------------------------------------------------------------------
!
IF( kpass == 1 ) THEN !== first pass only and whatever the tracer is ==!
!
DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
akz (ji,jj,jk) = 0._wp
ah_wslp2(ji,jj,jk) = 0._wp
END_3D
!
DO kp = 0, 1 ! i-k triads
DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
......
src/OCE/TRA/tranpc.F90
View file @ da31f855
......@@ -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 )
......
src/OCE/TRA/traqsr.F90
View file @ da31f855
This diff is collapsed.
src/OCE/TRA/trasbc.F90
View file @ da31f855
......@@ -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_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
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
src/OCE/ZDF/zdfphy.F90
View file @ da31f855
......@@ -209,7 +209,7 @@ CONTAINS
ioptio = 0
IF( ln_zdfcst ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_CST ; ENDIF
IF( ln_zdfric ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_RIC ; CALL zdf_ric_init ; ENDIF
IF( ln_zdftke ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_TKE ; CALL zdf_tke_init( Kmm ) ; ENDIF
IF( ln_zdftke ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_TKE ; CALL zdf_tke_init ; ENDIF
IF( ln_zdfgls ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_GLS ; CALL zdf_gls_init ; ENDIF
IF( ln_zdfosm ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_OSM ; CALL zdf_osm_init( Kmm ) ; ENDIF
!
......@@ -350,7 +350,7 @@ CONTAINS
IF( ln_zdfiwm ) CALL zdf_iwm( kt, Kmm, avm, avt, avs ) ! internal wave (de Lavergne et al 2017)
! !* Lateral boundary conditions (sign unchanged)
IF(nn_hls==1) THEN
IF(nn_hls==1) THEN ! if nn_hls==2 lbc_lnk done in stp routines
IF( l_zdfsh2 ) THEN
CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp, &
& avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp )
......
src/OCE/ZDF/zdftke.F90
View file @ da31f855
......@@ -698,7 +698,7 @@ CONTAINS
END SUBROUTINE tke_avn
SUBROUTINE zdf_tke_init( Kmm )
SUBROUTINE zdf_tke_init
!!----------------------------------------------------------------------
!! *** ROUTINE zdf_tke_init ***
!!
......@@ -714,7 +714,6 @@ CONTAINS
!!----------------------------------------------------------------------
USE zdf_oce , ONLY : ln_zdfiwm ! Internal Wave Mixing flag
!!
INTEGER, INTENT(in) :: Kmm ! time level index
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ios
!!
......
src/OCE/module_example.F90
View file @ da31f855
......@@ -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
!!----------------------------------------------------------------------
......
src/OCE/nemogcm.F90
View file @ da31f855
......@@ -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
......@@ -121,7 +125,11 @@ CONTAINS
CALL nemo_init !== Initialisations ==!
! !-----------------------!
#if defined key_agrif
Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices
# if defined key_RK3
Kbb_a = Nbb; Kmm_a = Nbb; Krhs_a = Nrhs ! RK3: agrif_oce module copies of time level indices
# else
Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! MLF: agrif_oce module copies of time level indices
# endif
CALL Agrif_Declare_Var ! " " " " " DYN/TRA
# if defined key_top
CALL Agrif_Declare_Var_top ! " " " " " TOP
......@@ -146,14 +154,22 @@ CONTAINS
CALL Agrif_Regrid()
!
! Recursive update from highest nested level to lowest:
Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices
# if defined key_RK3
Kbb_a = Nbb; Kmm_a = Nbb; Krhs_a = Nrhs ! RK3: agrif_oce module copies of time level indices
# else
Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! MLF: agrif_oce module copies of time level indices
# endif
CALL Agrif_step_child_adj(Agrif_Update_All)
CALL Agrif_step_child_adj(Agrif_Check_parent_bat)
!
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 +190,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
......@@ -391,7 +411,11 @@ CONTAINS
! Initialise time level indices
Nbb = 1 ; Nnn = 2 ; Naa = 3 ; Nrhs = Naa
#if defined key_agrif
Kbb_a = Nbb ; Kmm_a = Nnn ; Krhs_a = Nrhs ! agrif_oce module copies of time level indices
# if defined key_RK3
Kbb_a = Nbb ; Kmm_a = Nbb ; Krhs_a = Nrhs ! RK3: agrif_oce module copies of time level indices
# else
Kbb_a = Nbb ; Kmm_a = Nnn ; Krhs_a = Nrhs ! MLF: agrif_oce module copies of time level indices
# endif
#endif
! !-------------------------------!
! ! NEMO general initialization !
......@@ -470,7 +494,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
......
src/OCE/oce.F90
View file @ da31f855
This diff is collapsed.
src/OCE/stp2d.F90 0 → 100644
View file @ da31f855
This diff is collapsed.
src/OCE/stpmlf.F90
View file @ da31f855
This diff is collapsed.
src/OCE/stprk3.F90 0 → 100644
View file @ da31f855
This diff is collapsed.