Context Navigation

stdlevvar_mod.F90 @ 5218

Last change on this file since 5218 was 5160, checked in by abarral, 5 months ago
Put .h into modules
Property svn:executable set to ``*
File size: 25.8 KB

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

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

Download in other formats:

Original Format