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 @ 789

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

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

Download in other formats: