Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

traadv.F90 @ 9295

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

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

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

Context Navigation

source: branches/UKMO/r6232_tracer_advection/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90 @ 9295

Download in other formats: