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_qco.F90 in NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traatf_qco.F90 @ 14644

Last change on this file since 14644 was 14644, checked in by sparonuz, 3 years ago
Merge trunk -r14642:HEAD
Property svn:keywords set to `Id`
File size: 19.1 KB

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

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

Download in other formats: