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.

trcsub.F90 in branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/TOP_SRC – NEMO

Context Navigation

source: branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/TOP_SRC/trcsub.F90 @ 4317

Last change on this file since 4317 was 4306, checked in by cetlod, 10 years ago
dev_MERGE_2013 : merge in the solar mean flux branch from MERCATOR, see ticket #1187
File size: 51.1 KB

Line
1	MODULE trcsub
2	!!======================================================================
3	!! * MODULE trcsubstp *
4	!!TOP : Averages physics variables for TOP substepping.
5	!!======================================================================
6	!! History : 1.0 ! 2011-10 (K. Edwards) Original
7	!!----------------------------------------------------------------------
8	#if defined key_top
9	!!----------------------------------------------------------------------
10	!! trc_sub : passive tracer system sub-stepping
11	!!----------------------------------------------------------------------
12	USE oce_trc ! ocean dynamics and active tracers variables
13	USE trc
14	USE prtctl_trc ! Print control for debbuging
15	USE iom
16	USE in_out_manager
17	USE lbclnk
18	#if defined key_zdftke
19	USE zdftke ! twice TKE (en)
20	#endif
21	#if defined key_zdfgls
22	USE zdfgls, ONLY: en
23	#endif
24	USE trabbl
25	USE zdf_oce
26	USE domvvl
27	USE divcur ! hor. divergence and curl (div & cur routines)
28	USE sbcrnf, ONLY: h_rnf, nk_rnf ! River runoff
29	USE bdy_oce
30	#if defined key_obc
31	USE obc_oce, ONLY: obctmsk
32	#endif
33	#if defined key_agrif
34	USE agrif_opa_update
35	USE agrif_opa_interp
36	#endif
37
38	IMPLICIT NONE
39
40	PUBLIC trc_sub_stp ! called by trc_stp
41	PUBLIC trc_sub_ini ! called by trc_ini to initialize substepping arrays.
42	PUBLIC trc_sub_reset ! called by trc_stp to reset physics variables
43	PUBLIC trc_sub_ssh ! called by trc_stp to reset physics variables
44
45	!!* Module variables
46	REAL(wp) :: r1_ndttrc ! 1 / nn_dttrc
47	REAL(wp) :: r1_ndttrcp1 ! 1 / (nn_dttrc+1)
48
49	!!* Substitution
50	# include "top_substitute.h90"
51	!!----------------------------------------------------------------------
52	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
53	!! $Id: trcstp.F90 2528 2010-12-27 17:33:53Z rblod $
54	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
55	!!----------------------------------------------------------------------
56	CONTAINS
57
58	SUBROUTINE trc_sub_stp( kt )
59	!!-------------------------------------------------------------------
60	!! * ROUTINE trc_stp *
61	!!
62	!! ** Purpose : Average variables needed for sub-stepping passive tracers
63	!!
64	!! ** Method : Called every timestep to increment _tm (time mean) variables
65	!! on TOP steps, calculate averages.
66	!!-------------------------------------------------------------------
67	INTEGER, INTENT( in ) :: kt ! ocean time-step index
68	INTEGER :: ji,jj,jk ! dummy loop indices
69	REAL(wp) :: z1_ne3t, z1_ne3u, z1_ne3v, z1_ne3w
70	!!-------------------------------------------------------------------
71	!
72	IF( nn_timing == 1 ) CALL timing_start('trc_sub_stp')
73	!
74	IF( kt == nit000 ) THEN
75	IF(lwp) WRITE(numout,*)
76	IF(lwp) WRITE(numout,*) 'trc_sub_stp : substepping of the passive tracers'
77	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
78	!
79	sshb_hold (:,:) = sshn (:,:)
80	!!Z~ sshu_b_hold(:,:) = sshu_n(:,:)
81	!!Z~ sshv_b_hold(:,:) = sshv_n(:,:)
82	emp_b_hold (:,:) = emp_b (:,:)
83	!
84	r1_ndttrc = 1._wp / REAL( nn_dttrc , wp )
85	r1_ndttrcp1 = 1._wp / REAL( nn_dttrc + 1, wp )
86	!
87	ENDIF
88
89	IF( MOD( kt , nn_dttrc ) /= 0 ) THEN
90	!
91	un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * fse3u(:,:,:)
92	vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * fse3v(:,:,:)
93	tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * fse3t(:,:,:)
94	tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * fse3t(:,:,:)
95	rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * fse3t(:,:,:)
96	avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * fse3w(:,:,:)
97	# if defined key_zdfddm
98	avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:)
99	# endif
100	#if defined key_ldfslp
101	wslpi_tm(:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:) * fse3w(:,:,:)
102	wslpj_tm(:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:) * fse3w(:,:,:)
103	uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:) * fse3u(:,:,:)
104	vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:) * fse3v(:,:,:)
105	#endif
106	# if defined key_trabbl
107	IF( nn_bbl_ldf == 1 ) THEN
108	ahu_bbl_tm(:,:) = ahu_bbl_tm(:,:) + ahu_bbl(:,:)
109	ahv_bbl_tm(:,:) = ahv_bbl_tm(:,:) + ahv_bbl(:,:)
110	ENDIF
111	IF( nn_bbl_adv == 1 ) THEN
112	utr_bbl_tm(:,:) = utr_bbl_tm(:,:) + utr_bbl(:,:)
113	vtr_bbl_tm(:,:) = vtr_bbl_tm(:,:) + vtr_bbl(:,:)
114	ENDIF
115	# endif
116	!
117	sshn_tm (:,:) = sshn_tm (:,:) + sshn (:,:)
118	!!Z~ sshu_n_tm(:,:) = sshu_n_tm(:,:) + sshu_n(:,:)
119	!!Z~ sshv_n_tm(:,:) = sshv_n_tm(:,:) + sshv_n(:,:)
120	rnf_tm (:,:) = rnf_tm (:,:) + rnf (:,:)
121	h_rnf_tm (:,:) = h_rnf_tm (:,:) + h_rnf (:,:)
122	hmld_tm (:,:) = hmld_tm (:,:) + hmld (:,:)
123	fr_i_tm (:,:) = fr_i_tm (:,:) + fr_i (:,:)
124	emp_tm (:,:) = emp_tm (:,:) + emp (:,:)
125	fmmflx_tm(:,:) = fmmflx_tm(:,:) + fmmflx(:,:)
126	qsr_tm (:,:) = qsr_tm (:,:) + qsr (:,:)
127	wndm_tm (:,:) = wndm_tm (:,:) + wndm (:,:)
128	!
129	#if defined key_traldf_c3d
130	ahtt_tm (:,:,:) = ahtt_tm (:,:,:) + ahtt(:,:,:) * fse3t(:,:,:)
131	ahtu_tm (:,:,:) = ahtu_tm (:,:,:) + ahtu(:,:,:) * fse3u(:,:,:)
132	ahtv_tm (:,:,:) = ahtv_tm (:,:,:) + ahtv(:,:,:) * fse3v(:,:,:)
133	ahtw_tm (:,:,:) = ahtw_tm (:,:,:) + ahtw(:,:,:) * fse3w(:,:,:)
134	#elif defined key_traldf_c2d
135	ahtt_tm (:,:) = ahtt_tm (:,:) + ahtt(:,:)
136	ahtu_tm (:,:) = ahtu_tm (:,:) + ahtu(:,:)
137	ahtv_tm (:,:) = ahtv_tm (:,:) + ahtv(:,:)
138	ahtw_tm (:,:) = ahtw_tm (:,:) + ahtw(:,:)
139	#elif defined key_traldf_c1d
140	ahtt_tm (:) = ahtt_tm (:,:) + ahtt(:)
141	ahtu_tm (:) = ahtu_tm (:,:) + ahtu(:)
142	ahtv_tm (:) = ahtv_tm (:,:) + ahtv(:)
143	ahtw_tm (:) = ahtw_tm (:,:) + ahtw(:)
144	#else
145	ahtt_tm = ahtt_tm + ahtt
146	ahtu_tm = ahtu_tm + ahtu
147	ahtv_tm = ahtv_tm + ahtv
148	ahtw_tm = ahtw_tm + ahtw
149	#endif
150	#if defined key_traldf_eiv
151	# if defined key_traldf_c3d
152	aeiu_tm (:,:,:) = aeiu_tm (:,:,:) + aeiu(:,:,:) * fse3u(:,:,:)
153	aeiv_tm (:,:,:) = aeiv_tm (:,:,:) + aeiv(:,:,:) * fse3v(:,:,:)
154	aeiw_tm (:,:,:) = aeiw_tm (:,:,:) + aeiw(:,:,:) * fse3w(:,:,:)
155	# elif defined key_traldf_c2d
156	aeiu_tm (:,:) = aeiu_tm (:,:) + aeiu(:,:)
157	aeiv_tm (:,:) = aeiv_tm (:,:) + aeiv(:,:)
158	aeiw_tm (:,:) = aeiw_tm (:,:) + aeiw(:,:)
159	# elif defined key_traldf_c1d
160	aeiu_tm (:) = aeiu_tm (:,:) + aeiu(:)
161	aeiv_tm (:) = aeiv_tm (:,:) + aeiv(:)
162	aeiw_tm (:) = aeiw_tm (:,:) + aeiw(:)
163	# else
164	aeiu_tm = aeiu_tm + aeiu
165	aeiv_tm = aeiv_tm + aeiv
166	aeiw_tm = aeiw_tm + aeiw
167	# endif
168	#endif
169
170	ELSE ! It is time to substep
171	! 1. set temporary arrays to hold physics variables
172	un_temp (:,:,:) = un (:,:,:)
173	vn_temp (:,:,:) = vn (:,:,:)
174	wn_temp (:,:,:) = wn (:,:,:)
175	tsn_temp (:,:,:,:) = tsn (:,:,:,:)
176	rhop_temp (:,:,:) = rhop (:,:,:)
177	avt_temp (:,:,:) = avt (:,:,:)
178	# if defined key_zdfddm
179	avs_temp (:,:,:) = avs (:,:,:)
180	# endif
181	#if defined key_ldfslp
182	wslpi_temp (:,:,:) = wslpi (:,:,:)
183	wslpj_temp (:,:,:) = wslpj (:,:,:)
184	uslp_temp (:,:,:) = uslp (:,:,:)
185	vslp_temp (:,:,:) = vslp (:,:,:)
186	#endif
187	# if defined key_trabbl
188	IF( nn_bbl_ldf == 1 ) THEN
189	ahu_bbl_temp(:,:) = ahu_bbl(:,:)
190	ahv_bbl_temp(:,:) = ahv_bbl(:,:)
191	ENDIF
192	IF( nn_bbl_adv == 1 ) THEN
193	utr_bbl_temp(:,:) = utr_bbl(:,:)
194	vtr_bbl_temp(:,:) = vtr_bbl(:,:)
195	ENDIF
196	# endif
197	sshn_temp (:,:) = sshn (:,:)
198	!!Z~ sshu_n_temp(:,:) = sshu_n(:,:)
199	!!Z~ sshv_n_temp(:,:) = sshv_n(:,:)
200	!!Z~ sshf_n_temp(:,:) = sshf_n(:,:)
201	sshb_temp (:,:) = sshb (:,:)
202	!!Z~ sshu_b_temp(:,:) = sshu_b(:,:)
203	!!Z~ sshv_b_temp(:,:) = sshv_b(:,:)
204	ssha_temp (:,:) = ssha (:,:)
205	!!Z~ sshu_a_temp(:,:) = sshu_a(:,:)
206	!!Z~ sshv_a_temp(:,:) = sshv_a(:,:)
207	rnf_temp (:,:) = rnf (:,:)
208	h_rnf_temp (:,:) = h_rnf (:,:)
209	hmld_temp (:,:) = hmld (:,:)
210	fr_i_temp (:,:) = fr_i (:,:)
211	emp_temp (:,:) = emp (:,:)
212	emp_b_temp (:,:) = emp_b (:,:)
213	fmmflx_temp(:,:) = fmmflx(:,:)
214	qsr_temp (:,:) = qsr (:,:)
215	wndm_temp (:,:) = wndm (:,:)
216	#if defined key_traldf_c3d
217	ahtu_temp (:,:,:) = ahtu (:,:,:)
218	ahtv_temp (:,:,:) = ahtv (:,:,:)
219	ahtw_temp (:,:,:) = ahtw (:,:,:)
220	ahtt_temp (:,:,:) = ahtt (:,:,:)
221	#elif defined key_traldf_c2d
222	ahtu_temp (:,:) = ahtu (:,:)
223	ahtv_temp (:,:) = ahtv (:,:)
224	ahtw_temp (:,:) = ahtw (:,:)
225	ahtt_temp (:,:) = ahtt (:,:)
226	#elif defined key_traldf_c1d
227	ahtu_temp (:) = ahtu (:)
228	ahtv_temp (:) = ahtv (:)
229	ahtw_temp (:) = ahtw (:)
230	ahtt_temp (:) = ahtt (:)
231	#else
232	ahtu_temp = ahtu
233	ahtv_temp = ahtv
234	ahtw_temp = ahtw
235	ahtt_temp = ahtt
236	#endif
237
238	#if defined key_traldf_eiv
239	# if defined key_traldf_c3d
240	aeiu_temp (:,:,:) = aeiu(:,:,:)
241	aeiv_temp (:,:,:) = aeiv(:,:,:)
242	aeiw_temp (:,:,:) = aeiw(:,:,:)
243	# elif defined key_traldf_c2d
244	aeiu_temp (:,:) = aeiu(:,:)
245	aeiv_temp (:,:) = aeiv(:,:)
246	aeiw_temp (:,:) = aeiw(:,:)
247	# elif defined key_traldf_c1d
248	aeiu_temp (:) = aeiu(:)
249	aeiv_temp (:) = aeiv(:)
250	aeiw_temp (:) = aeiw(:)
251	# else
252	aeiu_temp = aeiu
253	aeiv_temp = aeiv
254	aeiw_temp = aeiw
255	# endif
256	#endif
257	! ! Variables reset in trc_sub_ssh
258	rotn_temp (:,:,:) = rotn (:,:,:)
259	hdivn_temp (:,:,:) = hdivn (:,:,:)
260	rotb_temp (:,:,:) = rotb (:,:,:)
261	hdivb_temp (:,:,:) = hdivb (:,:,:)
262	hu_temp (:,:) = hu (:,:)
263	hv_temp (:,:) = hv (:,:)
264	hur_temp (:,:) = hur (:,:)
265	hvr_temp (:,:) = hvr (:,:)
266	!
267	DO jk = 1, jpk
268	e3t_temp(:,:,jk) = fse3t(:,:,jk)
269	e3u_temp(:,:,jk) = fse3u(:,:,jk)
270	e3v_temp(:,:,jk) = fse3v(:,:,jk)
271	e3w_temp(:,:,jk) = fse3w(:,:,jk)
272	ENDDO
273	IF( lk_vvl ) THEN ! Update Now Vertical coord. ! (only in vvl case)
274	! !------------------------------!
275	DO jk = 1, jpk
276	fse3t (:,:,jk) = fse3t_n (:,:,jk) ! vertical scale factors stored in fse3. arrays
277	fse3u (:,:,jk) = fse3u_n (:,:,jk)
278	fse3v (:,:,jk) = fse3v_n (:,:,jk)
279	fse3w (:,:,jk) = fse3w_n (:,:,jk)
280	END DO
281	ENDIF
282
283	! 2. Create averages and reassign variables
284	un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * e3u_temp(:,:,:)
285	vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * e3v_temp(:,:,:)
286	tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * e3t_temp(:,:,:)
287	tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * e3t_temp(:,:,:)
288	rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * e3t_temp(:,:,:)
289	avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * e3w_temp(:,:,:)
290	# if defined key_zdfddm
291	avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * e3w_temp(:,:,:)
292	# endif
293	#if defined key_ldfslp
294	wslpi_tm (:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:) * e3w_temp(:,:,:)
295	wslpj_tm (:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:) * e3w_temp(:,:,:)
296	uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:) * e3u_temp(:,:,:)
297	vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:) * e3v_temp(:,:,:)
298	#endif
299	# if defined key_trabbl
300	IF( nn_bbl_ldf == 1 ) THEN
301	ahu_bbl_tm(:,:) = ahu_bbl_tm(:,:) + ahu_bbl(:,:)
302	ahv_bbl_tm(:,:) = ahv_bbl_tm(:,:) + ahv_bbl(:,:)
303	ENDIF
304	IF( nn_bbl_adv == 1 ) THEN
305	utr_bbl_tm(:,:) = utr_bbl_tm(:,:) + utr_bbl(:,:)
306	vtr_bbl_tm(:,:) = vtr_bbl_tm(:,:) + vtr_bbl(:,:)
307	ENDIF
308	# endif
309	sshn_tm (:,:) = sshn_tm (:,:) + sshn (:,:)
310	!!Z~ sshu_n_tm(:,:) = sshu_n_tm (:,:) + sshu_n(:,:)
311	!!Z~ sshv_n_tm(:,:) = sshv_n_tm (:,:) + sshv_n(:,:)
312	rnf_tm (:,:) = rnf_tm (:,:) + rnf (:,:)
313	h_rnf_tm (:,:) = h_rnf_tm (:,:) + h_rnf (:,:)
314	hmld_tm (:,:) = hmld_tm (:,:) + hmld (:,:)
315	fr_i_tm (:,:) = fr_i_tm (:,:) + fr_i (:,:)
316	emp_tm (:,:) = emp_tm (:,:) + emp (:,:)
317	fmmflx_tm(:,:) = fmmflx_tm (:,:) + fmmflx(:,:)
318	qsr_tm (:,:) = qsr_tm (:,:) + qsr (:,:)
319	wndm_tm (:,:) = wndm_tm (:,:) + wndm (:,:)
320	!
321	sshn (:,:) = sshn_tm (:,:) * r1_ndttrcp1
322	!!Z~ sshu_n (:,:) = sshu_n_tm (:,:) * r1_ndttrcp1
323	!!Z~ sshv_n (:,:) = sshv_n_tm (:,:) * r1_ndttrcp1
324	sshb (:,:) = sshb_hold (:,:)
325	!!Z~ sshu_b (:,:) = sshu_b_hold(:,:)
326	!!Z~ sshv_b (:,:) = sshv_b_hold(:,:)
327	rnf (:,:) = rnf_tm (:,:) * r1_ndttrcp1
328	h_rnf (:,:) = h_rnf_tm (:,:) * r1_ndttrcp1
329	hmld (:,:) = hmld_tm (:,:) * r1_ndttrcp1
330	! variables that are initialized after averages initialized
331	emp_b (:,:) = emp_b_hold (:,:)
332	IF( kt == nittrc000 ) THEN
333	wndm (:,:) = wndm_tm (:,:) * r1_ndttrc
334	qsr (:,:) = qsr_tm (:,:) * r1_ndttrc
335	emp (:,:) = emp_tm (:,:) * r1_ndttrc
336	fmmflx(:,:) = fmmflx_tm (:,:) * r1_ndttrc
337	fr_i (:,:) = fr_i_tm (:,:) * r1_ndttrc
338	# if defined key_trabbl
339	IF( nn_bbl_ldf == 1 ) THEN
340	ahu_bbl(:,:) = ahu_bbl_tm (:,:) * r1_ndttrc
341	ahv_bbl(:,:) = ahv_bbl_tm (:,:) * r1_ndttrc
342	ENDIF
343	IF( nn_bbl_adv == 1 ) THEN
344	utr_bbl(:,:) = utr_bbl_tm (:,:) * r1_ndttrc
345	vtr_bbl(:,:) = vtr_bbl_tm (:,:) * r1_ndttrc
346	ENDIF
347	# endif
348	ELSE
349	wndm (:,:) = wndm_tm (:,:) * r1_ndttrcp1
350	qsr (:,:) = qsr_tm (:,:) * r1_ndttrcp1
351	emp (:,:) = emp_tm (:,:) * r1_ndttrcp1
352	fmmflx(:,:) = fmmflx_tm (:,:) * r1_ndttrcp1
353	fr_i (:,:) = fr_i_tm (:,:) * r1_ndttrcp1
354	# if defined key_trabbl
355	IF( nn_bbl_ldf == 1 ) THEN
356	ahu_bbl(:,:) = ahu_bbl_tm (:,:) * r1_ndttrcp1
357	ahv_bbl(:,:) = ahv_bbl_tm (:,:) * r1_ndttrcp1
358	ENDIF
359	IF( nn_bbl_adv == 1 ) THEN
360	utr_bbl(:,:) = utr_bbl_tm (:,:) * r1_ndttrcp1
361	vtr_bbl(:,:) = vtr_bbl_tm (:,:) * r1_ndttrcp1
362	ENDIF
363	# endif
364	ENDIF
365	!
366	DO jk = 1, jpk
367	DO jj = 1, jpj
368	DO ji = 1, jpi
369	z1_ne3t = r1_ndttrcp1 / fse3t(ji,jj,jk)
370	z1_ne3u = r1_ndttrcp1 / fse3u(ji,jj,jk)
371	z1_ne3v = r1_ndttrcp1 / fse3v(ji,jj,jk)
372	z1_ne3w = r1_ndttrcp1 / fse3w(ji,jj,jk)
373	!
374	un (ji,jj,jk) = un_tm (ji,jj,jk) * z1_ne3u
375	vn (ji,jj,jk) = vn_tm (ji,jj,jk) * z1_ne3v
376	tsn (ji,jj,jk,jp_tem) = tsn_tm (ji,jj,jk,jp_tem) * z1_ne3t
377	tsn (ji,jj,jk,jp_sal) = tsn_tm (ji,jj,jk,jp_sal) * z1_ne3t
378	rhop (ji,jj,jk) = rhop_tm (ji,jj,jk) * z1_ne3t
379	avt (ji,jj,jk) = avt_tm (ji,jj,jk) * z1_ne3w
380	# if defined key_zdfddm
381	avs (ji,jj,jk) = avs_tm (ji,jj,jk) * z1_ne3w
382	# endif
383	#if defined key_ldfslp
384	wslpi(ji,jj,jk) = wslpi_tm(ji,jj,jk) * z1_ne3w
385	wslpj(ji,jj,jk) = wslpj_tm(ji,jj,jk) * z1_ne3w
386	uslp (ji,jj,jk) = uslp_tm (ji,jj,jk) * z1_ne3u
387	vslp (ji,jj,jk) = vslp_tm (ji,jj,jk) * z1_ne3v
388	#endif
389	ENDDO
390	ENDDO
391	ENDDO
392
393	#if defined key_traldf_c3d
394	ahtt_tm (:,:,:) = ahtt_tm (:,:,:) + ahtt(:,:,:) * e3t_temp(:,:,:)
395	ahtu_tm (:,:,:) = ahtu_tm (:,:,:) + ahtu(:,:,:) * e3u_temp(:,:,:)
396	ahtv_tm (:,:,:) = ahtv_tm (:,:,:) + ahtv(:,:,:) * e3v_temp(:,:,:)
397	ahtw_tm (:,:,:) = ahtw_tm (:,:,:) + ahtw(:,:,:) * e3w_temp(:,:,:)
398	!
399	ahtt (:,:,:) = ahtt_tm (:,:,:) * r1_ndttrcp1 / fse3t(:,:,:)
400	ahtu (:,:,:) = ahtu_tm (:,:,:) * r1_ndttrcp1 / fse3u(:,:,:)
401	ahtv (:,:,:) = ahtv_tm (:,:,:) * r1_ndttrcp1 / fse3v(:,:,:)
402	ahtw (:,:,:) = ahtw_tm (:,:,:) * r1_ndttrcp1 / fse3w(:,:,:)
403	#elif defined key_traldf_c2d
404	ahtt_tm (:,:) = ahtt_tm (:,:) + ahtt(:,:)
405	ahtu_tm (:,:) = ahtu_tm (:,:) + ahtu(:,:)
406	ahtv_tm (:,:) = ahtv_tm (:,:) + ahtv(:,:)
407	ahtw_tm (:,:) = ahtw_tm (:,:) + ahtw(:,:)
408	!
409	ahtt (:,:) = ahtt_tm (:,:) * r1_ndttrcp1
410	ahtu (:,:) = ahtu_tm (:,:) * r1_ndttrcp1
411	ahtv (:,:) = ahtv_tm (:,:) * r1_ndttrcp1
412	ahtw (:,:) = ahtw_tm (:,:) * r1_ndttrcp1
413	#elif defined key_traldf_c1d
414	ahtt_tm (:) = ahtt_tm (:,:) + ahtt(:)
415	ahtu_tm (:) = ahtu_tm (:,:) + ahtu(:)
416	ahtv_tm (:) = ahtv_tm (:,:) + ahtv(:)
417	ahtw_tm (:) = ahtw_tm (:,:) + ahtw(:)
418	!
419	ahtt (:) = ahtt_tm (:) * r1_ndttrcp1
420	ahtu (:) = ahtu_tm (:) * r1_ndttrcp1
421	ahtv (:) = ahtv_tm (:) * r1_ndttrcp1
422	ahtw (:) = ahtw_tm (:) * r1_ndttrcp1
423	#else
424	ahtt_tm = ahtt_tm + ahtt
425	ahtu_tm = ahtu_tm + ahtu
426	ahtv_tm = ahtv_tm + ahtv
427	ahtw_tm = ahtw_tm + ahtw
428	!
429	ahtt = ahtt_tm * r1_ndttrcp1
430	ahtu = ahtu_tm * r1_ndttrcp1
431	ahtv = ahtv_tm * r1_ndttrcp1
432	ahtw = ahtw_tm * r1_ndttrcp1
433	#endif
434
435	#if defined key_traldf_eiv
436	# if defined key_traldf_c3d
437	aeiu_tm (:,:,:) = aeiu_tm (:,:,:) + aeiu(:,:,:) * e3u_temp(:,:,:)
438	aeiv_tm (:,:,:) = aeiv_tm (:,:,:) + aeiv(:,:,:) * e3v_temp(:,:,:)
439	aeiw_tm (:,:,:) = aeiw_tm (:,:,:) + aeiw(:,:,:) * e3w_temp(:,:,:)
440	!
441	aeiu (:,:,:) = aeiu_tm (:,:,:) * r1_ndttrcp1 / fse3u(:,:,:)
442	aeiv (:,:,:) = aeiv_tm (:,:,:) * r1_ndttrcp1 / fse3v(:,:,:)
443	aeiw (:,:,:) = aeiw_tm (:,:,:) * r1_ndttrcp1 / fse3w(:,:,:)
444	# elif defined key_traldf_c2d
445	aeiu_tm (:,:) = aeiu_tm (:,:) + aeiu(:,:)
446	aeiv_tm (:,:) = aeiv_tm (:,:) + aeiv(:,:)
447	aeiw_tm (:,:) = aeiw_tm (:,:) + aeiw(:,:)
448	!
449	aeiu (:,:) = aeiu_tm (:,:) * r1_ndttrcp1
450	aeiv (:,:) = aeiv_tm (:,:) * r1_ndttrcp1
451	aeiw (:,:) = aeiw_tm (:,:) * r1_ndttrcp1
452	# elif defined key_traldf_c1d
453	aeiu_tm (:) = aeiu_tm (:,:) + aeiu(:)
454	aeiv_tm (:) = aeiv_tm (:,:) + aeiv(:)
455	aeiw_tm (:) = aeiw_tm (:,:) + aeiw(:)
456	!
457	aeiu (:) = aeiu_tm (:) * r1_ndttrcp1
458	aeiv (:) = aeiv_tm (:) * r1_ndttrcp1
459	aeiw (:) = aeiw_tm (:) * r1_ndttrcp1
460	# else
461	aeiu_tm = aeiu_tm + aeiu
462	aeiv_tm = aeiv_tm + aeiv
463	aeiw_tm = aeiw_tm + aeiw
464	!
465	aeiu = aeiu_tm * r1_ndttrcp1
466	aeiv = aeiv_tm * r1_ndttrcp1
467	aeiw = aeiw_tm * r1_ndttrcp1
468	# endif
469	#endif
470
471	CALL lbc_lnk( un (:,:,:) , 'U',-1. )
472	CALL lbc_lnk( vn (:,:,:) , 'V',-1. )
473	CALL lbc_lnk( tsn (:,:,:,jp_tem), 'T', 1. )
474	CALL lbc_lnk( tsn (:,:,:,jp_sal), 'T', 1. )
475	CALL lbc_lnk( rhop (:,:,:) , 'T', 1. )
476	CALL lbc_lnk( avt (:,:,:) , 'W', 1. )
477	# if defined key_zdfddm
478	CALL lbc_lnk( avs (:,:,:) , 'W', 1. )
479	# endif
480	#if defined key_ldfslp
481	CALL lbc_lnk( uslp (:,:,:) , 'U',-1. )
482	CALL lbc_lnk( vslp (:,:,:) , 'V',-1. )
483	CALL lbc_lnk( wslpi (:,:,:) , 'W',-1. )
484	CALL lbc_lnk( wslpj (:,:,:) , 'W',-1. )
485	#endif
486	CALL lbc_lnk( sshn (:,:) , 'T', 1. )
487	!!Z~ CALL lbc_lnk( sshu_n(:,:) , 'U', 1. )
488	!!Z~ CALL lbc_lnk( sshv_n(:,:) , 'V', 1. )
489	!!Z~ CALL lbc_lnk( sshf_n(:,:) , 'F', 1. )
490	CALL lbc_lnk( sshb (:,:) , 'T', 1. )
491	!!Z~ CALL lbc_lnk( sshu_b(:,:) , 'U', 1. )
492	!!Z~ CALL lbc_lnk( sshv_b(:,:) , 'V', 1. )
493	CALL lbc_lnk( ssha (:,:) , 'T', 1. )
494	!!Z~ CALL lbc_lnk( sshu_a(:,:) , 'U', 1. )
495	!!Z~ CALL lbc_lnk( sshv_a(:,:) , 'V', 1. )
496	CALL lbc_lnk( rnf (:,:) , 'T', 1. )
497	CALL lbc_lnk( h_rnf (:,:) , 'T', 1. )
498	CALL lbc_lnk( hmld (:,:) , 'T', 1. )
499	CALL lbc_lnk( fr_i (:,:) , 'T', 1. )
500	CALL lbc_lnk( emp (:,:) , 'T', 1. )
501	CALL lbc_lnk( emp_b (:,:) , 'T', 1. )
502	CALL lbc_lnk( fmmflx(:,:) , 'T', 1. )
503	CALL lbc_lnk( qsr (:,:) , 'T', 1. )
504	CALL lbc_lnk( wndm (:,:) , 'T', 1. )
505	# if defined key_trabbl
506	IF( nn_bbl_ldf == 1 ) THEN
507	CALL lbc_lnk( ahu_bbl(:,:) , 'U', 1. )
508	CALL lbc_lnk( ahv_bbl(:,:) , 'v', 1. )
509	ENDIF
510	IF( nn_bbl_adv == 1 ) THEN
511	CALL lbc_lnk( utr_bbl(:,:) , 'U', 1. )
512	CALL lbc_lnk( vtr_bbl(:,:) , 'U', 1. )
513	ENDIF
514	# endif
515	#if defined key_traldf_c3d
516	CALL lbc_lnk( ahtt (:,:,:) , 'T', 1. )
517	CALL lbc_lnk( ahtu (:,:,:) , 'U', 1. )
518	CALL lbc_lnk( ahtv (:,:,:) , 'V', 1. )
519	CALL lbc_lnk( ahtw (:,:,:) , 'W', 1. )
520	#elif defined key_traldf_c2d
521	CALL lbc_lnk( ahtt (:,:) , 'T', 1. )
522	CALL lbc_lnk( ahtu (:,:) , 'U', 1. )
523	CALL lbc_lnk( ahtv (:,:) , 'V', 1. )
524	CALL lbc_lnk( ahtw (:,:) , 'W', 1. )
525	#endif
526	#if defined key_traldf_eiv
527	#if defined key_traldf_c3d
528	CALL lbc_lnk( aeiu (:,:,:) , 'U', 1. )
529	CALL lbc_lnk( aeiv (:,:,:) , 'V', 1. )
530	CALL lbc_lnk( aeiw (:,:,:) , 'W', 1. )
531	#elif defined key_traldf_c2d
532	CALL lbc_lnk( aeiu (:,:) , 'U', 1. )
533	CALL lbc_lnk( aeiv (:,:) , 'V', 1. )
534	CALL lbc_lnk( aeiw (:,:) , 'W', 1. )
535	#endif
536	#endif
537	!
538	CALL trc_sub_ssh( kt ) ! after ssh & vertical velocity
539	!
540	CALL lbc_lnk( wn (:,:,:) , 'W',-1. )
541	CALL lbc_lnk( rotn (:,:,:) , 'F', 1. )
542	CALL lbc_lnk( hdivn (:,:,:) , 'T', 1. )
543	CALL lbc_lnk( rotb (:,:,:) , 'F', 1. )
544	CALL lbc_lnk( hdivb (:,:,:) , 'T', 1. )
545	CALL lbc_lnk( hu (:,:) , 'U', 1. )
546	CALL lbc_lnk( hv (:,:) , 'V', 1. )
547	CALL lbc_lnk( hur (:,:) , 'U', 1. )
548	CALL lbc_lnk( hvr (:,:) , 'V', 1. )
549	ENDIF
550	!
551	IF( nn_timing == 1 ) CALL timing_start('trc_sub_stp')
552	!
553	END SUBROUTINE trc_sub_stp
554
555	SUBROUTINE trc_sub_ini
556	!!-------------------------------------------------------------------
557	!! * ROUTINE trc_sub_ini *
558	!!
559	!! ** Purpose : Initialize variables needed for sub-stepping passive tracers
560	!!
561	!! ** Method :
562	!! Compute the averages for sub-stepping
563	!!-------------------------------------------------------------------
564	INTEGER :: ierr
565	!!-------------------------------------------------------------------
566	!
567	IF( nn_timing == 1 ) CALL timing_start('trc_sub_ini')
568	!
569	IF(lwp) WRITE(numout,*)
570	IF(lwp) WRITE(numout,*) 'trc_sub_ini : initial set up of the passive tracers substepping'
571	IF(lwp) WRITE(numout,*) '~~~~~~~'
572
573	ierr = trc_sub_alloc ()
574	IF( lk_mpp ) CALL mpp_sum( ierr )
575	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' )
576
577	un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:)
578	vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:)
579	tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:)
580	tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:)
581	rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:)
582	avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:)
583	# if defined key_zdfddm
584	avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:)
585	# endif
586	#if defined key_ldfslp
587	wslpi_tm(:,:,:) = wslpi(:,:,:) * fse3w(:,:,:)
588	wslpj_tm(:,:,:) = wslpj(:,:,:) * fse3w(:,:,:)
589	uslp_tm (:,:,:) = uslp (:,:,:) * fse3u(:,:,:)
590	vslp_tm (:,:,:) = vslp (:,:,:) * fse3v(:,:,:)
591	#endif
592	sshn_tm (:,:) = sshn (:,:)
593	!!Z~ sshu_n_tm(:,:) = sshu_n(:,:)
594	!!Z~ sshv_n_tm(:,:) = sshv_n(:,:)
595	rnf_tm (:,:) = rnf (:,:)
596	h_rnf_tm (:,:) = h_rnf (:,:)
597	hmld_tm (:,:) = hmld (:,:)
598
599	! Physics variables that are set after initialization:
600	fr_i_tm(:,:) = 0._wp
601	emp_tm (:,:) = 0._wp
602	fmmflx_tm(:,:) = 0._wp
603	qsr_tm (:,:) = 0._wp
604	wndm_tm(:,:) = 0._wp
605	# if defined key_trabbl
606	IF( nn_bbl_ldf == 1 ) THEN
607	ahu_bbl_tm(:,:) = 0._wp
608	ahv_bbl_tm(:,:) = 0._wp
609	ENDIF
610	IF( nn_bbl_adv == 1 ) THEN
611	utr_bbl_tm(:,:) = 0._wp
612	vtr_bbl_tm(:,:) = 0._wp
613	ENDIF
614	# endif
615	!
616	#if defined key_traldf_c3d
617	ahtt_tm(:,:,:) = ahtt(:,:,:) * fse3t(:,:,:)
618	ahtu_tm(:,:,:) = ahtu(:,:,:) * fse3u(:,:,:)
619	ahtv_tm(:,:,:) = ahtv(:,:,:) * fse3v(:,:,:)
620	ahtw_tm(:,:,:) = ahtw(:,:,:) * fse3w(:,:,:)
621	#elif defined key_traldf_c2d
622	ahtt_tm(:,:) = ahtt(:,:)
623	ahtu_tm(:,:) = ahtu(:,:)
624	ahtv_tm(:,:) = ahtv(:,:)
625	ahtw_tm(:,:) = ahtw(:,:)
626	#elif defined key_traldf_c1d
627	ahtt_tm(:) = ahtt(:)
628	ahtu_tm(:) = ahtu(:)
629	ahtv_tm(:) = ahtv(:)
630	ahtw_tm(:) = ahtw(:)
631	#else
632	ahtt_tm = ahtt
633	ahtu_tm = ahtu
634	ahtv_tm = ahtv
635	ahtw_tm = ahtw
636	#endif
637	!
638	#if defined key_traldf_eiv
639	# if defined key_traldf_c3d
640	aeiu_tm(:,:,:) = aeiu(:,:,:) * fse3u(:,:,:)
641	aeiv_tm(:,:,:) = aeiv(:,:,:) * fse3v(:,:,:)
642	aeiw_tm(:,:,:) = aeiw(:,:,:) * fse3w(:,:,:)
643	# elif defined key_traldf_c2d
644	aeiu_tm(:,:) = aeiu(:,:)
645	aeiv_tm(:,:) = aeiv(:,:)
646	aeiw_tm(:,:) = aeiw(:,:)
647	# elif defined key_traldf_c1d
648	aeiu_tm(:) = aeiu(:)
649	aeiv_tm(:) = aeiv(:)
650	aeiw_tm(:) = aeiw(:)
651	# else
652	aeiu_tm = aeiu
653	aeiv_tm = aeiv
654	aeiw_tm = aeiw
655	# endif
656	#endif
657	!
658	IF( nn_timing == 1 ) CALL timing_stop('trc_sub_ini')
659	!
660	END SUBROUTINE trc_sub_ini
661
662	SUBROUTINE trc_sub_reset( kt )
663	!!-------------------------------------------------------------------
664	!! * ROUTINE trc_sub_reset *
665	!!
666	!! ** Purpose : Reset physics variables averaged for substepping
667	!!
668	!! ** Method :
669	!! Compute the averages for sub-stepping
670	!!-------------------------------------------------------------------
671	INTEGER, INTENT( in ) :: kt ! ocean time-step index
672	INTEGER :: jk ! dummy loop indices
673	!!-------------------------------------------------------------------
674	!
675	IF( nn_timing == 1 ) CALL timing_start('trc_sub_reset')
676	!
677	! restore physics variables
678	un (:,:,:) = un_temp (:,:,:)
679	vn (:,:,:) = vn_temp (:,:,:)
680	wn (:,:,:) = wn_temp (:,:,:)
681	tsn (:,:,:,:) = tsn_temp (:,:,:,:)
682	rhop (:,:,:) = rhop_temp (:,:,:)
683	avt (:,:,:) = avt_temp (:,:,:)
684	# if defined key_zdfddm
685	avs (:,:,:) = avs_temp (:,:,:)
686	# endif
687	#if defined key_ldfslp
688	wslpi (:,:,:) = wslpi_temp (:,:,:)
689	wslpj (:,:,:) = wslpj_temp (:,:,:)
690	uslp (:,:,:) = uslp_temp (:,:,:)
691	vslp (:,:,:) = vslp_temp (:,:,:)
692	#endif
693	sshn (:,:) = sshn_temp (:,:)
694	sshb (:,:) = sshb_temp (:,:)
695	ssha (:,:) = ssha_temp (:,:)
696	!!Z~ sshu_n(:,:) = sshu_n_temp(:,:)
697	!!Z~ sshu_b(:,:) = sshu_b_temp(:,:)
698	!!Z~ sshu_a(:,:) = sshu_a_temp(:,:)
699	!!Z~ sshv_n(:,:) = sshv_n_temp(:,:)
700	!!Z~ sshv_b(:,:) = sshv_b_temp(:,:)
701	!!Z~ sshv_a(:,:) = sshv_a_temp(:,:)
702	!!Z~ sshf_n(:,:) = sshf_n_temp(:,:)
703	rnf (:,:) = rnf_temp (:,:)
704	h_rnf (:,:) = h_rnf_temp (:,:)
705	!
706	hmld (:,:) = hmld_temp (:,:)
707	fr_i (:,:) = fr_i_temp (:,:)
708	emp (:,:) = emp_temp (:,:)
709	fmmflx(:,:) = fmmflx_temp(:,:)
710	emp_b (:,:) = emp_b_temp (:,:)
711	qsr (:,:) = qsr_temp (:,:)
712	wndm (:,:) = wndm_temp (:,:)
713	# if defined key_trabbl
714	IF( nn_bbl_ldf == 1 ) THEN
715	ahu_bbl(:,:) = ahu_bbl_temp(:,:)
716	ahv_bbl(:,:) = ahv_bbl_temp(:,:)
717	ENDIF
718	IF( nn_bbl_adv == 1 ) THEN
719	utr_bbl(:,:) = utr_bbl_temp(:,:)
720	vtr_bbl(:,:) = vtr_bbl_temp(:,:)
721	ENDIF
722	# endif
723	!
724	#if defined key_traldf_c3d
725	ahtu (:,:,:) = ahtu_temp (:,:,:)
726	ahtv (:,:,:) = ahtv_temp (:,:,:)
727	ahtw (:,:,:) = ahtw_temp (:,:,:)
728	ahtt (:,:,:) = ahtt_temp (:,:,:)
729	#elif defined key_traldf_c2d
730	ahtu (:,:) = ahtu_temp (:,:)
731	ahtv (:,:) = ahtv_temp (:,:)
732	ahtw (:,:) = ahtw_temp (:,:)
733	ahtt (:,:) = ahtt_temp (:,:)
734	#elif defined key_traldf_c1d
735	ahtu (:) = ahtu_temp (:)
736	ahtv (:) = ahtv_temp (:)
737	ahtw (:) = ahtw_temp (:)
738	ahtt (:) = ahtt_temp (:)
739	#else
740	ahtu = ahtu_temp
741	ahtv = ahtv_temp
742	ahtw = ahtw_temp
743	ahtt = ahtt_temp
744	#endif
745	!
746	#if defined key_traldf_eiv
747	#if defined key_traldf_c3d
748	aeiu (:,:,:) = aeiu_temp(:,:,:)
749	aeiv (:,:,:) = aeiv_temp(:,:,:)
750	aeiw (:,:,:) = aeiw_temp(:,:,:)
751	#elif defined key_traldf_c2d
752	aeiu (:,:) = aeiu_temp(:,:)
753	aeiv (:,:) = aeiv_temp(:,:)
754	aeiw (:,:) = aeiw_temp(:,:)
755	#elif defined key_traldf_c1d
756	aeiu (:) = aeiu_temp(:)
757	aeiv (:) = aeiv_temp(:)
758	aeiw (:) = aeiw_temp(:)
759	#else
760	aeiu = aeiu_temp
761	aeiv = aeiv_temp
762	aeiw = aeiw_temp
763	#endif
764	#endif
765	hdivn (:,:,:) = hdivn_temp (:,:,:)
766	rotn (:,:,:) = rotn_temp (:,:,:)
767	hdivb (:,:,:) = hdivb_temp (:,:,:)
768	rotb (:,:,:) = rotb_temp (:,:,:)
769	hu (:,:) = hu_temp (:,:)
770	hv (:,:) = hv_temp (:,:)
771	hur (:,:) = hur_temp (:,:)
772	hvr (:,:) = hvr_temp (:,:)
773	!
774	DO jk = 1, jpk
775	fse3t(:,:,jk)= e3t_temp(:,:,jk)
776	fse3u(:,:,jk)= e3u_temp(:,:,jk)
777	fse3v(:,:,jk)= e3v_temp(:,:,jk)
778	fse3w(:,:,jk)= e3w_temp(:,:,jk)
779	END DO
780	! !------------------------------!
781	IF( lk_vvl ) THEN ! Update Now Vertical coord. ! (only in vvl case)
782	! !------------------------------!
783	DO jk = 1, jpkm1
784	fsdept(:,:,jk) = fsdept_n(:,:,jk) ! now local depths stored in fsdep. arrays
785	fsdepw(:,:,jk) = fsdepw_n(:,:,jk)
786	fsde3w(:,:,jk) = fsde3w_n(:,:,jk)
787	!
788	fse3t (:,:,jk) = fse3t_n (:,:,jk) ! vertical scale factors stored in fse3. arrays
789	fse3u (:,:,jk) = fse3u_n (:,:,jk)
790	fse3v (:,:,jk) = fse3v_n (:,:,jk)
791	fse3f (:,:,jk) = fse3f_n (:,:,jk)
792	fse3w (:,:,jk) = fse3w_n (:,:,jk)
793	fse3uw(:,:,jk) = fse3uw_n(:,:,jk)
794	fse3vw(:,:,jk) = fse3vw_n(:,:,jk)
795	END DO
796	!
797	ENDIF
798
799	! Start new averages
800	un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:)
801	vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:)
802	tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:)
803	tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:)
804	rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:)
805	avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:)
806	# if defined key_zdfddm
807	avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:)
808	# endif
809	#if defined key_ldfslp
810	wslpi_tm(:,:,:) = wslpi(:,:,:) * fse3w(:,:,:)
811	wslpj_tm(:,:,:) = wslpj(:,:,:) * fse3w(:,:,:)
812	uslp_tm (:,:,:) = uslp (:,:,:) * fse3u(:,:,:)
813	vslp_tm (:,:,:) = vslp (:,:,:) * fse3v(:,:,:)
814	#endif
815	!
816	sshb_hold (:,:) = sshn (:,:)
817	!!Z~ sshu_b_hold(:,:) = sshu_n(:,:)
818	!!Z~ sshv_b_hold(:,:) = sshv_n(:,:)
819	emp_b_hold (:,:) = emp (:,:)
820	sshn_tm (:,:) = sshn (:,:)
821	!!Z~ sshu_n_tm (:,:) = sshu_n(:,:)
822	!!Z~ sshv_n_tm (:,:) = sshv_n(:,:)
823	rnf_tm (:,:) = rnf (:,:)
824	h_rnf_tm (:,:) = h_rnf (:,:)
825	hmld_tm (:,:) = hmld (:,:)
826	fr_i_tm (:,:) = fr_i (:,:)
827	emp_tm (:,:) = emp (:,:)
828	fmmflx_tm (:,:) = fmmflx(:,:)
829	qsr_tm (:,:) = qsr (:,:)
830	wndm_tm (:,:) = wndm (:,:)
831	# if defined key_trabbl
832	IF( nn_bbl_ldf == 1 ) THEN
833	ahu_bbl_tm(:,:) = ahu_bbl(:,:)
834	ahv_bbl_tm(:,:) = ahv_bbl(:,:)
835	ENDIF
836	IF( nn_bbl_adv == 1 ) THEN
837	utr_bbl_tm(:,:) = utr_bbl(:,:)
838	vtr_bbl_tm(:,:) = vtr_bbl(:,:)
839	ENDIF
840	# endif
841	!
842	#if defined key_traldf_c3d
843	DO jk = 1, jpkm1
844	ahtt_tm(:,:,jk) = ahtt(:,:,jk) * fse3t(:,:,jk)
845	ahtu_tm(:,:,jk) = ahtu(:,:,jk) * fse3u(:,:,jk)
846	ahtv_tm(:,:,jk) = ahtv(:,:,jk) * fse3v(:,:,jk)
847	ahtw_tm(:,:,jk) = ahtw(:,:,jk) * fse3w(:,:,jk)
848	END DO
849	#elif defined key_traldf_c2d
850	ahtt_tm(:,:) = ahtt(:,:)
851	ahtu_tm(:,:) = ahtu(:,:)
852	ahtv_tm(:,:) = ahtv(:,:)
853	ahtw_tm(:,:) = ahtw(:,:)
854	#elif defined key_traldf_c1d
855	ahtt_tm(:) = ahtt(:)
856	ahtu_tm(:) = ahtu(:)
857	ahtv_tm(:) = ahtv(:)
858	ahtw_tm(:) = ahtw(:)
859	#else
860	ahtt_tm = ahtt
861	ahtu_tm = ahtu
862	ahtv_tm = ahtv
863	ahtw_tm = ahtw
864	#endif
865	!
866	#if defined key_traldf_eiv
867	# if defined key_traldf_c3d
868	DO jk = 1, jpk
869	aeiu_tm(:,:,jk) = aeiu(:,:,jk) * fse3u(:,:,jk)
870	aeiv_tm(:,:,jk) = aeiv(:,:,jk) * fse3v(:,:,jk)
871	aeiw_tm(:,:,jk) = aeiw(:,:,jk) * fse3w(:,:,jk)
872	END DO
873	# elif defined key_traldf_c2d
874	aeiu_tm(:,:) = aeiu(:,:)
875	aeiv_tm(:,:) = aeiv(:,:)
876	aeiw_tm(:,:) = aeiw(:,:)
877	# elif defined key_traldf_c1d
878	aeiu_tm(:) = aeiu(:)
879	aeiv_tm(:) = aeiv(:)
880	aeiw_tm(:) = aeiw(:)
881	# else
882	aeiu_tm = aeiu
883	aeiv_tm = aeiv
884	aeiw_tm = aeiw
885	# endif
886	#endif
887	!
888	IF( nn_timing == 1 ) CALL timing_stop('trc_sub_reset')
889	!
890	END SUBROUTINE trc_sub_reset
891
892
893	SUBROUTINE trc_sub_ssh( kt )
894	!!----------------------------------------------------------------------
895	!! * ROUTINE trc_sub_ssh *
896	!!
897	!! ** Purpose : compute the after ssh (ssha), the now vertical velocity
898	!! and update the now vertical coordinate (lk_vvl=T).
899	!!
900	!! ** Method : - Using the incompressibility hypothesis, the vertical
901	!! velocity is computed by integrating the horizontal divergence
902	!! from the bottom to the surface minus the scale factor evolution.
903	!! The boundary conditions are w=0 at the bottom (no flux) and.
904	!!
905	!! ** action : ssha : after sea surface height
906	!! wn : now vertical velocity
907	!! sshu_a, sshv_a, sshf_a : after sea surface height (lk_vvl=T)
908	!! hu, hv, hur, hvr : ocean depth and its inverse at u-,v-points
909	!!
910	!! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling.
911	!!----------------------------------------------------------------------
912	!
913	INTEGER, INTENT(in) :: kt ! time step
914	!
915	INTEGER :: ji, jj, jk ! dummy loop indices
916	REAL(wp) :: zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0 ! local scalars
917	REAL(wp), POINTER, DIMENSION(:,:) :: zhdiv
918	!!---------------------------------------------------------------------
919	!
920	IF( nn_timing == 1 ) CALL timing_start('trc_sub_ssh')
921	!
922	! Allocate temporary workspace
923	CALL wrk_alloc( jpi, jpj, zhdiv )
924
925	IF( kt == nittrc000 ) THEN
926	!
927	IF(lwp) WRITE(numout,*)
928	IF(lwp) WRITE(numout,*) 'trc_sub_ssh : after sea surface height and now vertical velocity '
929	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
930	!
931	wn(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all)
932	!
933	ENDIF
934
935	! !------------------------------------------!
936	IF( lk_vvl ) THEN ! Regridding: Update Now Vertical coord. ! (only in vvl case)
937	! !------------------------------------------!
938	DO jk = 1, jpkm1
939	fsdept(:,:,jk) = fsdept_n(:,:,jk) ! now local depths stored in fsdep. arrays
940	fsdepw(:,:,jk) = fsdepw_n(:,:,jk)
941	fsde3w(:,:,jk) = fsde3w_n(:,:,jk)
942	!
943	fse3t (:,:,jk) = fse3t_n (:,:,jk) ! vertical scale factors stored in fse3. arrays
944	fse3u (:,:,jk) = fse3u_n (:,:,jk)
945	fse3v (:,:,jk) = fse3v_n (:,:,jk)
946	fse3f (:,:,jk) = fse3f_n (:,:,jk)
947	fse3w (:,:,jk) = fse3w_n (:,:,jk)
948	fse3uw(:,:,jk) = fse3uw_n(:,:,jk)
949	fse3vw(:,:,jk) = fse3vw_n(:,:,jk)
950	END DO
951	!
952	!!Z~ hu(:,:) = hu_0(:,:) + sshu_n(:,:) ! now ocean depth (at u- and v-points)
953	!!Z~ hv(:,:) = hv_0(:,:) + sshv_n(:,:)
954	! ! now masked inverse of the ocean depth (at u- and v-points)
955	hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1._wp - umask(:,:,1) )
956	hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1._wp - vmask(:,:,1) )
957	!
958	ENDIF
959	!
960	CALL div_cur( kt ) ! Horizontal divergence & Relative vorticity
961	!
962	z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog)
963	IF( neuler == 0 .AND. kt == nittrc000 ) z2dt = rdt
964
965	! !------------------------------!
966	! ! After Sea Surface Height !
967	! !------------------------------!
968	zhdiv(:,:) = 0._wp
969	DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports
970	zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)
971	END DO
972	! ! Sea surface elevation time stepping
973	! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used
974	! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp
975	z1_rau0 = 0.5 / rau0
976	ssha(:,:) = ( sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * tmask(:,:,1)
977
978	#if defined key_agrif
979	CALL agrif_ssh( kt )
980	#endif
981	#if defined key_obc
982	IF( Agrif_Root() ) THEN
983	ssha(:,:) = ssha(:,:) * obctmsk(:,:)
984	CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm)
985	ENDIF
986	#endif
987	#if defined key_bdy
988	ssha(:,:) = ssha(:,:) * bdytmask(:,:)
989	CALL lbc_lnk( ssha, 'T', 1. )
990	#endif
991
992	! ! Sea Surface Height at u-,v- and f-points (vvl case only)
993	!!Z~ IF( lk_vvl ) THEN ! (required only in key_vvl case)
994	!!Z~ DO jj = 1, jpjm1
995	!!Z~ DO ji = 1, jpim1 ! NO Vector Opt.
996	!!Z~ sshu_a(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) ) &
997	!!Z~ & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha(ji ,jj) &
998	!!Z~ & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) )
999	!!Z~ sshv_a(ji,jj) = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) ) &
1000	!!Z~ & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha(ji,jj ) &
1001	!!Z~ & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) )
1002	!!Z~ END DO
1003	!!Z~ END DO
1004	!!Z~ CALL lbc_lnk( sshu_a, 'U', 1. ) ; CALL lbc_lnk( sshv_a, 'V', 1. ) ! Boundaries conditions
1005	!!Z~ ENDIF
1006
1007
1008	! !------------------------------!
1009	! ! Now Vertical Velocity !
1010	! !------------------------------!
1011	z1_2dt = 1.e0 / z2dt
1012	DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence
1013	! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
1014	wn(:,:,jk) = wn(:,:,jk+1) - fse3t_n(:,:,jk) * hdivn(:,:,jk) &
1015	& - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) &
1016	& * tmask(:,:,jk) * z1_2dt
1017	#if defined key_bdy
1018	wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
1019	#endif
1020	END DO
1021
1022	!
1023	CALL wrk_dealloc( jpi, jpj, zhdiv )
1024	!
1025	IF( nn_timing == 1 ) CALL timing_stop('trc_sub_ssh')
1026	!
1027	END SUBROUTINE trc_sub_ssh
1028
1029	INTEGER FUNCTION trc_sub_alloc()
1030	!!-------------------------------------------------------------------
1031	!! * ROUTINE trc_sub_alloc *
1032	!!-------------------------------------------------------------------
1033	USE lib_mpp, ONLY: ctl_warn
1034	INTEGER :: ierr
1035	!!-------------------------------------------------------------------
1036	!
1037	ALLOCATE( un_temp(jpi,jpj,jpk) , vn_temp(jpi,jpj,jpk) , &
1038	& wn_temp(jpi,jpj,jpk) , avt_temp(jpi,jpj,jpk) , &
1039	& rhop_temp(jpi,jpj,jpk) , rhop_tm(jpi,jpj,jpk) , &
1040	& sshn_temp(jpi,jpj) , sshb_temp(jpi,jpj) , &
1041	& ssha_temp(jpi,jpj) , sshu_a_temp(jpi,jpj), &
1042	& sshu_n_temp(jpi,jpj) , sshu_b_temp(jpi,jpj), &
1043	& sshv_n_temp(jpi,jpj) , sshv_b_temp(jpi,jpj), &
1044	& sshv_a_temp(jpi,jpj) , sshf_n_temp(jpi,jpj) , &
1045	& e3t_temp(jpi,jpj,jpk) , e3u_temp(jpi,jpj,jpk), &
1046	& e3v_temp(jpi,jpj,jpk) , e3w_temp(jpi,jpj,jpk), &
1047	#if defined key_ldfslp
1048	& wslpi_temp(jpi,jpj,jpk) , wslpj_temp(jpi,jpj,jpk), &
1049	& uslp_temp(jpi,jpj,jpk) , vslp_temp(jpi,jpj,jpk), &
1050	#endif
1051	#if defined key_trabbl
1052	& ahu_bbl_temp(jpi,jpj) , ahv_bbl_temp(jpi,jpj), &
1053	& utr_bbl_temp(jpi,jpj) , vtr_bbl_temp(jpi,jpj), &
1054	#endif
1055	& rnf_temp(jpi,jpj) , h_rnf_temp(jpi,jpj) , &
1056	& tsn_temp(jpi,jpj,jpk,2) , emp_b_temp(jpi,jpj), &
1057	& emp_temp(jpi,jpj) , fmmflx_temp(jpi,jpj), &
1058	& hmld_temp(jpi,jpj) , qsr_temp(jpi,jpj) , &
1059	& fr_i_temp(jpi,jpj) , fr_i_tm(jpi,jpj) , &
1060	& wndm_temp(jpi,jpj) , wndm_tm(jpi,jpj) , &
1061	# if defined key_zdfddm
1062	& avs_tm(jpi,jpj,jpk) , avs_temp(jpi,jpj,jpk) , &
1063	# endif
1064	#if defined key_traldf_c3d
1065	& ahtt_tm(jpi,jpj,jpk) , ahtt_temp(jpi,jpj,jpk), &
1066	& ahtu_tm(jpi,jpj,jpk) , ahtu_temp(jpi,jpj,jpk), &
1067	& ahtv_tm(jpi,jpj,jpk) , ahtv_temp(jpi,jpj,jpk), &
1068	& ahtw_tm(jpi,jpj,jpk) , ahtw_temp(jpi,jpj,jpk), &
1069	#elif defined key_traldf_c2d
1070	& ahtt_tm(jpi,jpj) , ahtt_temp(jpi,jpj), &
1071	& ahtu_tm(jpi,jpj) , ahtu_temp(jpi,jpj), &
1072	& ahtv_tm(jpi,jpj) , ahtv_temp(jpi,jpj), &
1073	& ahtw_tm(jpi,jpj) , ahtw_temp(jpi,jpj), &
1074	#elif defined key_traldf_c1d
1075	& ahtt_tm(jpk) , ahtt_temp(jpk), &
1076	& ahtu_tm(jpk) , ahtu_temp(jpk), &
1077	& ahtv_tm(jpk) , ahtv_temp(jpk), &
1078	& ahtw_tm(jpk) , ahtw_temp(jpk), &
1079	#endif
1080	#if defined key_traldf_eiv
1081	# if defined key_traldf_c3d
1082	& aeiu_tm(jpi,jpj,jpk) , aeiu_temp(jpi,jpj,jpk), &
1083	& aeiv_tm(jpi,jpj,jpk) , aeiv_temp(jpi,jpj,jpk), &
1084	& aeiw_tm(jpi,jpj,jpk) , aeiw_temp(jpi,jpj,jpk), &
1085	# elif defined key_traldf_c2d
1086	& aeiu_tm(jpi,jpj) , aeiu_temp(jpi,jpj), &
1087	& aeiv_tm(jpi,jpj) , aeiv_temp(jpi,jpj), &
1088	& aeiw_tm(jpi,jpj) , aeiw_temp(jpi,jpj), &
1089	# elif defined key_traldf_c1d
1090	& aeiu_tm(jpk) , aeiu_temp(jpk), &
1091	& aeiv_tm(jpk) , aeiv_temp(jpk), &
1092	& aeiw_tm(jpk) , aeiw_temp(jpk), &
1093	# endif
1094	# endif
1095	& hdivn_temp(jpi,jpj,jpk) , hdivb_temp(jpi,jpj,jpk), &
1096	& rotn_temp(jpi,jpj,jpk) , rotb_temp(jpi,jpj,jpk), &
1097	& hu_temp(jpi,jpj) , hv_temp(jpi,jpj), &
1098	& hur_temp(jpi,jpj) , hvr_temp(jpi,jpj), &
1099	& un_tm(jpi,jpj,jpk) , vn_tm(jpi,jpj,jpk) , &
1100	& avt_tm(jpi,jpj,jpk) , &
1101	& sshn_tm(jpi,jpj) , sshb_hold(jpi,jpj) , &
1102	& sshu_n_tm(jpi,jpj) , sshu_b_hold(jpi,jpj), &
1103	& sshv_n_tm(jpi,jpj) , sshv_b_hold(jpi,jpj), &
1104	& tsn_tm(jpi,jpj,jpk,2) , &
1105	& emp_tm(jpi,jpj) , fmmflx_tm(jpi,jpj) , &
1106	& emp_b_hold(jpi,jpj) , &
1107	& hmld_tm(jpi,jpj) , qsr_tm(jpi,jpj) , &
1108	#if defined key_ldfslp
1109	& wslpi_tm(jpi,jpj,jpk) , wslpj_tm(jpi,jpj,jpk), &
1110	& uslp_tm(jpi,jpj,jpk) , vslp_tm(jpi,jpj,jpk), &
1111	#endif
1112	#if defined key_trabbl
1113	& ahu_bbl_tm(jpi,jpj) , ahv_bbl_tm(jpi,jpj), &
1114	& utr_bbl_tm(jpi,jpj) , vtr_bbl_tm(jpi,jpj), &
1115	#endif
1116	& rnf_tm(jpi,jpj) , h_rnf_tm(jpi,jpj) , &
1117	& STAT=trc_sub_alloc )
1118	IF( trc_sub_alloc /= 0 ) CALL ctl_warn('trc_sub_alloc: failed to allocate arrays')
1119
1120	!
1121	END FUNCTION trc_sub_alloc
1122
1123	#else
1124	!!----------------------------------------------------------------------
1125	!! Default key NO passive tracers
1126	!!----------------------------------------------------------------------
1127	CONTAINS
1128	SUBROUTINE trc_sub_stp( kt ) ! Empty routine
1129	WRITE(,) 'trc_sub_stp: You should not have seen this print! error?', kt
1130	END SUBROUTINE trc_sub_stp
1131	SUBROUTINE trc_sub_ini ! Empty routine
1132	WRITE(,) 'trc_sub_ini: You should not have seen this print! error?', kt
1133	END SUBROUTINE trc_sub_ini
1134
1135	#endif
1136
1137	!!======================================================================
1138	END MODULE trcsub

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

Download in other formats: