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_r13508_HPC-09_communications_cleanup/src/TOP/TRP – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/TOP/TRP/trcadv.F90 @ 13660

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

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

Download in other formats: