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

  ViewVC Help
Powered by ViewVC 1.1.21