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.

tranxt.F90 in branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 4328

Last change on this file since 4328 was 4328, checked in by davestorkey, 10 years ago
Remove OBC module at NEMO 3.6. See ticket #1189.
Property svn:keywords set to `Id`
File size: 16.9 KB

Rev	Line
[3]	1	MODULE tranxt
	2	!!======================================================================
	3	!! * MODULE tranxt *
	4	!! Ocean active tracers: time stepping on temperature and salinity
	5	!!======================================================================
[1110]	6	!! History : OPA ! 1991-11 (G. Madec) Original code
	7	!! 7.0 ! 1993-03 (M. Guyon) symetrical conditions
	8	!! 8.0 ! 1996-02 (G. Madec & M. Imbard) opa release 8.0
	9	!! - ! 1996-04 (A. Weaver) Euler forward step
	10	!! 8.2 ! 1999-02 (G. Madec, N. Grima) semi-implicit pressure grad.
	11	!! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module
	12	!! - ! 2002-11 (C. Talandier, A-M Treguier) Open boundaries
	13	!! - ! 2005-04 (C. Deltel) Add Asselin trend in the ML budget
	14	!! 2.0 ! 2006-02 (L. Debreu, C. Mazauric) Agrif implementation
	15	!! 3.0 ! 2008-06 (G. Madec) time stepping always done in trazdf
[1438]	16	!! 3.1 ! 2009-02 (G. Madec, R. Benshila) re-introduce the vvl option
[2528]	17	!! 3.3 ! 2010-04 (M. Leclair, G. Madec) semi-implicit hpg with asselin filter + modified LF-RA
	18	!! - ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA
[3]	19	!!----------------------------------------------------------------------
[503]	20
	21	!!----------------------------------------------------------------------
[2528]	22	!! tra_nxt : time stepping on tracers
	23	!! tra_nxt_fix : time stepping on tracers : fixed volume case
	24	!! tra_nxt_vvl : time stepping on tracers : variable volume case
[3]	25	!!----------------------------------------------------------------------
	26	USE oce ! ocean dynamics and tracers variables
	27	USE dom_oce ! ocean space and time domain variables
[2528]	28	USE sbc_oce ! surface boundary condition: ocean
[3]	29	USE zdf_oce ! ???
[1438]	30	USE domvvl ! variable volume
[1601]	31	USE dynspg_oce ! surface pressure gradient variables
	32	USE dynhpg ! hydrostatic pressure gradient
[2528]	33	USE trdmod_oce ! ocean space and time domain variables
	34	USE trdtra ! ocean active tracers trends
[888]	35	USE phycst
[3294]	36	USE bdy_oce
	37	USE bdytra ! open boundary condition (bdy_tra routine)
[3]	38	USE in_out_manager ! I/O manager
	39	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
[258]	40	USE prtctl ! Print control
[2528]	41	USE traqsr ! penetrative solar radiation (needed for nksr)
	42	#if defined key_agrif
[389]	43	USE agrif_opa_update
	44	USE agrif_opa_interp
[2528]	45	#endif
[3294]	46	USE wrk_nemo ! Memory allocation
	47	USE timing ! Timing
[3]	48
	49	IMPLICIT NONE
	50	PRIVATE
	51
[2528]	52	PUBLIC tra_nxt ! routine called by step.F90
	53	PUBLIC tra_nxt_fix ! to be used in trcnxt
	54	PUBLIC tra_nxt_vvl ! to be used in trcnxt
[592]	55
[2715]	56	REAL(wp) :: rbcp ! Brown & Campana parameters for semi-implicit hpg
[1438]	57
[592]	58	!! * Substitutions
	59	# include "domzgr_substitute.h90"
[3]	60	!!----------------------------------------------------------------------
[2528]	61	!! NEMO/OPA 3.3 , NEMO-Consortium (2010)
[2715]	62	!! $Id$
	63	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[3]	64	!!----------------------------------------------------------------------
	65	CONTAINS
	66
	67	SUBROUTINE tra_nxt( kt )
	68	!!----------------------------------------------------------------------
	69	!! * ROUTINE tranxt *
	70	!!
[1110]	71	!! ** Purpose : Apply the boundary condition on the after temperature
	72	!! and salinity fields, achieved the time stepping by adding
	73	!! the Asselin filter on now fields and swapping the fields.
[3]	74	!!
[1110]	75	!! ** Method : At this stage of the computation, ta and sa are the
	76	!! after temperature and salinity as the time stepping has
	77	!! been performed in trazdf_imp or trazdf_exp module.
[3]	78	!!
[1110]	79	!! - Apply lateral boundary conditions on (ta,sa)
	80	!! at the local domain boundaries through lbc_lnk call,
[4328]	81	!! at the one-way open boundaries (lk_bdy=T),
[1110]	82	!! at the AGRIF zoom boundaries (lk_agrif=T)
	83	!!
[1438]	84	!! - Update lateral boundary conditions on AGRIF children
	85	!! domains (lk_agrif=T)
[1110]	86	!!
	87	!! ** Action : - (tb,sb) and (tn,sn) ready for the next time step
	88	!! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T)
[503]	89	!!----------------------------------------------------------------------
	90	INTEGER, INTENT(in) :: kt ! ocean time-step index
	91	!!
[2528]	92	INTEGER :: jk, jn ! dummy loop indices
	93	REAL(wp) :: zfact ! local scalars
[3294]	94	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds
[3]	95	!!----------------------------------------------------------------------
[3294]	96	!
	97	IF( nn_timing == 1 ) CALL timing_start( 'tra_nxt')
	98	!
[1110]	99	IF( kt == nit000 ) THEN
	100	IF(lwp) WRITE(numout,*)
	101	IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
	102	IF(lwp) WRITE(numout,*) '~~~~~~~'
[2528]	103	!
[4230]	104	rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp) ! Brown & Campana parameter for semi-implicit hpg
[592]	105	ENDIF
	106
[1110]	107	! Update after tracer on domain lateral boundaries
	108	!
[4230]	109	CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp ) ! local domain boundaries (T-point, unchanged sign)
	110	CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
[1110]	111	!
[2528]	112	#if defined key_bdy
[3294]	113	IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries
[1110]	114	#endif
[392]	115	#if defined key_agrif
[2528]	116	CALL Agrif_tra ! AGRIF zoom boundaries
[389]	117	#endif
[1438]	118
	119	! set time step size (Euler/Leapfrog)
[2715]	120	IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dtra(:) = rdttra(:) ! at nit000 (Euler)
[4230]	121	ELSEIF( kt <= nit000 + 1 ) THEN ; r2dtra(:) = 2._wp* rdttra(:) ! at nit000 or nit000+1 (Leapfrog)
[1438]	122	ENDIF
[3]	123
[1110]	124	! trends computation initialisation
[2528]	125	IF( l_trdtra ) THEN ! store now fields before applying the Asselin filter
[3294]	126	CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
	127	ztrdt(:,:,:) = tsn(:,:,:,jp_tem)
	128	ztrds(:,:,:) = tsn(:,:,:,jp_sal)
[1110]	129	ENDIF
	130
[2528]	131	IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step (only swap)
	132	DO jn = 1, jpts
	133	DO jk = 1, jpkm1
	134	tsn(:,:,jk,jn) = tsa(:,:,jk,jn)
	135	END DO
	136	END DO
	137	ELSE ! Leap-Frog + Asselin filter time stepping
	138	!
[3294]	139	IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! variable volume level (vvl)
	140	ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level
[2528]	141	ENDIF
	142	ENDIF
[2715]	143	!
[1438]	144	#if defined key_agrif
	145	! Update tracer at AGRIF zoom boundaries
	146	IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tra( kt ) ! children only
	147	#endif
[2715]	148	!
[1438]	149	! trends computation
[2528]	150	IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt
[1110]	151	DO jk = 1, jpkm1
[4230]	152	zfact = 1.e0_wp / r2dtra(jk)
[2528]	153	ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
	154	ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
[1110]	155	END DO
[2528]	156	CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_atf, ztrdt )
	157	CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_atf, ztrds )
[3294]	158	CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
[1438]	159	END IF
[2715]	160	!
[1438]	161	! ! control print
[2528]	162	IF(ln_ctl) CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt - Tn: ', mask1=tmask, &
	163	& tab3d_2=tsn(:,:,:,jp_sal), clinfo2= ' Sn: ', mask2=tmask )
[1438]	164	!
[3294]	165	!
	166	IF( nn_timing == 1 ) CALL timing_stop('tra_nxt')
	167	!
[1438]	168	END SUBROUTINE tra_nxt
	169
	170
[3294]	171	SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
[1438]	172	!!----------------------------------------------------------------------
	173	!! * ROUTINE tra_nxt_fix *
	174	!!
	175	!! ** Purpose : fixed volume: apply the Asselin time filter and
	176	!! swap the tracer fields.
	177	!!
	178	!! ** Method : - Apply a Asselin time filter on now fields.
	179	!! - save in (ta,sa) an average over the three time levels
	180	!! which will be used to compute rdn and thus the semi-implicit
	181	!! hydrostatic pressure gradient (ln_dynhpg_imp = T)
	182	!! - swap tracer fields to prepare the next time_step.
	183	!! This can be summurized for tempearture as:
[2528]	184	!! ztm = tn + rbcp * [ta -2 tn + tb ] ln_dynhpg_imp = T
	185	!! ztm = 0 otherwise
	186	!! with rbcp=1/4 * (1-atfp^4) / (1-atfp)
[1438]	187	!! tb = tn + atfp*[ tb - 2 tn + ta ]
[2528]	188	!! tn = ta
[1438]	189	!! ta = ztm (NB: reset to 0 after eos_bn2 call)
	190	!!
	191	!! ** Action : - (tb,sb) and (tn,sn) ready for the next time step
	192	!! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T)
	193	!!----------------------------------------------------------------------
[2715]	194	INTEGER , INTENT(in ) :: kt ! ocean time-step index
[3294]	195	INTEGER , INTENT(in ) :: kit000 ! first time step index
[2715]	196	CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	197	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	198	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields
	199	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields
	200	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend
	201	!
[2528]	202	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	203	LOGICAL :: ll_tra_hpg ! local logical
	204	REAL(wp) :: ztn, ztd ! local scalars
[1438]	205	!!----------------------------------------------------------------------
	206
[3294]	207	IF( kt == kit000 ) THEN
[1438]	208	IF(lwp) WRITE(numout,*)
[3294]	209	IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
[1438]	210	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	211	ENDIF
	212	!
[2528]	213	IF( cdtype == 'TRA' ) THEN ; ll_tra_hpg = ln_dynhpg_imp ! active tracers case and semi-implicit hpg
	214	ELSE ; ll_tra_hpg = .FALSE. ! passive tracers case or NO semi-implicit hpg
	215	ENDIF
	216	!
	217	DO jn = 1, kjpt
[1438]	218	!
[2528]	219	DO jk = 1, jpkm1
	220	DO jj = 1, jpj
	221	DO ji = 1, jpi
	222	ztn = ptn(ji,jj,jk,jn)
	223	ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn) ! time laplacian on tracers
	224	!
	225	ptb(ji,jj,jk,jn) = ztn + atfp * ztd ! ptb <-- filtered ptn
	226	ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta
	227	!
	228	IF( ll_tra_hpg ) pta(ji,jj,jk,jn) = ztn + rbcp * ztd ! pta <-- Brown & Campana average
[3]	229	END DO
[2528]	230	END DO
	231	END DO
[1110]	232	!
[2528]	233	END DO
[1438]	234	!
	235	END SUBROUTINE tra_nxt_fix
[3]	236
[1110]	237
[3294]	238	SUBROUTINE tra_nxt_vvl( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
[1438]	239	!!----------------------------------------------------------------------
	240	!! * ROUTINE tra_nxt_vvl *
	241	!!
	242	!! ** Purpose : Time varying volume: apply the Asselin time filter
	243	!! and swap the tracer fields.
	244	!!
	245	!! ** Method : - Apply a thickness weighted Asselin time filter on now fields.
	246	!! - save in (ta,sa) a thickness weighted average over the three
	247	!! time levels which will be used to compute rdn and thus the semi-
	248	!! implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
	249	!! - swap tracer fields to prepare the next time_step.
	250	!! This can be summurized for tempearture as:
[2528]	251	!! ztm = ( e3t_ntn + rbcp[ e3t_btb - 2 e3t_ntn + e3t_a*ta ] ) ln_dynhpg_imp = T
	252	!! /( e3t_n + rbcp*[ e3t_b - 2 e3t_n + e3t_a ] )
	253	!! ztm = 0 otherwise
[1438]	254	!! tb = ( e3t_ntn + atfp[ e3t_btb - 2 e3t_ntn + e3t_a*ta ] )
	255	!! /( e3t_n + atfp*[ e3t_b - 2 e3t_n + e3t_a ] )
	256	!! tn = ta
	257	!! ta = zt (NB: reset to 0 after eos_bn2 call)
	258	!!
	259	!! ** Action : - (tb,sb) and (tn,sn) ready for the next time step
	260	!! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T)
	261	!!----------------------------------------------------------------------
[2715]	262	INTEGER , INTENT(in ) :: kt ! ocean time-step index
[3294]	263	INTEGER , INTENT(in ) :: kit000 ! first time step index
[2715]	264	CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	265	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	266	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields
	267	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields
	268	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend
[1438]	269	!!
[2528]	270	LOGICAL :: ll_tra, ll_tra_hpg, ll_traqsr ! local logical
	271	INTEGER :: ji, jj, jk, jn ! dummy loop indices
[2715]	272	REAL(wp) :: zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar
	273	REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - -
[1438]	274	!!----------------------------------------------------------------------
[3294]	275	!
	276	IF( kt == kit000 ) THEN
[1438]	277	IF(lwp) WRITE(numout,*)
[3294]	278	IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
[1438]	279	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	280	ENDIF
[2528]	281	!
	282	IF( cdtype == 'TRA' ) THEN
	283	ll_tra = .TRUE. ! active tracers case
	284	ll_tra_hpg = ln_dynhpg_imp ! active tracers case and semi-implicit hpg
	285	ll_traqsr = ln_traqsr ! active tracers case and solar penetration
	286	ELSE
	287	ll_tra = .FALSE. ! passive tracers case
	288	ll_tra_hpg = .FALSE. ! passive tracers case or NO semi-implicit hpg
	289	ll_traqsr = .FALSE. ! active tracers case and NO solar penetration
	290	ENDIF
	291	!
	292	DO jn = 1, kjpt
	293	DO jk = 1, jpkm1
	294	zfact1 = atfp * rdttra(jk)
	295	zfact2 = zfact1 / rau0
	296	DO jj = 1, jpj
	297	DO ji = 1, jpi
	298	ze3t_b = fse3t_b(ji,jj,jk)
	299	ze3t_n = fse3t_n(ji,jj,jk)
	300	ze3t_a = fse3t_a(ji,jj,jk)
	301	! ! tracer content at Before, now and after
	302	ztc_b = ptb(ji,jj,jk,jn) * ze3t_b
	303	ztc_n = ptn(ji,jj,jk,jn) * ze3t_n
	304	ztc_a = pta(ji,jj,jk,jn) * ze3t_a
	305	!
	306	ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
	307	ztc_d = ztc_a - 2. * ztc_n + ztc_b
	308	!
	309	ze3t_f = ze3t_n + atfp * ze3t_d
	310	ztc_f = ztc_n + atfp * ztc_d
	311	!
	312	IF( ll_tra .AND. jk == 1 ) THEN ! first level only for T & S
	313	ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) )
	314	ztc_f = ztc_f - zfact1 * ( sbc_tsc(ji,jj,jn) - sbc_tsc_b(ji,jj,jn) )
	315	ENDIF
	316	IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) & ! solar penetration (temperature only)
	317	& ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )
[1438]	318
[2528]	319	ze3t_f = 1.e0 / ze3t_f
	320	ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered
	321	ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta
	322	!
	323	IF( ll_tra_hpg ) THEN ! semi-implicit hpg (T & S only)
	324	ze3t_d = 1.e0 / ( ze3t_n + rbcp * ze3t_d )
	325	pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n + rbcp * ztc_d ) ! ta <-- Brown & Campana average
	326	ENDIF
[1438]	327	END DO
	328	END DO
[2528]	329	END DO
	330	!
	331	END DO
[503]	332	!
[1438]	333	END SUBROUTINE tra_nxt_vvl
[3]	334
	335	!!======================================================================
	336	END MODULE tranxt

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

Download in other formats: