/[lmdze]/trunk/phylmd/Interface_surf/interfsurf_hq.f
ViewVC logotype

Contents of /trunk/phylmd/Interface_surf/interfsurf_hq.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 191 - (show annotations)
Mon May 9 19:56:28 2016 UTC (8 years ago) by guez
Original Path: trunk/Sources/phylmd/Interface_surf/interfsurf_hq.f
File size: 13796 byte(s)
Extracted the call to read_comdissnew out of conf_gcm.

Made ok_instan a variable of module clesphys, itau_phy a variable of
module phyetat0_m, nid_ins a variable of module ini_histins_m, itap a
variable of new module time_phylmdz, so that histwrite_phy can be
called from any procedure without the need to cascade those variables
into that procedure. Made itau_w a variable of module time_phylmdz so
that it is computed only once per time step of physics.

Extracted variables of module clesphys which were in namelist
conf_phys_nml into their own namelist, clesphys_nml, and created
procedure read_clesphys reading clesphys_nml, to avoid side effect.

No need for double precision in procedure getso4fromfile. Assume there
is a single variable for the whole year in the NetCDF file instead of
one variable per month.

Created generic procedure histwrite_phy and removed procedure
write_histins, following LMDZ. histwrite_phy has only two arguments,
can be called from anywhere, and should manage the logic of writing or
not writing into various history files with various operations. So the
test on ok_instan goes inside histwrite_phy.

Test for raz_date in phyetat0 instead of physiq to avoid side effect.

Created procedure increment_itap to avoid side effect.

Removed unnecessary differences between procedures readsulfate and
readsulfate_pi.

1 module interfsurf_hq_m
2
3 implicit none
4
5 contains
6
7 SUBROUTINE interfsurf_hq(dtime, jour, rmu0, nisurf, knon, knindex, pctsrf, &
8 rlat, debut, nsoilmx, tsoil, qsol, u1_lay, v1_lay, temp_air, spechum, &
9 tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, precip_rain, &
10 precip_snow, fder, rugos, rugoro, snow, qsurf, tsurf, p1lay, ps, &
11 radsol, evap, fluxsens, fluxlat, dflux_l, dflux_s, tsurf_new, albedo, &
12 z0_new, pctsrf_new, agesno, fqcalving, ffonte, run_off_lic_0)
13
14 ! Cette routine sert d'aiguillage entre l'atmosph\`ere et la surface
15 ! en g\'en\'eral (sols continentaux, oc\'eans, glaces) pour les flux de
16 ! chaleur et d'humidit\'e.
17
18 ! Laurent Fairhead, February 2000
19
20 USE abort_gcm_m, ONLY: abort_gcm
21 use alboc_cd_m, only: alboc_cd
22 use alboc_m, only: alboc
23 USE albsno_m, ONLY: albsno
24 use calbeta_m, only: calbeta
25 USE calcul_fluxs_m, ONLY: calcul_fluxs
26 use clesphys2, only: soil_model, cycle_diurne
27 USE dimphy, ONLY: klon
28 USE fonte_neige_m, ONLY: fonte_neige
29 USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
30 USE interface_surf, ONLY: run_off, run_off_lic, conf_interface
31 USE interfoce_lim_m, ONLY: interfoce_lim
32 USE interfsur_lim_m, ONLY: interfsur_lim
33 use soil_m, only: soil
34 USE suphec_m, ONLY: rcpd, rtt
35
36 real, intent(IN):: dtime ! pas de temps de la physique (en s)
37 integer, intent(IN):: jour ! jour dans l'annee en cours
38 real, intent(IN):: rmu0(klon) ! cosinus de l'angle solaire zenithal
39 integer, intent(IN):: nisurf ! index de la surface a traiter
40 integer, intent(IN):: knon ! nombre de points de la surface a traiter
41
42 integer, intent(in):: knindex(:) ! (knon)
43 ! index des points de la surface a traiter
44
45 real, intent(IN):: pctsrf(klon, nbsrf)
46 ! tableau des pourcentages de surface de chaque maille
47
48 real, intent(IN):: rlat(klon) ! latitudes
49
50 logical, intent(IN):: debut ! 1er appel a la physique
51 ! (si false calcul simplifie des fluxs sur les continents)
52
53 integer, intent(in):: nsoilmx
54 REAL tsoil(klon, nsoilmx)
55
56 REAL, intent(INOUT):: qsol(klon)
57 ! column-density of water in soil, in kg m-2
58
59 real, dimension(klon), intent(IN):: u1_lay, v1_lay
60 ! u1_lay vitesse u 1ere couche
61 ! v1_lay vitesse v 1ere couche
62 real, dimension(klon), intent(IN):: temp_air, spechum
63 ! temp_air temperature de l'air 1ere couche
64 ! spechum humidite specifique 1ere couche
65 real, dimension(klon), intent(INOUT):: tq_cdrag
66 ! tq_cdrag cdrag
67 real, dimension(klon), intent(IN):: petAcoef, peqAcoef
68 ! petAcoef coeff. A de la resolution de la CL pour t
69 ! peqAcoef coeff. A de la resolution de la CL pour q
70 real, dimension(klon), intent(IN):: petBcoef, peqBcoef
71 ! petBcoef coeff. B de la resolution de la CL pour t
72 ! peqBcoef coeff. B de la resolution de la CL pour q
73
74 real, intent(IN):: precip_rain(klon)
75 ! precipitation, liquid water mass flux (kg / m2 / s), positive down
76
77 real, intent(IN):: precip_snow(klon)
78 ! precipitation, solid water mass flux (kg / m2 / s), positive down
79
80 REAL, INTENT(INOUT):: fder(klon) ! derivee des flux (pour le couplage)
81 real, intent(IN):: rugos(klon) ! rugosite
82 real, intent(IN):: rugoro(klon) ! rugosite orographique
83 real, intent(INOUT):: snow(klon), qsurf(klon)
84 real, intent(IN):: tsurf(:) ! (knon) temp\'erature de surface
85 real, dimension(klon), intent(IN):: p1lay
86 ! p1lay pression 1er niveau (milieu de couche)
87 real, dimension(klon), intent(IN):: ps
88 ! ps pression au sol
89
90 REAL, DIMENSION(klon), INTENT(INOUT):: radsol
91 ! rayonnement net au sol (LW + SW)
92
93 real, intent(INOUT):: evap(klon) ! evaporation totale
94 real, dimension(klon), intent(OUT):: fluxsens, fluxlat
95 ! fluxsens flux de chaleur sensible
96 ! fluxlat flux de chaleur latente
97 real, dimension(klon), intent(OUT):: dflux_l, dflux_s
98 real, intent(OUT):: tsurf_new(knon) ! temp\'erature au sol
99 real, intent(OUT):: albedo(:) ! (knon) albedo
100 real, intent(OUT):: z0_new(klon) ! surface roughness
101 real, dimension(klon, nbsrf), intent(OUT):: pctsrf_new
102 ! pctsrf_new nouvelle repartition des surfaces
103 real, intent(INOUT):: agesno(:) ! (knon)
104
105 ! Flux d'eau "perdue" par la surface et n\'ecessaire pour que limiter la
106 ! hauteur de neige, en kg / m2 / s
107 !jld a rajouter real, dimension(klon), intent(INOUT):: fqcalving
108 real, dimension(klon), intent(INOUT):: fqcalving
109
110 ! Flux thermique utiliser pour fondre la neige
111 !jld a rajouter real, dimension(klon), intent(INOUT):: ffonte
112 real, dimension(klon), intent(INOUT):: ffonte
113
114 real, dimension(klon), intent(INOUT):: run_off_lic_0
115 ! run_off_lic_0 runoff glacier du pas de temps precedent
116
117 ! Local:
118 REAL soilcap(klon)
119 REAL soilflux(klon)
120 logical:: first_call = .true.
121 integer ii
122 real, dimension(klon):: cal, beta, dif_grnd, capsol
123 real, parameter:: calice = 1. / (5.1444e6 * 0.15), tau_gl = 86400. * 5.
124 real, parameter:: calsno = 1. / (2.3867e6 * 0.15)
125 real tsurf_temp(knon)
126 real alb_neig(knon)
127 real zfra(knon)
128
129 !-------------------------------------------------------------
130
131 ! On doit commencer par appeler les schemas de surfaces continentales
132 ! car l'ocean a besoin du ruissellement qui est y calcule
133
134 if (first_call) then
135 call conf_interface
136
137 if (nisurf /= is_ter .and. klon > 1) then
138 print *, ' nisurf = ', nisurf, ' /= is_ter = ', is_ter
139 print *, 'or on doit commencer par les surfaces continentales'
140 call abort_gcm("interfsurf_hq", &
141 'On doit commencer par les surfaces continentales')
142 endif
143
144 if (is_oce > is_sic) then
145 print *, 'is_oce = ', is_oce, '> is_sic = ', is_sic
146 call abort_gcm("interfsurf_hq", &
147 'L''ocean doit etre traite avant la banquise')
148 endif
149
150 first_call = .false.
151 endif
152
153 ! Initialisations diverses
154
155 ffonte(1:knon) = 0.
156 fqcalving(1:knon) = 0.
157 cal = 999999.
158 beta = 999999.
159 dif_grnd = 999999.
160 capsol = 999999.
161 z0_new = 999999.
162 tsurf_new = 999999.
163
164 ! Aiguillage vers les differents schemas de surface
165
166 select case (nisurf)
167 case (is_ter)
168 ! Surface "terre", appel \`a l'interface avec les sols continentaux
169
170 ! allocation du run-off
171 if (.not. allocated(run_off)) then
172 allocate(run_off(knon))
173 run_off = 0.
174 else if (size(run_off) /= knon) then
175 call abort_gcm("interfsurf_hq", 'Something is wrong: the number of ' &
176 // 'continental points has changed since last call.')
177 endif
178
179 ! Calcul age de la neige
180
181 ! Read albedo from the file containing boundary conditions then
182 ! add the albedo of snow:
183
184 call interfsur_lim(dtime, jour, knindex, debut, albedo, z0_new)
185
186 ! Calcul snow et qsurf, hydrologie adapt\'ee
187 CALL calbeta(nisurf, snow(:knon), qsol(:knon), beta(:knon), &
188 capsol(:knon), dif_grnd(:knon))
189
190 IF (soil_model) THEN
191 CALL soil(dtime, nisurf, knon, snow, tsurf, tsoil, soilcap, soilflux)
192 cal(1:knon) = RCPD / soilcap(1:knon)
193 radsol(1:knon) = radsol(1:knon) + soilflux(:knon)
194 ELSE
195 cal = RCPD * capsol
196 ENDIF
197
198 CALL calcul_fluxs(dtime, tsurf, p1lay(:knon), cal(:knon), &
199 beta(:knon), tq_cdrag(:knon), ps(:knon), qsurf(:knon), &
200 radsol(:knon), dif_grnd(:knon), temp_air(:knon), spechum(:knon), &
201 u1_lay(:knon), v1_lay(:knon), petAcoef(:knon), peqAcoef(:knon), &
202 petBcoef(:knon), peqBcoef(:knon), tsurf_new, evap(:knon), &
203 fluxlat(:knon), fluxsens(:knon), dflux_s(:knon), dflux_l(:knon))
204
205 CALL fonte_neige(nisurf, dtime, tsurf, p1lay(:knon), beta(:knon), &
206 tq_cdrag(:knon), ps(:knon), precip_rain(:knon), &
207 precip_snow(:knon), snow(:knon), qsol(:knon), temp_air(:knon), &
208 spechum(:knon), u1_lay(:knon), v1_lay(:knon), petAcoef(:knon), &
209 peqAcoef(:knon), petBcoef(:knon), peqBcoef(:knon), tsurf_new, &
210 evap(:knon), fqcalving(:knon), ffonte(:knon), run_off_lic_0(:knon))
211
212 call albsno(dtime, agesno, alb_neig, precip_snow(:knon))
213 where (snow(:knon) < 0.0001) agesno = 0.
214 zfra = max(0., min(1., snow(:knon) / (snow(:knon) + 10.)))
215 albedo = alb_neig * zfra + albedo * (1. - zfra)
216 z0_new = sqrt(z0_new**2 + rugoro**2)
217
218 ! Remplissage des pourcentages de surface
219 pctsrf_new(:, nisurf) = pctsrf(:, nisurf)
220 case (is_oce)
221 ! Surface "oc\'ean", appel \`a l'interface avec l'oc\'ean
222
223 call interfoce_lim(dtime, jour, knindex, debut, tsurf_temp, pctsrf_new)
224
225 cal = 0.
226 beta = 1.
227 dif_grnd = 0.
228 agesno = 0.
229 call calcul_fluxs(dtime, tsurf_temp, p1lay(:knon), cal(:knon), &
230 beta(:knon), tq_cdrag(:knon), ps(:knon), qsurf(:knon), &
231 radsol(:knon), dif_grnd(:knon), temp_air(:knon), spechum(:knon), &
232 u1_lay(:knon), v1_lay(:knon), petAcoef(:knon), peqAcoef(:knon), &
233 petBcoef(:knon), peqBcoef(:knon), tsurf_new, evap(:knon), &
234 fluxlat(:knon), fluxsens(:knon), dflux_s(:knon), dflux_l(:knon))
235 fder = fder + dflux_s + dflux_l
236
237 ! Compute the albedo:
238 if (cycle_diurne) then
239 CALL alboc_cd(rmu0(knindex), albedo)
240 else
241 CALL alboc(jour, rlat(knindex), albedo)
242 endif
243
244 z0_new = sqrt(rugos**2 + rugoro**2)
245 case (is_sic)
246 ! Surface "glace de mer" appel a l'interface avec l'ocean
247
248 ! ! lecture conditions limites
249 CALL interfoce_lim(dtime, jour, knindex, debut, tsurf_new, pctsrf_new)
250
251 DO ii = 1, knon
252 tsurf_new(ii) = tsurf(ii)
253 IF (pctsrf_new(knindex(ii), nisurf) < EPSFRA) then
254 snow(ii) = 0.
255 tsurf_new(ii) = RTT - 1.8
256 IF (soil_model) tsoil(ii, :) = RTT - 1.8
257 endif
258 enddo
259
260 CALL calbeta(nisurf, snow(:knon), qsol(:knon), beta(:knon), &
261 capsol(:knon), dif_grnd(:knon))
262
263 IF (soil_model) THEN
264 CALL soil(dtime, nisurf, knon, snow, tsurf_new, tsoil, soilcap, &
265 soilflux)
266 cal(1:knon) = RCPD / soilcap(1:knon)
267 radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
268 dif_grnd = 0.
269 ELSE
270 dif_grnd = 1. / tau_gl
271 cal = RCPD * calice
272 WHERE (snow > 0.) cal = RCPD * calsno
273 ENDIF
274 tsurf_temp = tsurf_new
275 beta = 1.
276
277 CALL calcul_fluxs(dtime, tsurf_temp, p1lay(:knon), cal(:knon), &
278 beta(:knon), tq_cdrag(:knon), ps(:knon), qsurf(:knon), &
279 radsol(:knon), dif_grnd(:knon), temp_air(:knon), spechum(:knon), &
280 u1_lay(:knon), v1_lay(:knon), petAcoef(:knon), peqAcoef(:knon), &
281 petBcoef(:knon), peqBcoef(:knon), tsurf_new, evap(:knon), &
282 fluxlat(:knon), fluxsens(:knon), dflux_s(:knon), dflux_l(:knon))
283
284 CALL fonte_neige(nisurf, dtime, tsurf_temp, p1lay(:knon), beta(:knon), &
285 tq_cdrag(:knon), ps(:knon), precip_rain(:knon), &
286 precip_snow(:knon), snow(:knon), qsol(:knon), temp_air(:knon), &
287 spechum(:knon), u1_lay(:knon), v1_lay(:knon), petAcoef(:knon), &
288 peqAcoef(:knon), petBcoef(:knon), peqBcoef(:knon), tsurf_new, &
289 evap(:knon), fqcalving(:knon), ffonte(:knon), run_off_lic_0(:knon))
290
291 ! Compute the albedo:
292
293 CALL albsno(dtime, agesno, alb_neig, precip_snow(:knon))
294 WHERE (snow(:knon) < 0.0001) agesno = 0.
295 zfra = MAX(0., MIN(1., snow(:knon) / (snow(:knon) + 10.)))
296 albedo = alb_neig * zfra + 0.6 * (1. - zfra)
297
298 fder = fder + dflux_s + dflux_l
299 z0_new = SQRT(0.002**2 + rugoro**2)
300 case (is_lic)
301 if (.not. allocated(run_off_lic)) then
302 allocate(run_off_lic(knon))
303 run_off_lic = 0.
304 endif
305
306 ! Surface "glacier continentaux" appel a l'interface avec le sol
307
308 IF (soil_model) THEN
309 CALL soil(dtime, nisurf, knon, snow, tsurf, tsoil, soilcap, soilflux)
310 cal(1:knon) = RCPD / soilcap(1:knon)
311 radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
312 ELSE
313 cal = RCPD * calice
314 WHERE (snow > 0.) cal = RCPD * calsno
315 ENDIF
316 beta = 1.
317 dif_grnd = 0.
318
319 call calcul_fluxs(dtime, tsurf, p1lay(:knon), cal(:knon), &
320 beta(:knon), tq_cdrag(:knon), ps(:knon), qsurf(:knon), &
321 radsol(:knon), dif_grnd(:knon), temp_air(:knon), spechum(:knon), &
322 u1_lay(:knon), v1_lay(:knon), petAcoef(:knon), peqAcoef(:knon), &
323 petBcoef(:knon), peqBcoef(:knon), tsurf_new, evap(:knon), &
324 fluxlat(:knon), fluxsens(:knon), dflux_s(:knon), dflux_l(:knon))
325
326 call fonte_neige(nisurf, dtime, tsurf, p1lay(:knon), beta(:knon), &
327 tq_cdrag(:knon), ps(:knon), precip_rain(:knon), &
328 precip_snow(:knon), snow(:knon), qsol(:knon), temp_air(:knon), &
329 spechum(:knon), u1_lay(:knon), v1_lay(:knon), petAcoef(:knon), &
330 peqAcoef(:knon), petBcoef(:knon), peqBcoef(:knon), tsurf_new, &
331 evap(:knon), fqcalving(:knon), ffonte(:knon), run_off_lic_0(:knon))
332
333 ! calcul albedo
334 CALL albsno(dtime, agesno, alb_neig, precip_snow(:knon))
335 WHERE (snow(:knon) < 0.0001) agesno = 0.
336 albedo = 0.77
337
338 ! Rugosite
339 z0_new = rugoro
340
341 ! Remplissage des pourcentages de surface
342 pctsrf_new(:, nisurf) = pctsrf(:, nisurf)
343 case default
344 print *, 'Index surface = ', nisurf
345 call abort_gcm("interfsurf_hq", 'Index surface non valable')
346 end select
347
348 END SUBROUTINE interfsurf_hq
349
350 end module interfsurf_hq_m

  ViewVC Help
Powered by ViewVC 1.1.21