/[lmdze]/trunk/phylmd/Interface_surf/stdlevvar.f90
ViewVC logotype

Contents of /trunk/phylmd/Interface_surf/stdlevvar.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 342 - (show annotations)
Mon Oct 21 13:52:44 2019 UTC (4 years, 7 months ago) by guez
File size: 5704 byte(s)
Bug fixes in `CMakeLists.txt`

1 module stdlevvar_m
2
3 IMPLICIT NONE
4
5 contains
6
7 SUBROUTINE stdlevvar(nsrf, u1, v1, t1, q1, z1, ts1, qsurf, rugos, psol, &
8 pat1, t_2m, q_2m, t_10m, q_10m, wind10m, ustar)
9
10 ! From LMDZ4/libf/phylmd/stdlevvar.F90, version 1.3, 2005 May 25th
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 ! Author: I. Musat, July 1st, 2002
19
20 ! Library:
21 use nr_util, only: assert_eq
22
23 use cdrag_m, only: cdrag
24 USE dimphy, ONLY: klon
25 USE suphec_m, ONLY: rg, rkappa
26 use screenc_m, only: screenc
27 use screenp_m, only: screenp
28
29 INTEGER, intent(in):: nsrf ! indice pour le type de surface
30 REAL, intent(in):: u1(:) ! (knon) vent zonal au 1er niveau du modele
31 REAL, intent(in):: v1(:) ! (knon) vent meridien au 1er niveau du modele
32 REAL, intent(in):: t1(:) ! (knon) temperature de l'air au 1er
33 ! niveau du modele
34 REAL, intent(in):: q1(:) ! (knon) humidite relative au 1er niveau du modele
35 REAL, intent(in):: z1(:) ! (knon) geopotentiel au 1er niveau du modele
36 REAL, intent(in):: ts1(:) ! (knon) temperature de l'air a la surface
37 REAL, intent(in):: qsurf(:) ! (knon) humidit\'e relative \`a la surface
38 REAL, intent(in):: rugos(klon) ! rugosite
39 REAL, intent(in):: psol(:) ! (knon) pression au sol
40 REAL, intent(in):: pat1(:) ! (knon) 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):: wind10m(:) ! (knon) norme du vent \`a 10m
46 REAL, intent(out):: ustar(:) ! (knon) u*
47
48 ! Local:
49 INTEGER knon ! nombre de points pour un type de surface
50 REAL, PARAMETER:: RKAR = 0.4 ! constante de von Karman
51 INTEGER, parameter:: niter = 2 ! nombre iterations calcul "corrector"
52 INTEGER i, n
53 REAL zref
54 REAL, dimension(klon):: speed
55 ! tpot : temperature potentielle
56 REAL, dimension(klon):: tpot
57 REAL cdram(size(u1)), cdrah(size(u1))
58 REAL, dimension(klon):: testar, qstar
59 REAL, dimension(klon):: zdte, zdq
60 ! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney
61 DOUBLE PRECISION, dimension(klon):: lmon
62 REAL, dimension(klon):: delu, delte, delq
63 REAL, dimension(klon):: u_zref, te_zref, q_zref
64 REAL temp(size(u1)) ! (knon)
65 real pref(size(u1)) ! (knon)
66
67 !-------------------------------------------------------------------------
68
69 knon = assert_eq([size(u1), size(v1), size(t1), size(wind10m), &
70 size(ustar)], "stdlevvar knon")
71
72 DO i=1, knon
73 speed(i)=SQRT(u1(i)**2+v1(i)**2)
74 ENDDO
75
76 CALL cdrag(nsrf, speed(:knon), t1, q1, z1, psol, ts1, qsurf, &
77 rugos(:knon), cdram, cdrah)
78
79 ! Star variables
80
81 DO i = 1, knon
82 tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
83 ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
84 zdte(i) = tpot(i) - ts1(i)
85 zdq(i) = max(q1(i), 0.0) - max(qsurf(i), 0.0)
86
87 zdte(i) = sign(max(abs(zdte(i)), 1.e-10), zdte(i))
88
89 testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
90 qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
91 lmon(i) = (ustar(i) * ustar(i) * tpot(i)) / (RKAR * RG * testar(i))
92 ENDDO
93
94 ! First aproximation of variables at zref
95 zref = 2.0
96 CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
97 testar, qstar, zref, delu, delte, delq)
98
99 DO i = 1, knon
100 u_zref(i) = delu(i)
101 q_zref(i) = max(qsurf(i), 0.0) + delq(i)
102 te_zref(i) = ts1(i) + delte(i)
103 temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
104 ENDDO
105
106 ! Iteration of the variables at the reference level zref :
107 ! corrector calculation ; see Hess & McAvaney, 1995
108
109 DO n = 1, niter
110 CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, qsurf, &
111 rugos, psol, ustar, testar, qstar, pref, delu, delte, delq)
112
113 DO i = 1, knon
114 u_zref(i) = delu(i)
115 q_zref(i) = delq(i) + max(qsurf(i), 0.0)
116 te_zref(i) = delte(i) + ts1(i)
117
118 ! return to normal temperature
119 temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
120 ENDDO
121 ENDDO
122
123 ! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
124
125 DO i = 1, knon
126 t_2m(i) = temp(i)
127 q_2m(i) = q_zref(i)
128 ENDDO
129
130 ! First aproximation of variables at zref
131
132 zref = 10.
133 CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
134 testar, qstar, zref, delu, delte, delq)
135
136 DO i = 1, knon
137 u_zref(i) = delu(i)
138 q_zref(i) = max(qsurf(i), 0.0) + delq(i)
139 te_zref(i) = ts1(i) + delte(i)
140 temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
141 ENDDO
142
143 ! Iteration of the variables at the reference level zref:
144 ! corrector ; see Hess & McAvaney, 1995
145
146 DO n = 1, niter
147 CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, qsurf, &
148 rugos, psol, ustar, testar, qstar, pref, delu, delte, delq)
149
150 DO i = 1, knon
151 u_zref(i) = delu(i)
152 q_zref(i) = delq(i) + max(qsurf(i), 0.0)
153 te_zref(i) = delte(i) + ts1(i)
154 temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
155 ENDDO
156 ENDDO
157
158 DO i = 1, knon
159 wind10m(i) = u_zref(i)
160 t_10m(i) = temp(i)
161 q_10m(i) = q_zref(i)
162 ENDDO
163
164 END subroutine stdlevvar
165
166 end module stdlevvar_m

  ViewVC Help
Powered by ViewVC 1.1.21