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/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 8535

Last change on this file since 8535 was 8535, checked in by jpalmier, 7 years ago
JPALM -- trdtrc -- found ATF trend bug relative to TRC case
File size: 21.8 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
[5467]	29	USE sbcrnf ! river runoffs
[6487]	30	USE sbcisf ! ice shelf melting/freezing
[4990]	31	USE zdf_oce ! ocean vertical mixing
[1438]	32	USE domvvl ! variable volume
[1601]	33	USE dynspg_oce ! surface pressure gradient variables
	34	USE dynhpg ! hydrostatic pressure gradient
[4990]	35	USE trd_oce ! trends: ocean variables
	36	USE trdtra ! trends manager: tracers
	37	USE traqsr ! penetrative solar radiation (needed for nksr)
	38	USE phycst ! physical constant
	39	USE ldftra_oce ! lateral physics on tracers
	40	USE bdy_oce ! BDY open boundary condition variables
[3294]	41	USE bdytra ! open boundary condition (bdy_tra routine)
[4990]	42	!
[3]	43	USE in_out_manager ! I/O manager
	44	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
[258]	45	USE prtctl ! Print control
[4990]	46	USE wrk_nemo ! Memory allocation
	47	USE timing ! Timing
[2528]	48	#if defined key_agrif
[389]	49	USE agrif_opa_interp
[2528]	50	#endif
[3]	51
[8535]	52
[3]	53	IMPLICIT NONE
	54	PRIVATE
	55
[2528]	56	PUBLIC tra_nxt ! routine called by step.F90
	57	PUBLIC tra_nxt_fix ! to be used in trcnxt
	58	PUBLIC tra_nxt_vvl ! to be used in trcnxt
[592]	59
[2715]	60	REAL(wp) :: rbcp ! Brown & Campana parameters for semi-implicit hpg
[1438]	61
[592]	62	!! * Substitutions
	63	# include "domzgr_substitute.h90"
[3]	64	!!----------------------------------------------------------------------
[2528]	65	!! NEMO/OPA 3.3 , NEMO-Consortium (2010)
[2715]	66	!! $Id$
	67	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[3]	68	!!----------------------------------------------------------------------
	69	CONTAINS
	70
	71	SUBROUTINE tra_nxt( kt )
	72	!!----------------------------------------------------------------------
	73	!! * ROUTINE tranxt *
	74	!!
[1110]	75	!! ** Purpose : Apply the boundary condition on the after temperature
	76	!! and salinity fields, achieved the time stepping by adding
	77	!! the Asselin filter on now fields and swapping the fields.
[3]	78	!!
[1110]	79	!! ** Method : At this stage of the computation, ta and sa are the
	80	!! after temperature and salinity as the time stepping has
	81	!! been performed in trazdf_imp or trazdf_exp module.
[3]	82	!!
[1110]	83	!! - Apply lateral boundary conditions on (ta,sa)
	84	!! at the local domain boundaries through lbc_lnk call,
[4328]	85	!! at the one-way open boundaries (lk_bdy=T),
[4990]	86	!! at the AGRIF zoom boundaries (lk_agrif=T)
[1110]	87	!!
[1438]	88	!! - Update lateral boundary conditions on AGRIF children
	89	!! domains (lk_agrif=T)
[1110]	90	!!
	91	!! ** Action : - (tb,sb) and (tn,sn) ready for the next time step
	92	!! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T)
[503]	93	!!----------------------------------------------------------------------
	94	INTEGER, INTENT(in) :: kt ! ocean time-step index
	95	!!
[2528]	96	INTEGER :: jk, jn ! dummy loop indices
	97	REAL(wp) :: zfact ! local scalars
[3294]	98	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds
[3]	99	!!----------------------------------------------------------------------
[3294]	100	!
	101	IF( nn_timing == 1 ) CALL timing_start( 'tra_nxt')
	102	!
[1110]	103	IF( kt == nit000 ) THEN
	104	IF(lwp) WRITE(numout,*)
	105	IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
	106	IF(lwp) WRITE(numout,*) '~~~~~~~'
[2528]	107	!
[4230]	108	rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp) ! Brown & Campana parameter for semi-implicit hpg
[592]	109	ENDIF
	110
[1110]	111	! Update after tracer on domain lateral boundaries
	112	!
[6487]	113	#if defined key_agrif
	114	CALL Agrif_tra ! AGRIF zoom boundaries
	115	#endif
	116	!
[4230]	117	CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp ) ! local domain boundaries (T-point, unchanged sign)
	118	CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
[1110]	119	!
[2528]	120	#if defined key_bdy
[3294]	121	IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries
[1110]	122	#endif
[1438]	123
	124	! set time step size (Euler/Leapfrog)
[2715]	125	IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dtra(:) = rdttra(:) ! at nit000 (Euler)
[4230]	126	ELSEIF( kt <= nit000 + 1 ) THEN ; r2dtra(:) = 2._wp* rdttra(:) ! at nit000 or nit000+1 (Leapfrog)
[1438]	127	ENDIF
[3]	128
[1110]	129	! trends computation initialisation
[7554]	130	IF( l_trdtra ) THEN
[3294]	131	CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
[7573]	132	ztrdt(:,:,jpk) = 0._wp
	133	ztrds(:,:,jpk) = 0._wp
[4990]	134	IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend
	135	CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
	136	CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
	137	ENDIF
[8104]	138	! total trend for the non-time-filtered variables.
	139	! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms
	140	IF( lk_vvl ) THEN
	141	DO jk = 1, jpkm1
	142	zfact = 1.0 / rdttra(jk)
	143	ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) zfact
	144	ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) zfact
	145	END DO
	146	ELSE
	147	DO jk = 1, jpkm1
	148	zfact = 1.0 / rdttra(jk)
	149	ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact
	150	ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact
	151	END DO
	152	END IF
[7061]	153	CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt )
	154	CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds )
[8104]	155	IF( .NOT.lk_vvl ) THEN
	156	! Store now fields before applying the Asselin filter
	157	! in order to calculate Asselin filter trend later.
	158	ztrdt(:,:,:) = tsn(:,:,:,jp_tem)
	159	ztrds(:,:,:) = tsn(:,:,:,jp_sal)
	160	END IF
[1110]	161	ENDIF
	162
[2528]	163	IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step (only swap)
	164	DO jn = 1, jpts
	165	DO jk = 1, jpkm1
	166	tsn(:,:,jk,jn) = tsa(:,:,jk,jn)
	167	END DO
	168	END DO
[8104]	169	IF (l_trdtra.AND.lk_vvl) THEN ! Zero Asselin filter contribution must be explicitly written out since for vvl
	170	! Asselin filter is output by tra_nxt_vvl that is not called on this time step
	171	ztrdt(:,:,:) = 0._wp
	172	ztrds(:,:,:) = 0._wp
	173	CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
	174	CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
	175	END IF
[2528]	176	ELSE ! Leap-Frog + Asselin filter time stepping
	177	!
[5385]	178	IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa, &
	179	& sbc_tsc, sbc_tsc_b, jpts ) ! variable volume level (vvl)
	180	ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level
[2528]	181	ENDIF
[6487]	182	ENDIF
[2715]	183	!
[6487]	184	! trends computation
[8104]	185	IF( l_trdtra.AND..NOT.lk_vvl) THEN ! trend of the Asselin filter (tb filtered - tb)/dt
[1110]	186	DO jk = 1, jpkm1
[4990]	187	zfact = 1._wp / r2dtra(jk)
[2528]	188	ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
	189	ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
[1110]	190	END DO
[4990]	191	CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
	192	CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
[1438]	193	END IF
[8104]	194	IF( l_trdtra) CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
[2715]	195	!
[1438]	196	! ! control print
[2528]	197	IF(ln_ctl) CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt - Tn: ', mask1=tmask, &
	198	& tab3d_2=tsn(:,:,:,jp_sal), clinfo2= ' Sn: ', mask2=tmask )
[1438]	199	!
[4990]	200	IF( nn_timing == 1 ) CALL timing_stop('tra_nxt')
[3294]	201	!
[1438]	202	END SUBROUTINE tra_nxt
	203
	204
[3294]	205	SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
[1438]	206	!!----------------------------------------------------------------------
	207	!! * ROUTINE tra_nxt_fix *
	208	!!
	209	!! ** Purpose : fixed volume: apply the Asselin time filter and
	210	!! swap the tracer fields.
	211	!!
	212	!! ** Method : - Apply a Asselin time filter on now fields.
	213	!! - save in (ta,sa) an average over the three time levels
	214	!! which will be used to compute rdn and thus the semi-implicit
	215	!! hydrostatic pressure gradient (ln_dynhpg_imp = T)
	216	!! - swap tracer fields to prepare the next time_step.
	217	!! This can be summurized for tempearture as:
[2528]	218	!! ztm = tn + rbcp * [ta -2 tn + tb ] ln_dynhpg_imp = T
	219	!! ztm = 0 otherwise
	220	!! with rbcp=1/4 * (1-atfp^4) / (1-atfp)
[1438]	221	!! tb = tn + atfp*[ tb - 2 tn + ta ]
[2528]	222	!! tn = ta
[1438]	223	!! ta = ztm (NB: reset to 0 after eos_bn2 call)
	224	!!
	225	!! ** Action : - (tb,sb) and (tn,sn) ready for the next time step
	226	!! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T)
	227	!!----------------------------------------------------------------------
[2715]	228	INTEGER , INTENT(in ) :: kt ! ocean time-step index
[3294]	229	INTEGER , INTENT(in ) :: kit000 ! first time step index
[2715]	230	CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	231	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	232	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields
	233	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields
	234	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend
	235	!
[2528]	236	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	237	LOGICAL :: ll_tra_hpg ! local logical
	238	REAL(wp) :: ztn, ztd ! local scalars
[1438]	239	!!----------------------------------------------------------------------
	240
[3294]	241	IF( kt == kit000 ) THEN
[1438]	242	IF(lwp) WRITE(numout,*)
[3294]	243	IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
[1438]	244	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	245	ENDIF
	246	!
[2528]	247	IF( cdtype == 'TRA' ) THEN ; ll_tra_hpg = ln_dynhpg_imp ! active tracers case and semi-implicit hpg
	248	ELSE ; ll_tra_hpg = .FALSE. ! passive tracers case or NO semi-implicit hpg
	249	ENDIF
	250	!
	251	DO jn = 1, kjpt
[1438]	252	!
[2528]	253	DO jk = 1, jpkm1
	254	DO jj = 1, jpj
	255	DO ji = 1, jpi
	256	ztn = ptn(ji,jj,jk,jn)
	257	ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn) ! time laplacian on tracers
	258	!
	259	ptb(ji,jj,jk,jn) = ztn + atfp * ztd ! ptb <-- filtered ptn
	260	ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta
	261	!
	262	IF( ll_tra_hpg ) pta(ji,jj,jk,jn) = ztn + rbcp * ztd ! pta <-- Brown & Campana average
[3]	263	END DO
[2528]	264	END DO
	265	END DO
[1110]	266	!
[2528]	267	END DO
[1438]	268	!
	269	END SUBROUTINE tra_nxt_fix
[3]	270
[1110]	271
[5385]	272	SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
[1438]	273	!!----------------------------------------------------------------------
	274	!! * ROUTINE tra_nxt_vvl *
	275	!!
	276	!! ** Purpose : Time varying volume: apply the Asselin time filter
	277	!! and swap the tracer fields.
	278	!!
	279	!! ** Method : - Apply a thickness weighted Asselin time filter on now fields.
	280	!! - save in (ta,sa) a thickness weighted average over the three
	281	!! time levels which will be used to compute rdn and thus the semi-
	282	!! implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
	283	!! - swap tracer fields to prepare the next time_step.
	284	!! This can be summurized for tempearture as:
[2528]	285	!! ztm = ( e3t_ntn + rbcp[ e3t_btb - 2 e3t_ntn + e3t_a*ta ] ) ln_dynhpg_imp = T
	286	!! /( e3t_n + rbcp*[ e3t_b - 2 e3t_n + e3t_a ] )
	287	!! ztm = 0 otherwise
[1438]	288	!! tb = ( e3t_ntn + atfp[ e3t_btb - 2 e3t_ntn + e3t_a*ta ] )
	289	!! /( e3t_n + atfp*[ e3t_b - 2 e3t_n + e3t_a ] )
	290	!! tn = ta
	291	!! ta = zt (NB: reset to 0 after eos_bn2 call)
	292	!!
	293	!! ** Action : - (tb,sb) and (tn,sn) ready for the next time step
	294	!! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T)
	295	!!----------------------------------------------------------------------
[5385]	296	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	297	INTEGER , INTENT(in ) :: kit000 ! first time step index
	298	REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! time-step
	299	CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	300	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	301	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields
	302	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields
	303	REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend
	304	REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt) :: psbc_tc ! surface tracer content
	305	REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt) :: psbc_tc_b ! before surface tracer content
	306
[1438]	307	!!
[6487]	308	LOGICAL :: ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf ! local logical
[2528]	309	INTEGER :: ji, jj, jk, jn ! dummy loop indices
[8104]	310	REAL(wp) :: zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar
[2715]	311	REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - -
[8104]	312	REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrd_atf
[1438]	313	!!----------------------------------------------------------------------
[3294]	314	!
	315	IF( kt == kit000 ) THEN
[1438]	316	IF(lwp) WRITE(numout,*)
[8535]	317	IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping ', cdtype
[1438]	318	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	319	ENDIF
[2528]	320	!
	321	IF( cdtype == 'TRA' ) THEN
	322	ll_tra_hpg = ln_dynhpg_imp ! active tracers case and semi-implicit hpg
	323	ll_traqsr = ln_traqsr ! active tracers case and solar penetration
[5467]	324	ll_rnf = ln_rnf ! active tracers case and river runoffs
[6487]	325	IF (nn_isf .GE. 1) THEN
	326	ll_isf = .TRUE. ! active tracers case and ice shelf melting/freezing
	327	ELSE
	328	ll_isf = .FALSE.
	329	END IF
[2528]	330	ELSE
	331	ll_tra_hpg = .FALSE. ! passive tracers case or NO semi-implicit hpg
	332	ll_traqsr = .FALSE. ! active tracers case and NO solar penetration
[5467]	333	ll_rnf = .FALSE. ! passive tracers or NO river runoffs
[6487]	334	ll_isf = .FALSE. ! passive tracers or NO ice shelf melting/freezing
[2528]	335	ENDIF
	336	!
[8333]	337	IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
[8104]	338	CALL wrk_alloc( jpi, jpj, jpk, kjpt, ztrd_atf )
	339	ztrd_atf(:,:,:,:) = 0.0_wp
	340	ENDIF
[2528]	341	DO jn = 1, kjpt
	342	DO jk = 1, jpkm1
[8535]	343	!! zfact = 1._wp / r2dtra(jk)
	344	zfact = 0.5_wp *p2dt(jk)
[5385]	345	zfact1 = atfp * p2dt(jk)
[2528]	346	zfact2 = zfact1 / rau0
	347	DO jj = 1, jpj
	348	DO ji = 1, jpi
	349	ze3t_b = fse3t_b(ji,jj,jk)
	350	ze3t_n = fse3t_n(ji,jj,jk)
	351	ze3t_a = fse3t_a(ji,jj,jk)
	352	! ! tracer content at Before, now and after
	353	ztc_b = ptb(ji,jj,jk,jn) * ze3t_b
	354	ztc_n = ptn(ji,jj,jk,jn) * ze3t_n
	355	ztc_a = pta(ji,jj,jk,jn) * ze3t_a
	356	!
	357	ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
	358	ztc_d = ztc_a - 2. * ztc_n + ztc_b
	359	!
	360	ze3t_f = ze3t_n + atfp * ze3t_d
	361	ztc_f = ztc_n + atfp * ztc_d
	362	!
[6487]	363	IF( jk == mikt(ji,jj) ) THEN ! first level
	364	ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj) - emp(ji,jj) ) &
	365	& - (rnf_b(ji,jj) - rnf(ji,jj) ) &
	366	& + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) )
[5385]	367	ztc_f = ztc_f - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
[2528]	368	ENDIF
[5467]	369
[6487]	370	! solar penetration (temperature only)
	371	IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) &
[2528]	372	& ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )
[1438]	373
[6487]	374	! river runoff
	375	IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) &
[5467]	376	& ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &
	377	& * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
	378
[6487]	379	! ice shelf
	380	IF( ll_isf ) THEN
	381	! level fully include in the Losch_2008 ice shelf boundary layer
	382	IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) ) &
	383	ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) &
	384	& * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
	385	! level partially include in Losch_2008 ice shelf boundary layer
	386	IF ( jk == misfkb(ji,jj) ) &
	387	ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) &
	388	& * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
	389	END IF
	390
[5467]	391	ze3t_f = 1.e0 / ze3t_f
	392	ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered
	393	ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta
	394	!
	395	IF( ll_tra_hpg ) THEN ! semi-implicit hpg (T & S only)
	396	ze3t_d = 1.e0 / ( ze3t_n + rbcp * ze3t_d )
	397	pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n + rbcp * ztc_d ) ! ta <-- Brown & Campana average
	398	ENDIF
[8333]	399	IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
[8104]	400	ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n
	401	ENDIF
[1438]	402	END DO
	403	END DO
[2528]	404	END DO
	405	!
	406	END DO
[503]	407	!
[8333]	408	IF( l_trdtra .and. cdtype == 'TRA' ) THEN
	409	CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) )
	410	CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) )
[8104]	411	CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf )
	412	ENDIF
[8333]	413	IF( l_trdtrc .and. cdtype == 'TRC' ) THEN
	414	DO jn = 1, kjpt
	415	CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) )
	416	END DO
	417	CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf )
	418	ENDIF
[8104]	419
[1438]	420	END SUBROUTINE tra_nxt_vvl
[3]	421
	422	!!======================================================================
	423	END MODULE tranxt

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

Download in other formats: