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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 191 - (hide 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 guez 54 module interfsurf_hq_m
2    
3     implicit none
4    
5     contains
6    
7 guez 191 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 guez 54
14 guez 150 ! 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 guez 54
18 guez 104 ! Laurent Fairhead, February 2000
19 guez 54
20 guez 72 USE abort_gcm_m, ONLY: abort_gcm
21 guez 154 use alboc_cd_m, only: alboc_cd
22 guez 125 use alboc_m, only: alboc
23 guez 72 USE albsno_m, ONLY: albsno
24 guez 101 use calbeta_m, only: calbeta
25 guez 72 USE calcul_fluxs_m, ONLY: calcul_fluxs
26 guez 154 use clesphys2, only: soil_model, cycle_diurne
27 guez 98 USE dimphy, ONLY: klon
28 guez 72 USE fonte_neige_m, ONLY: fonte_neige
29     USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
30 guez 101 USE interface_surf, ONLY: run_off, run_off_lic, conf_interface
31 guez 72 USE interfoce_lim_m, ONLY: interfoce_lim
32     USE interfsur_lim_m, ONLY: interfsur_lim
33 guez 101 use soil_m, only: soil
34 guez 178 USE suphec_m, ONLY: rcpd, rtt
35 guez 54
36 guez 99 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 guez 101 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 guez 106 integer, intent(in):: knindex(:) ! (knon)
43 guez 101 ! index des points de la surface a traiter
44    
45 guez 99 real, intent(IN):: pctsrf(klon, nbsrf)
46 guez 101 ! 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 guez 54 ! (si false calcul simplifie des fluxs sur les continents)
52 guez 101
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 guez 99 real, dimension(klon), intent(IN):: u1_lay, v1_lay
60 guez 54 ! u1_lay vitesse u 1ere couche
61     ! v1_lay vitesse v 1ere couche
62 guez 99 real, dimension(klon), intent(IN):: temp_air, spechum
63 guez 54 ! temp_air temperature de l'air 1ere couche
64     ! spechum humidite specifique 1ere couche
65 guez 99 real, dimension(klon), intent(INOUT):: tq_cdrag
66 guez 54 ! tq_cdrag cdrag
67 guez 99 real, dimension(klon), intent(IN):: petAcoef, peqAcoef
68 guez 54 ! petAcoef coeff. A de la resolution de la CL pour t
69     ! peqAcoef coeff. A de la resolution de la CL pour q
70 guez 99 real, dimension(klon), intent(IN):: petBcoef, peqBcoef
71 guez 54 ! petBcoef coeff. B de la resolution de la CL pour t
72     ! peqBcoef coeff. B de la resolution de la CL pour q
73 guez 101
74     real, intent(IN):: precip_rain(klon)
75 guez 175 ! precipitation, liquid water mass flux (kg / m2 / s), positive down
76 guez 101
77     real, intent(IN):: precip_snow(klon)
78 guez 175 ! precipitation, solid water mass flux (kg / m2 / s), positive down
79 guez 101
80 guez 154 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 guez 101 real, intent(INOUT):: snow(klon), qsurf(klon)
84 guez 150 real, intent(IN):: tsurf(:) ! (knon) temp\'erature de surface
85 guez 104 real, dimension(klon), intent(IN):: p1lay
86 guez 54 ! p1lay pression 1er niveau (milieu de couche)
87 guez 99 real, dimension(klon), intent(IN):: ps
88 guez 54 ! ps pression au sol
89 guez 175
90 guez 99 REAL, DIMENSION(klon), INTENT(INOUT):: radsol
91 guez 175 ! rayonnement net au sol (LW + SW)
92    
93 guez 106 real, intent(INOUT):: evap(klon) ! evaporation totale
94 guez 99 real, dimension(klon), intent(OUT):: fluxsens, fluxlat
95 guez 54 ! fluxsens flux de chaleur sensible
96     ! fluxlat flux de chaleur latente
97 guez 99 real, dimension(klon), intent(OUT):: dflux_l, dflux_s
98 guez 150 real, intent(OUT):: tsurf_new(knon) ! temp\'erature au sol
99 guez 156 real, intent(OUT):: albedo(:) ! (knon) albedo
100 guez 154 real, intent(OUT):: z0_new(klon) ! surface roughness
101 guez 72 real, dimension(klon, nbsrf), intent(OUT):: pctsrf_new
102 guez 99 ! pctsrf_new nouvelle repartition des surfaces
103 guez 175 real, intent(INOUT):: agesno(:) ! (knon)
104 guez 54
105 guez 150 ! Flux d'eau "perdue" par la surface et n\'ecessaire pour que limiter la
106 guez 175 ! hauteur de neige, en kg / m2 / s
107 guez 54 !jld a rajouter real, dimension(klon), intent(INOUT):: fqcalving
108     real, dimension(klon), intent(INOUT):: fqcalving
109 guez 99
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 guez 175 REAL soilcap(klon)
119     REAL soilflux(klon)
120     logical:: first_call = .true.
121     integer ii
122 guez 54 real, dimension(klon):: cal, beta, dif_grnd, capsol
123 guez 175 real, parameter:: calice = 1. / (5.1444e6 * 0.15), tau_gl = 86400. * 5.
124     real, parameter:: calsno = 1. / (2.3867e6 * 0.15)
125 guez 104 real tsurf_temp(knon)
126 guez 174 real alb_neig(knon)
127     real zfra(knon)
128 guez 54
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 guez 72 call conf_interface
136 guez 175
137 guez 54 if (nisurf /= is_ter .and. klon > 1) then
138 guez 101 print *, ' nisurf = ', nisurf, ' /= is_ter = ', is_ter
139     print *, 'or on doit commencer par les surfaces continentales'
140 guez 175 call abort_gcm("interfsurf_hq", &
141     'On doit commencer par les surfaces continentales')
142 guez 54 endif
143 guez 175
144 guez 101 if (is_oce > is_sic) then
145 guez 175 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 guez 54 endif
149 guez 175
150     first_call = .false.
151 guez 54 endif
152    
153     ! Initialisations diverses
154    
155 guez 175 ffonte(1:knon) = 0.
156     fqcalving(1:knon) = 0.
157 guez 54 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 guez 104 select case (nisurf)
167     case (is_ter)
168 guez 171 ! Surface "terre", appel \`a l'interface avec les sols continentaux
169 guez 54
170     ! allocation du run-off
171 guez 101 if (.not. allocated(run_off)) then
172     allocate(run_off(knon))
173     run_off = 0.
174     else if (size(run_off) /= knon) then
175 guez 175 call abort_gcm("interfsurf_hq", 'Something is wrong: the number of ' &
176 guez 171 // 'continental points has changed since last call.')
177 guez 54 endif
178    
179     ! Calcul age de la neige
180    
181 guez 174 ! Read albedo from the file containing boundary conditions then
182     ! add the albedo of snow:
183    
184 guez 191 call interfsur_lim(dtime, jour, knindex, debut, albedo, z0_new)
185 guez 54
186 guez 174 ! Calcul snow et qsurf, hydrologie adapt\'ee
187 guez 101 CALL calbeta(nisurf, snow(:knon), qsol(:knon), beta(:knon), &
188     capsol(:knon), dif_grnd(:knon))
189 guez 54
190 guez 99 IF (soil_model) THEN
191 guez 101 CALL soil(dtime, nisurf, knon, snow, tsurf, tsoil, soilcap, soilflux)
192 guez 99 cal(1:knon) = RCPD / soilcap(1:knon)
193 guez 104 radsol(1:knon) = radsol(1:knon) + soilflux(:knon)
194 guez 99 ELSE
195     cal = RCPD * capsol
196     ENDIF
197 guez 171
198     CALL calcul_fluxs(dtime, tsurf, p1lay(:knon), cal(:knon), &
199 guez 116 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 guez 54
205 guez 104 CALL fonte_neige(nisurf, dtime, tsurf, p1lay(:knon), beta(:knon), &
206 guez 116 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 guez 54
212 guez 175 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 guez 174 albedo = alb_neig * zfra + albedo * (1. - zfra)
216 guez 101 z0_new = sqrt(z0_new**2 + rugoro**2)
217 guez 54
218     ! Remplissage des pourcentages de surface
219     pctsrf_new(:, nisurf) = pctsrf(:, nisurf)
220 guez 104 case (is_oce)
221 guez 175 ! Surface "oc\'ean", appel \`a l'interface avec l'oc\'ean
222    
223 guez 191 call interfoce_lim(dtime, jour, knindex, debut, tsurf_temp, pctsrf_new)
224 guez 54
225     cal = 0.
226     beta = 1.
227     dif_grnd = 0.
228     agesno = 0.
229 guez 175 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 guez 154 fder = fder + dflux_s + dflux_l
236 guez 54
237 guez 174 ! Compute the albedo:
238 guez 154 if (cycle_diurne) then
239 guez 156 CALL alboc_cd(rmu0(knindex), albedo)
240 guez 154 else
241 guez 156 CALL alboc(jour, rlat(knindex), albedo)
242 guez 54 endif
243    
244     z0_new = sqrt(rugos**2 + rugoro**2)
245 guez 104 case (is_sic)
246 guez 54 ! Surface "glace de mer" appel a l'interface avec l'ocean
247    
248 guez 99 ! ! lecture conditions limites
249 guez 191 CALL interfoce_lim(dtime, jour, knindex, debut, tsurf_new, pctsrf_new)
250 guez 54
251 guez 99 DO ii = 1, knon
252     tsurf_new(ii) = tsurf(ii)
253     IF (pctsrf_new(knindex(ii), nisurf) < EPSFRA) then
254 guez 175 snow(ii) = 0.
255 guez 99 tsurf_new(ii) = RTT - 1.8
256 guez 154 IF (soil_model) tsoil(ii, :) = RTT - 1.8
257 guez 99 endif
258     enddo
259 guez 54
260 guez 101 CALL calbeta(nisurf, snow(:knon), qsol(:knon), beta(:knon), &
261     capsol(:knon), dif_grnd(:knon))
262 guez 54
263 guez 99 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 guez 54 ELSE
270 guez 175 dif_grnd = 1. / tau_gl
271 guez 99 cal = RCPD * calice
272 guez 175 WHERE (snow > 0.) cal = RCPD * calsno
273 guez 54 ENDIF
274 guez 99 tsurf_temp = tsurf_new
275 guez 175 beta = 1.
276 guez 54
277 guez 171 CALL calcul_fluxs(dtime, tsurf_temp, p1lay(:knon), cal(:knon), &
278 guez 104 beta(:knon), tq_cdrag(:knon), ps(:knon), qsurf(:knon), &
279 guez 116 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 guez 54
284 guez 104 CALL fonte_neige(nisurf, dtime, tsurf_temp, p1lay(:knon), beta(:knon), &
285 guez 116 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 guez 54
291 guez 174 ! Compute the albedo:
292 guez 54
293 guez 175 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 guez 54
298 guez 154 fder = fder + dflux_s + dflux_l
299 guez 191 z0_new = SQRT(0.002**2 + rugoro**2)
300 guez 104 case (is_lic)
301 guez 54 if (.not. allocated(run_off_lic)) then
302 guez 101 allocate(run_off_lic(knon))
303 guez 54 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 guez 175 WHERE (snow > 0.) cal = RCPD * calsno
315 guez 54 ENDIF
316 guez 175 beta = 1.
317     dif_grnd = 0.
318 guez 54
319 guez 171 call calcul_fluxs(dtime, tsurf, p1lay(:knon), cal(:knon), &
320 guez 116 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 guez 54
326 guez 104 call fonte_neige(nisurf, dtime, tsurf, p1lay(:knon), beta(:knon), &
327 guez 116 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 guez 54
333     ! calcul albedo
334 guez 175 CALL albsno(dtime, agesno, alb_neig, precip_snow(:knon))
335     WHERE (snow(:knon) < 0.0001) agesno = 0.
336 guez 156 albedo = 0.77
337 guez 54
338     ! Rugosite
339     z0_new = rugoro
340    
341     ! Remplissage des pourcentages de surface
342     pctsrf_new(:, nisurf) = pctsrf(:, nisurf)
343 guez 104 case default
344 guez 101 print *, 'Index surface = ', nisurf
345 guez 175 call abort_gcm("interfsurf_hq", 'Index surface non valable')
346 guez 104 end select
347 guez 54
348     END SUBROUTINE interfsurf_hq
349    
350     end module interfsurf_hq_m

  ViewVC Help
Powered by ViewVC 1.1.21