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

Last change on this file since 3389 was 3294, checked in by rblod, 12 years ago
Merge of 3.4beta into the trunk
Property svn:keywords set to `Id`
File size: 11.8 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
[458]	46
[503]	47	INTEGER :: nadv ! choice of the type of advection scheme
[458]	48
	49	!! * Substitutions
[503]	50	# include "domzgr_substitute.h90"
	51	# include "vectopt_loop_substitute.h90"
[458]	52	!!----------------------------------------------------------------------
[2528]	53	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
	54	!! $Id$
	55	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[458]	56	!!----------------------------------------------------------------------
	57	CONTAINS
	58
	59	SUBROUTINE tra_adv( kt )
	60	!!----------------------------------------------------------------------
	61	!! * ROUTINE tra_adv *
	62	!!
	63	!! ** Purpose : compute the ocean tracer advection trend.
	64	!!
[503]	65	!! ** Method : - Update (ua,va) with the advection term following nadv
[458]	66	!!----------------------------------------------------------------------
[2715]	67	!
[503]	68	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[2528]	69	!
	70	INTEGER :: jk ! dummy loop index
[3294]	71	REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn
[458]	72	!!----------------------------------------------------------------------
[2715]	73	!
[3294]	74	IF( nn_timing == 1 ) CALL timing_start('tra_adv')
	75	!
	76	CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
[2528]	77	! ! set time step
	78	IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000
[2715]	79	r2dtra(:) = rdttra(:) ! = rdtra (restarting with Euler time stepping)
[2528]	80	ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1
[2715]	81	r2dtra(:) = 2._wp * rdttra(:) ! = 2 rdttra (leapfrog)
[458]	82	ENDIF
[2528]	83	!
	84	IF( nn_cla == 1 ) CALL cla_traadv( kt ) !== Cross Land Advection ==! (hor. advection)
	85	!
	86	! !== effective transport ==!
	87	DO jk = 1, jpkm1
	88	zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only
	89	zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
	90	zwn(:,:,jk) = e1t(:,:) * e2t(:,:) * wn(:,:,jk)
	91	END DO
[2558]	92	zun(:,:,jpk) = 0._wp ! no transport trough the bottom
	93	zvn(:,:,jpk) = 0._wp ! no transport trough the bottom
	94	zwn(:,:,jpk) = 0._wp ! no transport trough the bottom
[2528]	95	!
	96	IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) &
[3294]	97	& CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary)
[2528]	98	!
[2561]	99	CALL iom_put( "uocetr_eff", zun ) ! output effective transport
	100	CALL iom_put( "vocetr_eff", zvn )
	101	CALL iom_put( "wocetr_eff", zwn )
[458]	102
[2528]	103	SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
[3294]	104	CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered
	105	CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD
	106	CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL
	107	CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2
	108	CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS
	109	CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST
[503]	110	!
[2528]	111	CASE (-1 ) !== esopa: test all possibility with control print ==!
[3294]	112	CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	113	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, &
	114	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	115	CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	116	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, &
	117	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	118	CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts )
[2528]	119	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, &
	120	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	121	CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	122	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, &
	123	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	124	CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	125	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, &
	126	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	127	CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	128	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, &
	129	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[458]	130	END SELECT
[2528]	131	!
[503]	132	! ! print mean trends (used for debugging)
[2528]	133	IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, &
	134	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]	135	!
[3294]	136	IF( nn_timing == 1 ) CALL timing_stop('tra_adv')
[2715]	137	!
[3294]	138	CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
	139	!
[458]	140	END SUBROUTINE tra_adv
	141
	142
[2528]	143	SUBROUTINE tra_adv_init
[458]	144	!!---------------------------------------------------------------------
[2528]	145	!! * ROUTINE tra_adv_init *
[458]	146	!!
[503]	147	!! ** Purpose : Control the consistency between namelist options for
	148	!! tracer advection schemes and set nadv
[458]	149	!!----------------------------------------------------------------------
	150	INTEGER :: ioptio
[2528]	151	!!
	152	NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd, &
	153	& ln_traadv_muscl, ln_traadv_muscl2, &
[637]	154	& ln_traadv_ubs , ln_traadv_qck
[458]	155	!!----------------------------------------------------------------------
	156
[2715]	157	REWIND( numnam ) ! Read Namelist namtra_adv : tracer advection scheme
	158	READ ( numnam, namtra_adv )
[458]	159
[503]	160	IF(lwp) THEN ! Namelist print
[458]	161	WRITE(numout,*)
[2528]	162	WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
[458]	163	WRITE(numout,*) '~~~~~~~~~~~'
[1601]	164	WRITE(numout,*) ' Namelist namtra_adv : chose a advection scheme for tracers'
	165	WRITE(numout,*) ' 2nd order advection scheme ln_traadv_cen2 = ', ln_traadv_cen2
	166	WRITE(numout,*) ' TVD advection scheme ln_traadv_tvd = ', ln_traadv_tvd
	167	WRITE(numout,*) ' MUSCL advection scheme ln_traadv_muscl = ', ln_traadv_muscl
	168	WRITE(numout,*) ' MUSCL2 advection scheme ln_traadv_muscl2 = ', ln_traadv_muscl2
	169	WRITE(numout,*) ' UBS advection scheme ln_traadv_ubs = ', ln_traadv_ubs
	170	WRITE(numout,*) ' QUICKEST advection scheme ln_traadv_qck = ', ln_traadv_qck
[2528]	171	ENDIF
[458]	172
[503]	173	ioptio = 0 ! Parameter control
[458]	174	IF( ln_traadv_cen2 ) ioptio = ioptio + 1
	175	IF( ln_traadv_tvd ) ioptio = ioptio + 1
	176	IF( ln_traadv_muscl ) ioptio = ioptio + 1
	177	IF( ln_traadv_muscl2 ) ioptio = ioptio + 1
[503]	178	IF( ln_traadv_ubs ) ioptio = ioptio + 1
[637]	179	IF( ln_traadv_qck ) ioptio = ioptio + 1
[503]	180	IF( lk_esopa ) ioptio = 1
[458]	181
[1601]	182	IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' )
[458]	183
[503]	184	! ! Set nadv
	185	IF( ln_traadv_cen2 ) nadv = 1
	186	IF( ln_traadv_tvd ) nadv = 2
	187	IF( ln_traadv_muscl ) nadv = 3
	188	IF( ln_traadv_muscl2 ) nadv = 4
	189	IF( ln_traadv_ubs ) nadv = 5
[637]	190	IF( ln_traadv_qck ) nadv = 6
[503]	191	IF( lk_esopa ) nadv = -1
[458]	192
[503]	193	IF(lwp) THEN ! Print the choice
	194	WRITE(numout,*)
[789]	195	IF( nadv == 1 ) WRITE(numout,*) ' 2nd order scheme is used'
[503]	196	IF( nadv == 2 ) WRITE(numout,*) ' TVD scheme is used'
	197	IF( nadv == 3 ) WRITE(numout,*) ' MUSCL scheme is used'
	198	IF( nadv == 4 ) WRITE(numout,*) ' MUSCL2 scheme is used'
	199	IF( nadv == 5 ) WRITE(numout,*) ' UBS scheme is used'
[789]	200	IF( nadv == 6 ) WRITE(numout,*) ' QUICKEST scheme is used'
[503]	201	IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection scheme'
[458]	202	ENDIF
[503]	203	!
[2528]	204	END SUBROUTINE tra_adv_init
[458]	205
	206	!!======================================================================
	207	END MODULE traadv

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

Download in other formats: