/[lmdze]/trunk/Sources/phylmd/stdlevvar.f
ViewVC logotype

Annotation of /trunk/Sources/phylmd/stdlevvar.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 108 - (hide annotations)
Tue Sep 16 14:00:41 2014 UTC (9 years, 8 months ago) by guez
Original Path: trunk/phylmd/stdlevvar.f
File size: 7556 byte(s)
Imported writefield from LMDZ. Close at the end of gcm the files which
were created by writefiled (not done in LMDZ).

Removed procedures for the output of Grads files. Removed calls to
dump2d. In guide, replaced calls to wrgrads by calls to writefield.

In vlspltqs, removed redundant programming of saturation
pressure. Call foeew from module FCTTRE instead.

Bug fix in interpre: size of w exceeding size of correponding actual
argument wg in advtrac.

In leapfrog, call guide until the end of the run, instead of six hours
before the end.

Bug fix in readsulfate_preind: type of arguments.

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

  ViewVC Help
Powered by ViewVC 1.1.21