Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

traadv.F90 @ 7083

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

Download in other formats: