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/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 6079

Last change on this file since 6079 was 6079, checked in by jamesharle, 8 years ago
merge to trunk@5936
Property svn:keywords set to `Id`
File size: 16.4 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
[5620]	29	USE sbcrnf ! river runoffs
[5901]	30	USE sbcisf ! ice shelf melting/freezing
[5038]	31	USE zdf_oce ! ocean vertical mixing
[1438]	32	USE domvvl ! variable volume
[5038]	33	USE trd_oce ! trends: ocean variables
	34	USE trdtra ! trends manager: tracers
	35	USE traqsr ! penetrative solar radiation (needed for nksr)
	36	USE phycst ! physical constant
[5901]	37	USE ldftra ! lateral physics on tracers
	38	USE ldfslp
[5038]	39	USE bdy_oce ! BDY open boundary condition variables
[3294]	40	USE bdytra ! open boundary condition (bdy_tra routine)
[5038]	41	!
[3]	42	USE in_out_manager ! I/O manager
	43	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
[258]	44	USE prtctl ! Print control
[5038]	45	USE wrk_nemo ! Memory allocation
	46	USE timing ! Timing
[2528]	47	#if defined key_agrif
[389]	48	USE agrif_opa_interp
[2528]	49	#endif
[3]	50
	51	IMPLICIT NONE
	52	PRIVATE
	53
[2528]	54	PUBLIC tra_nxt ! routine called by step.F90
	55	PUBLIC tra_nxt_fix ! to be used in trcnxt
	56	PUBLIC tra_nxt_vvl ! to be used in trcnxt
[592]	57
[1438]	58
[592]	59	!! * Substitutions
	60	# include "domzgr_substitute.h90"
[3]	61	!!----------------------------------------------------------------------
[2528]	62	!! NEMO/OPA 3.3 , NEMO-Consortium (2010)
[2715]	63	!! $Id$
	64	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[3]	65	!!----------------------------------------------------------------------
	66	CONTAINS
	67
	68	SUBROUTINE tra_nxt( kt )
	69	!!----------------------------------------------------------------------
	70	!! * ROUTINE tranxt *
	71	!!
[1110]	72	!! ** Purpose : Apply the boundary condition on the after temperature
	73	!! and salinity fields, achieved the time stepping by adding
	74	!! the Asselin filter on now fields and swapping the fields.
[3]	75	!!
[1110]	76	!! ** Method : At this stage of the computation, ta and sa are the
	77	!! after temperature and salinity as the time stepping has
	78	!! been performed in trazdf_imp or trazdf_exp module.
[3]	79	!!
[1110]	80	!! - Apply lateral boundary conditions on (ta,sa)
	81	!! at the local domain boundaries through lbc_lnk call,
[4328]	82	!! at the one-way open boundaries (lk_bdy=T),
[5038]	83	!! at the AGRIF zoom boundaries (lk_agrif=T)
[1110]	84	!!
[1438]	85	!! - Update lateral boundary conditions on AGRIF children
	86	!! domains (lk_agrif=T)
[1110]	87	!!
	88	!! ** Action : - (tb,sb) and (tn,sn) ready for the next time step
[6079]	89	!!
[503]	90	!!----------------------------------------------------------------------
	91	INTEGER, INTENT(in) :: kt ! ocean time-step index
	92	!!
[2528]	93	INTEGER :: jk, jn ! dummy loop indices
	94	REAL(wp) :: zfact ! local scalars
[3294]	95	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds
[3]	96	!!----------------------------------------------------------------------
[3294]	97	!
	98	IF( nn_timing == 1 ) CALL timing_start( 'tra_nxt')
	99	!
[1110]	100	IF( kt == nit000 ) THEN
	101	IF(lwp) WRITE(numout,*)
	102	IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
	103	IF(lwp) WRITE(numout,*) '~~~~~~~'
[592]	104	ENDIF
	105
[1110]	106	! Update after tracer on domain lateral boundaries
	107	!
[6079]	108	!
[5901]	109	#if defined key_agrif
	110	CALL Agrif_tra ! AGRIF zoom boundaries
	111	#endif
	112	!
[4230]	113	CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp ) ! local domain boundaries (T-point, unchanged sign)
	114	CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
[1110]	115	!
[2528]	116	#if defined key_bdy
[3294]	117	IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries
[1110]	118	#endif
[1438]	119
	120	! set time step size (Euler/Leapfrog)
[2715]	121	IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dtra(:) = rdttra(:) ! at nit000 (Euler)
[4230]	122	ELSEIF( kt <= nit000 + 1 ) THEN ; r2dtra(:) = 2._wp* rdttra(:) ! at nit000 or nit000+1 (Leapfrog)
[1438]	123	ENDIF
[3]	124
[1110]	125	! trends computation initialisation
[2528]	126	IF( l_trdtra ) THEN ! store now fields before applying the Asselin filter
[3294]	127	CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
	128	ztrdt(:,:,:) = tsn(:,:,:,jp_tem)
	129	ztrds(:,:,:) = tsn(:,:,:,jp_sal)
[5038]	130	IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend
	131	CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
	132	CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
	133	ENDIF
[1110]	134	ENDIF
	135
[2528]	136	IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step (only swap)
	137	DO jn = 1, jpts
	138	DO jk = 1, jpkm1
	139	tsn(:,:,jk,jn) = tsa(:,:,jk,jn)
	140	END DO
	141	END DO
	142	ELSE ! Leap-Frog + Asselin filter time stepping
	143	!
[5620]	144	IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa, &
	145	& sbc_tsc, sbc_tsc_b, jpts ) ! variable volume level (vvl)
	146	ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level
[2528]	147	ENDIF
[5901]	148	ENDIF
[2715]	149	!
[1438]	150	! trends computation
[2528]	151	IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt
[1110]	152	DO jk = 1, jpkm1
[5038]	153	zfact = 1._wp / r2dtra(jk)
[2528]	154	ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
	155	ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
[1110]	156	END DO
[5038]	157	CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
	158	CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
[3294]	159	CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
[1438]	160	END IF
[2715]	161	!
[1438]	162	! ! control print
[2528]	163	IF(ln_ctl) CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt - Tn: ', mask1=tmask, &
	164	& tab3d_2=tsn(:,:,:,jp_sal), clinfo2= ' Sn: ', mask2=tmask )
[1438]	165	!
[5038]	166	IF( nn_timing == 1 ) CALL timing_stop('tra_nxt')
[3294]	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	!! - swap tracer fields to prepare the next time_step.
	180	!!
	181	!! ** Action : - (tb,sb) and (tn,sn) ready for the next time step
[6079]	182	!!
[1438]	183	!!----------------------------------------------------------------------
[2715]	184	INTEGER , INTENT(in ) :: kt ! ocean time-step index
[3294]	185	INTEGER , INTENT(in ) :: kit000 ! first time step index
[2715]	186	CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	187	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	188	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields
	189	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields
	190	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend
	191	!
[2528]	192	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	193	REAL(wp) :: ztn, ztd ! local scalars
[1438]	194	!!----------------------------------------------------------------------
	195
[3294]	196	IF( kt == kit000 ) THEN
[1438]	197	IF(lwp) WRITE(numout,*)
[3294]	198	IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
[1438]	199	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	200	ENDIF
	201	!
[2528]	202	!
	203	DO jn = 1, kjpt
[1438]	204	!
[2528]	205	DO jk = 1, jpkm1
	206	DO jj = 1, jpj
	207	DO ji = 1, jpi
	208	ztn = ptn(ji,jj,jk,jn)
	209	ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn) ! time laplacian on tracers
	210	!
	211	ptb(ji,jj,jk,jn) = ztn + atfp * ztd ! ptb <-- filtered ptn
	212	ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta
	213	!
[3]	214	END DO
[2528]	215	END DO
	216	END DO
[1110]	217	!
[2528]	218	END DO
[1438]	219	!
	220	END SUBROUTINE tra_nxt_fix
[3]	221
[1110]	222
[5620]	223	SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
[1438]	224	!!----------------------------------------------------------------------
	225	!! * ROUTINE tra_nxt_vvl *
	226	!!
	227	!! ** Purpose : Time varying volume: apply the Asselin time filter
	228	!! and swap the tracer fields.
	229	!!
	230	!! ** Method : - Apply a thickness weighted Asselin time filter on now fields.
	231	!! - swap tracer fields to prepare the next time_step.
	232	!! This can be summurized for tempearture as:
	233	!!
	234	!! ** Action : - (tb,sb) and (tn,sn) ready for the next time step
[6079]	235	!!
[1438]	236	!!----------------------------------------------------------------------
[5620]	237	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	238	INTEGER , INTENT(in ) :: kit000 ! first time step index
	239	REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! time-step
	240	CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	241	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	242	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields
	243	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields
	244	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend
	245	REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt) :: psbc_tc ! surface tracer content
	246	REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt) :: psbc_tc_b ! before surface tracer content
	247
[1438]	248	!!
[6079]	249	LOGICAL :: ll_traqsr, ll_rnf, ll_isf ! local logical
[2528]	250	INTEGER :: ji, jj, jk, jn ! dummy loop indices
[2715]	251	REAL(wp) :: zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar
	252	REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - -
[1438]	253	!!----------------------------------------------------------------------
[3294]	254	!
	255	IF( kt == kit000 ) THEN
[1438]	256	IF(lwp) WRITE(numout,*)
[3294]	257	IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
[1438]	258	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	259	ENDIF
[2528]	260	!
	261	IF( cdtype == 'TRA' ) THEN
	262	ll_traqsr = ln_traqsr ! active tracers case and solar penetration
[5620]	263	ll_rnf = ln_rnf ! active tracers case and river runoffs
[5901]	264	IF (nn_isf .GE. 1) THEN
	265	ll_isf = .TRUE. ! active tracers case and ice shelf melting/freezing
	266	ELSE
	267	ll_isf = .FALSE.
	268	END IF
[2528]	269	ELSE
	270	ll_traqsr = .FALSE. ! active tracers case and NO solar penetration
[5620]	271	ll_rnf = .FALSE. ! passive tracers or NO river runoffs
[5901]	272	ll_isf = .FALSE. ! passive tracers or NO ice shelf melting/freezing
[2528]	273	ENDIF
	274	!
	275	DO jn = 1, kjpt
	276	DO jk = 1, jpkm1
[5620]	277	zfact1 = atfp * p2dt(jk)
[2528]	278	zfact2 = zfact1 / rau0
	279	DO jj = 1, jpj
	280	DO ji = 1, jpi
	281	ze3t_b = fse3t_b(ji,jj,jk)
	282	ze3t_n = fse3t_n(ji,jj,jk)
	283	ze3t_a = fse3t_a(ji,jj,jk)
	284	! ! tracer content at Before, now and after
	285	ztc_b = ptb(ji,jj,jk,jn) * ze3t_b
	286	ztc_n = ptn(ji,jj,jk,jn) * ze3t_n
	287	ztc_a = pta(ji,jj,jk,jn) * ze3t_a
	288	!
	289	ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
	290	ztc_d = ztc_a - 2. * ztc_n + ztc_b
	291	!
	292	ze3t_f = ze3t_n + atfp * ze3t_d
	293	ztc_f = ztc_n + atfp * ztc_d
	294	!
[5901]	295	IF( jk == mikt(ji,jj) ) THEN ! first level
	296	ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj) - emp(ji,jj) ) &
	297	& - (rnf_b(ji,jj) - rnf(ji,jj) ) &
	298	& + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) )
[5620]	299	ztc_f = ztc_f - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
[2528]	300	ENDIF
[5620]	301
[5901]	302	! solar penetration (temperature only)
	303	IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) &
[2528]	304	& ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )
[1438]	305
[5901]	306	! river runoff
	307	IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) &
[5620]	308	& ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &
	309	& * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
	310
[5901]	311	! ice shelf
	312	IF( ll_isf ) THEN
	313	! level fully include in the Losch_2008 ice shelf boundary layer
	314	IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) ) &
	315	ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) &
	316	& * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
	317	! level partially include in Losch_2008 ice shelf boundary layer
	318	IF ( jk == misfkb(ji,jj) ) &
	319	ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) &
	320	& * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
	321	END IF
	322
[5620]	323	ze3t_f = 1.e0 / ze3t_f
	324	ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered
	325	ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta
	326	!
[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: