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.

trcnxt.F90 in branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

Context Navigation

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90 @ 9019

Last change on this file since 9019 was 9019, checked in by timgraham, 6 years ago
Merge of dev_CNRS_2017 into branch
Property svn:keywords set to `Id`
File size: 10.7 KB

Rev	Line
[941]	1	MODULE trcnxt
	2	!!======================================================================
	3	!! * MODULE trcnxt *
	4	!! Ocean passive tracers: time stepping on passives tracers
	5	!!======================================================================
[2528]	6	!! History : 7.0 ! 1991-11 (G. Madec) Original code
	7	!! ! 1993-03 (M. Guyon) symetrical conditions
	8	!! ! 1995-02 (M. Levy) passive tracers
	9	!! ! 1996-02 (G. Madec & M. Imbard) opa release 8.0
	10	!! 8.0 ! 1996-04 (A. Weaver) Euler forward step
	11	!! 8.2 ! 1999-02 (G. Madec, N. Grima) semi-implicit pressure grad.
	12	!! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module
	13	!! ! 2002-08 (G. Madec) F90: Free form and module
	14	!! ! 2002-11 (C. Talandier, A-M Treguier) Open boundaries
	15	!! ! 2004-03 (C. Ethe) passive tracers
	16	!! ! 2007-02 (C. Deltel) Diagnose ML trends for passive tracers
	17	!! 2.0 ! 2006-02 (L. Debreu, C. Mazauric) Agrif implementation
	18	!! 3.0 ! 2008-06 (G. Madec) time stepping always done in trazdf
	19	!! 3.1 ! 2009-02 (G. Madec, R. Benshila) re-introduce the vvl option
	20	!! 3.3 ! 2010-06 (C. Ethe, G. Madec) Merge TRA-TRC
[1175]	21	!!----------------------------------------------------------------------
[941]	22	#if defined key_top
	23	!!----------------------------------------------------------------------
	24	!! 'key_top' TOP models
	25	!!----------------------------------------------------------------------
	26	!! trc_nxt : time stepping on passive tracers
	27	!!----------------------------------------------------------------------
	28	USE oce_trc ! ocean dynamics and tracers variables
[2528]	29	USE trc ! ocean passive tracers variables
[4990]	30	USE trd_oce
[2528]	31	USE trdtra
	32	USE tranxt
[7646]	33	USE bdy_oce , ONLY: ln_bdy
[6140]	34	USE trcbdy ! BDY open boundaries
[2528]	35	# if defined key_agrif
[941]	36	USE agrif_top_interp
[2528]	37	# endif
[9019]	38	!
	39	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	40	USE prtctl_trc ! Print control for debbuging
[941]	41
	42	IMPLICIT NONE
	43	PRIVATE
	44
[9019]	45	PUBLIC trc_nxt ! routine called by step.F90
[2528]	46
[7881]	47	REAL(wp) :: rfact1, rfact2
[7872]	48
[941]	49	!!----------------------------------------------------------------------
[2528]	50	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
[7753]	51	!! $Id$
[2715]	52	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[941]	53	!!----------------------------------------------------------------------
	54	CONTAINS
	55
	56	SUBROUTINE trc_nxt( kt )
	57	!!----------------------------------------------------------------------
	58	!! * ROUTINE trcnxt *
	59	!!
	60	!! ** Purpose : Compute the passive tracers fields at the
	61	!! next time-step from their temporal trends and swap the fields.
	62	!!
	63	!! ** Method : Apply lateral boundary conditions on (ua,va) through
	64	!! call to lbc_lnk routine
	65	!! default:
	66	!! arrays swap
	67	!! (trn) = (tra) ; (tra) = (0,0)
	68	!! (trb) = (trn)
	69	!!
	70	!! For Arakawa or TVD Scheme :
	71	!! A Asselin time filter applied on now tracers (trn) to avoid
	72	!! the divergence of two consecutive time-steps and tr arrays
	73	!! to prepare the next time_step:
	74	!! (trb) = (trn) + atfp [ (trb) + (tra) - 2 (trn) ]
	75	!! (trn) = (tra) ; (tra) = (0,0)
	76	!!
	77	!!
	78	!! ** Action : - update trb, trn
	79	!!----------------------------------------------------------------------
[1271]	80	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[2715]	81	!
[7753]	82	INTEGER :: jk, jn ! dummy loop indices
[941]	83	REAL(wp) :: zfact ! temporary scalar
	84	CHARACTER (len=22) :: charout
[9019]	85	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrdt ! 4D workspace
[941]	86	!!----------------------------------------------------------------------
[3294]	87	!
	88	IF( nn_timing == 1 ) CALL timing_start('trc_nxt')
	89	!
	90	IF( kt == nittrc000 .AND. lwp ) THEN
[941]	91	WRITE(numout,*)
	92	WRITE(numout,*) 'trc_nxt : time stepping on passive tracers'
	93	ENDIF
[6140]	94	!
[5656]	95	#if defined key_agrif
	96	CALL Agrif_trc ! AGRIF zoom boundaries
	97	#endif
[6140]	98	DO jn = 1, jptra ! Update after tracer on domain lateral boundaries
[941]	99	CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )
[2528]	100	END DO
[941]	101
[7646]	102	IF( ln_bdy ) CALL trc_bdy( kt )
[941]	103
[6140]	104	IF( l_trdtrc ) THEN ! trends: store now fields before the Asselin filter application
[9019]	105	ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) )
[7753]	106	ztrdt(:,:,:,:) = trn(:,:,:,:)
[2528]	107	ENDIF
[6140]	108	! ! Leap-Frog + Asselin filter time stepping
[8399]	109	IF( (neuler == 0 .AND. kt == nittrc000) .OR. ln_top_euler ) THEN ! Euler time-stepping (only swap)
[2528]	110	DO jn = 1, jptra
	111	DO jk = 1, jpkm1
[7753]	112	trn(:,:,jk,jn) = tra(:,:,jk,jn)
[8399]	113	trb(:,:,jk,jn) = trn(:,:,jk,jn)
[2528]	114	END DO
	115	END DO
[7872]	116	ELSE
[7881]	117	IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping
[7872]	118	IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! linear ssh
	119	ELSE ; CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra, &
	120	& sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh
	121	ENDIF
	122	ELSE
	123	CALL trc_nxt_off( kt ) ! offline
[2528]	124	ENDIF
[6140]	125	!
	126	DO jn = 1, jptra
	127	CALL lbc_lnk( trb(:,:,:,jn), 'T', 1._wp )
	128	CALL lbc_lnk( trn(:,:,:,jn), 'T', 1._wp )
	129	CALL lbc_lnk( tra(:,:,:,jn), 'T', 1._wp )
	130	END DO
[2528]	131	ENDIF
[6140]	132	!
	133	IF( l_trdtrc ) THEN ! trends: send Asselin filter trends to trdtra manager for further diagnostics
[2528]	134	DO jn = 1, jptra
	135	DO jk = 1, jpkm1
[6140]	136	zfact = 1._wp / r2dttrc
[7753]	137	ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact
[4990]	138	CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt )
[1175]	139	END DO
[2528]	140	END DO
[9019]	141	DEALLOCATE( ztrdt )
[2528]	142	END IF
	143	!
[941]	144	IF(ln_ctl) THEN ! print mean trends (used for debugging)
	145	WRITE(charout, FMT="('nxt')")
	146	CALL prt_ctl_trc_info(charout)
	147	CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
	148	ENDIF
[2528]	149	!
[3294]	150	IF( nn_timing == 1 ) CALL timing_stop('trc_nxt')
	151	!
[941]	152	END SUBROUTINE trc_nxt
	153
[7872]	154
	155	SUBROUTINE trc_nxt_off( kt )
	156	!!----------------------------------------------------------------------
	157	!! * ROUTINE tra_nxt_vvl *
	158	!!
	159	!! ** Purpose : Time varying volume: apply the Asselin time filter
	160	!! and swap the tracer fields.
	161	!!
	162	!! ** Method : - Apply a thickness weighted Asselin time filter on now fields.
	163	!! - save in (ta,sa) a thickness weighted average over the three
	164	!! time levels which will be used to compute rdn and thus the semi-
	165	!! implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
	166	!! - swap tracer fields to prepare the next time_step.
	167	!! This can be summurized for tempearture as:
	168	!! ztm = ( e3t_ntn + rbcp[ e3t_btb - 2 e3t_ntn + e3t_a*ta ] ) ln_dynhpg_imp = T
	169	!! /( e3t_n + rbcp*[ e3t_b - 2 e3t_n + e3t_a ] )
	170	!! ztm = 0 otherwise
	171	!! tb = ( e3t_ntn + atfp[ e3t_btb - 2 e3t_ntn + e3t_a*ta ] )
	172	!! /( e3t_n + atfp*[ e3t_b - 2 e3t_n + e3t_a ] )
	173	!! tn = ta
	174	!! ta = zt (NB: reset to 0 after eos_bn2 call)
	175	!!
	176	!! ** Action : - (tb,sb) and (tn,sn) ready for the next time step
	177	!! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T)
	178	!!----------------------------------------------------------------------
	179	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	180	!!
	181	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	182	REAL(wp) :: ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar
	183	REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - -
	184	!!----------------------------------------------------------------------
	185	!
	186	IF( kt == nittrc000 ) THEN
	187	IF(lwp) WRITE(numout,*)
	188	IF(lwp) WRITE(numout,*) 'trc_nxt_off : time stepping'
	189	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	190	IF( .NOT. ln_linssh ) THEN
	191	rfact1 = atfp * rdttrc
	192	rfact2 = rfact1 / rau0
	193	ENDIF
	194	!
	195	ENDIF
	196	!
	197	DO jn = 1, jptra
	198	DO jk = 1, jpkm1
	199	DO jj = 1, jpj
	200	DO ji = 1, jpi
	201	ze3t_b = e3t_b(ji,jj,jk)
	202	ze3t_n = e3t_n(ji,jj,jk)
	203	ze3t_a = e3t_a(ji,jj,jk)
	204	! ! tracer content at Before, now and after
	205	ztc_b = trb(ji,jj,jk,jn) * ze3t_b
	206	ztc_n = trn(ji,jj,jk,jn) * ze3t_n
	207	ztc_a = tra(ji,jj,jk,jn) * ze3t_a
	208	!
	209	ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
	210	ztc_d = ztc_a - 2. * ztc_n + ztc_b
	211	!
	212	ze3t_f = ze3t_n + atfp * ze3t_d
	213	ztc_f = ztc_n + atfp * ztc_d
	214	!
	215	IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN ! first level
	216	ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj) - emp(ji,jj) )
	217	ztc_f = ztc_f - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) )
	218	ENDIF
	219
	220	ze3t_f = 1.e0 / ze3t_f
	221	trb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered
	222	trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn) ! ptn <-- pta
	223	!
	224	END DO
	225	END DO
	226	END DO
	227	!
	228	END DO
	229	!
	230	END SUBROUTINE trc_nxt_off
	231
[941]	232	#else
	233	!!----------------------------------------------------------------------
	234	!! Default option Empty module
	235	!!----------------------------------------------------------------------
	236	CONTAINS
	237	SUBROUTINE trc_nxt( kt )
	238	INTEGER, INTENT(in) :: kt
	239	WRITE(,) 'trc_nxt: You should not have seen this print! error?', kt
	240	END SUBROUTINE trc_nxt
	241	#endif
	242	!!======================================================================
	243	END MODULE trcnxt

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

Download in other formats: