source: LMDZ.3.3/trunk/libf/phylmd/stdlevvar.F90 @ 877

Last change on this file since 877 was 416, checked in by lmdzadmin, 22 years ago

Inclusion initiale

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.2 KB
Line 
1      SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
2                           u1, v1, t1, q1, z1, &
3                           ts1, qsurf, rugos, psol, pat1, &
4                           t_2m, q_2m, u_10m)
5      USE coefcdrag_int
6      USE screenpc_int
7      IMPLICIT NONE
8!-------------------------------------------------------------------------
9!
10! Objet : calcul de la temperature et l'humidite relative a 2m et du
11!         module du vent a 10m a partir des relations de Dyer-Businger et
12!         des equations de Louis.
13!
14! Reference : Hess, Colman et McAvaney (1995)       
15!
16! I. Musat, 01.07.2002
17!-------------------------------------------------------------------------
18!
19! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
20! knon----input-I- nombre de points pour un type de surface
21! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
22! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
23! u1------input-R- vent zonal au 1er niveau du modele
24! v1------input-R- vent meridien au 1er niveau du modele
25! t1------input-R- temperature de l'air au 1er niveau du modele
26! q1------input-R- humidite relative au 1er niveau du modele
27! z1------input-R- geopotentiel au 1er niveau du modele
28! ts1-----input-R- temperature de l'air a la surface
29! qsurf---input-R- humidite relative a la surface
30! rugos---input-R- rugosite
31! psol----input-R- pression au sol
32! pat1----input-R- pression au 1er niveau du modele
33!
34! t_2m---output-R- temperature de l'air a 2m
35! q_2m---output-R- humidite relative a 2m
36! u_10m--output-R- vitesse du vent a 10m
37!
38      INTEGER, intent(in) :: klon, knon, nsrf
39      LOGICAL, intent(in) :: zxli
40      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1
41      REAL, dimension(klon), intent(in) :: qsurf, rugos
42      REAL, dimension(klon), intent(in) :: psol, pat1
43!
44      REAL, dimension(klon), intent(out) :: t_2m, q_2m, u_10m
45!-------------------------------------------------------------------------
46#include "YOMCST.inc"
47!IM PLUS
48#include "YOETHF.inc"
49!
50! Quelques constantes et options:
51!
52! RKAR : constante de von Karman
53      REAL, PARAMETER :: RKAR=0.40
54! niter : nombre iterations calcul "corrector"
55      INTEGER, parameter :: niter=6, ncon=niter-1
56!
57! Variables locales
58      INTEGER :: i, n
59      REAL :: zref
60      REAL, dimension(klon) :: speed
61! tpot : temperature potentielle
62      REAL, dimension(klon) :: tpot
63      REAL, dimension(klon) :: zri1, cdran
64      REAL, dimension(klon) :: cdram, cdrah
65! ri1 : nb. de Richardson entre la surface --> la 1ere couche
66      REAL, dimension(klon) :: ri1
67      REAL, dimension(klon) :: ustar, testar, qstar
68      REAL, dimension(klon) :: zdte, zdq   
69! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney
70      DOUBLE PRECISION, dimension(klon) :: lmon
71      DOUBLE PRECISION, parameter :: eps=1.0D-20
72      REAL, dimension(klon) :: delu, delte, delq
73      REAL, dimension(klon) :: u_zref, te_zref, q_zref 
74      REAL, dimension(klon) :: temp, pref
75      LOGICAL :: okri
76      REAL, dimension(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
77      REAL, dimension(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
78      REAL, dimension(klon) :: ok_pred, ok_corr
79      REAL, dimension(klon) :: conv_te, conv_q
80!-------------------------------------------------------------------------
81      DO i=1, knon
82       speed(i)=SQRT(u1(i)**2+v1(i)**2)
83       ri1(i) = 0.0
84      ENDDO
85!
86      okri=.FALSE.
87      CALL coefcdrag(klon, knon, nsrf, zxli, &
88                     speed, t1, q1, z1, psol, &
89                     ts1, qsurf, rugos, okri, ri1,  &         
90                     cdram, cdrah, cdran, zri1, pref)           
91!
92!---------Star variables----------------------------------------------------
93!
94      DO i = 1, knon
95        ri1(i) = zri1(i)
96        tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
97        ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
98        zdte(i) = tpot(i) - ts1(i)
99        zdq(i) = max(q1(i),0.0) - max(qsurf(i),0.0)
100!
101        testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
102        qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
103        lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ &
104                  (RKAR * RG * testar(i))
105      ENDDO
106!
107!----------First aproximation of variables at zref --------------------------
108      zref = 2.0
109      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
110                   ts1, qsurf, rugos, lmon, &
111                   ustar, testar, qstar, zref, &
112                   delu, delte, delq)
113!
114      DO i = 1, knon
115        u_zref(i) = delu(i)
116        q_zref(i) = max(qsurf(i),0.0) + delq(i)
117        te_zref(i) = ts1(i) + delte(i)
118        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
119!       q_zref_p(i) = q_zref(i)
120!       te_zref_p(i) = te_zref(i)
121        temp_p(i) = temp(i)
122      ENDDO
123!
124! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
125!
126      DO n = 1, niter
127!
128        okri=.TRUE.
129        CALL screenc(klon, knon, nsrf, zxli, &
130                     u_zref, temp, q_zref, zref, &
131                     ts1, qsurf, rugos, psol, &           
132                     ustar, testar, qstar, okri, ri1, &
133                     pref, delu, delte, delq)
134!
135        DO i = 1, knon
136          u_zref(i) = delu(i)
137          q_zref(i) = delq(i) + max(qsurf(i),0.0)
138          te_zref(i) = delte(i) + ts1(i)
139!
140! return to normal temperature
141!
142          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
143!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
144!                 (1 + RVTMP2 * max(q_zref(i),0.0))
145!
146          IF(temp(i).GT.350.) THEN
147            WRITE(*,*) 'temp(i) GT 350 K !!',i,nsrf,temp(i)
148          ENDIF
149!
150        IF(n.EQ.ncon) THEN
151          te_zref_p(i) = te_zref(i)
152          q_zref_p(i) = q_zref(i)
153        ENDIF
154!
155        ENDDO
156!
157      ENDDO
158!
159! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
160!
161        DO i = 1, knon
162          conv_te(i) = (te_zref(i) - te_zref_p(i))/te_zref_p(i)
163          conv_q(i) = (q_zref(i) - q_zref_p(i))/q_zref_p(i)
164          IF(abs(conv_te(i)).GE.0.0025.AND.abs(conv_q(i)).GE.0.05) THEN
165            PRINT*,'DIV','i=',i,te_zref_p(i),te_zref(i),conv_te(i), &
166            q_zref_p(i),q_zref(i),conv_q(i)
167          ENDIF
168        ENDDO
169!
170      DO i = 1, knon
171        q_zref_c(i) = q_zref(i)
172        temp_c(i) = temp(i)
173!
174        IF(zri1(i).LT.0.) THEN
175          IF(nsrf.EQ.1) THEN
176            ok_pred(i)=1.
177            ok_corr(i)=0.
178          ELSE
179            ok_pred(i)=0.
180            ok_corr(i)=1.
181          ENDIF
182        ELSE
183          ok_pred(i)=0.
184          ok_corr(i)=1.
185        ENDIF
186!
187        t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
188        q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
189      ENDDO
190!
191!
192!----------First aproximation of variables at zref --------------------------
193!
194      zref = 10.0
195      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
196                   ts1, qsurf, rugos, lmon, &
197                   ustar, testar, qstar, zref, &
198                   delu, delte, delq)
199!
200      DO i = 1, knon
201        u_zref(i) = delu(i)
202        q_zref(i) = max(qsurf(i),0.0) + delq(i)
203        te_zref(i) = ts1(i) + delte(i)
204        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
205!       temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
206!                 (1 + RVTMP2 * max(q_zref(i),0.0))
207        u_zref_p(i) = u_zref(i)
208      ENDDO
209!
210! Iteration of the variables at the reference level zref : corrector ; see Hess & McAvaney, 1995
211!
212      DO n = 1, niter
213!
214        okri=.TRUE.
215        CALL screenc(klon, knon, nsrf, zxli, &
216                     u_zref, temp, q_zref, zref, &
217                     ts1, qsurf, rugos, psol, &
218                     ustar, testar, qstar, okri, ri1, &
219                     pref, delu, delte, delq)
220!
221        DO i = 1, knon
222          u_zref(i) = delu(i)
223          q_zref(i) = delq(i) + max(qsurf(i),0.0)
224          te_zref(i) = delte(i) + ts1(i)
225          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
226!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
227!                   (1 + RVTMP2 * max(q_zref(i),0.0))
228        ENDDO
229!
230      ENDDO
231!
232      DO i = 1, knon
233        u_zref_c(i) = u_zref(i)
234!
235        u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
236      ENDDO
237!
238      RETURN
239      END subroutine stdlevvar
Note: See TracBrowser for help on using the repository browser.