New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

traadv.F90 in trunk/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/TRA/traadv.F90 @ 785

Last change on this file since 785 was 719, checked in by ctlod, 17 years ago
get back to the nemo_v2_3 version for trunk
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 10.9 KB

Rev	Line
[458]	1	MODULE traadv
	2	!!==============================================================================
	3	!! * MODULE traadv *
	4	!! Ocean active tracers: advection trend
	5	!!==============================================================================
[503]	6	!! History : 9.0 ! 05-11 (G. Madec) Original code
[458]	7	!!----------------------------------------------------------------------
[503]	8
	9	!!----------------------------------------------------------------------
[458]	10	!! tra_adv : compute ocean tracer advection trend
	11	!! tra_adv_ctl : control the different options of advection scheme
	12	!!----------------------------------------------------------------------
	13	USE oce ! ocean dynamics and active tracers
	14	USE dom_oce ! ocean space and time domain
[503]	15	USE traadv_cen2 ! 2nd order centered scheme (tra_adv_cen2 routine)
	16	USE traadv_cen2_jki ! 2nd order centered scheme (tra_adv_cen2 routine)
[637]	17	USE traadv_tvd ! TVD scheme (tra_adv_tvd routine)
	18	USE traadv_muscl ! MUSCL scheme (tra_adv_muscl routine)
	19	USE traadv_muscl2 ! MUSCL2 scheme (tra_adv_muscl2 routine)
	20	USE traadv_ubs ! UBS scheme (tra_adv_ubs routine)
	21	USE traadv_qck !! QUICKEST scheme (tra_adv_qck routine)
[458]	22	USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine)
[503]	23	USE trabbl ! tracers: bottom boundary layer
	24	USE ldftra_oce ! lateral diffusion coefficient on tracers
[458]	25	USE in_out_manager ! I/O manager
	26	USE prtctl ! Print control
	27
	28	IMPLICIT NONE
	29	PRIVATE
	30
[503]	31	PUBLIC tra_adv ! routine called by step module
[458]	32
[503]	33	!!* Namelist nam_traadv
	34	LOGICAL, PUBLIC :: ln_traadv_cen2 = .TRUE. ! 2nd order centered scheme flag
	35	LOGICAL, PUBLIC :: ln_traadv_tvd = .FALSE. ! TVD scheme flag
	36	LOGICAL, PUBLIC :: ln_traadv_muscl = .FALSE. ! MUSCL scheme flag
	37	LOGICAL, PUBLIC :: ln_traadv_muscl2 = .FALSE. ! MUSCL2 scheme flag
	38	LOGICAL, PUBLIC :: ln_traadv_ubs = .FALSE. ! UBS scheme flag
[637]	39	LOGICAL, PUBLIC :: ln_traadv_qck = .FALSE. ! QUICKEST scheme flag
[458]	40
[503]	41	INTEGER :: nadv ! choice of the type of advection scheme
[458]	42
	43	!! * Substitutions
[503]	44	# include "domzgr_substitute.h90"
	45	# include "vectopt_loop_substitute.h90"
[458]	46	!!----------------------------------------------------------------------
[503]	47	!! OPA 9.0 , LOCEAN-IPSL (2006)
[719]	48	!! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRA/traadv.F90,v 1.7 2007/06/05 11:00:53 opalod Exp $
[503]	49	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
[458]	50	!!----------------------------------------------------------------------
	51
	52	CONTAINS
	53
	54	SUBROUTINE tra_adv( kt )
	55	!!----------------------------------------------------------------------
	56	!! * ROUTINE tra_adv *
	57	!!
	58	!! ** Purpose : compute the ocean tracer advection trend.
	59	!!
[503]	60	!! ** Method : - Update (ua,va) with the advection term following nadv
[458]	61	!!----------------------------------------------------------------------
	62	#if ( defined key_trabbl_adv \|\| defined key_traldf_eiv )
[503]	63	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! effective velocity
[458]	64	#else
[503]	65	USE oce, ONLY : zun => un ! the effective velocity is the
	66	USE oce, ONLY : zvn => vn ! Eulerian velocity
	67	USE oce, ONLY : zwn => wn !
[458]	68	#endif
[503]	69	!!
	70	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[458]	71	!!----------------------------------------------------------------------
	72
[503]	73	IF( kt == nit000 ) CALL tra_adv_ctl ! initialisation & control of options
[458]	74
	75	#if defined key_trabbl_adv
[503]	76	zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:) ! add the bbl velocity
[458]	77	zvn(:,:,:) = vn(:,:,:) - v_bbl(:,:,:)
	78	zwn(:,:,:) = wn(:,:,:) + w_bbl(:,:,:)
	79	#endif
[503]	80	IF( lk_traldf_eiv ) THEN ! commpute and add the eiv velocity
[458]	81	IF( .NOT. lk_trabbl_adv ) THEN
	82	zun(:,:,:) = un(:,:,:)
	83	zvn(:,:,:) = vn(:,:,:)
	84	zwn(:,:,:) = wn(:,:,:)
	85	ENDIF
[503]	86	CALL tra_adv_eiv( kt, zun, zvn, zwn )
[458]	87	ENDIF
	88
[503]	89	SELECT CASE ( nadv ) ! compute advection trend and add it to general trend
	90	CASE ( 0 ) ; CALL tra_adv_cen2 ( kt, zun, zvn, zwn ) ! 2nd order centered scheme k-j-i loops
	91	CASE ( 1 ) ; CALL tra_adv_cen2_jki( kt, zun, zvn, zwn ) ! 2nd order centered scheme
[637]	92	CASE ( 2 ) ; CALL tra_adv_tvd ( kt, zun, zvn, zwn ) ! TVD scheme
	93	CASE ( 3 ) ; CALL tra_adv_muscl ( kt, zun, zvn, zwn ) ! MUSCL scheme
	94	CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, zun, zvn, zwn ) ! MUSCL2 scheme
	95	CASE ( 5 ) ; CALL tra_adv_ubs ( kt, zun, zvn, zwn ) ! UBS scheme
	96	CASE ( 6 ) ; CALL tra_adv_qck ( kt, zun, zvn, zwn ) ! QUICKEST scheme
[503]	97	!
	98	CASE (-1 ) ! esopa: test all possibility with control print
[684]	99	CALL tra_adv_cen2 ( kt, zun, zvn, zwn )
	100	CALL prt_ctl( tab3d_1=ta, clinfo1=' adv0 - Ta: ', mask1=tmask, &
[503]	101	& tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[684]	102	CALL tra_adv_cen2_jki( kt, zun, zvn, zwn )
	103	CALL prt_ctl( tab3d_1=ta, clinfo1=' adv1 - Ta: ', mask1=tmask, &
[503]	104	& tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[684]	105	CALL tra_adv_tvd ( kt, zun, zvn, zwn )
	106	CALL prt_ctl( tab3d_1=ta, clinfo1=' adv2 - Ta: ', mask1=tmask, &
[503]	107	& tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[684]	108	CALL tra_adv_muscl ( kt, zun, zvn, zwn )
	109	CALL prt_ctl( tab3d_1=ta, clinfo1=' adv3 - Ta: ', mask1=tmask, &
[503]	110	& tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[684]	111	CALL tra_adv_muscl2 ( kt, zun, zvn, zwn )
	112	CALL prt_ctl( tab3d_1=ta, clinfo1=' adv4 - Ta: ', mask1=tmask, &
[503]	113	& tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[684]	114	CALL tra_adv_ubs ( kt, zun, zvn, zwn )
	115	CALL prt_ctl( tab3d_1=ta, clinfo1=' adv5 - Ta: ', mask1=tmask, &
[503]	116	& tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[684]	117	CALL tra_adv_qck ( kt, zun, zvn, zwn )
	118	CALL prt_ctl( tab3d_1=ta, clinfo1=' adv6 - Ta: ', mask1=tmask, &
[637]	119	& tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[458]	120	END SELECT
[503]	121	! ! print mean trends (used for debugging)
	122	IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' adv - Ta: ', mask1=tmask, &
	123	& tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
	124	!
[458]	125	END SUBROUTINE tra_adv
	126
	127
	128	SUBROUTINE tra_adv_ctl
	129	!!---------------------------------------------------------------------
	130	!! * ROUTINE tra_adv_ctl *
	131	!!
[503]	132	!! ** Purpose : Control the consistency between namelist options for
	133	!! tracer advection schemes and set nadv
[458]	134	!!----------------------------------------------------------------------
	135	INTEGER :: ioptio
[541]	136
[637]	137	NAMELIST/nam_traadv/ ln_traadv_cen2 , ln_traadv_tvd, &
	138	& ln_traadv_muscl, ln_traadv_muscl2, &
	139	& ln_traadv_ubs , ln_traadv_qck
[458]	140	!!----------------------------------------------------------------------
	141
[503]	142	REWIND ( numnam ) ! Read Namelist nam_traadv : tracer advection scheme
[458]	143	READ ( numnam, nam_traadv )
	144
[503]	145	IF(lwp) THEN ! Namelist print
[458]	146	WRITE(numout,*)
	147	WRITE(numout,*) 'tra_adv_ctl : choice/control of the tracer advection scheme'
	148	WRITE(numout,*) '~~~~~~~~~~~'
[503]	149	WRITE(numout,*) ' Namelist nam_traadv : chose a advection scheme for tracers'
	150	WRITE(numout,*) ' 2nd order advection scheme ln_traadv_cen2 = ', ln_traadv_cen2
	151	WRITE(numout,*) ' TVD advection scheme ln_traadv_tvd = ', ln_traadv_tvd
	152	WRITE(numout,*) ' MUSCL advection scheme ln_traadv_muscl = ', ln_traadv_muscl
	153	WRITE(numout,*) ' MUSCL2 advection scheme ln_traadv_muscl2 = ', ln_traadv_muscl2
	154	WRITE(numout,*) ' UBS advection scheme ln_traadv_ubs = ', ln_traadv_ubs
[637]	155	WRITE(numout,*) ' QUICKEST advection scheme ln_traadv_qck = ', ln_traadv_qck
	156	ENDIF
[458]	157
[503]	158	ioptio = 0 ! Parameter control
[458]	159	IF( ln_traadv_cen2 ) ioptio = ioptio + 1
	160	IF( ln_traadv_tvd ) ioptio = ioptio + 1
	161	IF( ln_traadv_muscl ) ioptio = ioptio + 1
	162	IF( ln_traadv_muscl2 ) ioptio = ioptio + 1
[503]	163	IF( ln_traadv_ubs ) ioptio = ioptio + 1
[637]	164	IF( ln_traadv_qck ) ioptio = ioptio + 1
[503]	165	IF( lk_esopa ) ioptio = 1
[458]	166
[503]	167	IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist nam_traadv' )
[458]	168
[503]	169	IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 ) &
	170	& CALL ctl_stop( 'cross-land advection only with 2nd order advection scheme' )
[458]	171
[503]	172	! ! Set nadv
	173	IF( ln_traadv_cen2 ) nadv = 0
[458]	174	#if defined key_mpp_omp
[503]	175	IF( ln_traadv_cen2 ) nadv = 1
[458]	176	#endif
[503]	177	IF( ln_traadv_tvd ) nadv = 2
	178	IF( ln_traadv_muscl ) nadv = 3
	179	IF( ln_traadv_muscl2 ) nadv = 4
	180	IF( ln_traadv_ubs ) nadv = 5
[637]	181	IF( ln_traadv_qck ) nadv = 6
[503]	182	IF( lk_esopa ) nadv = -1
[458]	183
[503]	184	IF(lwp) THEN ! Print the choice
	185	WRITE(numout,*)
	186	IF( nadv == 0 ) WRITE(numout,*) ' 2nd order scheme is used'
	187	IF( nadv == 1 ) WRITE(numout,*) ' 2nd order scheme is usedi, k-j-i case'
	188	IF( nadv == 2 ) WRITE(numout,*) ' TVD scheme is used'
	189	IF( nadv == 3 ) WRITE(numout,*) ' MUSCL scheme is used'
	190	IF( nadv == 4 ) WRITE(numout,*) ' MUSCL2 scheme is used'
	191	IF( nadv == 5 ) WRITE(numout,*) ' UBS scheme is used'
[637]	192	IF( nadv == 6 ) WRITE(numout,*) ' PPM scheme is used'
	193	IF( nadv == 7 ) WRITE(numout,*) ' QUICKEST scheme is used'
[503]	194	IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection scheme'
[458]	195	ENDIF
[503]	196	!
[458]	197	END SUBROUTINE tra_adv_ctl
	198
	199	!!======================================================================
	200	END MODULE traadv

Note: See TracBrowser for help on using the repository browser.

Download in other formats: