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

Context Navigation

source: branches/2011/dev_r2802_TOP_substepping/NEMOGCM/NEMO/TOP_SRC/trcsub.F90 @ 2944

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

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

Download in other formats: