MODULE traadv !!============================================================================== !! *** MODULE traadv *** !! Ocean active tracers: advection trend !!============================================================================== !! History : 2.0 ! 05-11 (G. Madec) Original code !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! tra_adv : compute ocean tracer advection trend !! tra_adv_ctl : control the different options of advection scheme !!---------------------------------------------------------------------- USE oce ! ocean dynamics and active tracers USE dom_oce ! ocean space and time domain USE traadv_cen2 ! 2nd order centered scheme (tra_adv_cen2 routine) USE traadv_tvd ! TVD scheme (tra_adv_tvd routine) USE traadv_muscl ! MUSCL scheme (tra_adv_muscl routine) USE traadv_muscl2 ! MUSCL2 scheme (tra_adv_muscl2 routine) USE traadv_ubs ! UBS scheme (tra_adv_ubs routine) USE traadv_qck !! QUICKEST scheme (tra_adv_qck routine) USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine) USE trabbl ! tracers: bottom boundary layer USE ldftra_oce ! lateral diffusion coefficient on tracers USE in_out_manager ! I/O manager USE prtctl ! Print control USE iom IMPLICIT NONE PRIVATE PUBLIC tra_adv ! routine called by step module ! !!* Namelist namtra_adv * LOGICAL, PUBLIC :: ln_traadv_cen2 = .TRUE. ! 2nd order centered scheme flag LOGICAL, PUBLIC :: ln_traadv_tvd = .FALSE. ! TVD scheme flag LOGICAL, PUBLIC :: ln_traadv_muscl = .FALSE. ! MUSCL scheme flag LOGICAL, PUBLIC :: ln_traadv_muscl2 = .FALSE. ! MUSCL2 scheme flag LOGICAL, PUBLIC :: ln_traadv_ubs = .FALSE. ! UBS scheme flag LOGICAL, PUBLIC :: ln_traadv_qck = .FALSE. ! QUICKEST scheme flag INTEGER :: nadv ! choice of the type of advection scheme !! * Substitutions # include "domzgr_substitute.h90" # include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) !! $Id$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE tra_adv( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE tra_adv *** !! !! ** Purpose : compute the ocean tracer advection trend. !! !! ** Method : - Update (ua,va) with the advection term following nadv !!---------------------------------------------------------------------- #if ( defined key_trabbl_adv || defined key_traldf_eiv ) REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! effective velocity #else USE oce, ONLY : zun => un ! the effective velocity is the USE oce, ONLY : zvn => vn ! Eulerian velocity USE oce, ONLY : zwn => wn ! #endif !! INTEGER, INTENT( in ) :: kt ! ocean time-step index !!---------------------------------------------------------------------- IF( kt == nit000 ) CALL tra_adv_ctl ! initialisation & control of options #if defined key_trabbl_adv zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:) ! add the bbl velocity zvn(:,:,:) = vn(:,:,:) - v_bbl(:,:,:) zwn(:,:,:) = wn(:,:,:) + w_bbl(:,:,:) #endif IF( lk_traldf_eiv ) THEN ! commpute and add the eiv velocity IF( .NOT. lk_trabbl_adv ) THEN zun(:,:,:) = un(:,:,:) zvn(:,:,:) = vn(:,:,:) zwn(:,:,:) = wn(:,:,:) ENDIF CALL tra_adv_eiv( kt, zun, zvn, zwn ) ENDIF SELECT CASE ( nadv ) ! compute advection trend and add it to general trend CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, zun, zvn, zwn ) ! 2nd order centered scheme CASE ( 2 ) ; CALL tra_adv_tvd ( kt, zun, zvn, zwn ) ! TVD scheme CASE ( 3 ) ; CALL tra_adv_muscl ( kt, zun, zvn, zwn ) ! MUSCL scheme CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, zun, zvn, zwn ) ! MUSCL2 scheme CASE ( 5 ) ; CALL tra_adv_ubs ( kt, zun, zvn, zwn ) ! UBS scheme CASE ( 6 ) ; CALL tra_adv_qck ( kt, zun, zvn, zwn ) ! QUICKEST scheme ! CASE (-1 ) ! esopa: test all possibility with control print CALL tra_adv_cen2 ( kt, zun, zvn, zwn ) CALL prt_ctl( tab3d_1=ta, clinfo1=' adv0 - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) CALL tra_adv_tvd ( kt, zun, zvn, zwn ) CALL prt_ctl( tab3d_1=ta, clinfo1=' adv2 - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) CALL tra_adv_muscl ( kt, zun, zvn, zwn ) CALL prt_ctl( tab3d_1=ta, clinfo1=' adv3 - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) CALL tra_adv_muscl2 ( kt, zun, zvn, zwn ) CALL prt_ctl( tab3d_1=ta, clinfo1=' adv4 - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) CALL tra_adv_ubs ( kt, zun, zvn, zwn ) CALL prt_ctl( tab3d_1=ta, clinfo1=' adv5 - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) CALL tra_adv_qck ( kt, zun, zvn, zwn ) CALL prt_ctl( tab3d_1=ta, clinfo1=' adv6 - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) END SELECT CALL iom_put( "uoce_eff", zun ) ! effective i-current CALL iom_put( "voce_eff", zvn ) ! effective j-current CALL iom_put( "woce_eff", zwn ) ! effective vert. current ! ! print mean trends (used for debugging) IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' adv - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) ! END SUBROUTINE tra_adv SUBROUTINE tra_adv_ctl !!--------------------------------------------------------------------- !! *** ROUTINE tra_adv_ctl *** !! !! ** Purpose : Control the consistency between namelist options for !! tracer advection schemes and set nadv !!---------------------------------------------------------------------- INTEGER :: ioptio NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd, & & ln_traadv_muscl, ln_traadv_muscl2, & & ln_traadv_ubs , ln_traadv_qck !!---------------------------------------------------------------------- REWIND ( numnam ) ! Read Namelist namtra_adv : tracer advection scheme READ ( numnam, namtra_adv ) IF(lwp) THEN ! Namelist print WRITE(numout,*) WRITE(numout,*) 'tra_adv_ctl : choice/control of the tracer advection scheme' WRITE(numout,*) '~~~~~~~~~~~' WRITE(numout,*) ' Namelist namtra_adv : chose a advection scheme for tracers' WRITE(numout,*) ' 2nd order advection scheme ln_traadv_cen2 = ', ln_traadv_cen2 WRITE(numout,*) ' TVD advection scheme ln_traadv_tvd = ', ln_traadv_tvd WRITE(numout,*) ' MUSCL advection scheme ln_traadv_muscl = ', ln_traadv_muscl WRITE(numout,*) ' MUSCL2 advection scheme ln_traadv_muscl2 = ', ln_traadv_muscl2 WRITE(numout,*) ' UBS advection scheme ln_traadv_ubs = ', ln_traadv_ubs WRITE(numout,*) ' QUICKEST advection scheme ln_traadv_qck = ', ln_traadv_qck ENDIF ioptio = 0 ! Parameter control IF( ln_traadv_cen2 ) ioptio = ioptio + 1 IF( ln_traadv_tvd ) ioptio = ioptio + 1 IF( ln_traadv_muscl ) ioptio = ioptio + 1 IF( ln_traadv_muscl2 ) ioptio = ioptio + 1 IF( ln_traadv_ubs ) ioptio = ioptio + 1 IF( ln_traadv_qck ) ioptio = ioptio + 1 IF( lk_esopa ) ioptio = 1 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' ) IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 ) & & CALL ctl_stop( 'cross-land advection only with 2nd order advection scheme' ) ! ! Set nadv IF( ln_traadv_cen2 ) nadv = 1 IF( ln_traadv_tvd ) nadv = 2 IF( ln_traadv_muscl ) nadv = 3 IF( ln_traadv_muscl2 ) nadv = 4 IF( ln_traadv_ubs ) nadv = 5 IF( ln_traadv_qck ) nadv = 6 IF( lk_esopa ) nadv = -1 IF(lwp) THEN ! Print the choice WRITE(numout,*) IF( nadv == 1 ) WRITE(numout,*) ' 2nd order scheme is used' IF( nadv == 2 ) WRITE(numout,*) ' TVD scheme is used' IF( nadv == 3 ) WRITE(numout,*) ' MUSCL scheme is used' IF( nadv == 4 ) WRITE(numout,*) ' MUSCL2 scheme is used' IF( nadv == 5 ) WRITE(numout,*) ' UBS scheme is used' IF( nadv == 6 ) WRITE(numout,*) ' QUICKEST scheme is used' IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection scheme' ENDIF ! END SUBROUTINE tra_adv_ctl !!====================================================================== END MODULE traadv