MODULE traldf !!====================================================================== !! *** MODULE traldf *** !! Ocean Active tracers : lateral diffusive trends !!===================================================================== !! History : 9.0 ! 05-11 (G. Madec) Original code !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! tra_ldf : update the tracer trend with the lateral diffusion !! ldf_ctl : initialization, namelist read, and parameters control !! ldf_ano : compute lateral diffusion for constant T-S profiles !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE phycst ! physical constants USE ldftra_oce ! ocean tracer lateral physics USE ldfslp ! ??? USE traldf_bilapg ! lateral mixing (tra_ldf_bilapg routine) USE traldf_bilap ! lateral mixing (tra_ldf_bilap routine) USE traldf_iso ! lateral mixing (tra_ldf_iso routine) USE traldf_lap ! lateral mixing (tra_ldf_lap routine) USE trdmod ! ocean active tracers trends USE trdmod_oce ! ocean variables trends USE prtctl ! Print control USE in_out_manager ! I/O manager USE lib_mpp ! distribued memory computing library USE lbclnk ! ocean lateral boundary conditions (or mpp link) IMPLICIT NONE PRIVATE PUBLIC tra_ldf ! called by step.F90 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) #if defined key_traldf_ano REAL, DIMENSION(jpi,jpj,jpk) :: t0_ldf, s0_ldf ! lateral diffusion trends of T & S ! ! for a constant vertical profile #endif !! * Substitutions # include "domzgr_substitute.h90" # include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2006) !! $Header$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE tra_ldf( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE tra_ldf *** !! !! ** Purpose : compute the lateral ocean tracer physics. !! !!---------------------------------------------------------------------- INTEGER, INTENT( in ) :: kt ! ocean time-step index !! REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdt, ztrds ! 3D temporary workspace !!---------------------------------------------------------------------- IF( kt == nit000 ) CALL ldf_ctl ! initialisation & control of options IF( l_trdtra ) THEN ! temporary save of ta and sa trends ztrdt(:,:,:) = ta(:,:,:) ztrds(:,:,:) = sa(:,:,:) ENDIF SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend CASE ( 0 ) ; CALL tra_ldf_lap ( kt ) ! iso-level laplacian CASE ( 1 ) ; CALL tra_ldf_iso ( kt ) ! rotated laplacian (except dk[ dk[.] ] part) CASE ( 2 ) ; CALL tra_ldf_bilap ( kt ) ! iso-level bilaplacian CASE ( 3 ) ; CALL tra_ldf_bilapg( kt ) ! s-coord. horizontal bilaplacian ! CASE ( -1 ) ! esopa: test all possibility with control print CALL tra_ldf_lap ( kt ) CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf0 - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) CALL tra_ldf_iso ( kt ) CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf1 - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) CALL tra_ldf_bilap ( kt ) CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf2 - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) CALL tra_ldf_bilapg ( kt ) CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf3 - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) END SELECT #if defined key_traldf_ano ta(:,:,:) = ta(:,:,:) - t0_ldf(:,:,:) ! anomaly: substract the reference diffusivity sa(:,:,:) = sa(:,:,:) - s0_ldf(:,:,:) #endif IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) CALL trd_mod( ztrdt, ztrds, jptra_trd_ldf, 'TRA', kt ) ENDIF ! ! print mean trends (used for debugging) IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) ! END SUBROUTINE tra_ldf SUBROUTINE ldf_ctl !!---------------------------------------------------------------------- !! *** ROUTINE ldf_ctl *** !! !! ** Purpose : Choice of the operator for the lateral tracer diffusion !! !! ** Method : set nldf from the nam_traldf logicals !! nldf == -1 ESOPA test: ALL operators are used !! nldf == 0 laplacian operator !! nldf == 1 Rotated laplacian operator !! nldf == 2 bilaplacian operator !! nldf == 3 Rotated bilaplacian !!---------------------------------------------------------------------- INTEGER :: ioptio, ierr ! temporary integers ! ! NAMELIST/nam_traldf/ ln_traldf_lap , ln_traldf_bilap, & ! & ln_traldf_level, ln_traldf_hor, ln_traldf_iso, & ! & aht0, ahtb0, aeiv0 !!---------------------------------------------------------------------- ! Define the lateral mixing oparator for tracers ! =============================================== ! Namelist nam_traldf already read in ldftra module ! ! Read Namelist nam_traldf : Lateral physics on tracers ! REWIND( numnam ) ! READ ( numnam, nam_traldf ) IF(lwp) THEN ! Namelist print WRITE(numout,*) WRITE(numout,*) 'tra:ldf_ctl : lateral tracer diffusive operator' WRITE(numout,*) '~~~~~~~~~~~' WRITE(numout,*) ' Namelist nam_traldf : set lateral mixing parameters (type, direction, coefficients)' WRITE(numout,*) ' laplacian operator ln_traldf_lap = ', ln_traldf_lap WRITE(numout,*) ' bilaplacian operator ln_traldf_bilap = ', ln_traldf_bilap WRITE(numout,*) ' iso-level ln_traldf_level = ', ln_traldf_level WRITE(numout,*) ' horizontal (geopotential) ln_traldf_hor = ', ln_traldf_hor WRITE(numout,*) ' iso-neutral ln_traldf_iso = ', ln_traldf_iso ENDIF ! ! control the input ioptio = 0 IF( ln_traldf_lap ) ioptio = ioptio + 1 IF( ln_traldf_bilap ) ioptio = ioptio + 1 IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE of the 2 lap/bilap operator type on tracer' ) ioptio = 0 IF( ln_traldf_level ) ioptio = ioptio + 1 IF( ln_traldf_hor ) ioptio = ioptio + 1 IF( ln_traldf_iso ) ioptio = ioptio + 1 IF( ioptio /= 1 ) CALL ctl_stop( ' use only ONE direction (level/hor/iso)' ) ! defined the type of lateral diffusion from ln_traldf_... logicals ierr = 0 IF ( ln_traldf_lap ) THEN ! laplacian operator IF ( ln_zco ) THEN ! z-coordinate IF ( ln_traldf_level ) nldf = 0 ! iso-level (no rotation) IF ( ln_traldf_hor ) nldf = 0 ! horizontal (no rotation) IF ( ln_traldf_iso ) nldf = 1 ! isoneutral ( rotation) ENDIF IF ( ln_zps ) THEN ! z-coordinate IF ( ln_traldf_level ) ierr = 1 ! iso-level not allowed IF ( ln_traldf_hor ) nldf = 0 ! horizontal (no rotation) IF ( ln_traldf_iso ) nldf = 1 ! isoneutral ( rotation) ENDIF IF ( ln_sco ) THEN ! z-coordinate IF ( ln_traldf_level ) nldf = 0 ! iso-level (no rotation) IF ( ln_traldf_hor ) nldf = 1 ! horizontal ( rotation) IF ( ln_traldf_iso ) nldf = 1 ! isoneutral ( rotation) ENDIF ENDIF IF( ln_traldf_bilap ) THEN ! bilaplacian operator IF ( ln_zco ) THEN ! z-coordinate IF ( ln_traldf_level ) nldf = 2 ! iso-level (no rotation) IF ( ln_traldf_hor ) nldf = 2 ! horizontal (no rotation) IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) ENDIF IF ( ln_zps ) THEN ! z-coordinate IF ( ln_traldf_level ) ierr = 1 ! iso-level not allowed IF ( ln_traldf_hor ) nldf = 2 ! horizontal (no rotation) IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) ENDIF IF ( ln_sco ) THEN ! z-coordinate IF ( ln_traldf_level ) nldf = 2 ! iso-level (no rotation) IF ( ln_traldf_hor ) nldf = 3 ! horizontal ( rotation) IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) ENDIF ENDIF IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) IF( ierr == 2 ) CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso ) & CALL ctl_stop( ' eddy induced velocity on tracers', & & ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) IF( nldf == 1 .OR. nldf == 3 ) THEN ! rotation IF( .NOT.lk_ldfslp ) CALL ctl_stop( ' the rotation of the diffusive tensor require key_ldfslp' ) ENDIF IF( lk_esopa ) THEN IF(lwp) WRITE(numout,*) ' esopa control: use all lateral physics options' nldf = -1 ENDIF IF(lwp) THEN WRITE(numout,*) IF( nldf == -1 ) WRITE(numout,*) ' ESOPA test All scheme used' IF( nldf == 0 ) WRITE(numout,*) ' laplacian operator' IF( nldf == 1 ) WRITE(numout,*) ' Rotated laplacian operator' IF( nldf == 2 ) WRITE(numout,*) ' bilaplacian operator' IF( nldf == 3 ) WRITE(numout,*) ' Rotated bilaplacian' ENDIF ! Reference T & S diffusivity (if necessary) ! =========================== CALL ldf_ano ! END SUBROUTINE ldf_ctl #if defined key_traldf_ano !!---------------------------------------------------------------------- !! 'key_traldf_ano' T & S lateral diffusion on anomalies !!---------------------------------------------------------------------- SUBROUTINE ldf_ano !!---------------------------------------------------------------------- !! *** ROUTINE ldf_ano *** !! !! ** Purpose : initializations of !!---------------------------------------------------------------------- USE zdf_oce ! vertical mixing USE trazdf ! vertical mixing: double diffusion USE zdfddm ! vertical mixing: double diffusion !! INTEGER :: jk ! Dummy loop indice LOGICAL :: llsave ! REAL(wp) :: zt0, zs0, z12 ! temporary scalar REAL(wp), DIMENSION(jpi,jpj,jpk) :: zt_ref, ztb, zavt ! 3D workspace REAL(wp), DIMENSION(jpi,jpj,jpk) :: zs_ref, zsb ! 3D workspace !!---------------------------------------------------------------------- IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on anomalies' WRITE(numout,*) '~~~~~~~~~~~' ENDIF ! defined the T & S reference profiles ! ------------------------------------ zt0 =10.e0 ! homogeneous ocean zs0 =35.e0 zt_ref(:,:,:) = 10.0 * tmask(:,:,:) zs_ref(:,:,:) = 35.0 * tmask(:,:,:) IF(lwp) WRITE(numout,*) ' homogeneous ocean T = ', zt0, ' S = ',zs0 ! ! T & S profile (to be coded +namelist parameter ! prepare the ldf computation ! --------------------------- llsave = l_trdtra l_trdtra = .false. ! desactivate trend computation t0_ldf(:,:,:) = 0.e0 s0_ldf(:,:,:) = 0.e0 ztb (:,:,:) = tb (:,:,:) zsb (:,:,:) = sb (:,:,:) ua (:,:,:) = ta (:,:,:) va (:,:,:) = sa (:,:,:) zavt (:,:,:) = avt(:,:,:) IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' ) ! set tb, sb to reference values and avr to zero tb (:,:,:) = zt_ref(:,:,:) sb (:,:,:) = zs_ref(:,:,:) ta (:,:,:) = 0.e0 sa (:,:,:) = 0.e0 avt(:,:,:) = 0.e0 ! Compute the ldf trends ! ---------------------- CALL tra_ldf( nit000+1 ) ! horizontal components (+1: no more init) CALL tra_zdf( nit000 ) ! vertical component (if necessary nit000 to performed the init) ! finalise the computation and recover all arrays ! ----------------------------------------------- l_trdtra = llsave z12 = 2.e0 IF( neuler == 1) z12 = 1.e0 IF( ln_zdfexp ) THEN ! ta,sa are the trends t0_ldf(:,:,:) = ta(:,:,:) s0_ldf(:,:,:) = sa(:,:,:) ELSE DO jk = 1, jpkm1 t0_ldf(:,:,jk) = ( ta(:,:,jk) - tb(:,:,jk) ) / ( z12 *rdttra(jk) ) s0_ldf(:,:,jk) = ( sa(:,:,jk) - tb(:,:,jk) ) / ( z12 *rdttra(jk) ) END DO ENDIF tb (:,:,:) = ztb (:,:,:) sb (:,:,:) = zsb (:,:,:) ta (:,:,:) = ua (:,:,:) sa (:,:,:) = va (:,:,:) avt (:,:,:) = zavt(:,:,:) ! END SUBROUTINE ldf_ano #else !!---------------------------------------------------------------------- !! default option : Dummy code NO T & S background profiles !!---------------------------------------------------------------------- SUBROUTINE ldf_ano IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on the full fields' WRITE(numout,*) '~~~~~~~~~~~' ENDIF END SUBROUTINE ldf_ano #endif !!====================================================================== END MODULE traldf