Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

lmdz_call_gwd.f90

Last change on this file was 6090, checked in by rkazeroni, 2 days ago

Edit call_gwd routine to enable automatic GPU porting with GPUM:

add "nogpu directive" for call to diagnostic
replace Forall statement not supported by GPUM by DO-loop
move array operation before call instead of inside a call because it is not supproted on GPU

File size: 23.6 KB

Line
1	!$gpum horizontal klon
2	MODULE lmdz_call_gwd
3
4	!=====================================================================================================
5	! lmdz_call_gwd is the interface between the LMDZ physics monitor
6	! physiq_mod and the routines that compute the drag due to gravity
7	! waves and subgrid-scale orography (SSO)
8	! It consists in a sequence of several parameterizations:
9	! Part I: the effect of orographic gravity waves due to SSO (in fact gravity waves + blocking effect)
10	! Part II: the effect of non-orographic gravity waves, due to fronts/jets and precipitation ("flott")
11	! Part III: optional diagnostics of surface torque and angular momentum
12	! Part IV: effects of mountain drag onto turbulent kinetic energy (TKE)
13	! contact: F. Lott flott@lmd.ens.fr
14	!=====================================================================================================
15
16	IMPLICIT NONE
17
18	CONTAINS
19
20	!===================================================================
21
22	SUBROUTINE call_gwd(klon, klev, nbsrf, is_ter, is_lic, is_ave, abortphy, flag_inhib_tend, itap, JD_cur, JD_ref, JH_cur, &
23	pctsrf, is_sequential, phys_tstep, cell_area, longitude_deg, latitude_deg, pphis, &
24	zstd, zpic, zmea, zval, zsig, zgam, zthe, pplay, paprs, presnivs, rain_fall, snow_fall, &
25	u_beginphys, v_beginphys, rot, tke, wake_delta_tke, &
26	d_u_oro, d_v_oro, d_t_oro, zustr_oro, zvstr_oro, &
27	d_u_lif, d_v_lif, d_t_lif, zustr_lif, zvstr_lif, &
28	d_u_hines, d_v_hines, d_t_hines, zustr_hines, zvstr_hines, &
29	d_u_front, d_v_front, zustr_front, zvstr_front, &
30	d_u_precip, d_v_precip, zustr_precip, zvstr_precip, &
31	east_gwstress, west_gwstress, aam, torsfc)
32
33	USE lmdz_gwd_ini, ONLY: ok_strato, ok_orodr, ok_orolf, ok_hines, ok_gwd_rando
34	USE lmdz_gwd_ini, ONLY: addtkeoro, smallscales_tkeoro, alphatkeoro
35	USE lmdz_gwd_ini, ONLY: zpmm_orodr_t, zstd_orodr_t, zpmm_orolf_t, nm_oro_t
36	USE lmdz_gwd_ini, ONLY: ra, rg, rcpd, romega, rkappa
37
38	USE lmdz_gwd_ogwd, ONLY: drag_noro_strato, lift_noro_strato
39	USE lmdz_gwd_ogwd_old, ONLY: drag_noro, lift_noro
40	USE lmdz_gwd_hines, ONLY: hines_gwd
41	USE lmdz_gwd_front, ONLY: acama_gwd_rando
42	USE lmdz_gwd_precip, ONLY: flott_gwd_rando
43
44	USE add_phys_tend_mod, ONLY: add_phys_tend, prt_enerbil
45	USE phys_local_var_mod, ONLY: u_seri, v_seri, t_seri
46	USE lmdz_gwd_tendtotke, ONLY: tend_to_tke
47
48	IMPLICIT NONE
49
50	!===================================================================
51	! Declarations
52	!===================================================================
53
54	! Input variables
55	!----------------
56
57	INTEGER, INTENT(IN) :: klon, klev ! number of horizontal and vertical grid points
58	INTEGER, INTENT(IN) :: nbsrf ! number of sub-surfaces
59	INTEGER, INTENT(IN) :: abortphy, flag_inhib_tend, itap ! flags and counter for add_phys_tend
60	REAL, INTENT(IN) :: JD_cur ! current day
61	REAL, INTENT(IN) :: JD_ref ! start day of the run
62	REAL, INTENT(IN) :: JH_cur ! time of the day in seconds
63	INTEGER, INTENT(IN) :: is_ter, is_lic, is_ave ! indices for land and landice subsurfaces and mesh-averaged
64	LOGICAL, INTENT(IN) :: is_sequential ! sequential or parallel model
65	REAL, INTENT(IN) :: phys_tstep ! time step [s]
66	REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf ! fraction of each subsurface [0-1]
67
68	REAL, DIMENSION(klon), INTENT(IN) :: cell_area ! area of the mesh [m2]
69	REAL, DIMENSION(klon), INTENT(IN) :: longitude_deg ! lonfitude of grid points [o]
70	REAL, DIMENSION(klon), INTENT(IN) :: latitude_deg ! latitude of grid points [o]
71	REAL, DIMENSION(klon), INTENT(IN) :: pphis ! surface geopotential [m2/s2]
72
73	REAL, DIMENSION(klon), INTENT(IN) :: zstd ! std of subgrid-scale orography [m]
74	REAL, DIMENSION(klon), INTENT(IN) :: zpic ! altitude of subgrid-scale orography peaks [m]
75	REAL, DIMENSION(klon), INTENT(IN) :: zmea ! mean altitude of subgrid-scale orography [m]
76	REAL, DIMENSION(klon), INTENT(IN) :: zval ! altitude of subgrid-scale orography valleys [m]
77	REAL, DIMENSION(klon), INTENT(IN) :: zsig ! subgrid-scale orography slope [-]
78	REAL, DIMENSION(klon), INTENT(IN) :: zthe ! subgrid-scale orography small-axis orientation [rad]
79	REAL, DIMENSION(klon), INTENT(IN) :: rain_fall ! rain fall flux at the surface [kg/m2/s]
80	REAL, DIMENSION(klon), INTENT(IN) :: snow_fall ! snowfall flux at the surface [kg/m2/s]
81
82	REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay ! air pressure [Pa]
83	REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs ! air pressure at bottom layer interface [Pa]
84	REAL, DIMENSION(klev), INTENT(IN) :: presnivs ! equivalent pressure for vertical discretization
85	REAL, DIMENSION(klon, klev), INTENT(IN) :: u_beginphys ! u at the beginning of the physics [m/s]
86	REAL, DIMENSION(klon, klev), INTENT(IN) :: v_beginphys ! v at the beginning of the physics [m/s]
87	REAL, DIMENSION(klon, klev), INTENT(IN) :: rot ! relative vorticity [s-1]
88
89	! Inout variables
90	!-----------------
91	REAL, DIMENSION(klon), INTENT(INOUT) :: zgam ! subgrid-scale orography asymetry parameter [-]
92	REAL, DIMENSION(klon, klev + 1, nbsrf + 1), INTENT(INOUT) :: tke ! turbulent kinetic energy [m2/s2]
93	REAL, DIMENSION(klon, klev + 1, nbsrf + 1), INTENT(INOUT) :: wake_delta_tke ! turbulent kinetic energy difference between wakes and environment [m2/s2]
94	! tendencies from random non orographic graviy wave processes are inout variables (to account for some process memory).
95	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_u_front ! u increment due to gwd generated by fronts [m/s]
96	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_u_precip ! u increment due to gwd generated by precipitation [m/s]
97	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_v_front ! v increment due to gwd generated by fronts [m/s]
98	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: d_v_precip ! v increment due to gwd generated by precipitation [m/s]
99	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: east_gwstress ! eastward gravity wave stress [Pa]
100	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: west_gwstress ! westward gravity wave stress [Pa]
101
102	! Output variables
103	!----------------
104
105	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u_oro ! u increment due to sso drag [m/S]
106	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v_oro ! v increment due to sso drag [m/s]
107	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t_oro ! t increment due to sso drag [K]
108
109	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u_lif ! u increment due to sso lift [m/s]
110	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v_lif ! v increment due to sso lift [m/s]
111	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t_lif ! t increment due to sso lift [K]
112
113	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u_hines ! u increment due to Hines param [m/s]
114	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v_hines ! v increment due to Hines param [m/s]
115	REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t_hines ! t increment due to Hines param [K]
116
117	REAL, DIMENSION(klon), INTENT(OUT) :: zustr_oro ! vertically integrated zonal stress due to sso drag [kg.m/s/m2]
118	REAL, DIMENSION(klon), INTENT(OUT) :: zvstr_oro ! vertically integrated meridional stress due to sso drag [kg.m/s/m2]
119
120	REAL, DIMENSION(klon), INTENT(OUT) :: zustr_lif ! vertically integrated zonal stress due to sso lift [kg.m/s/m2]
121	REAL, DIMENSION(klon), INTENT(OUT) :: zvstr_lif ! vertically integrated meridional stress due to sso lift [kg.m/s/m2]
122
123	REAL, DIMENSION(klon), INTENT(OUT) :: zustr_hines ! vertically integrated zonal stress due to Hines param [kg.m/s/m2]
124	REAL, DIMENSION(klon), INTENT(OUT) :: zvstr_hines ! vertically integrated meridional stress due to Hines param [kg.m/s/m2]
125
126	REAL, DIMENSION(klon), INTENT(OUT) :: zustr_front ! vertically integrated zonal stress due to fronts gwd param [kg.m/s/m2]
127	REAL, DIMENSION(klon), INTENT(OUT) :: zvstr_front ! vertically integrated meridional stress due to fronts gwd param [kg.m/s/m2]
128
129	REAL, DIMENSION(klon), INTENT(OUT) :: zustr_precip ! vertically integrated zonal stress due to precip. gwd param [kg.m/s/m2]
130	REAL, DIMENSION(klon), INTENT(OUT) :: zvstr_precip ! vertically integrated meridional stress due to precip. gwd param [kg.m/s/m2]
131
132	REAL, INTENT(OUT) :: aam ! axial wind angular momentum
133	REAL, INTENT(OUT) :: torsfc ! total surface torque
134
135	! Local variables
136	!-----------------
137
138	INTEGER :: i, k, igwd
139	INTEGER, DIMENSION(klon) :: itest ! whether the scheme is active (1) or not (0)
140	INTEGER, DIMENSION(klon) :: idx ! indices where the scheme is active
141	REAL, DIMENSION(klon) :: nm_oro ! proxy for the number of subgrid-scale mountains
142	REAL, DIMENSION(klon) :: zulow, zvlow, zustr_phys, zvstr_phys
143	REAL, DIMENSION(klon, klev) :: dt0, dq0, dql0, dqi0, dqbs0, dxt0, dxtl0, dxti0
144	REAL, DIMENSION(klon, klev) :: dtadd, duadd, dvadd, exner
145	REAL, DIMENSION(klon, klev) :: d_t_oro_tke, d_u_oro_tke, d_v_oro_tke
146	REAL, DIMENSION(klon) :: fall
147
148	!===================================================================
149	! Initialisations of local and output variables (as they are not
150	! always filled in)
151	!===================================================================
152
153	dt0(:, :) = 0.
154	dq0(:, :) = 0.
155	dql0(:, :) = 0.
156	dqi0(:, :) = 0.
157	dqbs0(:, :) = 0.
158	dxt0(:, :) = 0.
159	dxtl0(:, :) = 0.
160	dxti0(:, :) = 0.
161
162	d_u_oro(:, :) = 0.
163	d_v_oro(:, :) = 0.
164	d_t_oro(:, :) = 0.
165
166	d_u_lif(:, :) = 0.
167	d_v_lif(:, :) = 0.
168	d_t_lif(:, :) = 0.
169
170	d_u_hines(:, :) = 0.
171	d_v_hines(:, :) = 0.
172	d_t_hines(:, :) = 0.
173
174	! DO NOT set tendencies associated with front and precip to 0
175	! as they are inout variables because
176	! the parameterizations considers some "process memory"
177
178	zustr_hines(:) = 0.
179	zvstr_hines(:) = 0.
180
181	zustr_front(:) = 0.
182	zvstr_front(:) = 0.
183
184	zustr_precip(:) = 0.
185	zvstr_precip(:) = 0.
186
187	zustr_phys(:) = 0.
188	zvstr_phys(:) = 0.
189
190	dtadd(:, :) = 0.
191	duadd(:, :) = 0.
192	dvadd(:, :) = 0.
193
194	aam = 0.
195	torsfc = 0.
196
197	! calculation of nm_oro
198	DO i = 1, klon
199	! nm_oro is a proxy for the number of subgrid scale mountains
200	! -> condition on nm_oro can deactivate SSO params on tilted planar terrains
201	! such as ice sheets (work by V. Wiener).
202	! see Wiener et al. (2025), doi: 10.5194/wcd-6-1605-2025
203	! in such a case, the SSO params should activate only where nm_oro>0 i.e. by setting
204	! nm_oro_t=0.
205	nm_oro(i) = zsig(i)sqrt(cell_area(i)(pctsrf(i, is_ter) + pctsrf(i, is_lic)))/(4.*MAX(zstd(i), 1.e-8)) - 1.
206	END DO
207
208	!===================================================================
209	! Part I: effects of orographic gravity waves
210	!===================================================================
211
212	! I. 1 : drag associated with SSO (that slows down the wind)
213	! due to gravity wave breaking and relief blocking effect
214	!----------------------------------------------------------------
215
216	! activate or not the param with ok_orodr
217	IF (ok_orodr) THEN
218	! we select points where the scheme should be activated (not to treat ocean points mostly)
219	igwd = 0
220	DO i = 1, klon
221	itest(i) = 0
222	! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to
223	! earn computation time but they are not physical (-> set to 0 from CMIP7)
224	! nm_oro_t is a threshold to avoir activate the param over sloping but not mountainous terrains
225	IF (((zpic(i) - zmea(i)) .GT. zpmm_orodr_t) .AND. (zstd(i) .GT. zstd_orodr_t) .AND. (nm_oro(i) .GT. nm_oro_t)) THEN
226	itest(i) = 1
227	igwd = igwd + 1
228	idx(igwd) = i
229	END IF
230	END DO
231
232	IF (ok_strato) THEN
233
234	CALL drag_noro_strato(klon, klev, phys_tstep, 0, paprs, pplay, &
235	zmea, zstd, zsig, zgam, zthe, zpic, zval, &
236	igwd, idx, itest, &
237	t_seri, u_seri, v_seri, &
238	zulow, zvlow, zustr_oro, zvstr_oro, &
239	d_t_oro, d_u_oro, d_v_oro)
240
241	ELSE
242	! this routine is becoming obsolete. Do not use it.
243	CALL drag_noro(klon, klev, phys_tstep, paprs, pplay, &
244	zmea, zstd, zsig, zgam, zthe, zpic, zval, &
245	igwd, idx, itest, &
246	t_seri, u_seri, v_seri, &
247	zulow, zvlow, zustr_oro, zvstr_oro, &
248	d_t_oro, d_u_oro, d_v_oro)
249	END IF
250
251	! Add tendencies
252	!-----------------------------------------------------------------------
253
254	CALL add_phys_tend(d_u_oro, d_v_oro, d_t_oro, dq0, dql0, dqi0, dqbs0, paprs, 'oro', &
255	abortphy, flag_inhib_tend, itap, 0)
256	CALL prt_enerbil('oro', itap)
257
258	END IF
259
260	! I. 2 lift effect due to SSO that changes the direction of the flow (torque effect)
261	!------------------------------------------------------------------------------------
262
263	! activate or not the param with ok_orodr
264	IF (ok_orolf) THEN
265
266	! we select points where the scheme should be activated (not to treat ocean points mostly)
267	igwd = 0
268	DO i = 1, klon
269	itest(i) = 0
270	! zpmm_orolf_t is an activation thresholds set by F. Lott to
271	! earn computation time but they are not physical (-> set to 0 from CMIP7)
272	! nm_oro_t is a threshold to avoir activate the param over sloping but not mountainous terrains
273	IF (((zpic(i) - zmea(i)) .GT. zpmm_orolf_t) .AND. (nm_oro(i) .GT. nm_oro_t)) THEN
274	itest(i) = 1
275	igwd = igwd + 1
276	idx(igwd) = i
277	END IF
278	END DO
279
280	IF (ok_strato) THEN
281
282	CALL lift_noro_strato(klon, klev, phys_tstep, paprs, pplay, &
283	latitude_deg, zmea, zstd, zpic, zgam, zthe, zpic, zval, &
284	igwd, idx, itest, &
285	t_seri, u_seri, v_seri, &
286	zulow, zvlow, zustr_lif, zvstr_lif, &
287	d_t_lif, d_u_lif, d_v_lif)
288
289	ELSE
290	! this routine is becoming obsolete. Do not use it.
291	CALL lift_noro(klon, klev, phys_tstep, paprs, pplay, &
292	latitude_deg, zmea, zstd, zpic, &
293	itest, &
294	t_seri, u_seri, v_seri, &
295	zulow, zvlow, zustr_lif, zvstr_lif, &
296	d_t_lif, d_u_lif, d_v_lif)
297	END IF
298
299	! Add tendencies
300	!-----------------------------------------------------------------------
301
302	CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, dqbs0, paprs, &
303	'lif', abortphy, flag_inhib_tend, itap, 0)
304
305	CALL prt_enerbil('lif', itap)
306
307	END IF
308
309	!===================================================================
310	! Part II: Non-orographic GW drag
311	!===================================================================
312
313	! II.0 Drag by GWs generated by fronts
314	!--------------------------------------
315
316	! old approach following Hines 1997
317	IF (ok_hines) THEN
318	! this routine is now out of date. Do not use it except for specific purposes
319	CALL hines_gwd(klon, klev, phys_tstep, paprs, pplay, latitude_deg, t_seri, &
320	u_seri, v_seri, zustr_hines, zvstr_hines, d_t_hines, &
321	d_u_hines, d_v_hines)
322
323	! Add tendencies
324	!-----------------------------------------------------------------------
325
326	CALL add_phys_tend(d_u_hines, d_v_hines, d_t_hines, dq0, dql0, &
327	dqi0, dqbs0, paprs, 'hin', abortphy, flag_inhib_tend, itap, 0)
328
329	CALL prt_enerbil('hin', itap)
330
331	! Local diagnostics
332	!-----------------------------------------------------------------------
333	DO k = 1, klev
334	zustr_hines(:) = zustr_hines(:) + d_u_hines(:, k)/phys_tstep &
335	*(paprs(:, k) - paprs(:, k + 1))/rg
336	zvstr_hines(:) = zvstr_hines(:) + d_v_hines(:, k)/phys_tstep &
337	*(paprs(:, k) - paprs(:, k + 1))/rg
338	END DO
339
340	east_gwstress(:, :) = 0.
341	west_gwstress(:, :) = 0.
342
343	END IF
344
345	! stochastic approach following De la Camara & Lott 2015
346	IF (.NOT. ok_hines .AND. ok_gwd_rando) THEN
347
348	CALL acama_gwd_rando(klon, klev, phys_tstep, pplay, presnivs, latitude_deg, t_seri, u_seri, &
349	v_seri, rot, zustr_front, zvstr_front, d_u_front, &
350	d_v_front, east_gwstress, west_gwstress)
351
352	! Add tendencies
353	!-----------------------------------------------------------------------
354
355	CALL add_phys_tend(d_u_front, d_v_front, dt0, dq0, dql0, dqi0, dqbs0, &
356	paprs, 'gwdfront', abortphy, flag_inhib_tend, itap, 0)
357
358	CALL prt_enerbil('gwdfront', itap)
359
360	! Local diagnostics of vertically integrated wind tendencies
361	!-----------------------------------------------------------------------
362	DO k = 1, klev
363	zustr_front(:) = zustr_front(:) + d_u_front(:, k)/phys_tstep &
364	*(paprs(:, k) - paprs(:, k + 1))/rg
365	zvstr_front(:) = zvstr_front(:) + d_v_front(:, k)/phys_tstep &
366	*(paprs(:, k) - paprs(:, k + 1))/rg
367	END DO
368
369	END IF
370
371	! Drag by convective (precip) GWs (stochastic approach) from Lott & Guez 2013
372	!------------------------------------------------------------------------------
373
374	IF (ok_gwd_rando) THEN
375
376	fall = rain_fall + snow_fall
377	CALL flott_gwd_rando(klon, klev, phys_tstep, pplay, presnivs, t_seri, u_seri, v_seri, &
378	fall, zustr_precip, zvstr_precip, &
379	d_u_precip, d_v_precip, east_gwstress, west_gwstress)
380
381	! Add tendencies
382	!-----------------------------------------------------------------------
383
384	CALL add_phys_tend(d_u_precip, d_v_precip, dt0, dq0, dql0, dqi0, dqbs0, &
385	paprs, 'gwdprecip', abortphy, flag_inhib_tend, itap, 0)
386
387	CALL prt_enerbil('gwdprecip', itap)
388
389	! Local diagnostics of vertically integrated wind tendencies
390	!-----------------------------------------------------------------------
391	DO k = 1, klev
392	zustr_precip(:) = zustr_precip(:) + d_u_precip(:, k)/phys_tstep &
393	*(paprs(:, k) - paprs(:, k + 1))/rg
394	zvstr_precip(:) = zvstr_precip(:) + d_v_precip(:, k)/phys_tstep &
395	*(paprs(:, k) - paprs(:, k + 1))/rg
396	END DO
397
398	END IF
399
400	!====================================================================================================
401	! Part III Diagnostics of mountain-induced torque and angular momentum computation (axial component)
402	!====================================================================================================
403
404	IF (is_sequential .and. ok_orodr) THEN
405
406	! Local diagnostics of vertically integrated wind tendencies due to all physics param
407	!-------------------------------------------------------------------------------------
408	DO k = 1, klev
409	DO i = 1, klon
410	zustr_phys(i) = zustr_phys(i) + (u_seri(i, k) - u_beginphys(i, k))/phys_tstep* &
411	(paprs(i, k) - paprs(i, k + 1))/rg
412	zvstr_phys(i) = zvstr_phys(i) + (v_seri(i, k) - v_beginphys(i, k))/phys_tstep* &
413	(paprs(i, k) - paprs(i, k + 1))/rg
414	END DO
415	END DO
416
417	! Mountain-induced torque and angular momentum calculation
418	!-------------------------------------------------------------------------------------
419	!$gpum nocall
420	CALL aaam_bud(27, klon, klev, jD_cur - jD_ref, jH_cur, &
421	ra, rg, romega, &
422	latitude_deg, longitude_deg, pphis, &
423	zustr_oro, zustr_lif, zustr_phys, &
424	zvstr_oro, zvstr_lif, zvstr_phys, &
425	paprs, u_beginphys, v_beginphys, &
426	aam, torsfc)
427
428	END IF
429
430	!========================================================================================================
431	! Part IV TKE tendency associated with gravity waves. Only effect of orographic gravity waves so far
432	! see E. Vignon PhD thesis, chapter 7 and Cheruy et al. 2020, appendix, doi: 10.1029/2019MS002005
433	!========================================================================================================
434
435	! Choices for addtkeoro:
436	! ** 0 no TKE tendency from orography
437	! ** 1 we include a fraction alphatkeoro of the whole tendency duoro
438	! ** 2 we include a fraction alphatkeoro of the gravity wave part of duoro
439
440	IF (addtkeoro .GT. 0 .AND. ok_orodr) THEN
441
442	IF (addtkeoro .EQ. 1) THEN
443
444	duadd(:, :) = alphatkeoro*d_u_oro(:, :)
445	dvadd(:, :) = alphatkeoro*d_v_oro(:, :)
446
447	ELSE IF (addtkeoro .EQ. 2) THEN
448	! this option is obsolete since now
449	! to be removed after tests
450	IF (smallscales_tkeoro) THEN
451	igwd = 0
452	DO i = 1, klon
453	itest(i) = 0
454	! Here we take into account "all" the subgrid relief (compared to the routine drag_noro_strato
455	! that activates depending on thresholds as small relief scales can lead to TKE production
456	IF ((zstd(i) .GT. 1.0) .AND. (nm_oro(i) .GT. nm_oro_t)) THEN
457	itest(i) = 1
458	igwd = igwd + 1
459	idx(igwd) = i
460	END IF
461	END DO
462
463	ELSE
464	igwd = 0
465	DO i = 1, klon
466	itest(i) = 0
467	IF (((zpic(i) - zmea(i)) .GT. zpmm_orodr_t) .AND. (zstd(i) .GT. zstd_orodr_t) .AND. (nm_oro(i) .GT. nm_oro_t)) THEN
468	itest(i) = 1
469	igwd = igwd + 1
470	idx(igwd) = i
471	END IF
472	END DO
473	END IF
474
475	CALL drag_noro_strato(klon, klev, phys_tstep, addtkeoro, paprs, pplay, &
476	zmea, zstd, zsig, zgam, zthe, zpic, zval, &
477	igwd, idx, itest, &
478	t_seri, u_seri, v_seri, &
479	zulow, zvlow, zustr_oro, zvstr_oro, &
480	d_t_oro_tke, d_u_oro_tke, d_v_oro_tke)
481
482	zulow(:) = 0.
483	zvlow(:) = 0.
484
485	duadd(:, :) = alphatkeoro*d_u_oro_tke(:, :)
486	dvadd(:, :) = alphatkeoro*d_v_oro_tke(:, :)
487	END IF
488
489	! TKE update from subgrid temperature and wind tendencies
490	!----------------------------------------------------------
491	DO k = 1, klev
492	exner(:, k) = (pplay(:, k)/paprs(:, 1))**rkappa
493	END DO
494
495	CALL tend_to_tke(phys_tstep, klon, klev, nbsrf, is_ave, paprs, exner, t_seri, u_seri, v_seri, dtadd, duadd, dvadd, pctsrf, tke)
496
497	! Prevent pbl_tke_w from becoming negative
498	wake_delta_tke(:, :, :) = max(wake_delta_tke(:, :, :), -tke(:, :, :))
499
500	END IF
501
502	END SUBROUTINE call_gwd
503
504	END MODULE lmdz_call_gwd

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

Download in other formats:

Original Format