MODULE tranxt !!====================================================================== !! *** MODULE tranxt *** !! Ocean active tracers: time stepping on temperature and salinity !!====================================================================== !! History : 7.0 ! 91-11 (G. Madec) Original code !! ! 93-03 (M. Guyon) symetrical conditions !! ! 96-02 (G. Madec & M. Imbard) opa release 8.0 !! 8.0 ! 96-04 (A. Weaver) Euler forward step !! 8.2 ! 99-02 (G. Madec, N. Grima) semi-implicit pressure grad. !! 8.5 ! 02-08 (G. Madec) F90: Free form and module !! ! 02-11 (C. Talandier, A-M Treguier) Open boundaries !! ! 05-04 (C. Deltel) Add Asselin trend in the ML budget !! 9.0 ! 06-02 (L. Debreu, C. Mazauric) Agrif implementation !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! tra_nxt : time stepping on temperature and salinity !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers variables USE dom_oce ! ocean space and time domain variables USE zdf_oce ! ??? USE in_out_manager ! I/O manager USE lbclnk ! ocean lateral boundary conditions (or mpp link) USE obctra ! open boundary condition (obc_tra routine) USE trdmod ! ocean active tracers trends USE trdmod_oce ! ocean variables trends USE prtctl ! Print control USE agrif_opa_update USE agrif_opa_interp USE ocesbc ! ocean surface boundary condition USE domvvl ! variable volume USE dynspg_oce ! surface pressure gradient variables USE phycst IMPLICIT NONE PRIVATE !! * Routine accessibility PUBLIC tra_nxt ! routine called by step.F90 REAL(wp) :: vemp ! total amount of volume added or removed by E-P forcing !! * Substitutions # include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2006) !! $Header$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE tra_nxt( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE tranxt *** !! !! ** Purpose : Compute the temperature and salinity fields at the !! next time-step from their temporal trends and swap the fields. !! !! ** Method : Apply lateral boundary conditions on (ua,va) through !! call to lbc_lnk routine !! After t and s are compute using a leap-frog scheme environment: !! ta = tb + 2 rdttra(k) * ta !! sa = sb + 2 rdttra(k) * sa !! Compute and save in (ta,sa) an average over three time levels !! (before,now and after) of temperature and salinity which is !! used to compute rhd in eos routine and thus the hydrostatic !! pressure gradient (ln_dynhpg_imp = T) !! Apply an Asselin time filter on now tracers (tn,sn) to avoid !! the divergence of two consecutive time-steps and swap tracer !! arrays to prepare the next time_step: !! (zt,zs) = (ta+2tn+tb,sa+2sn+sb)/4 (ln_dynhpg_imp = T) !! (zt,zs) = (0,0) (default option) !! (tb,sb) = (tn,vn) + atfp [ (tb,sb) + (ta,sa) - 2 (tn,sn) ] !! (tn,sn) = (ta,sa) !! (ta,sa) = (zt,zs) (NB: reset to 0 after use in eos.F) !! !! ** Action : - update (tb,sb) and (tn,sn) !! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T) !!---------------------------------------------------------------------- USE oce, ONLY : ztrdt => ua ! use ua as 3D workspace USE oce, ONLY : ztrds => va ! use va as 3D workspace !! INTEGER, INTENT(in) :: kt ! ocean time-step index !! INTEGER :: ji, jj, jk ! dummy loop indices REAL(wp) :: zt, zs, zssh1 ! temporary scalars REAL(wp) :: zfact ! temporary scalar !! Variable volume REAL(wp), DIMENSION(jpi,jpj) :: zssh ! temporary scalars REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfse3tb, zfse3tn, zfse3ta ! 3D workspace !!---------------------------------------------------------------------- !! Explicit physics with thickness weighted updates IF( lk_vvl .AND. ln_zdfexp ) THEN ! Scale factors at before and after time step ! ------------------------------------------- zfse3tb(:,:,:) = sfe3( sshb, 'T' ) ; zfse3ta(:,:,:) = sfe3( ssha, 'T' ) ! Asselin filtered scale factor at now time step ! ---------------------------------------------- IF( (neuler == 0 .AND. kt == nit000) .OR. lk_dynspg_ts ) THEN zfse3tn(:,:,:) = sfe3ini( 'T' ) ELSE zssh(:,:) = atfp * ( sshb(:,:) + ssha(:,:) ) + atfp1 * sshn(:,:) zfse3tn(:,:,:) = sfe3( zssh, 'T' ) ENDIF ! Thickness weighting ! ------------------- DO jk = 1, jpkm1 DO jj = 1, jpj DO ji = 1, jpi ta(ji,jj,jk) = ta(ji,jj,jk) * fse3t(ji,jj,jk) sa(ji,jj,jk) = sa(ji,jj,jk) * fse3t(ji,jj,jk) tn(ji,jj,jk) = tn(ji,jj,jk) * fse3t(ji,jj,jk) sn(ji,jj,jk) = sn(ji,jj,jk) * fse3t(ji,jj,jk) tb(ji,jj,jk) = tb(ji,jj,jk) * zfse3tb(ji,jj,jk) sb(ji,jj,jk) = sb(ji,jj,jk) * zfse3tb(ji,jj,jk) END DO END DO END DO ENDIF IF( l_trdtra ) THEN ztrdt(:,:,jpk) = 0.e0 ztrds(:,:,jpk) = 0.e0 ENDIF ! 0. Lateral boundary conditions on ( ta, sa ) (T-point, unchanged sign) ! ---------------------------------============ CALL lbc_lnk( ta, 'T', 1. ) CALL lbc_lnk( sa, 'T', 1. ) ! ! =============== DO jk = 1, jpkm1 ! Horizontal slab ! ! =============== ! 1. Leap-frog scheme (only in explicit case, otherwise the ! ------------------- time stepping is already done in trazdf) IF( ln_zdfexp ) THEN zfact = 2. * rdttra(jk) IF( neuler == 0 .AND. kt == nit000 ) zfact = rdttra(jk) ta(:,:,jk) = ( tb(:,:,jk) + zfact * ta(:,:,jk) ) * tmask(:,:,jk) sa(:,:,jk) = ( sb(:,:,jk) + zfact * sa(:,:,jk) ) * tmask(:,:,jk) IF(l_trdtra) CALL ctl_stop( 'tranxt: Asselin ML trend not yet accounted for.' ) ENDIF #if defined key_obc ! ! =============== END DO ! End of slab ! ! =============== ! Update tracers on open boundaries. CALL obc_tra( kt ) ! ! =============== DO jk = 1, jpkm1 ! Horizontal slab ! ! =============== #endif #if defined key_agrif ! ! =============== END DO ! End of slab ! ! =============== ! Update tracers on open boundaries. CALL Agrif_tra( kt ) ! ! =============== DO jk = 1, jpkm1 ! Horizontal slab ! ! =============== #endif ! 2. Time filter and swap of arrays ! --------------------------------- IF( ln_dynhpg_imp ) THEN ! semi-implicite hpg IF( neuler == 0 .AND. kt == nit000 ) THEN DO jj = 1, jpj DO ji = 1, jpi zt = ( ta(ji,jj,jk) + 2. * tn(ji,jj,jk) + tb(ji,jj,jk) ) * 0.25 zs = ( sa(ji,jj,jk) + 2. * sn(ji,jj,jk) + sb(ji,jj,jk) ) * 0.25 tb(ji,jj,jk) = tn(ji,jj,jk) sb(ji,jj,jk) = sn(ji,jj,jk) tn(ji,jj,jk) = ta(ji,jj,jk) sn(ji,jj,jk) = sa(ji,jj,jk) ta(ji,jj,jk) = zt sa(ji,jj,jk) = zs END DO END DO IF( l_trdtra ) THEN ztrdt(:,:,jk) = 0.e0 ztrds(:,:,jk) = 0.e0 END IF ELSE DO jj = 1, jpj DO ji = 1, jpi zt = ( ta(ji,jj,jk) + 2. * tn(ji,jj,jk) + tb(ji,jj,jk) ) * 0.25 zs = ( sa(ji,jj,jk) + 2. * sn(ji,jj,jk) + sb(ji,jj,jk) ) * 0.25 tb(ji,jj,jk) = atfp * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk) sb(ji,jj,jk) = atfp * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk) IF( l_trdtra ) THEN ! ChD ceci est a optimiser, mais ca marche ztrdt(ji,jj,jk) = tb(ji,jj,jk) - tn(ji,jj,jk) ztrds(ji,jj,jk) = sb(ji,jj,jk) - sn(ji,jj,jk) END IF tn(ji,jj,jk) = ta(ji,jj,jk) sn(ji,jj,jk) = sa(ji,jj,jk) ta(ji,jj,jk) = zt sa(ji,jj,jk) = zs END DO END DO ENDIF ELSE ! Default case IF( neuler == 0 .AND. kt == nit000 ) THEN IF( (lk_vvl .AND. ln_zdfexp) ) THEN ! Varying levels DO jj = 1, jpj DO ji = 1, jpi zssh1 = tmask(ji,jj,jk) / fse3t(ji,jj,jk) tb(ji,jj,jk) = tn(ji,jj,jk) * zssh1 * tmask(ji,jj,jk) sb(ji,jj,jk) = sn(ji,jj,jk) * zssh1 * tmask(ji,jj,jk) zssh1 = tmask(ji,jj,jk) / zfse3ta(ji,jj,jk) tn(ji,jj,jk) = ta(ji,jj,jk) * zssh1 * tmask(ji,jj,jk) sn(ji,jj,jk) = sa(ji,jj,jk) * zssh1 * tmask(ji,jj,jk) END DO END DO ELSE ! Fixed levels DO jj = 1, jpj DO ji = 1, jpi tb(ji,jj,jk) = tn(ji,jj,jk) sb(ji,jj,jk) = sn(ji,jj,jk) tn(ji,jj,jk) = ta(ji,jj,jk) sn(ji,jj,jk) = sa(ji,jj,jk) END DO END DO ENDIF IF( l_trdtra ) THEN ztrdt(:,:,jk) = 0.e0 ztrds(:,:,jk) = 0.e0 END IF ELSE IF( l_trdtra ) THEN DO jj = 1, jpj DO ji = 1, jpi ztrdt(ji,jj,jk) = atfp * ( tb(ji,jj,jk) - 2*tn(ji,jj,jk) + ta(ji,jj,jk) ) ztrds(ji,jj,jk) = atfp * ( sb(ji,jj,jk) - 2*sn(ji,jj,jk) + sa(ji,jj,jk) ) END DO END DO END IF IF( (lk_vvl .AND. ln_zdfexp) ) THEN ! Varying levels DO jj = 1, jpj DO ji = 1, jpi zssh1 = tmask(ji,jj,jk) / zfse3tn(ji,jj,jk) tb(ji,jj,jk) = ( atfp * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) & & + atfp1 * tn(ji,jj,jk) ) * zssh1 sb(ji,jj,jk) = ( atfp * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) & & + atfp1 * sn(ji,jj,jk) ) * zssh1 zssh1 = tmask(ji,jj,1) / zfse3ta(ji,jj,jk) tn(ji,jj,jk) = ta(ji,jj,jk) * zssh1 sn(ji,jj,jk) = sa(ji,jj,jk) * zssh1 END DO END DO ELSE ! Fixed levels or first varying level DO jj = 1, jpj DO ji = 1, jpi tb(ji,jj,jk) = atfp * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk) sb(ji,jj,jk) = atfp * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk) tn(ji,jj,jk) = ta(ji,jj,jk) sn(ji,jj,jk) = sa(ji,jj,jk) END DO END DO ENDIF ENDIF ENDIF ! ! =============== END DO ! End of slab ! ! =============== IF( l_trdtra ) THEN ! Take the Asselin trend into account ztrdt(:,:,:) = ztrdt(:,:,:) / ( 2.*rdt ) ztrds(:,:,:) = ztrds(:,:,:) / ( 2.*rdt ) CALL trd_mod( ztrdt, ztrds, jptra_trd_atf, 'TRA', kt ) END IF IF(ln_ctl) CALL prt_ctl( tab3d_1=tn, clinfo1=' nxt - Tn: ', mask1=tmask, & & tab3d_2=sn, clinfo2= ' Sn: ', mask2=tmask ) #if defined key_agrif IF (.NOT.Agrif_Root()) CALL Agrif_Update_Tra( kt ) #endif ! END SUBROUTINE tra_nxt !!====================================================================== END MODULE tranxt