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.

traadv.F90 in NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv.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: 16.0 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
[5836]	8	!! 3.6 ! 2011-06 (G. Madec) Addition of Mixed Layer Eddy parameterisation
	9	!! 3.7 ! 2014-05 (G. Madec) Add 2nd/4th order cases for CEN and FCT schemes
	10	!! - ! 2014-12 (G. Madec) suppression of cross land advection option
[7646]	11	!! 3.6 ! 2015-06 (E. Clementi) Addition of Stokes drift in case of wave coupling
[458]	12	!!----------------------------------------------------------------------
[503]	13
	14	!!----------------------------------------------------------------------
[5836]	15	!! tra_adv : compute ocean tracer advection trend
[9019]	16	!! tra_adv_init : control the different options of advection scheme
[458]	17	!!----------------------------------------------------------------------
[5836]	18	USE oce ! ocean dynamics and active tracers
	19	USE dom_oce ! ocean space and time domain
	20	USE domvvl ! variable vertical scale factors
[9019]	21	USE sbcwave ! wave module
	22	USE sbc_oce ! surface boundary condition: ocean
[9531]	23	USE traadv_cen ! centered scheme (tra_adv_cen routine)
	24	USE traadv_fct ! FCT scheme (tra_adv_fct routine)
	25	USE traadv_mus ! MUSCL scheme (tra_adv_mus routine)
	26	USE traadv_ubs ! UBS scheme (tra_adv_ubs routine)
	27	USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine)
	28	USE tramle ! Mixed Layer Eddy transport (tra_mle_trp routine)
	29	USE ldftra ! Eddy Induced transport (ldf_eiv_trp routine)
[5836]	30	USE ldfslp ! Lateral diffusion: slopes of neutral surfaces
[9019]	31	USE trd_oce ! trends: ocean variables
	32	USE trdtra ! trends manager: tracers
	33	USE diaptr ! Poleward heat transport
[5147]	34	!
[5836]	35	USE in_out_manager ! I/O manager
	36	USE iom ! I/O module
	37	USE prtctl ! Print control
	38	USE lib_mpp ! MPP library
	39	USE timing ! Timing
	40
[458]	41	IMPLICIT NONE
	42	PRIVATE
	43
[9019]	44	PUBLIC tra_adv ! called by step.F90
	45	PUBLIC tra_adv_init ! called by nemogcm.F90
[2715]	46
[5836]	47	! !!* Namelist namtra_adv *
[9526]	48	LOGICAL :: ln_traadv_OFF ! no advection on T and S
[5836]	49	LOGICAL :: ln_traadv_cen ! centered scheme flag
	50	INTEGER :: nn_cen_h, nn_cen_v ! =2/4 : horizontal and vertical choices of the order of CEN scheme
	51	LOGICAL :: ln_traadv_fct ! FCT scheme flag
	52	INTEGER :: nn_fct_h, nn_fct_v ! =2/4 : horizontal and vertical choices of the order of FCT scheme
	53	LOGICAL :: ln_traadv_mus ! MUSCL scheme flag
	54	LOGICAL :: ln_mus_ups ! use upstream scheme in vivcinity of river mouths
	55	LOGICAL :: ln_traadv_ubs ! UBS scheme flag
	56	INTEGER :: nn_ubs_v ! =2/4 : vertical choice of the order of UBS scheme
	57	LOGICAL :: ln_traadv_qck ! QUICKEST scheme flag
[458]	58
[9019]	59	INTEGER :: nadv ! choice of the type of advection scheme
	60	! ! associated indices:
[5836]	61	INTEGER, PARAMETER :: np_NO_adv = 0 ! no T-S advection
	62	INTEGER, PARAMETER :: np_CEN = 1 ! 2nd/4th order centered scheme
	63	INTEGER, PARAMETER :: np_FCT = 2 ! 2nd/4th order Flux Corrected Transport scheme
[9019]	64	INTEGER, PARAMETER :: np_MUS = 3 ! MUSCL scheme
	65	INTEGER, PARAMETER :: np_UBS = 4 ! 3rd order Upstream Biased Scheme
	66	INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme
[5836]	67
[13237]	68	# include "domzgr_substitute.h90"
[458]	69	!!----------------------------------------------------------------------
[9598]	70	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2528]	71	!! $Id$
[10068]	72	!! Software governed by the CeCILL license (see ./LICENSE)
[458]	73	!!----------------------------------------------------------------------
	74	CONTAINS
	75
[12377]	76	SUBROUTINE tra_adv( kt, Kbb, Kmm, pts, Krhs )
[458]	77	!!----------------------------------------------------------------------
	78	!! * ROUTINE tra_adv *
	79	!!
	80	!! ** Purpose : compute the ocean tracer advection trend.
	81	!!
[12377]	82	!! ** Method : - Update (uu(:,:,:,Krhs),vv(:,:,:,Krhs)) with the advection term following nadv
[458]	83	!!----------------------------------------------------------------------
[12377]	84	INTEGER , INTENT(in) :: kt ! ocean time-step index
	85	INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices
	86	REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
[2528]	87	!
[7753]	88	INTEGER :: jk ! dummy loop index
[12377]	89	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuu, zvv, zww ! 3D workspace
[9019]	90	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds
[458]	91	!!----------------------------------------------------------------------
[2715]	92	!
[9019]	93	IF( ln_timing ) CALL timing_start('tra_adv')
[3294]	94	!
[5836]	95	! !== effective transport ==!
[12377]	96	zuu(:,:,jpk) = 0._wp
	97	zvv(:,:,jpk) = 0._wp
	98	zww(:,:,jpk) = 0._wp
[7646]	99	IF( ln_wave .AND. ln_sdw ) THEN
	100	DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift
[13237]	101	zuu(:,:,jk) = &
	102	& e2u (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) )
	103	zvv(:,:,jk) = &
	104	& e1v (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) )
	105	zww(:,:,jk) = &
	106	& e1e2t(:,:) * ( ww(:,:,jk) + wsd(:,:,jk) )
[7646]	107	END DO
	108	ELSE
	109	DO jk = 1, jpkm1
[12377]	110	zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm) ! eulerian transport only
	111	zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm)
	112	zww(:,:,jk) = e1e2t(:,:) * ww(:,:,jk)
[7646]	113	END DO
	114	ENDIF
[4292]	115	!
[5836]	116	IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections
[12377]	117	zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:)
	118	zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:)
[4292]	119	ENDIF
	120	!
[12377]	121	zuu(:,:,jpk) = 0._wp ! no transport trough the bottom
	122	zvv(:,:,jpk) = 0._wp
	123	zww(:,:,jpk) = 0._wp
[2528]	124	!
[5836]	125	IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) &
[12377]	126	& CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs ) ! add the eiv transport (if necessary)
[2528]	127	!
[12377]	128	IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm ) ! add the mle transport (if necessary)
[5147]	129	!
[12377]	130	CALL iom_put( "uocetr_eff", zuu ) ! output effective transport
	131	CALL iom_put( "vocetr_eff", zvv )
	132	CALL iom_put( "wocetr_eff", zww )
[5147]	133	!
[5836]	134	!!gm ???
[12377]	135	CALL dia_ptr( kt, Kmm, zvv ) ! diagnose the effective MSF
[5836]	136	!!gm ???
[5147]	137	!
[12377]	138
[7646]	139	IF( l_trdtra ) THEN !* Save ta and sa trends
[9019]	140	ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
[12377]	141	ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
	142	ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
[7646]	143	ENDIF
	144	!
[5836]	145	SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
[503]	146	!
[9019]	147	CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order
[13660]	148	IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. )
[12377]	149	CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v )
[9019]	150	CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order
[13660]	151	IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.)
	152	CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) ; END IF
[12489]	153	CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
[9019]	154	CASE ( np_MUS ) ! MUSCL
[12489]	155	CALL tra_adv_mus ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )
[9019]	156	CASE ( np_UBS ) ! UBS
[13660]	157	IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.)
[12489]	158	CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v )
[9019]	159	CASE ( np_QCK ) ! QUICKEST
[13660]	160	IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.)
	161	CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) ; END IF
[12489]	162	CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs )
[5836]	163	!
[458]	164	END SELECT
[2528]	165	!
[7646]	166	IF( l_trdtra ) THEN ! save the advective trends for further diagnostics
	167	DO jk = 1, jpkm1
[12377]	168	ztrdt(:,:,jk) = pts(:,:,jk,jp_tem,Krhs) - ztrdt(:,:,jk)
	169	ztrds(:,:,jk) = pts(:,:,jk,jp_sal,Krhs) - ztrds(:,:,jk)
[7646]	170	END DO
[12377]	171	CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_totad, ztrdt )
	172	CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_totad, ztrds )
[9019]	173	DEALLOCATE( ztrdt, ztrds )
[7646]	174	ENDIF
	175	! ! print mean trends (used for debugging)
[12377]	176	IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv - Ta: ', mask1=tmask, &
	177	& tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]	178	!
[9019]	179	IF( ln_timing ) CALL timing_stop( 'tra_adv' )
[2715]	180	!
[458]	181	END SUBROUTINE tra_adv
	182
	183
[2528]	184	SUBROUTINE tra_adv_init
[458]	185	!!---------------------------------------------------------------------
[2528]	186	!! * ROUTINE tra_adv_init *
[458]	187	!!
[503]	188	!! ** Purpose : Control the consistency between namelist options for
	189	!! tracer advection schemes and set nadv
[458]	190	!!----------------------------------------------------------------------
[5836]	191	INTEGER :: ioptio, ios ! Local integers
	192	!
[9526]	193	NAMELIST/namtra_adv/ ln_traadv_OFF, & ! No advection
[9019]	194	& ln_traadv_cen , nn_cen_h, nn_cen_v, & ! CEN
	195	& ln_traadv_fct , nn_fct_h, nn_fct_v, & ! FCT
	196	& ln_traadv_mus , ln_mus_ups, & ! MUSCL
	197	& ln_traadv_ubs , nn_ubs_v, & ! UBS
	198	& ln_traadv_qck ! QCK
[458]	199	!!----------------------------------------------------------------------
[5836]	200	!
	201	! !== Namelist ==!
[4147]	202	READ ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901)
[11536]	203	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in reference namelist' )
[5836]	204	!
[4147]	205	READ ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 )
[11536]	206	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_adv in configuration namelist' )
[6140]	207	IF(lwm) WRITE( numond, namtra_adv )
	208	!
[5836]	209	IF(lwp) THEN ! Namelist print
[458]	210	WRITE(numout,*)
[2528]	211	WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
[9019]	212	WRITE(numout,*) '~~~~~~~~~~~~'
[1601]	213	WRITE(numout,*) ' Namelist namtra_adv : chose a advection scheme for tracers'
[9526]	214	WRITE(numout,*) ' No advection on T & S ln_traadv_OFF = ', ln_traadv_OFF
[5836]	215	WRITE(numout,*) ' centered scheme ln_traadv_cen = ', ln_traadv_cen
	216	WRITE(numout,*) ' horizontal 2nd/4th order nn_cen_h = ', nn_fct_h
	217	WRITE(numout,*) ' vertical 2nd/4th order nn_cen_v = ', nn_fct_v
	218	WRITE(numout,*) ' Flux Corrected Transport scheme ln_traadv_fct = ', ln_traadv_fct
	219	WRITE(numout,*) ' horizontal 2nd/4th order nn_fct_h = ', nn_fct_h
	220	WRITE(numout,*) ' vertical 2nd/4th order nn_fct_v = ', nn_fct_v
	221	WRITE(numout,*) ' MUSCL scheme ln_traadv_mus = ', ln_traadv_mus
	222	WRITE(numout,*) ' + upstream scheme near river mouths ln_mus_ups = ', ln_mus_ups
	223	WRITE(numout,*) ' UBS scheme ln_traadv_ubs = ', ln_traadv_ubs
	224	WRITE(numout,*) ' vertical 2nd/4th order nn_ubs_v = ', nn_ubs_v
	225	WRITE(numout,*) ' QUICKEST scheme ln_traadv_qck = ', ln_traadv_qck
[2528]	226	ENDIF
[6140]	227	!
[9019]	228	! !== Parameter control & set nadv ==!
	229	ioptio = 0
[9526]	230	IF( ln_traadv_OFF ) THEN ; ioptio = ioptio + 1 ; nadv = np_NO_adv ; ENDIF
	231	IF( ln_traadv_cen ) THEN ; ioptio = ioptio + 1 ; nadv = np_CEN ; ENDIF
	232	IF( ln_traadv_fct ) THEN ; ioptio = ioptio + 1 ; nadv = np_FCT ; ENDIF
	233	IF( ln_traadv_mus ) THEN ; ioptio = ioptio + 1 ; nadv = np_MUS ; ENDIF
	234	IF( ln_traadv_ubs ) THEN ; ioptio = ioptio + 1 ; nadv = np_UBS ; ENDIF
	235	IF( ln_traadv_qck ) THEN ; ioptio = ioptio + 1 ; nadv = np_QCK ; ENDIF
[5836]	236	!
[9019]	237	IF( ioptio /= 1 ) CALL ctl_stop( 'tra_adv_init: Choose ONE advection option in namelist namtra_adv' )
[5836]	238	!
	239	IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 ) & ! Centered
	240	.AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 ) ) THEN
	241	CALL ctl_stop( 'tra_adv_init: CEN scheme, choose 2nd or 4th order' )
	242	ENDIF
	243	IF( ln_traadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 ) & ! FCT
	244	.AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 ) ) THEN
	245	CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' )
	246	ENDIF
	247	IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 ) ) THEN ! UBS
	248	CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' )
	249	ENDIF
	250	IF( ln_traadv_ubs .AND. nn_ubs_v == 4 ) THEN
	251	CALL ctl_warn( 'tra_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
	252	ENDIF
	253	IF( ln_isfcav ) THEN ! ice-shelf cavities
[6140]	254	IF( ln_traadv_cen .AND. nn_cen_v == 4 .OR. & ! NO 4th order with ISF
	255	& ln_traadv_fct .AND. nn_fct_v == 4 ) CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' )
[5836]	256	ENDIF
	257	!
[9019]	258	! !== Print the choice ==!
	259	IF(lwp) THEN
[503]	260	WRITE(numout,*)
[6140]	261	SELECT CASE ( nadv )
[9190]	262	CASE( np_NO_adv ) ; WRITE(numout,*) ' ==>>> NO T-S advection'
	263	CASE( np_CEN ) ; WRITE(numout,*) ' ==>>> CEN scheme is used. Horizontal order: ', nn_cen_h, &
	264	& ' Vertical order: ', nn_cen_v
	265	CASE( np_FCT ) ; WRITE(numout,*) ' ==>>> FCT scheme is used. Horizontal order: ', nn_fct_h, &
	266	& ' Vertical order: ', nn_fct_v
	267	CASE( np_MUS ) ; WRITE(numout,*) ' ==>>> MUSCL scheme is used'
	268	CASE( np_UBS ) ; WRITE(numout,*) ' ==>>> UBS scheme is used'
	269	CASE( np_QCK ) ; WRITE(numout,*) ' ==>>> QUICKEST scheme is used'
[6140]	270	END SELECT
[458]	271	ENDIF
[503]	272	!
[9531]	273	CALL tra_mle_init !== initialisation of the Mixed Layer Eddy parametrisation (MLE) ==!
[4245]	274	!
[2528]	275	END SUBROUTINE tra_adv_init
[458]	276
	277	!!======================================================================
	278	END MODULE traadv

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

Download in other formats: