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/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90 @ 3980

Last change on this file since 3980 was 3718, checked in by cetlod, 12 years ago
dev_MERGE_2012 : modification in MUSCL routines ; needed to be able to use the upstream parametisation with passive tracers
Property svn:keywords set to `Id`
File size: 12.0 KB

Rev	Line
[458]	1	MODULE traadv
	2	!!==============================================================================
	3	!! * MODULE traadv *
	4	!! Ocean active tracers: advection trend
	5	!!==============================================================================
[2528]	6	!! History : 2.0 ! 2005-11 (G. Madec) Original code
	7	!! 3.3 ! 2010-09 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport
[458]	8	!!----------------------------------------------------------------------
[503]	9
	10	!!----------------------------------------------------------------------
[458]	11	!! tra_adv : compute ocean tracer advection trend
	12	!! tra_adv_ctl : control the different options of advection scheme
	13	!!----------------------------------------------------------------------
	14	USE oce ! ocean dynamics and active tracers
	15	USE dom_oce ! ocean space and time domain
[503]	16	USE traadv_cen2 ! 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)
[2528]	21	USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine)
[458]	22	USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine)
[2528]	23	USE cla ! cross land advection (cla_traadv routine)
[503]	24	USE ldftra_oce ! lateral diffusion coefficient on tracers
[458]	25	USE in_out_manager ! I/O manager
[2715]	26	USE iom ! I/O module
[458]	27	USE prtctl ! Print control
[2715]	28	USE lib_mpp ! MPP library
[3294]	29	USE wrk_nemo ! Memory Allocation
	30	USE timing ! Timing
[458]	31
[3294]	32
[458]	33	IMPLICIT NONE
	34	PRIVATE
	35
[2528]	36	PUBLIC tra_adv ! routine called by step module
	37	PUBLIC tra_adv_init ! routine called by opa module
[2715]	38
[2528]	39	! !!* Namelist namtra_adv *
	40	LOGICAL :: ln_traadv_cen2 = .TRUE. ! 2nd order centered scheme flag
	41	LOGICAL :: ln_traadv_tvd = .FALSE. ! TVD scheme flag
	42	LOGICAL :: ln_traadv_muscl = .FALSE. ! MUSCL scheme flag
	43	LOGICAL :: ln_traadv_muscl2 = .FALSE. ! MUSCL2 scheme flag
	44	LOGICAL :: ln_traadv_ubs = .FALSE. ! UBS scheme flag
	45	LOGICAL :: ln_traadv_qck = .FALSE. ! QUICKEST scheme flag
[3718]	46	LOGICAL :: ln_traadv_msc_ups= .FALSE. ! use upstream scheme within muscl
[458]	47
[3680]	48
[503]	49	INTEGER :: nadv ! choice of the type of advection scheme
[458]	50
	51	!! * Substitutions
[503]	52	# include "domzgr_substitute.h90"
	53	# include "vectopt_loop_substitute.h90"
[458]	54	!!----------------------------------------------------------------------
[2528]	55	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
	56	!! $Id$
	57	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[458]	58	!!----------------------------------------------------------------------
	59	CONTAINS
	60
	61	SUBROUTINE tra_adv( kt )
	62	!!----------------------------------------------------------------------
	63	!! * ROUTINE tra_adv *
	64	!!
	65	!! ** Purpose : compute the ocean tracer advection trend.
	66	!!
[503]	67	!! ** Method : - Update (ua,va) with the advection term following nadv
[458]	68	!!----------------------------------------------------------------------
[2715]	69	!
[503]	70	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[2528]	71	!
	72	INTEGER :: jk ! dummy loop index
[3294]	73	REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn
[458]	74	!!----------------------------------------------------------------------
[2715]	75	!
[3294]	76	IF( nn_timing == 1 ) CALL timing_start('tra_adv')
	77	!
	78	CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
[2528]	79	! ! set time step
	80	IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000
[2715]	81	r2dtra(:) = rdttra(:) ! = rdtra (restarting with Euler time stepping)
[2528]	82	ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1
[2715]	83	r2dtra(:) = 2._wp * rdttra(:) ! = 2 rdttra (leapfrog)
[458]	84	ENDIF
[2528]	85	!
	86	IF( nn_cla == 1 ) CALL cla_traadv( kt ) !== Cross Land Advection ==! (hor. advection)
	87	!
	88	! !== effective transport ==!
	89	DO jk = 1, jpkm1
	90	zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only
	91	zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
	92	zwn(:,:,jk) = e1t(:,:) * e2t(:,:) * wn(:,:,jk)
	93	END DO
[2558]	94	zun(:,:,jpk) = 0._wp ! no transport trough the bottom
	95	zvn(:,:,jpk) = 0._wp ! no transport trough the bottom
	96	zwn(:,:,jpk) = 0._wp ! no transport trough the bottom
[2528]	97	!
	98	IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) &
[3294]	99	& CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary)
[2528]	100	!
[2561]	101	CALL iom_put( "uocetr_eff", zun ) ! output effective transport
	102	CALL iom_put( "vocetr_eff", zvn )
	103	CALL iom_put( "wocetr_eff", zwn )
[458]	104
[2528]	105	SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
[3294]	106	CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered
	107	CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD
[3718]	108	CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL
[3294]	109	CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2
	110	CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS
	111	CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST
[503]	112	!
[2528]	113	CASE (-1 ) !== esopa: test all possibility with control print ==!
[3294]	114	CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	115	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, &
	116	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	117	CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	118	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, &
	119	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3718]	120	CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups )
[2528]	121	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, &
	122	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	123	CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	124	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, &
	125	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	126	CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	127	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, &
	128	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	129	CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	130	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, &
	131	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[458]	132	END SELECT
[2528]	133	!
[503]	134	! ! print mean trends (used for debugging)
[2528]	135	IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, &
	136	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]	137	!
[3294]	138	IF( nn_timing == 1 ) CALL timing_stop('tra_adv')
[2715]	139	!
[3294]	140	CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
	141	!
[458]	142	END SUBROUTINE tra_adv
	143
	144
[2528]	145	SUBROUTINE tra_adv_init
[458]	146	!!---------------------------------------------------------------------
[2528]	147	!! * ROUTINE tra_adv_init *
[458]	148	!!
[503]	149	!! ** Purpose : Control the consistency between namelist options for
	150	!! tracer advection schemes and set nadv
[458]	151	!!----------------------------------------------------------------------
	152	INTEGER :: ioptio
[2528]	153	!!
	154	NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd, &
	155	& ln_traadv_muscl, ln_traadv_muscl2, &
[3680]	156	& ln_traadv_ubs , ln_traadv_qck, &
	157	& ln_traadv_msc_ups
[458]	158	!!----------------------------------------------------------------------
	159
[2715]	160	REWIND( numnam ) ! Read Namelist namtra_adv : tracer advection scheme
	161	READ ( numnam, namtra_adv )
[458]	162
[503]	163	IF(lwp) THEN ! Namelist print
[458]	164	WRITE(numout,*)
[2528]	165	WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
[458]	166	WRITE(numout,*) '~~~~~~~~~~~'
[1601]	167	WRITE(numout,*) ' Namelist namtra_adv : chose a advection scheme for tracers'
[3718]	168	WRITE(numout,*) ' 2nd order advection scheme ln_traadv_cen2 = ', ln_traadv_cen2
	169	WRITE(numout,*) ' TVD advection scheme ln_traadv_tvd = ', ln_traadv_tvd
	170	WRITE(numout,*) ' MUSCL advection scheme ln_traadv_muscl = ', ln_traadv_muscl
	171	WRITE(numout,*) ' MUSCL2 advection scheme ln_traadv_muscl2 = ', ln_traadv_muscl2
	172	WRITE(numout,*) ' UBS advection scheme ln_traadv_ubs = ', ln_traadv_ubs
	173	WRITE(numout,*) ' QUICKEST advection scheme ln_traadv_qck = ', ln_traadv_qck
	174	WRITE(numout,*) ' upstream scheme within muscl ln_traadv_msc_ups = ', ln_traadv_msc_ups
[2528]	175	ENDIF
[458]	176
[503]	177	ioptio = 0 ! Parameter control
[458]	178	IF( ln_traadv_cen2 ) ioptio = ioptio + 1
	179	IF( ln_traadv_tvd ) ioptio = ioptio + 1
	180	IF( ln_traadv_muscl ) ioptio = ioptio + 1
	181	IF( ln_traadv_muscl2 ) ioptio = ioptio + 1
[503]	182	IF( ln_traadv_ubs ) ioptio = ioptio + 1
[637]	183	IF( ln_traadv_qck ) ioptio = ioptio + 1
[503]	184	IF( lk_esopa ) ioptio = 1
[458]	185
[1601]	186	IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' )
[458]	187
[503]	188	! ! Set nadv
	189	IF( ln_traadv_cen2 ) nadv = 1
	190	IF( ln_traadv_tvd ) nadv = 2
	191	IF( ln_traadv_muscl ) nadv = 3
	192	IF( ln_traadv_muscl2 ) nadv = 4
	193	IF( ln_traadv_ubs ) nadv = 5
[637]	194	IF( ln_traadv_qck ) nadv = 6
[503]	195	IF( lk_esopa ) nadv = -1
[458]	196
[503]	197	IF(lwp) THEN ! Print the choice
	198	WRITE(numout,*)
[789]	199	IF( nadv == 1 ) WRITE(numout,*) ' 2nd order scheme is used'
[503]	200	IF( nadv == 2 ) WRITE(numout,*) ' TVD scheme is used'
	201	IF( nadv == 3 ) WRITE(numout,*) ' MUSCL scheme is used'
	202	IF( nadv == 4 ) WRITE(numout,*) ' MUSCL2 scheme is used'
	203	IF( nadv == 5 ) WRITE(numout,*) ' UBS scheme is used'
[789]	204	IF( nadv == 6 ) WRITE(numout,*) ' QUICKEST scheme is used'
[503]	205	IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection scheme'
[458]	206	ENDIF
[503]	207	!
[2528]	208	END SUBROUTINE tra_adv_init
[458]	209
	210	!!======================================================================
	211	END MODULE traadv

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

Download in other formats: