Sources/phylmd/stdlevvar.f

module stdlevvar_m

 IMPLICIT NONE

contains

  SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, u1, v1, t1, q1, z1, ts1, &
       qsurf, rugos, psol, pat1, t_2m, q_2m, t_10m, q_10m, u_10m, ustar)

    ! From LMDZ4/libf/phylmd/stdlevvar.F90, version 1.3 2005/05/25 13:10:09

    ! Objet : calcul de la température et de l'humidité relative à 2 m
    ! et du module du vent à 10 m à partir des relations de
    ! Dyer-Businger et des équations de Louis.

    ! Reference: Hess, Colman and McAvaney (1995) 

    ! Author: I. Musat, July 1st, 2002

    use coefcdrag_m, only: coefcdrag
    USE suphec_m, ONLY: rg, rkappa
    use screenc_m, only: screenc
    use screenp_m, only: screenp

    INTEGER, intent(in):: klon
    ! dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)

    INTEGER, intent(in):: knon ! nombre de points pour un type de surface
    INTEGER, intent(in):: nsrf ! indice pour le type de surface
    LOGICAL, intent(in):: zxli ! calcul des cdrags selon Laurent Li
    REAL, intent(in):: u1(:) ! (knon) vent zonal au 1er niveau du modele
    REAL, intent(in):: v1(:) ! (knon) vent meridien au 1er niveau du modele
    REAL, intent(in):: t1 (klon) ! temperature de l'air au 1er niveau du modele
    REAL, intent(in):: q1(klon) ! humidite relative au 1er niveau du modele
    REAL, intent(in):: z1 (klon) ! geopotentiel au 1er niveau du modele
    REAL, intent(in):: ts1(klon) ! temperature de l'air a la surface
    REAL, intent(in):: qsurf(klon) ! humidite relative a la surface
    REAL, intent(in):: rugos(klon) ! rugosite
    REAL, intent(in):: psol(klon) ! pression au sol
    REAL, intent(in):: pat1(klon) ! pression au 1er niveau du modele
    REAL, intent(out):: t_2m(klon) ! temperature de l'air a 2m
    REAL, intent(out):: q_2m(klon) ! humidite relative a 2m
    REAL, intent(out):: t_10m(klon) ! temperature de l'air a 10m
    REAL, intent(out):: q_10m(klon) ! humidite specifique a 10m
    REAL, intent(out):: u_10m(klon) ! vitesse du vent a 10m
    REAL, intent(out):: ustar(klon) ! u*

    ! Local:

    ! RKAR : constante de von Karman
    REAL, PARAMETER:: RKAR=0.40
    ! niter : nombre iterations calcul "corrector"
    INTEGER, parameter:: niter=2

    ! Variables locales
    INTEGER i, n
    REAL zref
    REAL, dimension(klon):: speed
    ! tpot : temperature potentielle
    REAL, dimension(klon):: tpot
    REAL, dimension(klon):: zri1, cdran
    REAL cdram(klon), cdrah(klon)
    ! ri1 : nb. de Richardson entre la surface --> la 1ere couche
    REAL, dimension(klon):: ri1 
    REAL, dimension(klon):: testar, qstar
    REAL, dimension(klon):: zdte, zdq 
    ! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney 
    DOUBLE PRECISION, dimension(klon):: lmon
    REAL, dimension(klon):: delu, delte, delq
    REAL, dimension(klon):: u_zref, te_zref, q_zref 
    REAL, dimension(klon):: temp, pref
    LOGICAL okri
    REAL, dimension(klon):: u_zref_p, temp_p, q_zref_p
    !convertgence
    REAL, dimension(klon):: u_zref_c, temp_c, q_zref_c
    REAL, dimension(klon):: ok_pred, ok_corr

    !------------------------------------------------------------------------- 

    DO i=1, knon
       speed(i)=SQRT(u1(i)**2+v1(i)**2)
       ri1(i) = 0.0
    ENDDO

    okri=.FALSE.
    CALL coefcdrag(klon, knon, nsrf, zxli, speed, t1, q1, z1, psol, ts1, &
         qsurf, rugos, okri, ri1, cdram, cdrah, cdran, zri1, pref) 

    ! Star variables 

    DO i = 1, knon
       ri1(i) = zri1(i)
       tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
       ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
       zdte(i) = tpot(i) - ts1(i)
       zdq(i) = max(q1(i), 0.0) - max(qsurf(i), 0.0)

       zdte(i) = sign(max(abs(zdte(i)), 1.e-10), zdte(i))

       testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
       qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
       lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ &
            (RKAR * RG * testar(i))
    ENDDO

    ! First aproximation of variables at zref  
    zref = 2.0
    CALL screenp(klon, knon, speed, tpot, q1, &
         ts1, qsurf, rugos, lmon, &
         ustar, testar, qstar, zref, &
         delu, delte, delq)

    DO i = 1, knon
       u_zref(i) = delu(i)
       q_zref(i) = max(qsurf(i), 0.0) + delq(i)
       te_zref(i) = ts1(i) + delte(i)
       temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
       q_zref_p(i) = q_zref(i)
       temp_p(i) = temp(i)
    ENDDO

    ! Iteration of the variables at the reference level zref :
    ! corrector calculation ; see Hess & McAvaney, 1995

    DO n = 1, niter
       okri=.TRUE.
       CALL screenc(klon, knon, nsrf, zxli, &
            u_zref, temp, q_zref, zref, &
            ts1, qsurf, rugos, psol, & 
            ustar, testar, qstar, okri, ri1, &
            pref, delu, delte, delq) 

       DO i = 1, knon
          u_zref(i) = delu(i)
          q_zref(i) = delq(i) + max(qsurf(i), 0.0)
          te_zref(i) = delte(i) + ts1(i) 

          ! return to normal temperature

          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
       ENDDO
    ENDDO

    ! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref

    DO i = 1, knon
       q_zref_c(i) = q_zref(i)
       temp_c(i) = temp(i)

       ok_pred(i)=0.
       ok_corr(i)=1.

       t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
       q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
    ENDDO

    ! First aproximation of variables at zref  

    zref = 10.0
    CALL screenp(klon, knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
         testar, qstar, zref, delu, delte, delq)

    DO i = 1, knon
       u_zref(i) = delu(i)
       q_zref(i) = max(qsurf(i), 0.0) + delq(i)
       te_zref(i) = ts1(i) + delte(i)
       temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
       u_zref_p(i) = u_zref(i)
    ENDDO

    ! Iteration of the variables at the reference level zref:
    ! corrector ; see Hess & McAvaney, 1995

    DO n = 1, niter
       okri=.TRUE.
       CALL screenc(klon, knon, nsrf, zxli, u_zref, temp, q_zref, zref, ts1, &
            qsurf, rugos, psol, ustar, testar, qstar, okri, ri1, pref, delu, &
            delte, delq)

       DO i = 1, knon
          u_zref(i) = delu(i)
          q_zref(i) = delq(i) + max(qsurf(i), 0.0)
          te_zref(i) = delte(i) + ts1(i)
          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
       ENDDO
    ENDDO

    DO i = 1, knon
       u_zref_c(i) = u_zref(i)
       u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
       q_zref_c(i) = q_zref(i)
       temp_c(i) = temp(i)
       t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
       q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
    ENDDO

  END subroutine stdlevvar

end module stdlevvar_m
1	guez	104	module stdlevvar_m
2
3			IMPLICIT NONE
4
5			contains
6
7			SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, u1, v1, t1, q1, z1, ts1, &
8			qsurf, rugos, psol, pat1, t_2m, q_2m, t_10m, q_10m, u_10m, ustar)
9
10			! From LMDZ4/libf/phylmd/stdlevvar.F90, version 1.3 2005/05/25 13:10:09
11
12			! Objet : calcul de la température et de l'humidité relative à 2 m
13			! et du module du vent à 10 m à partir des relations de
14			! Dyer-Businger et des équations de Louis.
15
16			! Reference: Hess, Colman and McAvaney (1995)
17
18	guez	208	! Author: I. Musat, July 1st, 2002
19	guez	104
20	guez	225	use coefcdrag_m, only: coefcdrag
21			USE suphec_m, ONLY: rg, rkappa
22			use screenc_m, only: screenc
23			use screenp_m, only: screenp
24
25	guez	104	INTEGER, intent(in):: klon
26			! dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
27
28	guez	208	INTEGER, intent(in):: knon ! nombre de points pour un type de surface
29	guez	225	INTEGER, intent(in):: nsrf ! indice pour le type de surface
30	guez	208	LOGICAL, intent(in):: zxli ! calcul des cdrags selon Laurent Li
31	guez	225	REAL, intent(in):: u1(:) ! (knon) vent zonal au 1er niveau du modele
32			REAL, intent(in):: v1(:) ! (knon) vent meridien au 1er niveau du modele
33			REAL, intent(in):: t1 (klon) ! temperature de l'air au 1er niveau du modele
34			REAL, intent(in):: q1(klon) ! humidite relative au 1er niveau du modele
35			REAL, intent(in):: z1 (klon) ! geopotentiel au 1er niveau du modele
36			REAL, intent(in):: ts1(klon) ! temperature de l'air a la surface
37			REAL, intent(in):: qsurf(klon) ! humidite relative a la surface
38			REAL, intent(in):: rugos(klon) ! rugosite
39			REAL, intent(in):: psol(klon) ! pression au sol
40			REAL, intent(in):: pat1(klon) ! pression au 1er niveau du modele
41			REAL, intent(out):: t_2m(klon) ! temperature de l'air a 2m
42			REAL, intent(out):: q_2m(klon) ! humidite relative a 2m
43			REAL, intent(out):: t_10m(klon) ! temperature de l'air a 10m
44			REAL, intent(out):: q_10m(klon) ! humidite specifique a 10m
45			REAL, intent(out):: u_10m(klon) ! vitesse du vent a 10m
46	guez	104	REAL, intent(out):: ustar(klon) ! u*
47
48			! Local:
49
50			! RKAR : constante de von Karman
51			REAL, PARAMETER:: RKAR=0.40
52			! niter : nombre iterations calcul "corrector"
53	guez	188	INTEGER, parameter:: niter=2
54	guez	104
55			! Variables locales
56			INTEGER i, n
57			REAL zref
58			REAL, dimension(klon):: speed
59			! tpot : temperature potentielle
60			REAL, dimension(klon):: tpot
61			REAL, dimension(klon):: zri1, cdran
62			REAL cdram(klon), cdrah(klon)
63			! ri1 : nb. de Richardson entre la surface --> la 1ere couche
64			REAL, dimension(klon):: ri1
65			REAL, dimension(klon):: testar, qstar
66			REAL, dimension(klon):: zdte, zdq
67			! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney
68			DOUBLE PRECISION, dimension(klon):: lmon
69			REAL, dimension(klon):: delu, delte, delq
70			REAL, dimension(klon):: u_zref, te_zref, q_zref
71			REAL, dimension(klon):: temp, pref
72			LOGICAL okri
73			REAL, dimension(klon):: u_zref_p, temp_p, q_zref_p
74			!convertgence
75			REAL, dimension(klon):: u_zref_c, temp_c, q_zref_c
76			REAL, dimension(klon):: ok_pred, ok_corr
77
78			!-------------------------------------------------------------------------
79
80			DO i=1, knon
81	guez	3	speed(i)=SQRT(u1(i)2+v1(i)2)
82			ri1(i) = 0.0
83	guez	104	ENDDO
84
85			okri=.FALSE.
86			CALL coefcdrag(klon, knon, nsrf, zxli, speed, t1, q1, z1, psol, ts1, &
87			qsurf, rugos, okri, ri1, cdram, cdrah, cdran, zri1, pref)
88
89			! Star variables
90
91			DO i = 1, knon
92			ri1(i) = zri1(i)
93			tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
94			ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
95			zdte(i) = tpot(i) - ts1(i)
96			zdq(i) = max(q1(i), 0.0) - max(qsurf(i), 0.0)
97
98			zdte(i) = sign(max(abs(zdte(i)), 1.e-10), zdte(i))
99
100			testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
101			qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
102			lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ &
103			(RKAR * RG * testar(i))
104			ENDDO
105
106			! First aproximation of variables at zref
107			zref = 2.0
108	guez	178	CALL screenp(klon, knon, speed, tpot, q1, &
109	guez	104	ts1, qsurf, rugos, lmon, &
110			ustar, testar, qstar, zref, &
111			delu, delte, delq)
112
113			DO i = 1, knon
114			u_zref(i) = delu(i)
115			q_zref(i) = max(qsurf(i), 0.0) + delq(i)
116			te_zref(i) = ts1(i) + delte(i)
117			temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
118			q_zref_p(i) = q_zref(i)
119			temp_p(i) = temp(i)
120			ENDDO
121
122			! Iteration of the variables at the reference level zref :
123			! corrector calculation ; see Hess & McAvaney, 1995
124
125			DO n = 1, niter
126			okri=.TRUE.
127			CALL screenc(klon, knon, nsrf, zxli, &
128			u_zref, temp, q_zref, zref, &
129			ts1, qsurf, rugos, psol, &
130			ustar, testar, qstar, okri, ri1, &
131			pref, delu, delte, delq)
132
133			DO i = 1, knon
134	guez	3	u_zref(i) = delu(i)
135	guez	104	q_zref(i) = delq(i) + max(qsurf(i), 0.0)
136	guez	3	te_zref(i) = delte(i) + ts1(i)
137	guez	104
138			! return to normal temperature
139
140	guez	3	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
141	guez	104	ENDDO
142			ENDDO
143
144			! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
145
146			DO i = 1, knon
147			q_zref_c(i) = q_zref(i)
148			temp_c(i) = temp(i)
149
150			ok_pred(i)=0.
151			ok_corr(i)=1.
152
153			t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
154			q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
155			ENDDO
156
157			! First aproximation of variables at zref
158
159			zref = 10.0
160	guez	225	CALL screenp(klon, knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
161			testar, qstar, zref, delu, delte, delq)
162	guez	104
163			DO i = 1, knon
164			u_zref(i) = delu(i)
165			q_zref(i) = max(qsurf(i), 0.0) + delq(i)
166			te_zref(i) = ts1(i) + delte(i)
167			temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
168			u_zref_p(i) = u_zref(i)
169			ENDDO
170
171			! Iteration of the variables at the reference level zref:
172			! corrector ; see Hess & McAvaney, 1995
173
174			DO n = 1, niter
175			okri=.TRUE.
176	guez	225	CALL screenc(klon, knon, nsrf, zxli, u_zref, temp, q_zref, zref, ts1, &
177			qsurf, rugos, psol, ustar, testar, qstar, okri, ri1, pref, delu, &
178			delte, delq)
179	guez	104
180			DO i = 1, knon
181	guez	3	u_zref(i) = delu(i)
182	guez	104	q_zref(i) = delq(i) + max(qsurf(i), 0.0)
183	guez	3	te_zref(i) = delte(i) + ts1(i)
184			temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
185	guez	104	ENDDO
186			ENDDO
187
188			DO i = 1, knon
189			u_zref_c(i) = u_zref(i)
190			u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
191			q_zref_c(i) = q_zref(i)
192			temp_c(i) = temp(i)
193			t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
194			q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
195			ENDDO
196
197			END subroutine stdlevvar
198
199			end module stdlevvar_m