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

Contents of /trunk/phylmd/stdlevvar.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 104 - (show annotations)
Thu Sep 4 10:05:52 2014 UTC (9 years, 8 months ago) by guez
File size: 7102 byte(s)
Removed procedure sortvarc0. Called sortvarc with an additional
argument resetvarc instead. (Following LMDZ.) Moved current time
computations and some printing statements from sortvarc to
caldyn. Could then remove arguments itau and time_0 of sortvarc, and
could remove "use dynetat0". Better to keep "dynetat0.f" as a gcm-only
file.

Moved some variables from module ener to module sortvarc.

Split file "mathelp.f" into single-procedure files.

Removed unused argument nadv of adaptdt. Removed dimension arguments
of bernoui.

Removed unused argument nisurf of interfoce_lim. Changed the size of
argument lmt_sst of interfoce_lim from klon to knon. Removed case when
newlmt is false.

dynredem1 is called only once in each run, either ce0l or gcm. So
variable nb in call to nf95_put_var was always 1. Removed variable nb.

Removed dimension arguments of calcul_fluxs. Removed unused arguments
precip_rain, precip_snow, snow of calcul_fluxs. Changed the size of
all the arrays in calcul_fluxs from klon to knon.

Removed dimension arguments of fonte_neige. Changed the size of all
the arrays in fonte_neige from klon to knon.

Changed the size of arguments tsurf and tsurf_new of interfsurf_hq
from klon to knon. Changed the size of argument ptsrf of soil from
klon to knon.

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

  ViewVC Help
Powered by ViewVC 1.1.21