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/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcadv.F90 @ 10946

Last change on this file since 10946 was 10946, checked in by acc, 5 years ago
2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert STO, TRD and USR modules and all knock on effects of these conversions. Note change to USR module may have implications for the TEST CASES (not tested yet). Standard SETTE tested only
Property svn:keywords set to `Id`
File size: 14.1 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	!
[9019]	31	USE prtctl_trc ! control print
	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
[2030]	61	!! * Substitutions
	62	# include "vectopt_loop_substitute.h90"
	63	!!----------------------------------------------------------------------
[9598]	64	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
[7753]	65	!! $Id$
[10068]	66	!! Software governed by the CeCILL license (see ./LICENSE)
[2030]	67	!!----------------------------------------------------------------------
	68	CONTAINS
	69
[10880]	70	SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs )
[2030]	71	!!----------------------------------------------------------------------
	72	!! * ROUTINE trc_adv *
	73	!!
	74	!! ** Purpose : compute the ocean tracer advection trend.
	75	!!
[9019]	76	!! ** Method : - Update after tracers (tra) with the advection term following nadv
[2030]	77	!!----------------------------------------------------------------------
[10880]	78	INTEGER , INTENT(in) :: kt ! ocean time-step index
	79	INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices
	80	REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation
[2030]	81	!
[7753]	82	INTEGER :: jk ! dummy loop index
[2715]	83	CHARACTER (len=22) :: charout
[9019]	84	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! effective velocity
[2030]	85	!!----------------------------------------------------------------------
[2715]	86	!
[9019]	87	IF( ln_timing ) CALL timing_start('trc_adv')
[3294]	88	!
[9019]	89	! !== effective transport ==!
[7646]	90	IF( l_offline ) THEN
[9019]	91	zun(:,:,:) = un(:,:,:) ! already in (un,vn,wn)
[7753]	92	zvn(:,:,:) = vn(:,:,:)
	93	zwn(:,:,:) = wn(:,:,:)
[9019]	94	ELSE ! build the effective transport
	95	zun(:,:,jpk) = 0._wp
	96	zvn(:,:,jpk) = 0._wp
	97	zwn(:,:,jpk) = 0._wp
	98	IF( ln_wave .AND. ln_sdw ) THEN
	99	DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift
	100	zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) )
	101	zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) )
	102	zwn(:,:,jk) = e1e2t(:,:) * ( wn(:,:,jk) + wsd(:,:,jk) )
	103	END DO
	104	ELSE
	105	DO jk = 1, jpkm1
	106	zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport
	107	zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
	108	zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk)
	109	END DO
	110	ENDIF
[7646]	111	!
	112	IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections
[7753]	113	zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
	114	zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
[7646]	115	ENDIF
	116	!
	117	IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) &
[10946]	118	& CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC', Kmm, Krhs ) ! add the eiv transport
[7646]	119	!
[9531]	120	IF( ln_mle ) CALL tra_mle_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport
[7646]	121	!
[4610]	122	ENDIF
	123	!
[5836]	124	SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
	125	!
[9019]	126	CASE ( np_CEN ) ! Centered : 2nd / 4th order
[10880]	127	CALL tra_adv_cen( kt, nittrc000,'TRC', zun, zvn, zwn, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v )
[9019]	128	CASE ( np_FCT ) ! FCT : 2nd / 4th order
[10880]	129	CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v )
[9019]	130	CASE ( np_MUS ) ! MUSCL
[10880]	131	CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
[9019]	132	CASE ( np_UBS ) ! UBS
[10880]	133	CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v )
[9019]	134	CASE ( np_QCK ) ! QUICKEST
[10880]	135	CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs )
[5836]	136	!
[2030]	137	END SELECT
[5836]	138	!
[9019]	139	IF( ln_ctl ) THEN !== print mean trends (used for debugging)
	140	WRITE(charout, FMT="('adv ')")
	141	CALL prt_ctl_trc_info(charout)
	142	CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
[2030]	143	END IF
	144	!
[9019]	145	IF( ln_timing ) CALL timing_stop('trc_adv')
[2715]	146	!
[2030]	147	END SUBROUTINE trc_adv
	148
	149
[5836]	150	SUBROUTINE trc_adv_ini
[2030]	151	!!---------------------------------------------------------------------
[5836]	152	!! * ROUTINE trc_adv_ini *
[2030]	153	!!
[9019]	154	!! ** Purpose : Control the consistency between namelist options for
[2030]	155	!! passive tracer advection schemes and set nadv
	156	!!----------------------------------------------------------------------
[9169]	157	INTEGER :: ioptio, ios ! Local integer
[5836]	158	!!
[9526]	159	NAMELIST/namtrc_adv/ ln_trcadv_OFF, & ! No advection
[9019]	160	& ln_trcadv_cen, nn_cen_h, nn_cen_v, & ! CEN
	161	& ln_trcadv_fct, nn_fct_h, nn_fct_v, & ! FCT
	162	& ln_trcadv_mus, ln_mus_ups, & ! MUSCL
	163	& ln_trcadv_ubs, nn_ubs_v, & ! UBS
	164	& ln_trcadv_qck ! QCK
[2030]	165	!!----------------------------------------------------------------------
[5836]	166	!
[9019]	167	! !== Namelist ==!
	168	REWIND( numnat_ref ) ! namtrc_adv in reference namelist
[5836]	169	READ ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901)
[9169]	170	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp )
[9019]	171	REWIND( numnat_cfg ) ! namtrc_adv in configuration namelist
[5836]	172	READ ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 )
[9169]	173	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp )
[5836]	174	IF(lwm) WRITE ( numont, namtrc_adv )
[9019]	175	!
	176	IF(lwp) THEN ! Namelist print
[5836]	177	WRITE(numout,*)
	178	WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme'
	179	WRITE(numout,*) '~~~~~~~~~~~'
	180	WRITE(numout,*) ' Namelist namtrc_adv : chose a advection scheme for tracers'
[9526]	181	WRITE(numout,*) ' No advection on passive tracers ln_trcadv_OFF = ', ln_trcadv_OFF
[5836]	182	WRITE(numout,*) ' centered scheme ln_trcadv_cen = ', ln_trcadv_cen
	183	WRITE(numout,*) ' horizontal 2nd/4th order nn_cen_h = ', nn_fct_h
	184	WRITE(numout,*) ' vertical 2nd/4th order nn_cen_v = ', nn_fct_v
	185	WRITE(numout,*) ' Flux Corrected Transport scheme ln_trcadv_fct = ', ln_trcadv_fct
	186	WRITE(numout,*) ' horizontal 2nd/4th order nn_fct_h = ', nn_fct_h
	187	WRITE(numout,*) ' vertical 2nd/4th order nn_fct_v = ', nn_fct_v
	188	WRITE(numout,*) ' MUSCL scheme ln_trcadv_mus = ', ln_trcadv_mus
	189	WRITE(numout,*) ' + upstream scheme near river mouths ln_mus_ups = ', ln_mus_ups
	190	WRITE(numout,*) ' UBS scheme ln_trcadv_ubs = ', ln_trcadv_ubs
	191	WRITE(numout,*) ' vertical 2nd/4th order nn_ubs_v = ', nn_ubs_v
	192	WRITE(numout,*) ' QUICKEST scheme ln_trcadv_qck = ', ln_trcadv_qck
	193	ENDIF
	194	!
[9019]	195	! !== Parameter control & set nadv ==!
	196	ioptio = 0
[9526]	197	IF( ln_trcadv_OFF ) THEN ; ioptio = ioptio + 1 ; nadv = np_NO_adv ; ENDIF
	198	IF( ln_trcadv_cen ) THEN ; ioptio = ioptio + 1 ; nadv = np_CEN ; ENDIF
	199	IF( ln_trcadv_fct ) THEN ; ioptio = ioptio + 1 ; nadv = np_FCT ; ENDIF
	200	IF( ln_trcadv_mus ) THEN ; ioptio = ioptio + 1 ; nadv = np_MUS ; ENDIF
	201	IF( ln_trcadv_ubs ) THEN ; ioptio = ioptio + 1 ; nadv = np_UBS ; ENDIF
	202	IF( ln_trcadv_qck ) THEN ; ioptio = ioptio + 1 ; nadv = np_QCK ; ENDIF
[5836]	203	!
[9019]	204	IF( ioptio /= 1 ) CALL ctl_stop( 'trc_adv_ini: Choose ONE advection option in namelist namtrc_adv' )
[5836]	205	!
	206	IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 ) &
	207	.AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 ) ) THEN
[9019]	208	CALL ctl_stop( 'trc_adv_ini: CEN scheme, choose 2nd or 4th order' )
[5836]	209	ENDIF
	210	IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 ) &
	211	.AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 ) ) THEN
[9019]	212	CALL ctl_stop( 'trc_adv_ini: FCT scheme, choose 2nd or 4th order' )
[5836]	213	ENDIF
	214	IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 ) ) THEN
[9019]	215	CALL ctl_stop( 'trc_adv_ini: UBS scheme, choose 2nd or 4th order' )
[5836]	216	ENDIF
	217	IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN
[9019]	218	CALL ctl_warn( 'trc_adv_ini: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
[5836]	219	ENDIF
	220	IF( ln_isfcav ) THEN ! ice-shelf cavities
[9019]	221	IF( ln_trcadv_cen .AND. nn_cen_v == 4 .OR. & ! NO 4th order with ISF
	222	& ln_trcadv_fct .AND. nn_fct_v == 4 ) CALL ctl_stop( 'tra_adv_ini: 4th order COMPACT scheme not allowed with ISF' )
[5836]	223	ENDIF
	224	!
[9019]	225	! !== Print the choice ==!
	226	IF(lwp) THEN
[2030]	227	WRITE(numout,*)
[9019]	228	SELECT CASE ( nadv )
	229	CASE( np_NO_adv ) ; WRITE(numout,*) ' ===>> NO passive tracer advection'
	230	CASE( np_CEN ) ; WRITE(numout,*) ' ===>> CEN scheme is used. Horizontal order: ', nn_cen_h, &
	231	& ' Vertical order: ', nn_cen_v
	232	CASE( np_FCT ) ; WRITE(numout,*) ' ===>> FCT scheme is used. Horizontal order: ', nn_fct_h, &
	233	& ' Vertical order: ', nn_fct_v
	234	CASE( np_MUS ) ; WRITE(numout,*) ' ===>> MUSCL scheme is used'
	235	CASE( np_UBS ) ; WRITE(numout,*) ' ===>> UBS scheme is used'
	236	CASE( np_QCK ) ; WRITE(numout,*) ' ===>> QUICKEST scheme is used'
	237	END SELECT
[2030]	238	ENDIF
	239	!
[5836]	240	END SUBROUTINE trc_adv_ini
[2715]	241
[2030]	242	#endif
[2715]	243
[2030]	244	!!======================================================================
	245	END MODULE trcadv

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

Download in other formats: