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.

trcadv.F90 in NEMO/branches/2020/dev_r13723_KERNEL-01_Amy_Mike_newHPGschemes/src/TOP/TRP – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r13723_KERNEL-01_Amy_Mike_newHPGschemes/src/TOP/TRP/trcadv.F90 @ 14046

Last change on this file since 14046 was 14046, checked in by ayoung, 4 years ago
Updated to trunk at 14020. Sette tests passed with no changes of results. Ticket #2480.
Property svn:keywords set to `Id`
File size: 15.5 KB

Rev	Line
[2030]	1	MODULE trcadv
	2	!!==============================================================================
	3	!! * MODULE trcadv *
	4	!! Ocean passive tracers: advection trend
	5	!!==============================================================================
[5836]	6	!! History : 2.0 ! 2005-11 (G. Madec) Original code
	7	!! 3.0 ! 2010-06 (C. Ethe) Adapted to passive tracers
	8	!! 3.7 ! 2014-05 (G. Madec, C. Ethe) Add 2nd/4th order cases for CEN and FCT schemes
[9019]	9	!! 4.0 ! 2017-09 (G. Madec) remove vertical time-splitting option
[2030]	10	!!----------------------------------------------------------------------
	11	#if defined key_top
	12	!!----------------------------------------------------------------------
	13	!! 'key_top' TOP models
	14	!!----------------------------------------------------------------------
[5836]	15	!! trc_adv : compute ocean tracer advection trend
	16	!! trc_adv_ini : control the different options of advection scheme
[2030]	17	!!----------------------------------------------------------------------
[5836]	18	USE oce_trc ! ocean dynamics and active tracers
	19	USE trc ! ocean passive tracers variables
[9019]	20	USE sbcwave ! wave module
	21	USE sbc_oce ! surface boundary condition: ocean
[5836]	22	USE traadv_cen ! centered scheme (tra_adv_cen routine)
	23	USE traadv_fct ! FCT scheme (tra_adv_fct routine)
[14046]	24	USE traadv_fct_lf ! FCT scheme (tra_adv_fct routine - loop fusion version)
[5836]	25	USE traadv_mus ! MUSCL scheme (tra_adv_mus routine)
[14046]	26	USE traadv_mus_lf ! MUSCL scheme (tra_adv_mus routine - loop fusion version)
[5836]	27	USE traadv_ubs ! UBS scheme (tra_adv_ubs routine)
	28	USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine)
[9531]	29	USE tramle ! ML eddy induced transport (tra_adv_mle routine)
[9019]	30	USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff.
[5836]	31	USE ldfslp ! Lateral diffusion: slopes of neutral surfaces
	32	!
[13286]	33	USE prtctl ! control print
[9019]	34	USE timing ! Timing
[2030]	35
	36	IMPLICIT NONE
	37	PRIVATE
	38
[9019]	39	PUBLIC trc_adv ! called by trctrp.F90
	40	PUBLIC trc_adv_ini ! called by trcini.F90
[2082]	41
[5836]	42	! !!* Namelist namtrc_adv *
[9526]	43	LOGICAL :: ln_trcadv_OFF ! no advection on passive tracers
[5836]	44	LOGICAL :: ln_trcadv_cen ! centered scheme flag
	45	INTEGER :: nn_cen_h, nn_cen_v ! =2/4 : horizontal and vertical choices of the order of CEN scheme
	46	LOGICAL :: ln_trcadv_fct ! FCT scheme flag
	47	INTEGER :: nn_fct_h, nn_fct_v ! =2/4 : horizontal and vertical choices of the order of FCT scheme
	48	LOGICAL :: ln_trcadv_mus ! MUSCL scheme flag
	49	LOGICAL :: ln_mus_ups ! use upstream scheme in vivcinity of river mouths
	50	LOGICAL :: ln_trcadv_ubs ! UBS scheme flag
	51	INTEGER :: nn_ubs_v ! =2/4 : vertical choice of the order of UBS scheme
	52	LOGICAL :: ln_trcadv_qck ! QUICKEST scheme flag
	53
[9019]	54	INTEGER :: nadv ! choice of the type of advection scheme
	55	! ! associated indices:
[5836]	56	INTEGER, PARAMETER :: np_NO_adv = 0 ! no T-S advection
	57	INTEGER, PARAMETER :: np_CEN = 1 ! 2nd/4th order centered scheme
	58	INTEGER, PARAMETER :: np_FCT = 2 ! 2nd/4th order Flux Corrected Transport scheme
[9019]	59	INTEGER, PARAMETER :: np_MUS = 3 ! MUSCL scheme
	60	INTEGER, PARAMETER :: np_UBS = 4 ! 3rd order Upstream Biased Scheme
	61	INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme
	62
[13237]	63	# include "domzgr_substitute.h90"
[2030]	64	!!----------------------------------------------------------------------
[9598]	65	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
[7753]	66	!! $Id$
[10068]	67	!! Software governed by the CeCILL license (see ./LICENSE)
[2030]	68	!!----------------------------------------------------------------------
	69	CONTAINS
	70
[12377]	71	SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs )
[2030]	72	!!----------------------------------------------------------------------
	73	!! * ROUTINE trc_adv *
	74	!!
	75	!! ** Purpose : compute the ocean tracer advection trend.
	76	!!
[12377]	77	!! ** Method : - Update after tracers (tr(Krhs)) with the advection term following nadv
[2030]	78	!!----------------------------------------------------------------------
[12377]	79	INTEGER , INTENT(in) :: kt ! ocean time-step index
	80	INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices
	81	REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation
[2030]	82	!
[7753]	83	INTEGER :: jk ! dummy loop index
[2715]	84	CHARACTER (len=22) :: charout
[12377]	85	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuu, zvv, zww ! effective velocity
[2030]	86	!!----------------------------------------------------------------------
[2715]	87	!
[9019]	88	IF( ln_timing ) CALL timing_start('trc_adv')
[3294]	89	!
[9019]	90	! !== effective transport ==!
[7646]	91	IF( l_offline ) THEN
[12377]	92	zuu(:,:,:) = uu(:,:,:,Kmm) ! already in (uu(Kmm),vv(Kmm),ww)
	93	zvv(:,:,:) = vv(:,:,:,Kmm)
	94	zww(:,:,:) = ww(:,:,:)
[9019]	95	ELSE ! build the effective transport
[12377]	96	zuu(:,:,jpk) = 0._wp
	97	zvv(:,:,jpk) = 0._wp
	98	zww(:,:,jpk) = 0._wp
[9019]	99	IF( ln_wave .AND. ln_sdw ) THEN
	100	DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift
[12377]	101	zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) )
	102	zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) )
	103	zww(:,:,jk) = e1e2t(:,:) * ( ww(:,:,jk) + wsd(:,:,jk) )
[9019]	104	END DO
	105	ELSE
	106	DO jk = 1, jpkm1
[12377]	107	zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm) ! eulerian transport
	108	zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm)
	109	zww(:,:,jk) = e1e2t(:,:) * ww(:,:,jk)
[9019]	110	END DO
	111	ENDIF
[7646]	112	!
	113	IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections
[12377]	114	zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:)
	115	zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:)
[7646]	116	ENDIF
	117	!
	118	IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) &
[12377]	119	& CALL ldf_eiv_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm, Krhs ) ! add the eiv transport
[7646]	120	!
[12377]	121	IF( ln_mle ) CALL tra_mle_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm ) ! add the mle transport
[7646]	122	!
[4610]	123	ENDIF
	124	!
[5836]	125	SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
	126	!
[9019]	127	CASE ( np_CEN ) ! Centered : 2nd / 4th order
[14046]	128	IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kmm), 'T', 1.)
[12377]	129	CALL tra_adv_cen( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v )
[9019]	130	CASE ( np_FCT ) ! FCT : 2nd / 4th order
[14046]	131	IF (nn_hls.EQ.2) THEN
	132	CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.)
	133	CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.)
	134	#if defined key_loop_fusion
	135	CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v )
	136	#else
	137	CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v )
	138	#endif
	139	ELSE
	140	CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v )
	141	END IF
[9019]	142	CASE ( np_MUS ) ! MUSCL
[14046]	143	IF (nn_hls.EQ.2) THEN
	144	IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.)
	145	#if defined key_loop_fusion
	146	CALL tra_adv_mus_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
	147	#else
	148	CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
	149	#endif
	150	ELSE
	151	CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
	152	END IF
[9019]	153	CASE ( np_UBS ) ! UBS
[14046]	154	IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.)
[12489]	155	CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v )
[9019]	156	CASE ( np_QCK ) ! QUICKEST
[14046]	157	IF (nn_hls.EQ.2) THEN
	158	CALL lbc_lnk_multi( 'trcadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.)
	159	CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1.)
	160	END IF
[12489]	161	CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs )
[5836]	162	!
[2030]	163	END SELECT
[5836]	164	!
[12377]	165	IF( sn_cfctl%l_prttrc ) THEN !== print mean trends (used for debugging)
[9019]	166	WRITE(charout, FMT="('adv ')")
[13286]	167	CALL prt_ctl_info( charout, cdcomp = 'top' )
	168	CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' )
[2030]	169	END IF
	170	!
[9019]	171	IF( ln_timing ) CALL timing_stop('trc_adv')
[2715]	172	!
[2030]	173	END SUBROUTINE trc_adv
	174
	175
[5836]	176	SUBROUTINE trc_adv_ini
[2030]	177	!!---------------------------------------------------------------------
[5836]	178	!! * ROUTINE trc_adv_ini *
[2030]	179	!!
[9019]	180	!! ** Purpose : Control the consistency between namelist options for
[2030]	181	!! passive tracer advection schemes and set nadv
	182	!!----------------------------------------------------------------------
[9169]	183	INTEGER :: ioptio, ios ! Local integer
[5836]	184	!!
[9526]	185	NAMELIST/namtrc_adv/ ln_trcadv_OFF, & ! No advection
[9019]	186	& ln_trcadv_cen, nn_cen_h, nn_cen_v, & ! CEN
	187	& ln_trcadv_fct, nn_fct_h, nn_fct_v, & ! FCT
	188	& ln_trcadv_mus, ln_mus_ups, & ! MUSCL
	189	& ln_trcadv_ubs, nn_ubs_v, & ! UBS
	190	& ln_trcadv_qck ! QCK
[2030]	191	!!----------------------------------------------------------------------
[5836]	192	!
[9019]	193	! !== Namelist ==!
[5836]	194	READ ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901)
[11536]	195	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist' )
[5836]	196	READ ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 )
[11536]	197	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist' )
[5836]	198	IF(lwm) WRITE ( numont, namtrc_adv )
[9019]	199	!
	200	IF(lwp) THEN ! Namelist print
[5836]	201	WRITE(numout,*)
	202	WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme'
	203	WRITE(numout,*) '~~~~~~~~~~~'
	204	WRITE(numout,*) ' Namelist namtrc_adv : chose a advection scheme for tracers'
[9526]	205	WRITE(numout,*) ' No advection on passive tracers ln_trcadv_OFF = ', ln_trcadv_OFF
[5836]	206	WRITE(numout,*) ' centered scheme ln_trcadv_cen = ', ln_trcadv_cen
	207	WRITE(numout,*) ' horizontal 2nd/4th order nn_cen_h = ', nn_fct_h
	208	WRITE(numout,*) ' vertical 2nd/4th order nn_cen_v = ', nn_fct_v
	209	WRITE(numout,*) ' Flux Corrected Transport scheme ln_trcadv_fct = ', ln_trcadv_fct
	210	WRITE(numout,*) ' horizontal 2nd/4th order nn_fct_h = ', nn_fct_h
	211	WRITE(numout,*) ' vertical 2nd/4th order nn_fct_v = ', nn_fct_v
	212	WRITE(numout,*) ' MUSCL scheme ln_trcadv_mus = ', ln_trcadv_mus
	213	WRITE(numout,*) ' + upstream scheme near river mouths ln_mus_ups = ', ln_mus_ups
	214	WRITE(numout,*) ' UBS scheme ln_trcadv_ubs = ', ln_trcadv_ubs
	215	WRITE(numout,*) ' vertical 2nd/4th order nn_ubs_v = ', nn_ubs_v
	216	WRITE(numout,*) ' QUICKEST scheme ln_trcadv_qck = ', ln_trcadv_qck
	217	ENDIF
	218	!
[9019]	219	! !== Parameter control & set nadv ==!
	220	ioptio = 0
[9526]	221	IF( ln_trcadv_OFF ) THEN ; ioptio = ioptio + 1 ; nadv = np_NO_adv ; ENDIF
	222	IF( ln_trcadv_cen ) THEN ; ioptio = ioptio + 1 ; nadv = np_CEN ; ENDIF
	223	IF( ln_trcadv_fct ) THEN ; ioptio = ioptio + 1 ; nadv = np_FCT ; ENDIF
	224	IF( ln_trcadv_mus ) THEN ; ioptio = ioptio + 1 ; nadv = np_MUS ; ENDIF
	225	IF( ln_trcadv_ubs ) THEN ; ioptio = ioptio + 1 ; nadv = np_UBS ; ENDIF
	226	IF( ln_trcadv_qck ) THEN ; ioptio = ioptio + 1 ; nadv = np_QCK ; ENDIF
[5836]	227	!
[9019]	228	IF( ioptio /= 1 ) CALL ctl_stop( 'trc_adv_ini: Choose ONE advection option in namelist namtrc_adv' )
[5836]	229	!
	230	IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 ) &
	231	.AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 ) ) THEN
[9019]	232	CALL ctl_stop( 'trc_adv_ini: CEN scheme, choose 2nd or 4th order' )
[5836]	233	ENDIF
	234	IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 ) &
	235	.AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 ) ) THEN
[9019]	236	CALL ctl_stop( 'trc_adv_ini: FCT scheme, choose 2nd or 4th order' )
[5836]	237	ENDIF
	238	IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 ) ) THEN
[9019]	239	CALL ctl_stop( 'trc_adv_ini: UBS scheme, choose 2nd or 4th order' )
[5836]	240	ENDIF
	241	IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN
[9019]	242	CALL ctl_warn( 'trc_adv_ini: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
[5836]	243	ENDIF
	244	IF( ln_isfcav ) THEN ! ice-shelf cavities
[9019]	245	IF( ln_trcadv_cen .AND. nn_cen_v == 4 .OR. & ! NO 4th order with ISF
	246	& ln_trcadv_fct .AND. nn_fct_v == 4 ) CALL ctl_stop( 'tra_adv_ini: 4th order COMPACT scheme not allowed with ISF' )
[5836]	247	ENDIF
	248	!
[9019]	249	! !== Print the choice ==!
	250	IF(lwp) THEN
[2030]	251	WRITE(numout,*)
[9019]	252	SELECT CASE ( nadv )
	253	CASE( np_NO_adv ) ; WRITE(numout,*) ' ===>> NO passive tracer advection'
	254	CASE( np_CEN ) ; WRITE(numout,*) ' ===>> CEN scheme is used. Horizontal order: ', nn_cen_h, &
	255	& ' Vertical order: ', nn_cen_v
	256	CASE( np_FCT ) ; WRITE(numout,*) ' ===>> FCT scheme is used. Horizontal order: ', nn_fct_h, &
	257	& ' Vertical order: ', nn_fct_v
	258	CASE( np_MUS ) ; WRITE(numout,*) ' ===>> MUSCL scheme is used'
	259	CASE( np_UBS ) ; WRITE(numout,*) ' ===>> UBS scheme is used'
	260	CASE( np_QCK ) ; WRITE(numout,*) ' ===>> QUICKEST scheme is used'
	261	END SELECT
[2030]	262	ENDIF
	263	!
[5836]	264	END SUBROUTINE trc_adv_ini
[2715]	265
[2030]	266	#endif
[2715]	267
[2030]	268	!!======================================================================
	269	END MODULE trcadv

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

Download in other formats: