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 branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

Context Navigation

source: branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90 @ 8532

Last change on this file since 8532 was 7522, checked in by cetlod, 8 years ago
3.6 stable : update the offline routines to be able to run passive tracers offline with linear free surface, see ticket #1775
Property svn:keywords set to `Id`
File size: 11.5 KB

Rev	Line
[2030]	1	MODULE trcadv
	2	!!==============================================================================
	3	!! * MODULE trcadv *
	4	!! Ocean passive tracers: advection trend
	5	!!==============================================================================
	6	!! History : 2.0 ! 05-11 (G. Madec) Original code
	7	!! 3.0 ! 10-06 (C. Ethe) Adapted to passive tracers
	8	!!----------------------------------------------------------------------
	9	#if defined key_top
	10	!!----------------------------------------------------------------------
	11	!! 'key_top' TOP models
	12	!!----------------------------------------------------------------------
	13	!! trc_adv : compute ocean tracer advection trend
	14	!! trc_adv_ctl : control the different options of advection scheme
	15	!!----------------------------------------------------------------------
	16	USE oce_trc ! ocean dynamics and active tracers
	17	USE trc ! ocean passive tracers variables
	18	USE trcnam_trp ! passive tracers transport namelist variables
	19	USE traadv_cen2 ! 2nd order centered scheme (tra_adv_cen2 routine)
	20	USE traadv_tvd ! TVD scheme (tra_adv_tvd routine)
	21	USE traadv_muscl ! MUSCL scheme (tra_adv_muscl routine)
	22	USE traadv_muscl2 ! MUSCL2 scheme (tra_adv_muscl2 routine)
	23	USE traadv_ubs ! UBS scheme (tra_adv_ubs routine)
	24	USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine)
	25	USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine)
[4610]	26	USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine)
[2030]	27	USE ldftra_oce ! lateral diffusion coefficient on tracers
[2715]	28	USE prtctl_trc ! Print control
[2030]	29
	30	IMPLICIT NONE
	31	PRIVATE
	32
[2715]	33	PUBLIC trc_adv ! routine called by step module
	34	PUBLIC trc_adv_alloc ! routine called by nemogcm module
[2082]	35
[2030]	36	INTEGER :: nadv ! choice of the type of advection scheme
[2715]	37	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra
[3294]	38	! ! except at nitrrc000 (=rdttra) if neuler=0
[2030]	39
	40	!! * Substitutions
	41	# include "domzgr_substitute.h90"
	42	# include "vectopt_loop_substitute.h90"
	43	!!----------------------------------------------------------------------
[2287]	44	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
[2281]	45	!! $Id$
[2287]	46	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[2030]	47	!!----------------------------------------------------------------------
	48	CONTAINS
	49
[2715]	50	INTEGER FUNCTION trc_adv_alloc()
	51	!!----------------------------------------------------------------------
	52	!! * ROUTINE trc_adv_alloc *
	53	!!----------------------------------------------------------------------
	54
	55	ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc )
	56
	57	IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')
	58
	59	END FUNCTION trc_adv_alloc
	60
	61
[2030]	62	SUBROUTINE trc_adv( kt )
	63	!!----------------------------------------------------------------------
	64	!! * ROUTINE trc_adv *
	65	!!
	66	!! ** Purpose : compute the ocean tracer advection trend.
	67	!!
	68	!! ** Method : - Update the tracer with the advection term following nadv
	69	!!----------------------------------------------------------------------
	70	!!
[2715]	71	INTEGER, INTENT(in) :: kt ! ocean time-step index
[2030]	72	!
[2715]	73	INTEGER :: jk
	74	CHARACTER (len=22) :: charout
[3294]	75	REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn ! effective velocity
[2030]	76	!!----------------------------------------------------------------------
[2715]	77	!
[3294]	78	IF( nn_timing == 1 ) CALL timing_start('trc_adv')
	79	!
	80	CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
	81	!
[2030]	82
[3294]	83	IF( kt == nittrc000 ) CALL trc_adv_ctl ! initialisation & control of options
[2030]	84
[5385]	85	IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000
	86	r2dt(:) = rdttrc(:) ! = rdttrc (use or restarting with Euler time stepping)
	87	ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1
	88	r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog)
[2082]	89	ENDIF
[7522]	90	!
	91	IF( lk_offline ) THEN
	92	zun(:,:,:) = un(:,:,:) ! effective transport already in un/vn/wn
	93	zvn(:,:,:) = vn(:,:,:)
	94	zwn(:,:,:) = wn(:,:,:)
	95	ELSE
	96	! ! effective transport
	97	DO jk = 1, jpkm1
	98	! ! eulerian transport only
	99	zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk)
	100	zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk)
	101	zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk)
	102	!
	103	END DO
[2030]	104	!
[7522]	105	IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
	106	zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
	107	zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
	108	ENDIF
	109	!
	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
	113	!
	114
	115	IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & ! add the eiv transport (if necessary)
	116	& CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' )
	117	!
	118	IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport (if necessary)
	119	!
[4610]	120	ENDIF
	121	!
[2034]	122	SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
[3294]	123	CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered
	124	CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD
[3718]	125	CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups ) ! MUSCL
[3294]	126	CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2
	127	CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS
	128	CASE ( 6 ) ; CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST
[2034]	129	!
	130	CASE (-1 ) !== esopa: test all possibility with control print ==!
[3294]	131	CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra )
[2034]	132	WRITE(charout, FMT="('adv1')") ; CALL prt_ctl_trc_info(charout)
	133	CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
[3294]	134	CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )
[2034]	135	WRITE(charout, FMT="('adv2')") ; CALL prt_ctl_trc_info(charout)
	136	CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
[3718]	137	CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups )
[2034]	138	WRITE(charout, FMT="('adv3')") ; CALL prt_ctl_trc_info(charout)
	139	CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
[3294]	140	CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )
[2034]	141	WRITE(charout, FMT="('adv4')") ; CALL prt_ctl_trc_info(charout)
	142	CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
[3294]	143	CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )
[2034]	144	WRITE(charout, FMT="('adv5')") ; CALL prt_ctl_trc_info(charout)
	145	CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
[3294]	146	CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )
[2034]	147	WRITE(charout, FMT="('adv6')") ; CALL prt_ctl_trc_info(charout)
	148	CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
	149	!
[2030]	150	END SELECT
	151
	152	! ! print mean trends (used for debugging)
	153	IF( ln_ctl ) THEN
	154	WRITE(charout, FMT="('adv ')") ; CALL prt_ctl_trc_info(charout)
	155	CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
	156	END IF
	157	!
[3294]	158	CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
[2715]	159	!
[3294]	160	IF( nn_timing == 1 ) CALL timing_stop('trc_adv')
	161	!
[2030]	162	END SUBROUTINE trc_adv
	163
	164
	165	SUBROUTINE trc_adv_ctl
	166	!!---------------------------------------------------------------------
	167	!! * ROUTINE trc_adv_ctl *
	168	!!
	169	!! ** Purpose : Control the consistency between namelist options for
	170	!! passive tracer advection schemes and set nadv
	171	!!----------------------------------------------------------------------
	172	INTEGER :: ioptio
	173	!!----------------------------------------------------------------------
	174
	175	ioptio = 0 ! Parameter control
	176	IF( ln_trcadv_cen2 ) ioptio = ioptio + 1
	177	IF( ln_trcadv_tvd ) ioptio = ioptio + 1
	178	IF( ln_trcadv_muscl ) ioptio = ioptio + 1
	179	IF( ln_trcadv_muscl2 ) ioptio = ioptio + 1
	180	IF( ln_trcadv_ubs ) ioptio = ioptio + 1
	181	IF( ln_trcadv_qck ) ioptio = ioptio + 1
	182	IF( lk_esopa ) ioptio = 1
	183
	184	IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' )
	185
	186	! ! Set nadv
	187	IF( ln_trcadv_cen2 ) nadv = 1
	188	IF( ln_trcadv_tvd ) nadv = 2
	189	IF( ln_trcadv_muscl ) nadv = 3
	190	IF( ln_trcadv_muscl2 ) nadv = 4
	191	IF( ln_trcadv_ubs ) nadv = 5
	192	IF( ln_trcadv_qck ) nadv = 6
	193	IF( lk_esopa ) nadv = -1
	194
	195	IF(lwp) THEN ! Print the choice
	196	WRITE(numout,*)
	197	IF( nadv == 1 ) WRITE(numout,*) ' 2nd order scheme is used'
	198	IF( nadv == 2 ) WRITE(numout,*) ' TVD scheme is used'
	199	IF( nadv == 3 ) WRITE(numout,*) ' MUSCL scheme is used'
	200	IF( nadv == 4 ) WRITE(numout,*) ' MUSCL2 scheme is used'
	201	IF( nadv == 5 ) WRITE(numout,*) ' UBS scheme is used'
	202	IF( nadv == 6 ) WRITE(numout,*) ' QUICKEST scheme is used'
	203	IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection scheme'
	204	ENDIF
	205	!
	206	END SUBROUTINE trc_adv_ctl
[2715]	207
[2030]	208	#else
	209	!!----------------------------------------------------------------------
	210	!! Default option Empty module
	211	!!----------------------------------------------------------------------
	212	CONTAINS
	213	SUBROUTINE trc_adv( kt )
	214	INTEGER, INTENT(in) :: kt
	215	WRITE(,) 'trc_adv: You should not have seen this print! error?', kt
	216	END SUBROUTINE trc_adv
	217	#endif
[2715]	218
[2030]	219	!!======================================================================
	220	END MODULE trcadv

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

Download in other formats: