Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

lmdz_lscp_subgridvarq.f90

Last change on this file was 6028, checked in by evignon, 7 weeks ago
changement de nom des routines et module de neige soufflee par coherence avec la nomenclature de replayisation + passage de deux flags dans lmdz_lscp_ini
File size: 23.4 KB

Line
1	!$gpum horizontal klon ngrid
2	MODULE lmdz_lscp_subgridvarq
3	PRIVATE
4
5	LOGICAL, SAVE :: first = .TRUE. ! first call to ratqs_main
6	!$OMP THREADPRIVATE(first)
7
8	REAL, SAVE :: resolmax_glo
9	!$OMP THREADPRIVATE(resolmax_glo)
10
11	PUBLIC ratqs_main_first, ratqs_main
12
13	CONTAINS
14
15	!================================================================
16	SUBROUTINE ratqs_main_first(klon, cell_area)
17	USE mod_phys_lmdz_para
18	IMPLICIT NONE
19	INTEGER, INTENT(in) :: klon
20	REAL, DIMENSION(klon), INTENT(in) :: cell_area
21	REAL :: resolmax
22
23	IF (first) THEN
24	resolmax = sqrt(maxval(cell_area))
25	CALL reduce_max(resolmax, resolmax_glo)
26	CALL bcast(resolmax_glo)
27	first = .FALSE.
28	END IF
29
30	END SUBROUTINE ratqs_main_first
31
32	!=======================================================================
33	SUBROUTINE ratqs_main(klon, klev, nbsrf, is_ter, is_lic, pdtphys, &
34	pctsrf, s_pblh, zstd, wake_s, wake_deltaq, &
35	paprs, pplay, t_seri, q_seri, &
36	qtc_cv, sigt_cv, detrain_cv, fm_cv, fqd, fqcomp, &
37	sigd, qsat, &
38	fm_therm, entr_therm, detr_therm, cell_area, &
39	ratqsc, ratqs, ratqs_inter_, sigma_qtherm)
40
41	USE lmdz_lscp_ini, ONLY: prt_level, lunout, iflag_ratqs, iflag_cld_th
42	USE lmdz_lscp_ini, ONLY: ratqsbas, ratqshaut
43	USE lmdz_lscp_ini, ONLY: tau_ratqs, ratqsp0, ratqsdp
44
45	implicit none
46
47	!========================================================================
48	! Computation of ratqs, the width of the subrid scale water distribution
49	! (normalized by the mean value of specific humidity)
50	! that is, sigma=ratqs*qmean
51	! Various options controled by flags iflag_cld_th and iflag_ratqs
52	! This routine consists in 2 steps.
53	! First the "stratiform" ratqs (ratqss, corresponding to stratiform clouds)
54	! is computed
55	! Then the total ratqs is calculated either taken equal to ratqss or
56	! calculated as a combination of ratqss and
57	! that corresponding to deep convective clouds ratqsc
58	! (input of the routine, from the deep convection part).
59	! contact: Frederic Hourdin, frederic.hourdin@lmd.ipsl.fr
60	!
61	! References:
62	! Hourdin et al. 2013, doi:10.1007/s00382-012-1343-y
63	! Madeleine et al. 2020, doi:10.1029/2020MS002046
64	!========================================================================
65
66	! Declarations
67	!--------------
68
69	! Input
70	integer, intent(in) :: klon, klev ! horizontal and vertical dimensions
71	integer, intent(in) :: nbsrf, is_ter, is_lic ! number of subgrid tiles and indices for land and landice
72	real, intent(in) :: pdtphys ! physics time step [s]
73	real, dimension(klon, klev + 1), intent(in) :: paprs ! pressure at layer interfaces [Pa]
74	real, dimension(klon, klev), intent(in) :: pplay ! pressure at middle of layers [Pa]
75	real, dimension(klon, klev), intent(in) :: t_seri ! temperature [K]
76	real, dimension(klon, klev), intent(in) :: q_seri ! specific total water [kg/kg]
77	real, dimension(klon, klev), intent(in) :: qsat ! saturation specific humidity [kg/kg]
78	real, dimension(klon, klev), intent(in) :: entr_therm ! thermal plume entrainment rate * dz [kg/s/m2]
79	real, dimension(klon, klev), intent(in) :: detr_therm ! thermal plume detrainment rate * dz [kg/s/m2]
80	real, dimension(klon, klev), intent(in) :: qtc_cv ! total specific moisture in convective saturated draughts [kg/kg]
81	real, dimension(klon, klev), intent(in) :: sigt_cv ! surface fraction of convective saturated draughts [-]
82	real, dimension(klon, klev), intent(in) :: detrain_cv ! deep convection detrainment of specific humidity variance [kg/s/m2*(kg/kg)^2]
83	real, dimension(klon, klev), intent(in) :: fm_cv ! deep convective mass flux [kg/s/m2]
84	real, dimension(klon, klev), intent(in) :: fqd ! specific humidity tendency due to convective precip [kg/kg/s]
85	real, dimension(klon, klev), intent(in) :: fqcomp ! specific humidity tendency due to convective mixed draughts [kg/ks/s]
86	real, dimension(klon), intent(in) :: sigd ! fractional area covered by unsaturated convective downdrafts [-]
87
88	real, dimension(klon, klev + 1), intent(in) :: fm_therm ! convective mass flux of thermals [kg/s/m2]
89	real, dimension(klon, klev), intent(in) :: wake_deltaq ! difference in humidity between wakes and environment [kg/kg]
90	real, dimension(klon), intent(in) :: wake_s ! wake fraction area [-]
91	real, dimension(klon), intent(in) :: cell_area ! grid cell area [m2]
92	real, dimension(klon, nbsrf), intent(in) :: pctsrf ! fraction of each subgrid tiles [0-1]
93	real, dimension(klon), intent(in) :: s_pblh ! boundary layer height [m]
94	real, dimension(klon), intent(in) :: zstd ! sub grid orography standard deviation [m]
95	real, dimension(klon, klev), intent(in) :: ratqsc ! convective ratqs
96
97	! Output
98	real, dimension(klon, klev), intent(out) :: ratqs ! ratqs i.e. factor for subgrid standard deviation of humidit
99	real, dimension(klon, klev), intent(out) :: ratqs_inter_ ! interactive ratqs
100	real, dimension(klon, klev), intent(out) :: sigma_qtherm ! standard deviation of humidity in thermals [kg/kg]
101
102	! local
103	integer :: i, k
104	real, dimension(klon, klev) :: ratqss
105	real :: facteur, zfratqs1, zfratqs2
106	real, dimension(klon, klev) :: ratqs_oro_
107	real :: resol, fact
108
109	! First step: stratiform clouds ratqs (ratqss) computation
110	!---------------------------------------------------------
111	! for all options, the background ratqss is computed as a
112	! function increasing from a value at the ground surface
113	! (0 or ratqsbas) and a value for the high atmosphere
114	! (ratqshaut)
115
116	if (iflag_ratqs .eq. 0) then
117
118	! iflag_ratqs=0 corresponds to LMDZ4 version of the model
119	! with a linear function of pressure
120
121	do k = 1, klev
122	do i = 1, klon
123	ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas)* &
124	min((paprs(i, 1) - pplay(i, k))/(paprs(i, 1) - 30000.), 1.)
125	end do
126	end do
127
128	! for iflag_ratqs = 1 or 2, ratqss is constant above 300 hPa (ratqshaut),
129	! and then linearly varies between 600 and 300 hPa and it is either constant (ratqsbas)
130	! for iflag_ratqs=1 or lineary varies (between ratqsbas and 0 at the surface) for iflag_ratqs=2
131	! iflag_ratqs=2 was the option retained for LMDZ5A (see Hourdin et al. 2013)
132
133	else if (iflag_ratqs .eq. 1) then
134
135	do k = 1, klev
136	do i = 1, klon
137	if (pplay(i, k) .ge. 60000.) then
138	ratqss(i, k) = ratqsbas
139	else if ((pplay(i, k) .ge. 30000.) .and. (pplay(i, k) .lt. 60000.)) then
140	ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas)*(60000.-pplay(i, k))/(60000.-30000.)
141	else
142	ratqss(i, k) = ratqshaut
143	end if
144	end do
145	end do
146
147	else if (iflag_ratqs .eq. 2) then
148
149	do k = 1, klev
150	do i = 1, klon
151	if (pplay(i, k) .ge. 60000.) then
152	ratqss(i, k) = ratqsbas*(paprs(i, 1) - pplay(i, k))/(paprs(i, 1) - 60000.)
153	else if ((pplay(i, k) .ge. 30000.) .and. (pplay(i, k) .lt. 60000.)) then
154	ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas)*(60000.-pplay(i, k))/(60000.-30000.)
155	else
156	ratqss(i, k) = ratqshaut
157	end if
158	end do
159	end do
160
161	! quadratic dependency upon pressure
162
163	else if (iflag_ratqs == 3) then
164	do k = 1, klev
165	ratqss(:, k) = ratqsbas + (ratqshaut - ratqsbas) &
166	min(((paprs(:, 1) - pplay(:, k))/70000.)*2, 1.)
167	end do
168
169	! atan dependency on pressure, ratqsp0 being the pressure
170	! where the transition occurs and ratqsdp controls
171	! the sharpness of the transition. This is the version used
172	! in LMDZ6A (see Madeleine et al. 2020, fig 2).
173
174	else if (iflag_ratqs == 4) then
175	do k = 1, klev
176	ratqss(:, k) = ratqsbas + 0.5*(ratqshaut - ratqsbas) &
177	*(tanh((ratqsp0 - pplay(:, k))/ratqsdp) + 1.)
178	end do
179
180	else if (iflag_ratqs == 5) then
181	! Dependency of ratqs on model resolution (dependency on sqrt(cell_area)
182	! according to high-tropo aircraft obs, A. Borella PhD)
183	do k = 1, klev
184	do i = 1, klon
185	resol = sqrt(cell_area(i))
186	fact = sqrt(resol/resolmax_glo)
187	ratqss(i, k) = ratqsbasfact + 0.5(ratqshaut - ratqsbas)*fact &
188	*(tanh((ratqsp0 - pplay(i, k))/ratqsdp) + 1.)
189	end do
190	end do
191
192	else if (iflag_ratqs .GE. 10) then
193
194	! interactive ratqss calculations that depend on cold pools, orography
195	! This should help getting a more realistic ratqs in the low and mid troposphere
196	! We however need a "background" ratqs to account for subgrid distribution of qt (or qt/qs)
197	! in the high troposphere.
198	! work of Louis d'Alecon, PhD
199
200	! background atan ratqs and initialisations
201	do k = 1, klev
202	do i = 1, klon
203	ratqss(i, k) = ratqsbas + 0.5*(ratqshaut - ratqsbas) &
204	*(tanh((ratqsp0 - pplay(i, k))/ratqsdp) + 1.)
205	ratqss(i, k) = max(ratqss(i, k), 0.0)
206	ratqs_oro_(i, k) = 0.
207	ratqs_inter_(i, k) = 0
208	end do
209	end do
210
211	if ((iflag_ratqs .EQ. 10) .OR. (iflag_ratqs .EQ. 11)) then
212	! interactive ratqs with several sources
213	call ratqs_inter(klon, klev, iflag_ratqs, pdtphys, paprs, &
214	ratqsbas, wake_deltaq, wake_s, q_seri, qtc_cv, sigt_cv, &
215	fm_therm, entr_therm, detr_therm, detrain_cv, fm_cv, fqd, fqcomp, sigd, &
216	ratqs_inter_, sigma_qtherm)
217	ratqss = ratqss + ratqs_inter_
218	else if (iflag_ratqs .EQ. 12) then
219	! contribution of subgrid orography to ratqs
220	call ratqs_oro(klon, klev, nbsrf, is_ter, is_lic, pctsrf, zstd, qsat, t_seri, pplay, paprs, ratqs_oro_)
221	ratqss = ratqss + ratqs_oro_
222	end if
223
224	end if
225
226	! Second step: total ratqs calculation
227	!----------------------------------------
228
229	if (iflag_cld_th .eq. 1 .or. iflag_cld_th .eq. 2 .or. iflag_cld_th .eq. 4) then
230
231	! ratqs are a combination of ratqss et ratqsc
232
233	if (prt_level .ge. 9) write (lunout, *) 'PHYLMD NEW TAU_RATQS ', tau_ratqs
234
235	if (tau_ratqs > 1.e-10) then
236	facteur = exp(-pdtphys/tau_ratqs)
237	else
238	facteur = 0.
239	end if
240	ratqs(:, :) = ratqsc(:, :)(1.-facteur) + ratqs(:, :)facteur
241	ratqs(:, :) = max(ratqs(:, :), ratqss(:, :))
242
243	else if (iflag_cld_th <= 6) then
244
245	! ratqs is taken equal to ratqss
246	ratqs(:, :) = ratqss(:, :)
247
248	else
249
250	! additional exploratory combinations of ratqss and ratqsc
251	zfratqs1 = exp(-pdtphys/10800.)
252	zfratqs2 = exp(-pdtphys/10800.)
253	do k = 1, klev
254	do i = 1, klon
255	if (ratqsc(i, k) .gt. 1.e-10) then
256	ratqs(i, k) = ratqs(i, k)zfratqs2 + (iflag_cld_th/100.)ratqsc(i, k)*(1.-zfratqs2)
257	end if
258	ratqs(i, k) = min(ratqs(i, k)zfratqs1 + ratqss(i, k)(1.-zfratqs1), 0.5)
259	end do
260	end do
261	end if
262
263	return
264	END SUBROUTINE ratqs_main
265
266	!========================================================================
267	SUBROUTINE ratqs_inter(klon, klev, iflag_ratqs, pdtphys, paprs, &
268	ratqsbas, wake_deltaq, wake_s, q_seri, qtc_cv, sigt_cv, &
269	fm_therm, entr_therm, detr_therm, detrain_cv, fm_cv, fqd, fqcomp, sigd, &
270	ratqs_inter_, sigma_qtherm)
271
272	USE lmdz_lscp_ini, ONLY: a_ratqs_cv, tau_var, fac_tau, tau_cumul, a_ratqs_wake, dqimpl
273	USE lmdz_lscp_ini, ONLY: RG
274	USE lmdz_lscp_ini, ONLY: povariance, var_conv
275	USE lmdz_thermcell_dq, ONLY: thermcell_dq
276
277	implicit none
278
279	!========================================================================
280	! This routine computes a ratqsbas value through an interactive method
281	! that accounts for explicit source terms from convection parameterizations
282	! L. d'Alencon, 25/02/2021
283	! contact Frederic Hourdin, frederic.hourdin@lmd.ipsl.fr
284	! Catherine Rio, catherine.rio@meteo.fr
285	!
286	! References:
287	! Klein et al. 2005, doi: 10.1029/2004JD005017
288	!========================================================================
289
290	! Declarations
291
292	! Input
293	integer, intent(in) :: klon, klev ! horizontal and vertical dimensions
294	integer, intent(in) :: iflag_ratqs ! flag that controls ratqs options
295	real, intent(in) :: pdtphys ! physics time step [s]
296	real, intent(in) :: ratqsbas ! ratqs value near the surface [-]
297	real, dimension(klon, klev + 1), intent(in) :: paprs ! pressure at layers'interface [Pa]
298	real, dimension(klon, klev), intent(in) :: wake_deltaq ! difference in humidity between wakes and environment [kg/kg]
299	real, dimension(klon, klev), intent(in) :: q_seri ! total water specific humidity [kg/kg]
300	real, dimension(klon), intent(in) :: wake_s ! fractional area covered by wakes [-]
301	real, dimension(klon, klev + 1), intent(in) :: fm_therm ! mass flux in thermals [kg/m2/s]
302	real, dimension(klon, klev), intent(in) :: entr_therm ! thermal plume entrainment rate * dz [kg/s/m2]
303	real, dimension(klon, klev), intent(in) :: detr_therm ! thermal plume detrainment rate * dz [kg/s/m2]
304	real, dimension(klon, klev), intent(in) :: qtc_cv ! total specific moisture in convective saturated draughts [kg/kg]
305	real, dimension(klon, klev), intent(in) :: sigt_cv ! surface fraction of convective saturated draughts [-]
306	real, dimension(klon, klev), intent(in) :: detrain_cv ! deep convection detrainment of specific humidity variance [kg/s/m2*(kg/kg)^2]
307	real, dimension(klon, klev), intent(in) :: fm_cv ! deep convective mass flux [kg/s/m2]
308	real, dimension(klon, klev), intent(in) :: fqd ! specific humidity tendency due to convective precip [kg/kg/s]
309	real, dimension(klon, klev), intent(in) :: fqcomp ! specific humidity tendency due to convective mixed draughts [kg/ks/s]
310	real, dimension(klon), intent(in) :: sigd ! fractional area covered by unsaturated convective downdrafts [-]
311
312	! Inout and output
313	real, dimension(klon, klev), intent(inout) :: ratqs_inter_
314	real, dimension(klon, klev), intent(out) :: sigma_qtherm
315
316	! local
317	LOGICAL, PARAMETER :: klein = .false.
318	LOGICAL, PARAMETER :: klein_conv = .true.
319	REAL, PARAMETER :: taup0 = 70000
320	REAL, PARAMETER :: taudp = 500
321	integer :: lev_out
322	REAL, DIMENSION(klon, klev) :: zmasse, entr0, detr0, detraincv, dqp, detrain_p, q0, qd0, tau_diss
323	REAL, DIMENSION(klon, klev + 1) :: fm0
324	integer i, k
325	real, dimension(klon, klev) :: wake_dq
326
327	real, dimension(klon) :: max_sigd, max_dqconv, max_sigt
328	real, dimension(klon, klev) :: zoa, zocarrea, pdocarreadj, pocarre, po, pdoadj, varq_therm
329	real, dimension(klon, klev) :: var_moy, var_var, var_desc_th, var_det_conv, var_desc_prec, var_desc_conv
330
331	lev_out = 0.
332
333	! Computation of layers' mass
334	!-----------------------------------------------------------------------
335
336	do k = 1, klev
337	zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1))/RG
338	end do
339
340	! Computation of detrainment term of humidity variance due to thermal plumes
341	!---------------------------------------------------------------------------
342
343	! initialisations
344
345	do k = 1, klev
346	do i = 1, klon
347	tau_diss(i, k) = tau_var + 0.5fac_tautau_var*(tanh((taup0 - paprs(i, k))/taudp) + 1.)
348	end do
349	end do
350
351	entr0(:, :) = entr_therm(:, :)
352	fm0(:, :) = fm_therm(:, :)
353	detr0(:, :) = detr_therm(:, :)
354
355	! computation of the square of specific humidity and circulation in thermals
356	po(:, :) = q_seri(:, :)
357	call thermcell_dq(klon, klev, dqimpl, pdtphys, fm0, entr0, zmasse, &
358	& po, pdoadj, zoa, lev_out)
359	do k = 1, klev
360	do i = 1, klon
361	pocarre(i, k) = po(i, k)*po(i, k) + povariance(i, k)
362	end do
363	end do
364	call thermcell_dq(klon, klev, dqimpl, pdtphys, fm0, entr0, zmasse, &
365	& pocarre, pdocarreadj, zocarrea, lev_out)
366
367	! variance of total specific humidity in thermals
368	do k = 1, klev
369	do i = 1, klon
370	varq_therm(i, k) = zocarrea(i, k) - zoa(i, k)*zoa(i, k)
371	end do
372	end do
373
374	! computation of source terms of variance due to thermals and deep convection (see Klein et al. 2005)
375	do k = 1, klev
376	do i = 1, klon
377	var_moy(i, k) = detr0(i, k)((zoa(i, k) - po(i, k))*2)/zmasse(i, k)
378	var_var(i, k) = detr0(i, k)*(varq_therm(i, k) - povariance(i, k))/zmasse(i, k)
379	var_det_conv(i, k) = a_ratqs_cv*(detrain_cv(i, k)/zmasse(i, k))
380	if (sigd(i) .ne. 0) then
381	var_desc_prec(i, k) = sigd(i)(1 - sigd(i))(fqd(i, k)tau_cumul/sigd(i))*2/tau_cumul
382	else
383	var_desc_prec(i, k) = 0
384	end if
385	end do
386	end do
387
388	do k = 1, klev - 1
389	do i = 1, klon
390	var_desc_th(i, k) = fm0(i, k + 1)*povariance(i, k + 1)/zmasse(i, k) - &
391	fm0(i, k)*povariance(i, k)/zmasse(i, k)
392	var_desc_conv(i, k) = ((povariance(i, k + 1) - povariance(i, k))*(fm_cv(i, k)/zmasse(i, k)))
393	end do
394	end do
395	var_desc_th(:, klev) = var_desc_th(:, klev - 1)
396	var_desc_conv(:, klev) = var_desc_conv(:, klev - 1)
397
398	if (klein) then
399	do k = 1, klev - 1
400	do i = 1, klon
401	qd0(:, :) = 0.0
402	if (sigd(i) .ne. 0) then
403	qd0(i, k) = fqd(i, k)*tau_cumul/sigd(i)
404	end if
405	end do
406	end do
407	do k = 1, klev - 1
408	do i = 1, klon
409	povariance(i, k) = (var_moy(i, k) + var_var(i, k) + var_desc_th(i, k) + &
410	var_det_conv(i, k) + var_desc_prec(i, k) &
411	+ var_desc_conv(i, k))*pdtphys + povariance(i, k)
412	povariance(i, k) = povariance(i, k)*exp(-pdtphys/tau_diss(i, k))
413	end do
414	end do
415	povariance(:, klev) = povariance(:, klev - 1)
416
417	else ! direct computation
418	qd0(:, :) = 0.0
419	q0(:, :) = 0.0
420	do k = 1, klev - 1
421	do i = 1, klon
422	if (sigd(i) .ne. 0) then ! variance terms through accumulation
423	qd0(i, k) = fqd(i, k)*tau_cumul/sigd(i)
424	end if
425	if (sigt_cv(i, k) .ne. 0) then
426	q0(i, k) = fqcomp(i, k)*tau_cumul/sigt_cv(i, k)
427	end if
428	end do
429	end do
430	do k = 1, klev - 1
431	do i = 1, klon
432	povariance(i, k) = (pdocarreadj(i, k) - 2.po(i, k)pdoadj(i, k) + &
433	a_ratqs_cv(sigt_cv(i, k)(1 - sigt_cv(i, k))q0(i, k)*2/tau_cumul + var_desc_prec(i, k) + &
434	var_desc_conv(i, k)))*pdtphys + povariance(i, k)
435	povariance(i, k) = povariance(i, k)*exp(-pdtphys/tau_diss(i, k))
436	end do
437	end do
438	povariance(:, klev) = povariance(:, klev - 1)
439	! fqd(:,:)=sigt_cv(:,:)(1-sigt_cv(:,:))q0(:,:)**2/tau_cumul
440	end if
441
442	! Final ratqs_inter_ computation
443	!-------------------------------------------------------------------------
444
445	do k = 1, klev
446	do i = 1, klon
447	if (q_seri(i, k) .ge. 1E-7) then
448	ratqs_inter_(i, k) = abs(povariance(i, k))**0.5/q_seri(i, k)
449	sigma_qtherm(i, k) = abs(varq_therm(i, k))**0.5 ! sigma in thermals
450	else
451	ratqs_inter_(i, k) = 0.
452	sigma_qtherm(i, k) = 0.
453	end if
454	end do
455	end do
456
457	return
458
459	END SUBROUTINE ratqs_inter
460
461	!===========================================================================
462	SUBROUTINE ratqs_oro(klon, klev, nbsrf, is_ter, is_lic, pctsrf, zstd, qsat, temp, pplay, paprs, ratqs_oro_)
463
464	!--------------------------------------------------------------------------
465	! This routine computes the dependency of ratqs on the relief over lands.
466	! It considers the variability of q explained by temperature, hence qsat,
467	! variations due to subgrid relief.
468	! contact E. Vignon, etienne.vignon@lmd.ipsl.fr
469	!--------------------------------------------------------------------------
470
471	USE lmdz_lscp_ini, ONLY: RG, RV, RD, RLSTT, RLVTT, RTT
472
473	IMPLICIT NONE
474
475	! Declarations
476	!--------------
477
478	! Input
479
480	INTEGER, INTENT(IN) :: klon ! number of horizontal grid points
481	INTEGER, INTENT(IN) :: klev ! number of vertical layers
482	INTEGER, INTENT(IN) :: nbsrf ! number of subgrid tiles
483	INTEGER, INTENT(IN) :: is_ter, is_lic ! indices for landice and land tiles
484	REAL, DIMENSION(klon, nbsrf) :: pctsrf ! fraction of different tiles [0-1]
485	REAL, DIMENSION(klon, klev), INTENT(IN) :: qsat ! saturation specific humidity [kg/kg]
486	REAL, DIMENSION(klon), INTENT(IN) :: zstd ! sub grid orography standard deviation [m]
487	REAL, DIMENSION(klon, klev), INTENT(IN) :: temp ! air temperature [K]
488	REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay ! air pressure, layer's center [Pa]
489	REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs ! air pressure, lower inteface [Pa]
490
491	! Output
492
493	REAL, DIMENSION(klon, klev), INTENT(out) :: ratqs_oro_ ! ratqs profile due to subgrid orography
494
495	! Local
496
497	INTEGER :: i, k
498	REAL, DIMENSION(klon) :: orogradT, xsi0
499	REAL, DIMENSION(klon, klev) :: zlay
500	REAL :: Lvs, temp0
501
502	! Calculation of the near-surface temperature gradient along the topography
503	!--------------------------------------------------------------------------
504
505	! at the moment, we fix it at a constant value (moist adiab. lapse rate)
506
507	orogradT(:) = -6.5/1000. ! K/m
508
509	! Calculation of near-surface surface ratqs
510	!-------------------------------------------
511
512	DO i = 1, klon
513	temp0 = temp(i, 1)
514	IF (temp0 .LT. RTT) THEN
515	Lvs = RLSTT
516	ELSE
517	Lvs = RLVTT
518	END IF
519	xsi0(i) = zstd(i)ABS(orogradT(i))Lvs/temp0/temp0/RV
520	ratqs_oro_(i, 1) = xsi0(i)
521	END DO
522
523	! Vertical profile of ratqs assuming an exponential decrease with height
524	!------------------------------------------------------------------------
525
526	! calculation of geop. height AGL
527	zlay(:, 1) = RDtemp(:, 1)/(0.5(paprs(:, 1) + pplay(:, 1))) &
528	*(paprs(:, 1) - pplay(:, 1))/RG
529
530	DO k = 2, klev
531	DO i = 1, klon
532	zlay(i, k) = zlay(i, k - 1) + RD0.5(temp(i, k - 1) + temp(i, k)) &
533	/paprs(i, k)*(pplay(i, k - 1) - pplay(i, k))/RG
534
535	ratqs_oro_(i, k) = MAX(0.0, pctsrf(i, is_ter)xsi0(i)exp(-zlay(i, k)/MAX(zstd(i), 1.)))
536	END DO
537	END DO
538
539	END SUBROUTINE ratqs_oro
540	!===========================================================================
541
542	END MODULE lmdz_lscp_subgridvarq

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

Download in other formats:

Original Format