Context Navigation

stdlevvar_mod.F90 @ 5133

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

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

Download in other formats:

Original Format