Context Navigation

stdlevvar_mod.f90 @ 5274

Last change on this file since 5274 was 5274, checked in by abarral, 33 hours ago
Replace yomcst.h by existing module
Property svn:executable set to ``*
File size: 27.7 KB

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

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

Download in other formats:

Original Format