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/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC – NEMO

Context Navigation

source: branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcsub.F90 @ 3147

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

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

Download in other formats: