source: LMDZ.3.3/branches/rel-LF/libf/phylmd/stdlevvar.F90 @ 487

Last change on this file since 487 was 472, checked in by lmdzadmin, 21 years ago

IM: enleve le test sur la convergence pour cause de PBs sur vpp

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