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.

traatf.F90 in NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traatf.F90 @ 12353

Last change on this file since 12353 was 12353, checked in by acc, 4 years ago
Branch 2019/dev_r11943_MERGE_2019. Additions to the do loop macro implementation: converted a few loops previously missed because they used jpi-1 instead of jpim1 etc.; changed internal macro names in do_loop_substitute.h90 to strings that are much more unlikely to appear in any future code elsewhere and removed the key_vectopt_loop option (and all related code) since the do loop macros have suppressed this option. These changes have been fully SETTE-tested and this branch should now be ready to go back to the trunk.
Property svn:keywords set to `Id`
File size: 20.9 KB

Rev	Line
[11057]	1	MODULE traatf
[3]	2	!!======================================================================
[11057]	3	!! * MODULE traatf *
[11475]	4	!! Ocean active tracers: Asselin time filtering for temperature and salinity
[3]	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
[11475]	19	!! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename tranxt.F90 -> traatf.F90. Now only does time filtering.
[3]	20	!!----------------------------------------------------------------------
[503]	21
	22	!!----------------------------------------------------------------------
[11475]	23	!! tra_atf : time filtering on tracers
	24	!! tra_atf_fix : time filtering on tracers : fixed volume case
	25	!! tra_atf_vvl : time filtering on tracers : variable volume case
[3]	26	!!----------------------------------------------------------------------
	27	USE oce ! ocean dynamics and tracers variables
	28	USE dom_oce ! ocean space and time domain variables
[2528]	29	USE sbc_oce ! surface boundary condition: ocean
[5467]	30	USE sbcrnf ! river runoffs
[12150]	31	USE isf_oce ! ice shelf melting
[4990]	32	USE zdf_oce ! ocean vertical mixing
[1438]	33	USE domvvl ! variable volume
[4990]	34	USE trd_oce ! trends: ocean variables
	35	USE trdtra ! trends manager: tracers
	36	USE traqsr ! penetrative solar radiation (needed for nksr)
	37	USE phycst ! physical constant
[9019]	38	USE ldftra ! lateral physics : tracers
	39	USE ldfslp ! lateral physics : slopes
	40	USE bdy_oce , ONLY : ln_bdy
[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 timing ! Timing
[2528]	47	#if defined key_agrif
[9570]	48	USE agrif_oce_interp
[2528]	49	#endif
[3]	50
	51	IMPLICIT NONE
	52	PRIVATE
	53
[11057]	54	PUBLIC tra_atf ! routine called by step.F90
	55	PUBLIC tra_atf_fix ! to be used in trcnxt
	56	PUBLIC tra_atf_vvl ! to be used in trcnxt
[592]	57
	58	!! * Substitutions
[12340]	59	# include "do_loop_substitute.h90"
[3]	60	!!----------------------------------------------------------------------
[10068]	61	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2715]	62	!! $Id$
[10068]	63	!! Software governed by the CeCILL license (see ./LICENSE)
[3]	64	!!----------------------------------------------------------------------
	65	CONTAINS
	66
[11057]	67	SUBROUTINE tra_atf( kt, Kbb, Kmm, Kaa, pts )
[3]	68	!!----------------------------------------------------------------------
[11057]	69	!! * ROUTINE traatf *
[3]	70	!!
[1110]	71	!! ** Purpose : Apply the boundary condition on the after temperature
[11475]	72	!! and salinity fields and add the Asselin time filter on now fields.
[3]	73	!!
[1110]	74	!! ** Method : At this stage of the computation, ta and sa are the
	75	!! after temperature and salinity as the time stepping has
	76	!! been performed in trazdf_imp or trazdf_exp module.
[3]	77	!!
[1110]	78	!! - Apply lateral boundary conditions on (ta,sa)
	79	!! at the local domain boundaries through lbc_lnk call,
[7646]	80	!! at the one-way open boundaries (ln_bdy=T),
[4990]	81	!! at the AGRIF zoom boundaries (lk_agrif=T)
[1110]	82	!!
[1438]	83	!! - Update lateral boundary conditions on AGRIF children
	84	!! domains (lk_agrif=T)
[1110]	85	!!
[11475]	86	!! ** Action : - ts(Kmm) time filtered
[503]	87	!!----------------------------------------------------------------------
[11057]	88	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	89	INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! time level indices
	90	REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers
[503]	91	!!
[6140]	92	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	93	REAL(wp) :: zfact ! local scalars
[9019]	94	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds
[3]	95	!!----------------------------------------------------------------------
[3294]	96	!
[11057]	97	IF( ln_timing ) CALL timing_start( 'tra_atf')
[3294]	98	!
[1110]	99	IF( kt == nit000 ) THEN
	100	IF(lwp) WRITE(numout,*)
[11475]	101	IF(lwp) WRITE(numout,*) 'tra_atf : apply Asselin time filter to "now" fields'
[1110]	102	IF(lwp) WRITE(numout,*) '~~~~~~~'
[592]	103	ENDIF
	104
[1110]	105	! Update after tracer on domain lateral boundaries
	106	!
[5656]	107	#if defined key_agrif
	108	CALL Agrif_tra ! AGRIF zoom boundaries
	109	#endif
[9094]	110	! ! local domain boundaries (T-point, unchanged sign)
[11057]	111	CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. )
[5656]	112	!
[11057]	113	IF( ln_bdy ) CALL bdy_tra( kt, Kbb, pts, Kaa ) ! BDY open boundaries
[1438]	114
	115	! set time step size (Euler/Leapfrog)
[9019]	116	IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! at nit000 (Euler)
[6140]	117	ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2._wp* rdt ! at nit000 or nit000+1 (Leapfrog)
[1438]	118	ENDIF
[3]	119
[1110]	120	! trends computation initialisation
[7646]	121	IF( l_trdtra ) THEN
[9019]	122	ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
[8698]	123	ztrdt(:,:,jpk) = 0._wp
	124	ztrds(:,:,jpk) = 0._wp
[4990]	125	IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend
[11057]	126	CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_zdfp, ztrdt )
	127	CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_zdfp, ztrds )
[4990]	128	ENDIF
[7646]	129	! total trend for the non-time-filtered variables.
[8698]	130	zfact = 1.0 / rdt
[11057]	131	! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from pts(Kmm) terms
[7646]	132	DO jk = 1, jpkm1
[11057]	133	ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_tem,Kmm)) zfact
	134	ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_sal,Kmm)) zfact
[7646]	135	END DO
[11057]	136	CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_tot, ztrdt )
	137	CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_tot, ztrds )
[9019]	138	IF( ln_linssh ) THEN ! linear sea surface height only
[8698]	139	! Store now fields before applying the Asselin filter
	140	! in order to calculate Asselin filter trend later.
[11057]	141	ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kmm)
	142	ztrds(:,:,:) = pts(:,:,:,jp_sal,Kmm)
[8698]	143	ENDIF
[1110]	144	ENDIF
	145
[11099]	146	IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping
	147	!
[9019]	148	IF (l_trdtra .AND. .NOT. ln_linssh ) THEN ! Zero Asselin filter contribution must be explicitly written out since for vvl
[11057]	149	! ! Asselin filter is output by tra_atf_vvl that is not called on this time step
[8698]	150	ztrdt(:,:,:) = 0._wp
	151	ztrds(:,:,:) = 0._wp
[11057]	152	CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_atf, ztrdt )
	153	CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_atf, ztrds )
[8698]	154	END IF
[6140]	155	!
[2528]	156	ELSE ! Leap-Frog + Asselin filter time stepping
	157	!
[11057]	158	IF( ln_linssh ) THEN ; CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nit000, 'TRA', pts, jpts ) ! linear free surface
	159	ELSE ; CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nit000, rdt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface
[2528]	160	ENDIF
[6140]	161	!
[11057]	162	CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kbb) , 'T', 1., pts(:,:,:,jp_sal,Kbb) , 'T', 1., &
	163	& pts(:,:,:,jp_tem,Kmm) , 'T', 1., pts(:,:,:,jp_sal,Kmm) , 'T', 1., &
	164	& pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. )
[9094]	165	!
[5656]	166	ENDIF
[2715]	167	!
[8698]	168	IF( l_trdtra .AND. ln_linssh ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt
	169	zfact = 1._wp / r2dt
[1110]	170	DO jk = 1, jpkm1
[11099]	171	ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kmm) - ztrdt(:,:,jk) ) * zfact
	172	ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kmm) - ztrds(:,:,jk) ) * zfact
[1110]	173	END DO
[11057]	174	CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_atf, ztrdt )
	175	CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_atf, ztrds )
[1438]	176	END IF
[9019]	177	IF( l_trdtra ) DEALLOCATE( ztrdt , ztrds )
[2715]	178	!
[1438]	179	! ! control print
[12236]	180	IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kmm), clinfo1=' nxt - Tn: ', mask1=tmask, &
	181	& tab3d_2=pts(:,:,:,jp_sal,Kmm), clinfo2= ' Sn: ', mask2=tmask )
[1438]	182	!
[11057]	183	IF( ln_timing ) CALL timing_stop('tra_atf')
[3294]	184	!
[11057]	185	END SUBROUTINE tra_atf
[1438]	186
	187
[11099]	188	SUBROUTINE tra_atf_fix( kt, Kbb, Kmm, Kaa, kit000, cdtype, pt, kjpt )
[1438]	189	!!----------------------------------------------------------------------
[11057]	190	!! * ROUTINE tra_atf_fix *
[1438]	191	!!
[11475]	192	!! ** Purpose : fixed volume: apply the Asselin time filter to the "now" field
[1438]	193	!!
	194	!! ** Method : - Apply a Asselin time filter on now fields.
	195	!!
[11475]	196	!! ** Action : - pt(Kmm) ready for the next time step
[1438]	197	!!----------------------------------------------------------------------
[11057]	198	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	199	INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! time level indices
	200	INTEGER , INTENT(in ) :: kit000 ! first time step index
	201	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	202	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	203	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
[2715]	204	!
[2528]	205	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	206	REAL(wp) :: ztn, ztd ! local scalars
[1438]	207	!!----------------------------------------------------------------------
[6140]	208	!
[3294]	209	IF( kt == kit000 ) THEN
[1438]	210	IF(lwp) WRITE(numout,*)
[11475]	211	IF(lwp) WRITE(numout,*) 'tra_atf_fix : time filtering', cdtype
[1438]	212	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	213	ENDIF
	214	!
[2528]	215	DO jn = 1, kjpt
[1438]	216	!
[12340]	217	DO_3D_00_00( 1, jpkm1 )
	218	ztn = pt(ji,jj,jk,jn,Kmm)
	219	ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb) ! time laplacian on tracers
	220	!
	221	pt(ji,jj,jk,jn,Kmm) = ztn + atfp * ztd ! pt <-- filtered pt
	222	END_3D
[1110]	223	!
[2528]	224	END DO
[1438]	225	!
[11057]	226	END SUBROUTINE tra_atf_fix
[3]	227
[1110]	228
[11057]	229	SUBROUTINE tra_atf_vvl( kt, Kbb, Kmm, Kaa, kit000, p2dt, cdtype, pt, psbc_tc, psbc_tc_b, kjpt )
[1438]	230	!!----------------------------------------------------------------------
[11057]	231	!! * ROUTINE tra_atf_vvl *
[1438]	232	!!
	233	!! ** Purpose : Time varying volume: apply the Asselin time filter
	234	!!
	235	!! ** Method : - Apply a thickness weighted Asselin time filter on now fields.
[11475]	236	!! pt(Kmm) = ( e3t(Kmm)pt(Kmm) + atfp[ e3t(Kbb)pt(Kbb) - 2 e3t(Kmm)pt(Kmm) + e3t_a*pt(Kaa) ] )
	237	!! /( e3t(Kmm) + atfp*[ e3t(Kbb) - 2 e3t(Kmm) + e3t(Kaa) ] )
[1438]	238	!!
[11475]	239	!! ** Action : - pt(Kmm) ready for the next time step
[1438]	240	!!----------------------------------------------------------------------
[11057]	241	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	242	INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! time level indices
	243	INTEGER , INTENT(in ) :: kit000 ! first time step index
	244	REAL(wp) , INTENT(in ) :: p2dt ! time-step
	245	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	246	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	247	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
	248	REAL(wp), DIMENSION(jpi,jpj ,kjpt) , INTENT(in ) :: psbc_tc ! surface tracer content
	249	REAL(wp), DIMENSION(jpi,jpj ,kjpt) , INTENT(in ) :: psbc_tc_b ! before surface tracer content
[6140]	250	!
[5930]	251	LOGICAL :: ll_traqsr, ll_rnf, ll_isf ! local logical
[2528]	252	INTEGER :: ji, jj, jk, jn ! dummy loop indices
[8698]	253	REAL(wp) :: zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar
[2715]	254	REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - -
[9019]	255	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrd_atf
[1438]	256	!!----------------------------------------------------------------------
[3294]	257	!
	258	IF( kt == kit000 ) THEN
[1438]	259	IF(lwp) WRITE(numout,*)
[11475]	260	IF(lwp) WRITE(numout,*) 'tra_atf_vvl : time filtering', cdtype
[1438]	261	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	262	ENDIF
[2528]	263	!
	264	IF( cdtype == 'TRA' ) THEN
	265	ll_traqsr = ln_traqsr ! active tracers case and solar penetration
[5467]	266	ll_rnf = ln_rnf ! active tracers case and river runoffs
[6140]	267	ll_isf = ln_isf ! active tracers case and ice shelf melting
	268	ELSE ! passive tracers case
	269	ll_traqsr = .FALSE. ! NO solar penetration
	270	ll_rnf = .FALSE. ! NO river runoffs ???? !!gm BUG ?
	271	ll_isf = .FALSE. ! NO ice shelf melting/freezing !!gm BUG ??
[2528]	272	ENDIF
	273	!
[9019]	274	IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) ) THEN
	275	ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) )
[8698]	276	ztrd_atf(:,:,:,:) = 0.0_wp
	277	ENDIF
[10095]	278	zfact = 1._wp / p2dt
[9019]	279	zfact1 = atfp * p2dt
	280	zfact2 = zfact1 * r1_rau0
[2528]	281	DO jn = 1, kjpt
[12340]	282	DO_3D_00_00( 1, jpkm1 )
	283	ze3t_b = e3t(ji,jj,jk,Kbb)
	284	ze3t_n = e3t(ji,jj,jk,Kmm)
	285	ze3t_a = e3t(ji,jj,jk,Kaa)
	286	! ! tracer content at Before, now and after
	287	ztc_b = pt(ji,jj,jk,jn,Kbb) * ze3t_b
	288	ztc_n = pt(ji,jj,jk,jn,Kmm) * ze3t_n
	289	ztc_a = pt(ji,jj,jk,jn,Kaa) * ze3t_a
	290	!
	291	ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
	292	ztc_d = ztc_a - 2. * ztc_n + ztc_b
	293	!
	294	ze3t_f = ze3t_n + atfp * ze3t_d
	295	ztc_f = ztc_n + atfp * ztc_d
	296	!
	297	IF( jk == mikt(ji,jj) ) THEN ! first level
	298	ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) )
	299	ztc_f = ztc_f - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
	300	ENDIF
	301	IF( ln_rnf_depth ) THEN
	302	! Rivers are not just at the surface must go down to nk_rnf(ji,jj)
	303	IF( jk <= nk_rnf(ji,jj) ) THEN
	304	ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj) ) ) &
	305	& * ( e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj) )
	306	ENDIF
	307	ELSE
	308	IF( jk == 1 ) THEN ! first level
	309	ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj) ) )
	310	ENDIF
	311	ENDIF
	312	!
	313	!
	314	! solar penetration (temperature only)
	315	IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) &
	316	& ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )
	317	!
	318	!
	319	IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) &
	320	& ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &
	321	& * e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj)
[12156]	322
[12340]	323	!
	324	! ice shelf
	325	IF( ll_isf ) THEN
	326	!
	327	! melt in the cavity
	328	IF ( ln_isfcav_mlt ) THEN
	329	! level fully include in the Losch_2008 ice shelf boundary layer
	330	IF ( jk >= misfkt_cav(ji,jj) .AND. jk < misfkb_cav(ji,jj) ) THEN
	331	ztc_f = ztc_f - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) ) &
	332	& * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj)
	333	ze3t_f = ze3t_f - zfact2 * ( fwfisf_cav_b(ji,jj) - fwfisf_cav(ji,jj) ) &
	334	& * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj)
	335	END IF
	336	! level partially include in Losch_2008 ice shelf boundary layer
	337	IF ( jk == misfkb_cav(ji,jj) ) THEN
	338	ztc_f = ztc_f - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) ) &
	339	& * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) * rfrac_tbl_cav(ji,jj)
	340	ze3t_f = ze3t_f - zfact2 * ( fwfisf_cav_b(ji,jj) - fwfisf_cav(ji,jj) ) &
	341	& * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) * rfrac_tbl_cav(ji,jj)
	342	END IF
	343	END IF
	344	!
	345	! parametrised melt (cavity closed)
	346	IF ( ln_isfpar_mlt ) THEN
	347	! level fully include in the Losch_2008 ice shelf boundary layer
	348	IF ( jk >= misfkt_par(ji,jj) .AND. jk < misfkb_par(ji,jj) ) THEN
	349	ztc_f = ztc_f - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) ) &
	350	& * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj)
	351	ze3t_f = ze3t_f - zfact2 * ( fwfisf_par_b(ji,jj) - fwfisf_par(ji,jj) ) &
	352	& * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj)
	353	END IF
	354	! level partially include in Losch_2008 ice shelf boundary layer
	355	IF ( jk == misfkb_par(ji,jj) ) THEN
	356	ztc_f = ztc_f - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) ) &
	357	& * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) * rfrac_tbl_par(ji,jj)
	358	ze3t_f = ze3t_f - zfact2 * ( fwfisf_par_b(ji,jj) - fwfisf_par(ji,jj) ) &
	359	& * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) * rfrac_tbl_par(ji,jj)
	360	END IF
	361	END IF
	362	!
	363	! ice sheet coupling correction
	364	IF ( ln_isfcpl ) THEN
[12156]	365	!
[12340]	366	! at kt = nit000, risfcpl_vol_n = 0 and risfcpl_vol_b = risfcpl_vol so contribution nul
	367	IF ( ln_rstart .AND. kt == nit000+1 ) THEN
	368	ztc_f = ztc_f + zfact1 * risfcpl_tsc(ji,jj,jk,jn) * r1_e1e2t(ji,jj)
	369	ze3t_f = ze3t_f - zfact1 * risfcpl_vol(ji,jj,jk ) * r1_e1e2t(ji,jj)
[5643]	370	END IF
[6140]	371	!
[12340]	372	END IF
	373	!
	374	END IF
	375	!
	376	ze3t_f = 1.e0 / ze3t_f
	377	pt(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f ! time filtered "now" field
	378	!
	379	IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
	380	ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n
	381	ENDIF
	382	!
	383	END_3D
[2528]	384	!
	385	END DO
[503]	386	!
[9019]	387	IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) ) THEN
	388	IF( l_trdtra .AND. cdtype == 'TRA' ) THEN
[11057]	389	CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) )
	390	CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) )
[9019]	391	ENDIF
	392	IF( l_trdtrc .AND. cdtype == 'TRC' ) THEN
	393	DO jn = 1, kjpt
[11057]	394	CALL trd_tra( kt, Kmm, Kaa, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) )
[9019]	395	END DO
	396	ENDIF
	397	DEALLOCATE( ztrd_atf )
[8698]	398	ENDIF
	399	!
[11057]	400	END SUBROUTINE tra_atf_vvl
[3]	401
	402	!!======================================================================
[11057]	403	END MODULE traatf

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

Download in other formats: