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/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

Context Navigation

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90 @ 7217

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

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

Download in other formats: