Context Navigation

stdlevvar_mod.F90 @ 5141

Last change on this file since 5141 was 5139, checked in by abarral, 11 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

Rev	Line
[5099]	1
[3817]	2	MODULE stdlevvar_mod
[5099]	3
[3817]	4	! This module contains main procedures for calculation
	5	! of temperature, specific humidity and wind at a reference level
[5099]	6
[3817]	7	USE cdrag_mod
	8	USE screenp_mod
	9	USE screenc_mod
	10	IMPLICIT NONE
	11
	12	CONTAINS
[5099]	13
[3817]	14	!****************************************************************************************
[5099]	15
[3817]	16	!r original routine svn3623
[5099]	17
[3817]	18	SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
	19	u1, v1, t1, q1, z1, &
	20	ts1, qsurf, z0m, z0h, psol, pat1, &
[4722]	21	t_2m, q_2m, t_10m, q_10m, u_10m, ustar, s_pblh, prain, tsol)
[5139]	22	USE lmdz_flux_arp, ONLY: fsens, flat, betaevap, ust, tg, ok_flux_surf, ok_prescr_ust, ok_prescr_beta, ok_forc_tsurf
	23
[3817]	24	IMPLICIT NONE
	25	!-------------------------------------------------------------------------
[5099]	26
[3817]	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.
[5099]	30
[3817]	31	! Reference : Hess, Colman et McAvaney (1995)
[5099]	32
[3817]	33	! I. Musat, 01.07.2002
[5099]	34
[3817]	35	!AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
[5099]	36
[3817]	37	!-------------------------------------------------------------------------
[5099]	38
[3817]	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
[5099]	53
[3817]	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*
[5099]	61
[5117]	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
[5099]	68
[5117]	69	REAL, DIMENSION(klon), INTENT(OUT) :: t_2m, q_2m, ustar
	70	REAL, DIMENSION(klon), INTENT(OUT) :: u_10m, t_10m, q_10m
[4722]	71	REAL, DIMENSION(klon), INTENT(INOUT) :: s_pblh
	72	REAL, DIMENSION(klon), INTENT(IN) :: prain
	73	REAL, DIMENSION(klon), INTENT(IN) :: tsol
[3817]	74	!-------------------------------------------------------------------------
	75	include "YOMCST.h"
	76	!IM PLUS
	77	include "YOETHF.h"
[5099]	78
[3817]	79	! Quelques constantes et options:
[5099]	80
[3817]	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
[5099]	86
[3817]	87	! Variables locales
	88	INTEGER :: i, n
	89	REAL :: zref
[5117]	90	REAL, DIMENSION(klon) :: speed
[3817]	91	! tpot : temperature potentielle
[5117]	92	REAL, DIMENSION(klon) :: tpot
	93	REAL, DIMENSION(klon) :: zri1, cdran
	94	REAL, DIMENSION(klon) :: cdram, cdrah
[3817]	95	! ri1 : nb. de Richardson entre la surface --> la 1ere couche
[5117]	96	REAL, DIMENSION(klon) :: ri1
	97	REAL, DIMENSION(klon) :: testar, qstar
	98	REAL, DIMENSION(klon) :: zdte, zdq
[3817]	99	! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney
[5117]	100	DOUBLE PRECISION, DIMENSION(klon) :: lmon
[3817]	101	DOUBLE PRECISION, parameter :: eps=1.0D-20
[5117]	102	REAL, DIMENSION(klon) :: delu, delte, delq
	103	REAL, DIMENSION(klon) :: u_zref, te_zref, q_zref
	104	REAL, DIMENSION(klon) :: temp, pref
[3817]	105	LOGICAL :: okri
[5117]	106	REAL, DIMENSION(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
[3817]	107	!convertgence
[5117]	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
[3817]	112	!-------------------------------------------------------------------------
	113	DO i=1, knon
	114	speed(i)=SQRT(u1(i)2+v1(i)2)
	115	ri1(i) = 0.0
	116	ENDDO
[5099]	117
[3817]	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, &
[5087]	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)
[3817]	130
	131	! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
[5116]	132	IF (ok_prescr_ust) THEN
[3817]	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
[5099]	139
[3817]	140	!---------Star variables----------------------------------------------------
[5099]	141
[3817]	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)
[5099]	148
	149
[3817]	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))
[5099]	152
[3817]	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))/ &
[5087]	156	(RKAR * RG * testar(i))
[3817]	157	ENDDO
[5099]	158
[3817]	159	!----------First aproximation of variables at zref --------------------------
	160	zref = 2.0
	161	CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
[5087]	162	ts1, qsurf, z0m, lmon, &
	163	ustar, testar, qstar, zref, &
	164	delu, delte, delq)
[5099]	165
[3817]	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
[5099]	175
[3817]	176	! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
[5099]	177
[3817]	178	DO n = 1, niter
[5099]	179
[3817]	180	okri=.TRUE.
	181	CALL screenc(klon, knon, nsrf, zxli, &
[5087]	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)
[5099]	186
[3817]	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)
[5099]	191
[3817]	192	! return to normal temperature
[5099]	193
[3817]	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))
[5099]	197
[3817]	198	!IM +++
	199	! IF(temp(i).GT.350.) THEN
	200	! WRITE(,) 'temp(i) GT 350 K !!',i,nsrf,temp(i)
	201	! ENDIF
	202	!IM ---
[5099]	203
[5082]	204	IF(n==ncon) THEN
[3817]	205	te_zref_con(i) = te_zref(i)
	206	q_zref_con(i) = q_zref(i)
	207	ENDIF
[5099]	208
[3817]	209	ENDDO
[5099]	210
[3817]	211	ENDDO
[5099]	212
[3817]	213	! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
[5099]	214
[3817]	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
[5099]	225
[3817]	226	DO i = 1, knon
	227	q_zref_c(i) = q_zref(i)
	228	temp_c(i) = temp(i)
[5099]	229
[3817]	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
[5099]	242
[3817]	243	ok_pred(i)=0.
	244	ok_corr(i)=1.
[5099]	245
[3817]	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
[5099]	258
	259
[3817]	260	!----------First aproximation of variables at zref --------------------------
[5099]	261
[3817]	262	zref = 10.0
	263	CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
[5087]	264	ts1, qsurf, z0m, lmon, &
	265	ustar, testar, qstar, zref, &
	266	delu, delte, delq)
[5099]	267
[3817]	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
[5099]	277
[3817]	278	! Iteration of the variables at the reference level zref : corrector ; see Hess & McAvaney, 1995
[5099]	279
[3817]	280	DO n = 1, niter
[5099]	281
[3817]	282	okri=.TRUE.
	283	CALL screenc(klon, knon, nsrf, zxli, &
[5087]	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)
[5099]	288
[3817]	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
[5099]	297
[3817]	298	ENDDO
[5099]	299
[3817]	300	DO i = 1, knon
	301	u_zref_c(i) = u_zref(i)
[5099]	302
[3817]	303	u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
[5099]	304
[3817]	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
[5099]	312
[5105]	313
[5103]	314	END SUBROUTINE stdlevvar
[5099]	315
[3817]	316	SUBROUTINE stdlevvarn(klon, knon, nsrf, zxli, &
	317	u1, v1, t1, q1, z1, &
	318	ts1, qsurf, z0m, z0h, psol, pat1, &
[3839]	319	t_2m, q_2m, t_10m, q_10m, u_10m, ustar, &
	320	n2mout)
[5099]	321
[5112]	322	USE lmdz_ioipsl_getin_p, ONLY: getin_p
[5139]	323	USE lmdz_flux_arp, ONLY: fsens, flat, betaevap, ust, tg, ok_flux_surf, ok_prescr_ust, ok_prescr_beta, ok_forc_tsurf
	324
[3817]	325	IMPLICIT NONE
	326	!-------------------------------------------------------------------------
[5099]	327
[3817]	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.
[5099]	331
[3817]	332	! Reference : Hess, Colman et McAvaney (1995)
[5099]	333
[3817]	334	! I. Musat, 01.07.2002
[5099]	335
[3817]	336	!AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
[5099]	337
[3817]	338	!-------------------------------------------------------------------------
[5099]	339
[3817]	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
[5099]	354
[3817]	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
[3839]	359	! ustar--output-R- u*
[3817]	360	!AM
	361	! t_10m--output-R- temperature de l'air a 10m
	362	! q_10m--output-R- humidite specifique a 10m
[5099]	363
[5117]	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
[5099]	370
[5117]	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
[5099]	374
[5117]	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
[4722]	381	REAL, DIMENSION(klon) :: s_pblh
	382	REAL, DIMENSION(klon) :: prain
	383	REAL, DIMENSION(klon) :: tsol
[3817]	384	!-------------------------------------------------------------------------
	385	include "YOMCST.h"
	386	!IM PLUS
	387	include "YOETHF.h"
[5099]	388
[3817]	389	! Quelques constantes et options:
[5099]	390
[3817]	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
[5099]	398
[3817]	399	! Variables locales
	400	INTEGER :: i, n
	401	REAL :: zref
[5117]	402	REAL, DIMENSION(klon) :: speed
[3817]	403	! tpot : temperature potentielle
[5117]	404	REAL, DIMENSION(klon) :: tpot
	405	REAL, DIMENSION(klon) :: cdran
[3817]	406	! ri1 : nb. de Richardson entre la surface --> la 1ere couche
[5117]	407	REAL, DIMENSION(klon) :: ri1
[3817]	408	DOUBLE PRECISION, parameter :: eps=1.0D-20
[5117]	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
[3817]	416	LOGICAL :: okri
[5117]	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
[3817]	419	!convergence
[5117]	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
[5099]	423
[5117]	424	REAL, DIMENSION(klon) :: cdrm10m, cdrh10m, ri10m
	425	REAL, DIMENSION(klon) :: cdmn10m, cdhn10m, fm10m, fh10m
	426	REAL, DIMENSION(klon) :: cdn2m, cdn1, zri_zero
[3817]	427	REAL :: CEPDUE,zdu2
	428	INTEGER :: nzref, nz1
[5117]	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
[3817]	436
	437	!-------------------------------------------------------------------------
	438	CEPDUE=0.1
[5099]	439
[3817]	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]
[3831]	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]
[5099]	444
[3817]	445	n2mout(:,:)=0
[3831]	446	n10mout(:,:)=0
[3817]	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
[5099]	452
[3817]	453	okri=.FALSE.
	454	CALL cdrag(knon, nsrf, &
[5087]	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)
[3817]	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)
[3839]	464	ustar(i) = sqrt(cdram(i) * zdu2)
[5099]	465
[3817]	466	ENDDO
[5099]	467
[3817]	468	!----------First aproximation of variables at zref --------------------------
	469	zref = 2.0
[5099]	470
[3817]	471	! calcul first-guess en utilisant dans les calculs à 2m
	472	! le Richardson de la premiere couche atmospherique
[5099]	473
[3817]	474	CALL screencn(klon, knon, nsrf, zxli, &
[5087]	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 )
[5099]	481
[3817]	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) + &
[5087]	486	max(qsurf(i),0.0)*(1-delh_new(i))
[3817]	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)
[5099]	490
[3817]	491	! return to normal temperature
	492	temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
	493	temp_p(i) = temp(i)
[5099]	494
[3817]	495	! compteurs ici
[5099]	496
[5082]	497	ok_t2m_toosmall(i)=te_zref(i)<tpot(i).AND. &
[5087]	498	te_zref(i)<ts1(i)
[5082]	499	ok_t2m_toobig(i)=te_zref(i)>tpot(i).AND. &
[5087]	500	te_zref(i)>ts1(i)
[5082]	501	ok_q2m_toosmall(i)=q_zref(i)<q1(i).AND. &
[5087]	502	q_zref(i)<qsurf(i)
[5082]	503	ok_q2m_toobig(i)=q_zref(i)>q1(i).AND. &
[5087]	504	q_zref(i)>qsurf(i)
[5082]	505	ok_u2m_toobig(i)=u_zref(i)>speed(i)
[5099]	506
[3817]	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
[5099]	516
[3817]	517	IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
[5087]	518	ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
	519	ok_u2m_toobig(i)) THEN
[3817]	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) + &
[5087]	525	max(qsurf(i),0.0)*(1-delh_new(i))
[3817]	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)
[5099]	529
[3817]	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
[5099]	534
[3817]	535	ENDDO
[5099]	536
[3817]	537	! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
[5099]	538
[3817]	539	DO n = 1, niter
[5099]	540
[3817]	541	okri=.TRUE.
	542	CALL screencn(klon, knon, nsrf, zxli, &
[5087]	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 )
[5099]	549
[3817]	550	DO i = 1, knon
	551	u_zref(i) = delm(i)*speed(i)
	552	q_zref(i) = delh(i)*max(q1(i),0.0) + &
[5087]	553	max(qsurf(i),0.0)*(1-delh(i))
[3817]	554	te_zref(i) = delh(i)tpot(i) + ts1(i)(1-delh(i))
[5099]	555
[3817]	556	! return to normal temperature
	557	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
[5099]	558
[3817]	559	! compteurs ici
[5099]	560
[5082]	561	ok_t2m_toosmall(i)=te_zref(i)<tpot(i).AND. &
[5087]	562	te_zref(i)<ts1(i)
[5082]	563	ok_t2m_toobig(i)=te_zref(i)>tpot(i).AND. &
[5087]	564	te_zref(i)>ts1(i)
[5082]	565	ok_q2m_toosmall(i)=q_zref(i)<q1(i).AND. &
[5087]	566	q_zref(i)<qsurf(i)
[5082]	567	ok_q2m_toobig(i)=q_zref(i)>q1(i).AND. &
[5087]	568	q_zref(i)>qsurf(i)
[5082]	569	ok_u2m_toobig(i)=u_zref(i)>speed(i)
[5099]	570
[3817]	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
[5099]	580
[3817]	581	IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
[5087]	582	ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
	583	ok_u2m_toobig(i)) THEN
[3817]	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) + &
[5087]	588	max(qsurf(i),0.0)*(1-delh(i))
[3817]	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
[5099]	592
	593
[5082]	594	IF(n==ncon) THEN
[3817]	595	te_zref_con(i) = te_zref(i)
	596	q_zref_con(i) = q_zref(i)
	597	ENDIF
[5099]	598
[3817]	599	ENDDO
[5099]	600
[3817]	601	ENDDO
[5099]	602
[3817]	603	DO i = 1, knon
	604	q_zref_c(i) = q_zref(i)
	605	temp_c(i) = temp(i)
[5099]	606
[3817]	607	ok_pred(i)=0.
	608	ok_corr(i)=1.
[5099]	609
[3817]	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)
[5099]	612
[3817]	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
[5099]	616
	617
[3817]	618	!----------First aproximation of variables at zref --------------------------
[5099]	619
[3817]	620	zref = 10.0
[5099]	621
[3821]	622	CALL screencn(klon, knon, nsrf, zxli, &
[5087]	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 )
[5099]	629
[3821]	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) + &
[5087]	633	max(qsurf(i),0.0)*(1-delh_new(i))
[3821]	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)
[5099]	637
[3821]	638	! compteurs ici
[5099]	639
[5082]	640	ok_t10m_toosmall(i)=te_zref(i)<tpot(i).AND. &
[5087]	641	te_zref(i)<ts1(i)
[5082]	642	ok_t10m_toobig(i)=te_zref(i)>tpot(i).AND. &
[5087]	643	te_zref(i)>ts1(i)
[5082]	644	ok_q10m_toosmall(i)=q_zref(i)<q1(i).AND. &
[5087]	645	q_zref(i)<qsurf(i)
[5082]	646	ok_q10m_toobig(i)=q_zref(i)>q1(i).AND. &
[5087]	647	q_zref(i)>qsurf(i)
[5082]	648	ok_u10m_toobig(i)=u_zref(i)>speed(i)
[5099]	649
[3831]	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
[5099]	659
[3821]	660	IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
[5087]	661	ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
	662	ok_u10m_toobig(i)) THEN
[3821]	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) + &
[5087]	668	max(qsurf(i),0.0)*(1-delh_new(i))
[3821]	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
[5099]	672
[3821]	673	ENDDO
[5099]	674
[3821]	675	! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
[5099]	676
[3817]	677	DO n = 1, niter
[5099]	678
[3817]	679	okri=.TRUE.
	680	CALL screencn(klon, knon, nsrf, zxli, &
[5087]	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 )
[5099]	687
[3817]	688	DO i = 1, knon
	689	u_zref(i) = delm(i)*speed(i)
	690	q_zref(i) = delh(i)*max(q1(i),0.0) + &
[5087]	691	max(qsurf(i),0.0)*(1-delh(i))
[3817]	692	te_zref(i) = delh(i)tpot(i) + ts1(i)(1-delh(i))
[5099]	693
[3821]	694	! return to normal temperature
[3817]	695	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
[5099]	696
[3821]	697	! compteurs ici
[5099]	698
[5082]	699	ok_t10m_toosmall(i)=te_zref(i)<tpot(i).AND. &
[5087]	700	te_zref(i)<ts1(i)
[5082]	701	ok_t10m_toobig(i)=te_zref(i)>tpot(i).AND. &
[5087]	702	te_zref(i)>ts1(i)
[5082]	703	ok_q10m_toosmall(i)=q_zref(i)<q1(i).AND. &
[5087]	704	q_zref(i)<qsurf(i)
[5082]	705	ok_q10m_toobig(i)=q_zref(i)>q1(i).AND. &
[5087]	706	q_zref(i)>qsurf(i)
[5082]	707	ok_u10m_toobig(i)=u_zref(i)>speed(i)
[5099]	708
[3821]	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
[5099]	718
[3821]	719	IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
[5087]	720	ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
	721	ok_u10m_toobig(i)) THEN
[3821]	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) + &
[5087]	726	max(qsurf(i),0.0)*(1-delh(i))
[3821]	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
[5099]	730
	731
[5082]	732	IF(n==ncon) THEN
[3821]	733	te_zref_con(i) = te_zref(i)
	734	q_zref_con(i) = q_zref(i)
	735	ENDIF
[5099]	736
[3817]	737	ENDDO
[5099]	738
[3821]	739	ENDDO
[5099]	740
[3817]	741	DO i = 1, knon
[3821]	742	q_zref_c(i) = q_zref(i)
	743	temp_c(i) = temp(i)
[5099]	744
[3821]	745	ok_pred(i)=0.
	746	ok_corr(i)=1.
[5099]	747
[3817]	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)
[5099]	750
[3821]	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)
[3817]	753	ENDDO
[5099]	754
[5105]	755
[5103]	756	END SUBROUTINE stdlevvarn
[3817]	757
	758	END MODULE stdlevvar_mod

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

Download in other formats:

Original Format