/[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 300 - (hide annotations)
Thu Aug 2 15:55:01 2018 UTC (5 years, 10 months ago) by guez
File size: 9166 byte(s)
The calls to calcul_fluxs were always done with an array argument
dif_grnd set to a scalar (and that is also the case in LMDZ). So just
use a scalar argument.

In procedure fonte_neige, the value of run_off_lic from previous call
was actually not used. So we can remove the save attribute and make it
an automatic array.

1 guez 54 module interfsurf_hq_m
2    
3     implicit none
4    
5     contains
6    
7 guez 300 SUBROUTINE interfsurf_hq(julien, mu0, nisurf, knindex, debut, tsoil, qsol, &
8 guez 299 u1_lay, v1_lay, temp_air, spechum, tq_cdrag, tAcoef, qAcoef, tBcoef, &
9     qBcoef, precip_rain, precip_snow, rugos, rugoro, snow, qsurf, ts, &
10     p1lay, ps, radsol, evap, flux_t, fluxlat, dflux_l, dflux_s, tsurf_new, &
11     albedo, z0_new, pctsrf_new_sic, agesno, fqcalving, ffonte, run_off_lic_0)
12 guez 54
13 guez 150 ! Cette routine sert d'aiguillage entre l'atmosph\`ere et la surface
14     ! en g\'en\'eral (sols continentaux, oc\'eans, glaces) pour les flux de
15     ! chaleur et d'humidit\'e.
16 guez 54
17 guez 104 ! Laurent Fairhead, February 2000
18 guez 54
19 guez 72 USE abort_gcm_m, ONLY: abort_gcm
20 guez 154 use alboc_cd_m, only: alboc_cd
21 guez 72 USE albsno_m, ONLY: albsno
22     USE calcul_fluxs_m, ONLY: calcul_fluxs
23 guez 98 USE dimphy, ONLY: klon
24 guez 72 USE fonte_neige_m, ONLY: fonte_neige
25 guez 207 USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter
26 guez 297 USE conf_interface_m, ONLY: conf_interface
27 guez 72 USE interfsur_lim_m, ONLY: interfsur_lim
28 guez 293 use limit_read_sst_m, only: limit_read_sst
29 guez 101 use soil_m, only: soil
30 guez 178 USE suphec_m, ONLY: rcpd, rtt
31 guez 54
32 guez 221 integer, intent(IN):: julien ! jour dans l'annee en cours
33 guez 300 real, intent(IN):: mu0(:) ! (knon) cosinus de l'angle solaire zenithal
34 guez 101 integer, intent(IN):: nisurf ! index de la surface a traiter
35    
36 guez 106 integer, intent(in):: knindex(:) ! (knon)
37 guez 101 ! index des points de la surface a traiter
38    
39     logical, intent(IN):: debut ! 1er appel a la physique
40 guez 54 ! (si false calcul simplifie des fluxs sur les continents)
41 guez 101
42 guez 208 REAL, intent(inout):: tsoil(:, :) ! (knon, nsoilmx)
43 guez 101
44 guez 225 REAL, intent(INOUT):: qsol(:) ! (knon)
45 guez 101 ! column-density of water in soil, in kg m-2
46    
47 guez 225 real, intent(IN):: u1_lay(:), v1_lay(:) ! (knon) vitesse 1ere couche
48    
49 guez 281 real, intent(IN):: temp_air(:) ! (knon) temperature de l'air 1ere couche
50     real, intent(IN):: spechum(:) ! (knon) humidite specifique 1ere couche
51 guez 230 real, intent(IN):: tq_cdrag(:) ! (knon) coefficient d'echange
52 guez 215
53 guez 299 real, intent(IN):: tAcoef(:), qAcoef(:) ! (knon)
54 guez 215 ! coefficients A de la r\'esolution de la couche limite pour t et q
55    
56 guez 299 real, intent(IN):: tBcoef(:), qBcoef(:) ! (knon)
57 guez 215 ! coefficients B de la r\'esolution de la couche limite pour t et q
58 guez 101
59 guez 300 real, intent(IN):: precip_rain(:) ! (knon)
60 guez 175 ! precipitation, liquid water mass flux (kg / m2 / s), positive down
61 guez 101
62 guez 300 real, intent(IN):: precip_snow(:) ! (knon)
63 guez 175 ! precipitation, solid water mass flux (kg / m2 / s), positive down
64 guez 101
65 guez 282 real, intent(IN):: rugos(:) ! (knon) rugosite
66     real, intent(IN):: rugoro(:) ! (knon) rugosite orographique
67 guez 215 real, intent(INOUT):: snow(:) ! (knon)
68 guez 283 real, intent(OUT):: qsurf(:) ! (knon)
69 guez 221 real, intent(IN):: ts(:) ! (knon) temp\'erature de surface
70 guez 281 real, intent(IN):: p1lay(:) ! (knon) pression 1er niveau (milieu de couche)
71 guez 280 real, intent(IN):: ps(:) ! (knon) pression au sol
72 guez 267 REAL, INTENT(IN):: radsol(:) ! (knon) rayonnement net au sol (LW + SW)
73 guez 206 real, intent(OUT):: evap(:) ! (knon) evaporation totale
74 guez 214
75 guez 206 real, intent(OUT):: flux_t(:) ! (knon) flux de chaleur sensible
76 guez 214 ! (Cp T) à la surface, positif vers le bas, W / m2
77 guez 267
78 guez 214 real, intent(OUT):: fluxlat(:) ! (knon) flux de chaleur latente
79 guez 222 real, intent(OUT):: dflux_l(:), dflux_s(:) ! (knon)
80 guez 207 real, intent(OUT):: tsurf_new(:) ! (knon) temp\'erature au sol
81 guez 156 real, intent(OUT):: albedo(:) ! (knon) albedo
82 guez 282 real, intent(OUT):: z0_new(:) ! (knon) surface roughness
83 guez 202
84 guez 300 real, intent(in):: pctsrf_new_sic(:) ! (knon)
85 guez 202 ! nouvelle repartition des surfaces
86    
87 guez 175 real, intent(INOUT):: agesno(:) ! (knon)
88 guez 54
89 guez 282 real, intent(OUT):: fqcalving(:) ! (knon)
90 guez 215 ! Flux d'eau "perdue" par la surface et n\'ecessaire pour limiter la
91 guez 175 ! hauteur de neige, en kg / m2 / s
92 guez 99
93 guez 300 real, intent(OUT):: ffonte(:) ! (knon)
94     ! flux thermique utilis\'e pour fondre la neige
95 guez 99
96 guez 300 real, intent(INOUT):: run_off_lic_0(:) ! (knon)
97 guez 99 ! run_off_lic_0 runoff glacier du pas de temps precedent
98    
99     ! Local:
100 guez 222 integer knon ! nombre de points de la surface a traiter
101     REAL soilcap(size(knindex)) ! (knon)
102     REAL soilflux(size(knindex)) ! (knon)
103 guez 175 logical:: first_call = .true.
104     integer ii
105 guez 222 real cal(size(knindex)) ! (knon)
106     real beta(size(knindex)) ! (knon) evap reelle
107     real tsurf(size(knindex)) ! (knon)
108     real alb_neig(size(knindex)) ! (knon)
109     real zfra(size(knindex)) ! (knon)
110 guez 208 REAL, PARAMETER:: fmagic = 1. ! facteur magique pour r\'egler l'alb\'edo
111 guez 268 REAL, PARAMETER:: max_eau_sol = 150. ! in kg m-2
112 guez 269 REAL, PARAMETER:: tau_gl = 86400. * 5.
113 guez 54
114     !-------------------------------------------------------------
115    
116 guez 222 knon = size(knindex)
117 guez 267
118 guez 299 ! On doit commencer par appeler les sch\'emas de surfaces
119     ! continentales car l'oc\'ean a besoin du ruissellement.
120 guez 54
121     if (first_call) then
122 guez 72 call conf_interface
123 guez 175
124 guez 54 if (nisurf /= is_ter .and. klon > 1) then
125 guez 101 print *, ' nisurf = ', nisurf, ' /= is_ter = ', is_ter
126 guez 175 call abort_gcm("interfsurf_hq", &
127 guez 299 'On doit commencer par les surfaces continentales.')
128 guez 54 endif
129 guez 175
130 guez 101 if (is_oce > is_sic) then
131 guez 175 print *, 'is_oce = ', is_oce, '> is_sic = ', is_sic
132     call abort_gcm("interfsurf_hq", &
133 guez 299 "L'oc\'ean doit \^etre trait\'e avant la banquise.")
134 guez 54 endif
135 guez 175
136     first_call = .false.
137 guez 54 endif
138    
139     ! Aiguillage vers les differents schemas de surface
140    
141 guez 104 select case (nisurf)
142     case (is_ter)
143 guez 171 ! Surface "terre", appel \`a l'interface avec les sols continentaux
144 guez 54
145     ! Calcul age de la neige
146    
147 guez 174 ! Read albedo from the file containing boundary conditions then
148     ! add the albedo of snow:
149    
150 guez 299 call interfsur_lim(julien, knindex, debut, albedo, z0_new)
151 guez 54
152 guez 268 beta = min(2. * qsol / max_eau_sol, 1.)
153 guez 299 CALL soil(is_ter, snow, ts, tsoil, soilcap, soilflux)
154 guez 267 cal = RCPD / soilcap
155 guez 171
156 guez 299 CALL calcul_fluxs(ts, p1lay, cal, beta, tq_cdrag, ps, qsurf, &
157 guez 300 radsol + soilflux, temp_air, spechum, u1_lay, v1_lay, tAcoef, &
158     qAcoef, tBcoef, qBcoef, tsurf_new, evap, fluxlat, flux_t, dflux_s, &
159     dflux_l, dif_grnd = 0.)
160     CALL fonte_neige(is_ter, precip_rain, precip_snow, snow, qsol, &
161     tsurf_new, evap, fqcalving, ffonte, run_off_lic_0)
162 guez 54
163 guez 300 call albsno(agesno, alb_neig, precip_snow)
164 guez 215 where (snow < 0.0001) agesno = 0.
165     zfra = max(0., min(1., snow / (snow + 10.)))
166 guez 174 albedo = alb_neig * zfra + albedo * (1. - zfra)
167 guez 101 z0_new = sqrt(z0_new**2 + rugoro**2)
168 guez 104 case (is_oce)
169 guez 175 ! Surface "oc\'ean", appel \`a l'interface avec l'oc\'ean
170    
171 guez 300 ffonte = 0.
172 guez 293 call limit_read_sst(julien, knindex, tsurf)
173 guez 54 cal = 0.
174     beta = 1.
175 guez 299 call calcul_fluxs(tsurf, p1lay, cal, beta, tq_cdrag, ps, qsurf, radsol, &
176 guez 300 temp_air, spechum, u1_lay, v1_lay, tAcoef, qAcoef, tBcoef, qBcoef, &
177     tsurf_new, evap, fluxlat, flux_t, dflux_s, dflux_l, dif_grnd = 0.)
178 guez 54 agesno = 0.
179 guez 300 albedo = alboc_cd(mu0) * fmagic
180 guez 54 z0_new = sqrt(rugos**2 + rugoro**2)
181 guez 279 fqcalving = 0.
182 guez 104 case (is_sic)
183 guez 54 ! Surface "glace de mer" appel a l'interface avec l'ocean
184    
185 guez 99 DO ii = 1, knon
186 guez 300 IF (pctsrf_new_sic(ii) < EPSFRA) then
187 guez 175 snow(ii) = 0.
188 guez 99 tsurf_new(ii) = RTT - 1.8
189 guez 267 tsoil(ii, :) = RTT - 1.8
190 guez 221 else
191     tsurf_new(ii) = ts(ii)
192 guez 99 endif
193     enddo
194 guez 54
195 guez 299 CALL soil(is_sic, snow, tsurf_new, tsoil, soilcap, soilflux)
196 guez 267 cal = RCPD / soilcap
197 guez 222 tsurf = tsurf_new
198 guez 175 beta = 1.
199 guez 299 CALL calcul_fluxs(tsurf, p1lay, cal, beta, tq_cdrag, ps, qsurf, &
200 guez 300 radsol + soilflux, temp_air, spechum, u1_lay, v1_lay, tAcoef, &
201     qAcoef, tBcoef, qBcoef, tsurf_new, evap, fluxlat, flux_t, dflux_s, &
202     dflux_l, dif_grnd = 1. / tau_gl)
203     CALL fonte_neige(is_sic, precip_rain, precip_snow, snow, qsol, &
204     tsurf_new, evap, fqcalving, ffonte, run_off_lic_0)
205 guez 54
206 guez 174 ! Compute the albedo:
207 guez 54
208 guez 300 CALL albsno(agesno, alb_neig, precip_snow)
209 guez 215 WHERE (snow < 0.0001) agesno = 0.
210     zfra = MAX(0., MIN(1., snow / (snow + 10.)))
211 guez 175 albedo = alb_neig * zfra + 0.6 * (1. - zfra)
212 guez 54
213 guez 191 z0_new = SQRT(0.002**2 + rugoro**2)
214 guez 104 case (is_lic)
215 guez 54 ! Surface "glacier continentaux" appel a l'interface avec le sol
216    
217 guez 299 CALL soil(is_lic, snow, ts, tsoil, soilcap, soilflux)
218 guez 267 cal = RCPD / soilcap
219 guez 175 beta = 1.
220 guez 299 call calcul_fluxs(ts, p1lay, cal, beta, tq_cdrag, ps, qsurf, &
221 guez 300 radsol + soilflux, temp_air, spechum, u1_lay, v1_lay, tAcoef, &
222     qAcoef, tBcoef, qBcoef, tsurf_new, evap, fluxlat, flux_t, dflux_s, &
223     dflux_l, dif_grnd = 0.)
224     call fonte_neige(is_lic, precip_rain, precip_snow, snow, qsol, &
225     tsurf_new, evap, fqcalving, ffonte, run_off_lic_0)
226 guez 54
227     ! calcul albedo
228 guez 300 CALL albsno(agesno, alb_neig, precip_snow)
229 guez 215 WHERE (snow < 0.0001) agesno = 0.
230 guez 156 albedo = 0.77
231 guez 54
232     ! Rugosite
233     z0_new = rugoro
234 guez 104 case default
235 guez 101 print *, 'Index surface = ', nisurf
236 guez 175 call abort_gcm("interfsurf_hq", 'Index surface non valable')
237 guez 104 end select
238 guez 54
239     END SUBROUTINE interfsurf_hq
240    
241     end module interfsurf_hq_m

  ViewVC Help
Powered by ViewVC 1.1.21