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 branches/UKMO/r5518_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: branches/UKMO/r5518_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90 @ 7099

Last change on this file since 7099 was 7099, checked in by jcastill, 8 years ago
Changes as in r7078 of the original ING branch: branches/2015/dev_r5936_INGV1_WAVE
Property svn:keywords set to `Id`
File size: 14.9 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
[4245]	8	!! 4.0 ! 2011-06 (G. Madec) Addition of Mixed Layer Eddy parameterisation
[7099]	9	!! 3.6 ! 2015-06 (E. Clementi) Addition of Stokes drift in case of wave coupling
[458]	10	!!----------------------------------------------------------------------
[503]	11
	12	!!----------------------------------------------------------------------
[458]	13	!! tra_adv : compute ocean tracer advection trend
	14	!! tra_adv_ctl : control the different options of advection scheme
	15	!!----------------------------------------------------------------------
	16	USE oce ! ocean dynamics and active tracers
	17	USE dom_oce ! ocean space and time domain
[4292]	18	USE domvvl ! variable vertical scale factors
[503]	19	USE traadv_cen2 ! 2nd order centered scheme (tra_adv_cen2 routine)
[637]	20	USE traadv_tvd ! TVD scheme (tra_adv_tvd routine)
	21	USE traadv_muscl ! MUSCL scheme (tra_adv_muscl routine)
	22	USE traadv_muscl2 ! MUSCL2 scheme (tra_adv_muscl2 routine)
	23	USE traadv_ubs ! UBS scheme (tra_adv_ubs routine)
[2528]	24	USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine)
[458]	25	USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine)
[4245]	26	USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine)
[2528]	27	USE cla ! cross land advection (cla_traadv routine)
[503]	28	USE ldftra_oce ! lateral diffusion coefficient on tracers
[5147]	29	!
[458]	30	USE in_out_manager ! I/O manager
[2715]	31	USE iom ! I/O module
[458]	32	USE prtctl ! Print control
[2715]	33	USE lib_mpp ! MPP library
[3294]	34	USE wrk_nemo ! Memory Allocation
	35	USE timing ! Timing
[4990]	36	USE sbc_oce
[7099]	37	USE sbcwave ! wave module
	38	USE sbc_oce ! surface boundary condition: ocean
	39
	40	USE diaptr ! Poleward heat transport
	41	USE sbcwave ! wave module
	42	USE sbc_oce ! surface boundary condition: ocean
[458]	43
	44	IMPLICIT NONE
	45	PRIVATE
	46
[2528]	47	PUBLIC tra_adv ! routine called by step module
	48	PUBLIC tra_adv_init ! routine called by opa module
[2715]	49
[4147]	50	! !!* Namelist namtra_adv *
	51	LOGICAL :: ln_traadv_cen2 ! 2nd order centered scheme flag
	52	LOGICAL :: ln_traadv_tvd ! TVD scheme flag
[4990]	53	LOGICAL :: ln_traadv_tvd_zts ! TVD scheme flag with vertical sub time-stepping
[4147]	54	LOGICAL :: ln_traadv_muscl ! MUSCL scheme flag
	55	LOGICAL :: ln_traadv_muscl2 ! MUSCL2 scheme flag
	56	LOGICAL :: ln_traadv_ubs ! UBS scheme flag
	57	LOGICAL :: ln_traadv_qck ! QUICKEST scheme flag
	58	LOGICAL :: ln_traadv_msc_ups ! use upstream scheme within muscl
[458]	59
[3680]	60
[503]	61	INTEGER :: nadv ! choice of the type of advection scheme
[458]	62
	63	!! * Substitutions
[503]	64	# include "domzgr_substitute.h90"
	65	# include "vectopt_loop_substitute.h90"
[458]	66	!!----------------------------------------------------------------------
[2528]	67	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
	68	!! $Id$
	69	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[458]	70	!!----------------------------------------------------------------------
	71	CONTAINS
	72
	73	SUBROUTINE tra_adv( kt )
	74	!!----------------------------------------------------------------------
	75	!! * ROUTINE tra_adv *
	76	!!
	77	!! ** Purpose : compute the ocean tracer advection trend.
	78	!!
[503]	79	!! ** Method : - Update (ua,va) with the advection term following nadv
[458]	80	!!----------------------------------------------------------------------
[2715]	81	!
[503]	82	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[2528]	83	!
	84	INTEGER :: jk ! dummy loop index
[3294]	85	REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn
[458]	86	!!----------------------------------------------------------------------
[2715]	87	!
[3294]	88	IF( nn_timing == 1 ) CALL timing_start('tra_adv')
	89	!
	90	CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
[2528]	91	! ! set time step
[7099]	92	zun(:,:,:) = 0.0
	93	zvn(:,:,:) = 0.0
	94	zwn(:,:,:) = 0.0
	95	!
[2528]	96	IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000
[2715]	97	r2dtra(:) = rdttra(:) ! = rdtra (restarting with Euler time stepping)
[2528]	98	ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1
[2715]	99	r2dtra(:) = 2._wp * rdttra(:) ! = 2 rdttra (leapfrog)
[458]	100	ENDIF
[2528]	101	!
[4147]	102	IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 ) CALL cla_traadv( kt ) !== Cross Land Advection ==! (hor. advection)
[2528]	103	!
	104	! !== effective transport ==!
[7099]	105	IF (ln_wave .AND. ln_sdw) THEN
	106	DO jk = 1, jpkm1
	107	zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * &
	108	& ( un(:,:,jk) + usd3d(:,:,jk) ) !eulerian transport + Stokes Drift
	109	zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * &
	110	& ( vn(:,:,jk) + vsd3d(:,:,jk) )
	111	zwn(:,:,jk) = e1e2t(:,:) * &
	112	& ( wn(:,:,jk) + wsd3d(:,:,jk) )
	113	END DO
	114	ELSE
[2528]	115	DO jk = 1, jpkm1
	116	zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only
	117	zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
	118	zwn(:,:,jk) = e1t(:,:) * e2t(:,:) * wn(:,:,jk)
	119	END DO
[7099]	120	ENDIF
[4292]	121	!
	122	IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
	123	zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
	124	zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
	125	ENDIF
	126	!
[2558]	127	zun(:,:,jpk) = 0._wp ! no transport trough the bottom
	128	zvn(:,:,jpk) = 0._wp ! no transport trough the bottom
	129	zwn(:,:,jpk) = 0._wp ! no transport trough the bottom
[2528]	130	!
	131	IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) &
[3294]	132	& CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary)
[2528]	133	!
[4245]	134	IF( ln_mle ) CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the mle transport (if necessary)
[5147]	135	!
[2561]	136	CALL iom_put( "uocetr_eff", zun ) ! output effective transport
	137	CALL iom_put( "vocetr_eff", zvn )
	138	CALL iom_put( "wocetr_eff", zwn )
[5147]	139	!
	140	IF( ln_diaptr ) CALL dia_ptr( zvn ) ! diagnose the effective MSF
	141	!
	142
[2528]	143	SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
[5147]	144	CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered
	145	CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD
	146	CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL
	147	CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2
	148	CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS
	149	CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST
	150	CASE ( 7 ) ; CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD ZTS
[503]	151	!
[2528]	152	CASE (-1 ) !== esopa: test all possibility with control print ==!
[3294]	153	CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	154	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, &
	155	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	156	CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	157	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, &
	158	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3718]	159	CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups )
[2528]	160	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, &
	161	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	162	CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	163	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, &
	164	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	165	CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	166	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, &
	167	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	168	CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	169	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, &
	170	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[458]	171	END SELECT
[2528]	172	!
[503]	173	! ! print mean trends (used for debugging)
[2528]	174	IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, &
	175	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]	176	!
[4245]	177	IF( nn_timing == 1 ) CALL timing_stop( 'tra_adv' )
[2715]	178	!
[3294]	179	CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
	180	!
[458]	181	END SUBROUTINE tra_adv
	182
	183
[2528]	184	SUBROUTINE tra_adv_init
[458]	185	!!---------------------------------------------------------------------
[2528]	186	!! * ROUTINE tra_adv_init *
[458]	187	!!
[503]	188	!! ** Purpose : Control the consistency between namelist options for
	189	!! tracer advection schemes and set nadv
[458]	190	!!----------------------------------------------------------------------
	191	INTEGER :: ioptio
[4147]	192	INTEGER :: ios ! Local integer output status for namelist read
[2528]	193	!!
	194	NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd, &
	195	& ln_traadv_muscl, ln_traadv_muscl2, &
[3680]	196	& ln_traadv_ubs , ln_traadv_qck, &
[4990]	197	& ln_traadv_msc_ups, ln_traadv_tvd_zts
[458]	198	!!----------------------------------------------------------------------
	199
[4147]	200	REWIND( numnam_ref ) ! Namelist namtra_adv in reference namelist : Tracer advection scheme
	201	READ ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901)
	202	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp )
[458]	203
[4147]	204	REWIND( numnam_cfg ) ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
	205	READ ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 )
	206	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp )
[4624]	207	IF(lwm) WRITE ( numond, namtra_adv )
[4147]	208
[503]	209	IF(lwp) THEN ! Namelist print
[458]	210	WRITE(numout,*)
[2528]	211	WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
[458]	212	WRITE(numout,*) '~~~~~~~~~~~'
[1601]	213	WRITE(numout,*) ' Namelist namtra_adv : chose a advection scheme for tracers'
[3718]	214	WRITE(numout,*) ' 2nd order advection scheme ln_traadv_cen2 = ', ln_traadv_cen2
	215	WRITE(numout,*) ' TVD advection scheme ln_traadv_tvd = ', ln_traadv_tvd
	216	WRITE(numout,*) ' MUSCL advection scheme ln_traadv_muscl = ', ln_traadv_muscl
	217	WRITE(numout,*) ' MUSCL2 advection scheme ln_traadv_muscl2 = ', ln_traadv_muscl2
	218	WRITE(numout,*) ' UBS advection scheme ln_traadv_ubs = ', ln_traadv_ubs
	219	WRITE(numout,*) ' QUICKEST advection scheme ln_traadv_qck = ', ln_traadv_qck
	220	WRITE(numout,*) ' upstream scheme within muscl ln_traadv_msc_ups = ', ln_traadv_msc_ups
[4990]	221	WRITE(numout,*) ' TVD advection scheme with zts ln_traadv_tvd_zts = ', ln_traadv_tvd_zts
[2528]	222	ENDIF
[458]	223
[503]	224	ioptio = 0 ! Parameter control
[458]	225	IF( ln_traadv_cen2 ) ioptio = ioptio + 1
	226	IF( ln_traadv_tvd ) ioptio = ioptio + 1
	227	IF( ln_traadv_muscl ) ioptio = ioptio + 1
	228	IF( ln_traadv_muscl2 ) ioptio = ioptio + 1
[503]	229	IF( ln_traadv_ubs ) ioptio = ioptio + 1
[637]	230	IF( ln_traadv_qck ) ioptio = ioptio + 1
[4990]	231	IF( ln_traadv_tvd_zts) ioptio = ioptio + 1
[503]	232	IF( lk_esopa ) ioptio = 1
[458]	233
[5130]	234	IF( ( ln_traadv_muscl .OR. ln_traadv_muscl2 .OR. ln_traadv_ubs .OR. ln_traadv_qck .OR. ln_traadv_tvd_zts ) &
	235	.AND. ln_isfcav ) CALL ctl_stop( 'Only traadv_cen2 and traadv_tvd is compatible with ice shelf cavity')
[4990]	236
[1601]	237	IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' )
[458]	238
[503]	239	! ! Set nadv
	240	IF( ln_traadv_cen2 ) nadv = 1
	241	IF( ln_traadv_tvd ) nadv = 2
	242	IF( ln_traadv_muscl ) nadv = 3
	243	IF( ln_traadv_muscl2 ) nadv = 4
	244	IF( ln_traadv_ubs ) nadv = 5
[637]	245	IF( ln_traadv_qck ) nadv = 6
[4990]	246	IF( ln_traadv_tvd_zts) nadv = 7
[503]	247	IF( lk_esopa ) nadv = -1
[458]	248
[503]	249	IF(lwp) THEN ! Print the choice
	250	WRITE(numout,*)
[789]	251	IF( nadv == 1 ) WRITE(numout,*) ' 2nd order scheme is used'
[503]	252	IF( nadv == 2 ) WRITE(numout,*) ' TVD scheme is used'
	253	IF( nadv == 3 ) WRITE(numout,*) ' MUSCL scheme is used'
	254	IF( nadv == 4 ) WRITE(numout,*) ' MUSCL2 scheme is used'
	255	IF( nadv == 5 ) WRITE(numout,*) ' UBS scheme is used'
[789]	256	IF( nadv == 6 ) WRITE(numout,*) ' QUICKEST scheme is used'
[4990]	257	IF( nadv == 7 ) WRITE(numout,*) ' TVD ZTS scheme is used'
[503]	258	IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection scheme'
[458]	259	ENDIF
[503]	260	!
[4245]	261	CALL tra_adv_mle_init ! initialisation of the Mixed Layer Eddy parametrisation (MLE)
	262	!
[2528]	263	END SUBROUTINE tra_adv_init
[458]	264
	265	!!======================================================================
	266	END MODULE traadv

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

Download in other formats: