Context Navigation

stdlevvar_mod.F90 @ 5139

Last change on this file since 5139 was 5139, checked in by abarral, 3 months ago
Put nuage.h, flux_arp.h, compbl.h into modules Move unused phylmd/ini_hist* to obsolete
Property svn:executable set to ``*
File size: 25.8 KB

Line
1
2	MODULE stdlevvar_mod
3
4	! This module contains main procedures for calculation
5	! of temperature, specific humidity and wind at a reference level
6
7	USE cdrag_mod
8	USE screenp_mod
9	USE screenc_mod
10	IMPLICIT NONE
11
12	CONTAINS
13
14	!****************************************************************************************
15
16	!r original routine svn3623
17
18	SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
19	u1, v1, t1, q1, z1, &
20	ts1, qsurf, z0m, z0h, psol, pat1, &
21	t_2m, q_2m, t_10m, q_10m, u_10m, ustar, s_pblh, prain, tsol)
22	USE lmdz_flux_arp, ONLY: fsens, flat, betaevap, ust, tg, ok_flux_surf, ok_prescr_ust, ok_prescr_beta, ok_forc_tsurf
23
24	IMPLICIT NONE
25	!-------------------------------------------------------------------------
26
27	! Objet : calcul de la temperature et l'humidite relative a 2m et du
28	! module du vent a 10m a partir des relations de Dyer-Businger et
29	! des equations de Louis.
30
31	! Reference : Hess, Colman et McAvaney (1995)
32
33	! I. Musat, 01.07.2002
34
35	!AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
36
37	!-------------------------------------------------------------------------
38
39	! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
40	! knon----input-I- nombre de points pour un type de surface
41	! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
42	! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
43	! u1------input-R- vent zonal au 1er niveau du modele
44	! v1------input-R- vent meridien au 1er niveau du modele
45	! t1------input-R- temperature de l'air au 1er niveau du modele
46	! q1------input-R- humidite relative au 1er niveau du modele
47	! z1------input-R- geopotentiel au 1er niveau du modele
48	! ts1-----input-R- temperature de l'air a la surface
49	! qsurf---input-R- humidite relative a la surface
50	! z0m, z0h---input-R- rugosite
51	! psol----input-R- pression au sol
52	! pat1----input-R- pression au 1er niveau du modele
53
54	! t_2m---output-R- temperature de l'air a 2m
55	! q_2m---output-R- humidite relative a 2m
56	! u_10m--output-R- vitesse du vent a 10m
57	!AM
58	! t_10m--output-R- temperature de l'air a 10m
59	! q_10m--output-R- humidite specifique a 10m
60	! ustar--output-R- u*
61
62	INTEGER, INTENT(IN) :: klon, knon, nsrf
63	LOGICAL, INTENT(IN) :: zxli
64	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, t1, q1, z1, ts1
65	REAL, DIMENSION(klon), INTENT(IN) :: qsurf
66	REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h
67	REAL, DIMENSION(klon), INTENT(IN) :: psol, pat1
68
69	REAL, DIMENSION(klon), INTENT(OUT) :: t_2m, q_2m, ustar
70	REAL, DIMENSION(klon), INTENT(OUT) :: u_10m, t_10m, q_10m
71	REAL, DIMENSION(klon), INTENT(INOUT) :: s_pblh
72	REAL, DIMENSION(klon), INTENT(IN) :: prain
73	REAL, DIMENSION(klon), INTENT(IN) :: tsol
74	!-------------------------------------------------------------------------
75	include "YOMCST.h"
76	!IM PLUS
77	include "YOETHF.h"
78
79	! Quelques constantes et options:
80
81	! RKAR : constante de von Karman
82	REAL, PARAMETER :: RKAR=0.40
83	! niter : nombre iterations calcul "corrector"
84	! INTEGER, parameter :: niter=6, ncon=niter-1
85	INTEGER, parameter :: niter=2, ncon=niter-1
86
87	! Variables locales
88	INTEGER :: i, n
89	REAL :: zref
90	REAL, DIMENSION(klon) :: speed
91	! tpot : temperature potentielle
92	REAL, DIMENSION(klon) :: tpot
93	REAL, DIMENSION(klon) :: zri1, cdran
94	REAL, DIMENSION(klon) :: cdram, cdrah
95	! ri1 : nb. de Richardson entre la surface --> la 1ere couche
96	REAL, DIMENSION(klon) :: ri1
97	REAL, DIMENSION(klon) :: testar, qstar
98	REAL, DIMENSION(klon) :: zdte, zdq
99	! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney
100	DOUBLE PRECISION, DIMENSION(klon) :: lmon
101	DOUBLE PRECISION, parameter :: eps=1.0D-20
102	REAL, DIMENSION(klon) :: delu, delte, delq
103	REAL, DIMENSION(klon) :: u_zref, te_zref, q_zref
104	REAL, DIMENSION(klon) :: temp, pref
105	LOGICAL :: okri
106	REAL, DIMENSION(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
107	!convertgence
108	REAL, DIMENSION(klon) :: te_zref_con, q_zref_con
109	REAL, DIMENSION(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
110	REAL, DIMENSION(klon) :: ok_pred, ok_corr, zri_zero
111	! REAL, DIMENSION(klon) :: conv_te, conv_q
112	!-------------------------------------------------------------------------
113	DO i=1, knon
114	speed(i)=SQRT(u1(i)2+v1(i)2)
115	ri1(i) = 0.0
116	ENDDO
117
118	okri=.FALSE.
119	! CALL coefcdrag(klon, knon, nsrf, zxli, &
120	! & speed, t1, q1, z1, psol, &
121	! & ts1, qsurf, rugos, okri, ri1, &
122	! & cdram, cdrah, cdran, zri1, pref)
123	! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
124
125	CALL cdrag(knon, nsrf, &
126	speed, t1, q1, z1, &
127	psol, s_pblh, ts1, qsurf, z0m, z0h, &
128	zri_zero, 0, &
129	cdram, cdrah, zri1, pref, prain, tsol, pat1)
130
131	! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
132	IF (ok_prescr_ust) THEN
133	DO i = 1, knon
134	print *,'cdram avant=',cdram(i)
135	cdram(i) = ust*ust/speed(i)/speed(i)
136	print *,'cdram ust speed apres=',cdram(i),ust,speed
137	ENDDO
138	ENDIF
139
140	!---------Star variables----------------------------------------------------
141
142	DO i = 1, knon
143	ri1(i) = zri1(i)
144	tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
145	ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
146	zdte(i) = tpot(i) - ts1(i)
147	zdq(i) = max(q1(i),0.0) - max(qsurf(i),0.0)
148
149
150	!IM BUG BUG BUG zdte(i) = max(zdte(i),1.e-10)
151	zdte(i) = sign(max(abs(zdte(i)),1.e-10),zdte(i))
152
153	testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
154	qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
155	lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ &
156	(RKAR * RG * testar(i))
157	ENDDO
158
159	!----------First aproximation of variables at zref --------------------------
160	zref = 2.0
161	CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
162	ts1, qsurf, z0m, lmon, &
163	ustar, testar, qstar, zref, &
164	delu, delte, delq)
165
166	DO i = 1, knon
167	u_zref(i) = delu(i)
168	q_zref(i) = max(qsurf(i),0.0) + delq(i)
169	te_zref(i) = ts1(i) + delte(i)
170	temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
171	q_zref_p(i) = q_zref(i)
172	! te_zref_p(i) = te_zref(i)
173	temp_p(i) = temp(i)
174	ENDDO
175
176	! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
177
178	DO n = 1, niter
179
180	okri=.TRUE.
181	CALL screenc(klon, knon, nsrf, zxli, &
182	u_zref, temp, q_zref, zref, &
183	ts1, qsurf, z0m, z0h, psol, &
184	ustar, testar, qstar, okri, ri1, &
185	pref, delu, delte, delq, s_pblh ,prain, tsol, pat1)
186
187	DO i = 1, knon
188	u_zref(i) = delu(i)
189	q_zref(i) = delq(i) + max(qsurf(i),0.0)
190	te_zref(i) = delte(i) + ts1(i)
191
192	! return to normal temperature
193
194	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
195	! temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
196	! (1 + RVTMP2 * max(q_zref(i),0.0))
197
198	!IM +++
199	! IF(temp(i).GT.350.) THEN
200	! WRITE(,) 'temp(i) GT 350 K !!',i,nsrf,temp(i)
201	! ENDIF
202	!IM ---
203
204	IF(n==ncon) THEN
205	te_zref_con(i) = te_zref(i)
206	q_zref_con(i) = q_zref(i)
207	ENDIF
208
209	ENDDO
210
211	ENDDO
212
213	! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
214
215	! DO i = 1, knon
216	! conv_te(i) = (te_zref(i) - te_zref_con(i))/te_zref_con(i)
217	! conv_q(i) = (q_zref(i) - q_zref_con(i))/q_zref_con(i)
218	!IM +++
219	! IF(abs(conv_te(i)).GE.0.0025.AND.abs(conv_q(i)).GE.0.05) THEN
220	! PRINT*,'DIV','i=',i,te_zref_con(i),te_zref(i),conv_te(i), &
221	! q_zref_con(i),q_zref(i),conv_q(i)
222	! ENDIF
223	!IM ---
224	! ENDDO
225
226	DO i = 1, knon
227	q_zref_c(i) = q_zref(i)
228	temp_c(i) = temp(i)
229
230	! IF(zri1(i).LT.0.) THEN
231	! IF(nsrf.EQ.1) THEN
232	! ok_pred(i)=1.
233	! ok_corr(i)=0.
234	! ELSE
235	! ok_pred(i)=0.
236	! ok_corr(i)=1.
237	! ENDIF
238	! ELSE
239	! ok_pred(i)=0.
240	! ok_corr(i)=1.
241	! ENDIF
242
243	ok_pred(i)=0.
244	ok_corr(i)=1.
245
246	t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
247	q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
248	!IM +++
249	! IF(n.EQ.niter) THEN
250	! IF(t_2m(i).LT.t1(i).AND.t_2m(i).LT.ts1(i)) THEN
251	! PRINT*,' BAD t2m LT ',i,nsrf,t_2m(i),t1(i),ts1(i)
252	! ELSEIF(t_2m(i).GT.t1(i).AND.t_2m(i).GT.ts1(i)) THEN
253	! PRINT*,' BAD t2m GT ',i,nsrf,t_2m(i),t1(i),ts1(i)
254	! ENDIF
255	! ENDIF
256	!IM ---
257	ENDDO
258
259
260	!----------First aproximation of variables at zref --------------------------
261
262	zref = 10.0
263	CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
264	ts1, qsurf, z0m, lmon, &
265	ustar, testar, qstar, zref, &
266	delu, delte, delq)
267
268	DO i = 1, knon
269	u_zref(i) = delu(i)
270	q_zref(i) = max(qsurf(i),0.0) + delq(i)
271	te_zref(i) = ts1(i) + delte(i)
272	temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
273	! temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
274	! (1 + RVTMP2 * max(q_zref(i),0.0))
275	u_zref_p(i) = u_zref(i)
276	ENDDO
277
278	! Iteration of the variables at the reference level zref : corrector ; see Hess & McAvaney, 1995
279
280	DO n = 1, niter
281
282	okri=.TRUE.
283	CALL screenc(klon, knon, nsrf, zxli, &
284	u_zref, temp, q_zref, zref, &
285	ts1, qsurf, z0m, z0h, psol, &
286	ustar, testar, qstar, okri, ri1, &
287	pref, delu, delte, delq, s_pblh ,prain, tsol, pat1)
288
289	DO i = 1, knon
290	u_zref(i) = delu(i)
291	q_zref(i) = delq(i) + max(qsurf(i),0.0)
292	te_zref(i) = delte(i) + ts1(i)
293	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
294	! temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
295	! (1 + RVTMP2 * max(q_zref(i),0.0))
296	ENDDO
297
298	ENDDO
299
300	DO i = 1, knon
301	u_zref_c(i) = u_zref(i)
302
303	u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
304
305	!AM
306	q_zref_c(i) = q_zref(i)
307	temp_c(i) = temp(i)
308	t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
309	q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
310	!MA
311	ENDDO
312
313
314	END SUBROUTINE stdlevvar
315
316	SUBROUTINE stdlevvarn(klon, knon, nsrf, zxli, &
317	u1, v1, t1, q1, z1, &
318	ts1, qsurf, z0m, z0h, psol, pat1, &
319	t_2m, q_2m, t_10m, q_10m, u_10m, ustar, &
320	n2mout)
321
322	USE lmdz_ioipsl_getin_p, ONLY: getin_p
323	USE lmdz_flux_arp, ONLY: fsens, flat, betaevap, ust, tg, ok_flux_surf, ok_prescr_ust, ok_prescr_beta, ok_forc_tsurf
324
325	IMPLICIT NONE
326	!-------------------------------------------------------------------------
327
328	! Objet : calcul de la temperature et l'humidite relative a 2m et du
329	! module du vent a 10m a partir des relations de Dyer-Businger et
330	! des equations de Louis.
331
332	! Reference : Hess, Colman et McAvaney (1995)
333
334	! I. Musat, 01.07.2002
335
336	!AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
337
338	!-------------------------------------------------------------------------
339
340	! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
341	! knon----input-I- nombre de points pour un type de surface
342	! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
343	! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
344	! u1------input-R- vent zonal au 1er niveau du modele
345	! v1------input-R- vent meridien au 1er niveau du modele
346	! t1------input-R- temperature de l'air au 1er niveau du modele
347	! q1------input-R- humidite relative au 1er niveau du modele
348	! z1------input-R- geopotentiel au 1er niveau du modele
349	! ts1-----input-R- temperature de l'air a la surface
350	! qsurf---input-R- humidite relative a la surface
351	! z0m, z0h---input-R- rugosite
352	! psol----input-R- pression au sol
353	! pat1----input-R- pression au 1er niveau du modele
354
355	! t_2m---output-R- temperature de l'air a 2m
356	! q_2m---output-R- humidite relative a 2m
357	! u_2m--output-R- vitesse du vent a 2m
358	! u_10m--output-R- vitesse du vent a 10m
359	! ustar--output-R- u*
360	!AM
361	! t_10m--output-R- temperature de l'air a 10m
362	! q_10m--output-R- humidite specifique a 10m
363
364	INTEGER, INTENT(IN) :: klon, knon, nsrf
365	LOGICAL, INTENT(IN) :: zxli
366	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, t1, q1, ts1, z1
367	REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h
368	REAL, DIMENSION(klon), INTENT(IN) :: qsurf
369	REAL, DIMENSION(klon), INTENT(IN) :: psol, pat1
370
371	REAL, DIMENSION(klon), INTENT(OUT) :: t_2m, q_2m, ustar
372	REAL, DIMENSION(klon), INTENT(OUT) :: u_10m, t_10m, q_10m
373	INTEGER, DIMENSION(klon, 6), INTENT(OUT) :: n2mout
374
375	REAL, DIMENSION(klon) :: u_2m
376	REAL, DIMENSION(klon) :: cdrm2m, cdrh2m, ri2m
377	REAL, DIMENSION(klon) :: cdram, cdrah, zri1
378	REAL, DIMENSION(klon) :: cdmn1, cdhn1, fm1, fh1
379	REAL, DIMENSION(klon) :: cdmn2m, cdhn2m, fm2m, fh2m
380	REAL, DIMENSION(klon) :: ri2m_new
381	REAL, DIMENSION(klon) :: s_pblh
382	REAL, DIMENSION(klon) :: prain
383	REAL, DIMENSION(klon) :: tsol
384	!-------------------------------------------------------------------------
385	include "YOMCST.h"
386	!IM PLUS
387	include "YOETHF.h"
388
389	! Quelques constantes et options:
390
391	! RKAR : constante de von Karman
392	REAL, PARAMETER :: RKAR=0.40
393	! niter : nombre iterations calcul "corrector"
394	! INTEGER, parameter :: niter=6, ncon=niter-1
395	!IM 071020 INTEGER, parameter :: niter=2, ncon=niter-1
396	INTEGER, parameter :: niter=2, ncon=niter
397	! INTEGER, parameter :: niter=6, ncon=niter
398
399	! Variables locales
400	INTEGER :: i, n
401	REAL :: zref
402	REAL, DIMENSION(klon) :: speed
403	! tpot : temperature potentielle
404	REAL, DIMENSION(klon) :: tpot
405	REAL, DIMENSION(klon) :: cdran
406	! ri1 : nb. de Richardson entre la surface --> la 1ere couche
407	REAL, DIMENSION(klon) :: ri1
408	DOUBLE PRECISION, parameter :: eps=1.0D-20
409	REAL, DIMENSION(klon) :: delu, delte, delq
410	REAL, DIMENSION(klon) :: delh, delm
411	REAL, DIMENSION(klon) :: delh_new, delm_new
412	REAL, DIMENSION(klon) :: u_zref, te_zref, q_zref
413	REAL, DIMENSION(klon) :: u_zref_pnew, te_zref_pnew, q_zref_pnew
414	REAL, DIMENSION(klon) :: temp, pref
415	REAL, DIMENSION(klon) :: temp_new, pref_new
416	LOGICAL :: okri
417	REAL, DIMENSION(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
418	REAL, DIMENSION(klon) :: u_zref_p_new, te_zref_p_new, temp_p_new, q_zref_p_new
419	!convergence
420	REAL, DIMENSION(klon) :: te_zref_con, q_zref_con
421	REAL, DIMENSION(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
422	REAL, DIMENSION(klon) :: ok_pred, ok_corr
423
424	REAL, DIMENSION(klon) :: cdrm10m, cdrh10m, ri10m
425	REAL, DIMENSION(klon) :: cdmn10m, cdhn10m, fm10m, fh10m
426	REAL, DIMENSION(klon) :: cdn2m, cdn1, zri_zero
427	REAL :: CEPDUE,zdu2
428	INTEGER :: nzref, nz1
429	LOGICAL, DIMENSION(klon) :: ok_t2m_toosmall, ok_t2m_toobig
430	LOGICAL, DIMENSION(klon) :: ok_q2m_toosmall, ok_q2m_toobig
431	LOGICAL, DIMENSION(klon) :: ok_u2m_toobig
432	LOGICAL, DIMENSION(klon) :: ok_t10m_toosmall, ok_t10m_toobig
433	LOGICAL, DIMENSION(klon) :: ok_q10m_toosmall, ok_q10m_toobig
434	LOGICAL, DIMENSION(klon) :: ok_u10m_toobig
435	INTEGER, DIMENSION(klon, 6) :: n10mout
436
437	!-------------------------------------------------------------------------
438	CEPDUE=0.1
439
440	! n2mout : compteur des pas de temps ou t2m,q2m ou u2m sont en dehors des intervalles
441	! [tsurf, temp], [qsurf, q1] ou [0, speed]
442	! n10mout : compteur des pas de temps ou t10m,q10m ou u10m sont en dehors des intervalles
443	! [tsurf, temp], [qsurf, q1] ou [0, speed]
444
445	n2mout(:,:)=0
446	n10mout(:,:)=0
447
448	DO i=1, knon
449	speed(i)=MAX(SQRT(u1(i)2+v1(i)2),CEPDUE)
450	ri1(i) = 0.0
451	ENDDO
452
453	okri=.FALSE.
454	CALL cdrag(knon, nsrf, &
455	speed, t1, q1, z1, &
456	psol, s_pblh, ts1, qsurf, z0m, z0h, &
457	zri_zero, 0, &
458	cdram, cdrah, zri1, pref, prain, tsol, pat1)
459
460	DO i = 1, knon
461	ri1(i) = zri1(i)
462	tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
463	zdu2 = MAX(CEPDUECEPDUE, speed(i)*2)
464	ustar(i) = sqrt(cdram(i) * zdu2)
465
466	ENDDO
467
468	!----------First aproximation of variables at zref --------------------------
469	zref = 2.0
470
471	! calcul first-guess en utilisant dans les calculs à 2m
472	! le Richardson de la premiere couche atmospherique
473
474	CALL screencn(klon, knon, nsrf, zxli, &
475	speed, tpot, q1, zref, &
476	ts1, qsurf, z0m, z0h, psol, &
477	cdram, cdrah, okri, &
478	ri1, 1, &
479	pref_new, delm_new, delh_new, ri2m, &
480	s_pblh, prain, tsol, pat1 )
481
482	DO i = 1, knon
483	u_zref(i) = delm_new(i)*speed(i)
484	u_zref_p(i) = u_zref(i)
485	q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
486	max(qsurf(i),0.0)*(1-delh_new(i))
487	q_zref_p(i) = q_zref(i)
488	te_zref(i) = delh_new(i)tpot(i) + ts1(i)(1-delh_new(i))
489	te_zref_p(i) = te_zref(i)
490
491	! return to normal temperature
492	temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
493	temp_p(i) = temp(i)
494
495	! compteurs ici
496
497	ok_t2m_toosmall(i)=te_zref(i)<tpot(i).AND. &
498	te_zref(i)<ts1(i)
499	ok_t2m_toobig(i)=te_zref(i)>tpot(i).AND. &
500	te_zref(i)>ts1(i)
501	ok_q2m_toosmall(i)=q_zref(i)<q1(i).AND. &
502	q_zref(i)<qsurf(i)
503	ok_q2m_toobig(i)=q_zref(i)>q1(i).AND. &
504	q_zref(i)>qsurf(i)
505	ok_u2m_toobig(i)=u_zref(i)>speed(i)
506
507	IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i)) THEN
508	n2mout(i,1)=n2mout(i,1)+1
509	ENDIF
510	IF(ok_q2m_toosmall(i).OR.ok_q2m_toobig(i)) THEN
511	n2mout(i,3)=n2mout(i,3)+1
512	ENDIF
513	IF(ok_u2m_toobig(i)) THEN
514	n2mout(i,5)=n2mout(i,5)+1
515	ENDIF
516
517	IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
518	ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
519	ok_u2m_toobig(i)) THEN
520	delm_new(i)=min(max(delm_new(i),0.),1.)
521	delh_new(i)=min(max(delh_new(i),0.),1.)
522	u_zref(i) = delm_new(i)*speed(i)
523	u_zref_p(i) = u_zref(i)
524	q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
525	max(qsurf(i),0.0)*(1-delh_new(i))
526	q_zref_p(i) = q_zref(i)
527	te_zref(i) = delh_new(i)tpot(i) + ts1(i)(1-delh_new(i))
528	te_zref_p(i) = te_zref(i)
529
530	! return to normal temperature
531	temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
532	temp_p(i) = temp(i)
533	ENDIF
534
535	ENDDO
536
537	! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
538
539	DO n = 1, niter
540
541	okri=.TRUE.
542	CALL screencn(klon, knon, nsrf, zxli, &
543	u_zref, temp, q_zref, zref, &
544	ts1, qsurf, z0m, z0h, psol, &
545	cdram, cdrah, okri, &
546	ri1, 0, &
547	pref, delm, delh, ri2m, &
548	s_pblh, prain, tsol, pat1 )
549
550	DO i = 1, knon
551	u_zref(i) = delm(i)*speed(i)
552	q_zref(i) = delh(i)*max(q1(i),0.0) + &
553	max(qsurf(i),0.0)*(1-delh(i))
554	te_zref(i) = delh(i)tpot(i) + ts1(i)(1-delh(i))
555
556	! return to normal temperature
557	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
558
559	! compteurs ici
560
561	ok_t2m_toosmall(i)=te_zref(i)<tpot(i).AND. &
562	te_zref(i)<ts1(i)
563	ok_t2m_toobig(i)=te_zref(i)>tpot(i).AND. &
564	te_zref(i)>ts1(i)
565	ok_q2m_toosmall(i)=q_zref(i)<q1(i).AND. &
566	q_zref(i)<qsurf(i)
567	ok_q2m_toobig(i)=q_zref(i)>q1(i).AND. &
568	q_zref(i)>qsurf(i)
569	ok_u2m_toobig(i)=u_zref(i)>speed(i)
570
571	IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i)) THEN
572	n2mout(i,2)=n2mout(i,2)+1
573	ENDIF
574	IF(ok_q2m_toosmall(i).OR.ok_q2m_toobig(i)) THEN
575	n2mout(i,4)=n2mout(i,4)+1
576	ENDIF
577	IF(ok_u2m_toobig(i)) THEN
578	n2mout(i,6)=n2mout(i,6)+1
579	ENDIF
580
581	IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
582	ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
583	ok_u2m_toobig(i)) THEN
584	delm(i)=min(max(delm(i),0.),1.)
585	delh(i)=min(max(delh(i),0.),1.)
586	u_zref(i) = delm(i)*speed(i)
587	q_zref(i) = delh(i)*max(q1(i),0.0) + &
588	max(qsurf(i),0.0)*(1-delh(i))
589	te_zref(i) = delh(i)tpot(i) + ts1(i)(1-delh(i))
590	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
591	ENDIF
592
593
594	IF(n==ncon) THEN
595	te_zref_con(i) = te_zref(i)
596	q_zref_con(i) = q_zref(i)
597	ENDIF
598
599	ENDDO
600
601	ENDDO
602
603	DO i = 1, knon
604	q_zref_c(i) = q_zref(i)
605	temp_c(i) = temp(i)
606
607	ok_pred(i)=0.
608	ok_corr(i)=1.
609
610	t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
611	q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
612
613	u_zref_c(i) = u_zref(i)
614	u_2m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
615	ENDDO
616
617
618	!----------First aproximation of variables at zref --------------------------
619
620	zref = 10.0
621
622	CALL screencn(klon, knon, nsrf, zxli, &
623	speed, tpot, q1, zref, &
624	ts1, qsurf, z0m, z0h, psol, &
625	cdram, cdrah, okri, &
626	ri1, 1, &
627	pref_new, delm_new, delh_new, ri10m, &
628	s_pblh, prain, tsol, pat1 )
629
630	DO i = 1, knon
631	u_zref(i) = delm_new(i)*speed(i)
632	q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
633	max(qsurf(i),0.0)*(1-delh_new(i))
634	te_zref(i) = delh_new(i)tpot(i) + ts1(i)(1-delh_new(i))
635	temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
636	u_zref_p(i) = u_zref(i)
637
638	! compteurs ici
639
640	ok_t10m_toosmall(i)=te_zref(i)<tpot(i).AND. &
641	te_zref(i)<ts1(i)
642	ok_t10m_toobig(i)=te_zref(i)>tpot(i).AND. &
643	te_zref(i)>ts1(i)
644	ok_q10m_toosmall(i)=q_zref(i)<q1(i).AND. &
645	q_zref(i)<qsurf(i)
646	ok_q10m_toobig(i)=q_zref(i)>q1(i).AND. &
647	q_zref(i)>qsurf(i)
648	ok_u10m_toobig(i)=u_zref(i)>speed(i)
649
650	IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i)) THEN
651	n10mout(i,1)=n10mout(i,1)+1
652	ENDIF
653	IF(ok_q10m_toosmall(i).OR.ok_q10m_toobig(i)) THEN
654	n10mout(i,3)=n10mout(i,3)+1
655	ENDIF
656	IF(ok_u10m_toobig(i)) THEN
657	n10mout(i,5)=n10mout(i,5)+1
658	ENDIF
659
660	IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
661	ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
662	ok_u10m_toobig(i)) THEN
663	delm_new(i)=min(max(delm_new(i),0.),1.)
664	delh_new(i)=min(max(delh_new(i),0.),1.)
665	u_zref(i) = delm_new(i)*speed(i)
666	u_zref_p(i) = u_zref(i)
667	q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
668	max(qsurf(i),0.0)*(1-delh_new(i))
669	te_zref(i) = delh_new(i)tpot(i) + ts1(i)(1-delh_new(i))
670	temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
671	ENDIF
672
673	ENDDO
674
675	! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
676
677	DO n = 1, niter
678
679	okri=.TRUE.
680	CALL screencn(klon, knon, nsrf, zxli, &
681	u_zref, temp, q_zref, zref, &
682	ts1, qsurf, z0m, z0h, psol, &
683	cdram, cdrah, okri, &
684	ri1, 0, &
685	pref, delm, delh, ri10m, &
686	s_pblh, prain, tsol, pat1 )
687
688	DO i = 1, knon
689	u_zref(i) = delm(i)*speed(i)
690	q_zref(i) = delh(i)*max(q1(i),0.0) + &
691	max(qsurf(i),0.0)*(1-delh(i))
692	te_zref(i) = delh(i)tpot(i) + ts1(i)(1-delh(i))
693
694	! return to normal temperature
695	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
696
697	! compteurs ici
698
699	ok_t10m_toosmall(i)=te_zref(i)<tpot(i).AND. &
700	te_zref(i)<ts1(i)
701	ok_t10m_toobig(i)=te_zref(i)>tpot(i).AND. &
702	te_zref(i)>ts1(i)
703	ok_q10m_toosmall(i)=q_zref(i)<q1(i).AND. &
704	q_zref(i)<qsurf(i)
705	ok_q10m_toobig(i)=q_zref(i)>q1(i).AND. &
706	q_zref(i)>qsurf(i)
707	ok_u10m_toobig(i)=u_zref(i)>speed(i)
708
709	IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i)) THEN
710	n10mout(i,2)=n10mout(i,2)+1
711	ENDIF
712	IF(ok_q10m_toosmall(i).OR.ok_q10m_toobig(i)) THEN
713	n10mout(i,4)=n10mout(i,4)+1
714	ENDIF
715	IF(ok_u10m_toobig(i)) THEN
716	n10mout(i,6)=n10mout(i,6)+1
717	ENDIF
718
719	IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
720	ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
721	ok_u10m_toobig(i)) THEN
722	delm(i)=min(max(delm(i),0.),1.)
723	delh(i)=min(max(delh(i),0.),1.)
724	u_zref(i) = delm(i)*speed(i)
725	q_zref(i) = delh(i)*max(q1(i),0.0) + &
726	max(qsurf(i),0.0)*(1-delh(i))
727	te_zref(i) = delh(i)tpot(i) + ts1(i)(1-delh(i))
728	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
729	ENDIF
730
731
732	IF(n==ncon) THEN
733	te_zref_con(i) = te_zref(i)
734	q_zref_con(i) = q_zref(i)
735	ENDIF
736
737	ENDDO
738
739	ENDDO
740
741	DO i = 1, knon
742	q_zref_c(i) = q_zref(i)
743	temp_c(i) = temp(i)
744
745	ok_pred(i)=0.
746	ok_corr(i)=1.
747
748	t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
749	q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
750
751	u_zref_c(i) = u_zref(i)
752	u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
753	ENDDO
754
755
756	END SUBROUTINE stdlevvarn
757
758	END MODULE stdlevvar_mod

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

Download in other formats:

Original Format