Context Navigation

surf_landice_mod.F90 @ 5162

Last change on this file since 5162 was 4916, checked in by evignon, 7 months ago
correction formulation de l'erosion de la neige soufflee suite aux investigations de Nicolas Chiabrando, prise en compte d'un temps d'erosion de la neige fraiche nouvellement accumulee
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 23.4 KB

Line
1	!
2	MODULE surf_landice_mod
3
4	IMPLICIT NONE
5
6	CONTAINS
7	!
8	!****************************************************************************************
9	!
10	SUBROUTINE surf_landice(itime, dtime, knon, knindex, &
11	rlon, rlat, debut, lafin, &
12	rmu0, lwdownm, albedo, pphi1, &
13	swnet, lwnet, tsurf, p1lay, &
14	cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, &
15	AcoefH, AcoefQ, BcoefH, BcoefQ, &
16	AcoefU, AcoefV, BcoefU, BcoefV, &
17	AcoefQBS, BcoefQBS, &
18	ps, u1, v1, gustiness, rugoro, pctsrf, &
19	snow, qsurf, qsol, qbs1, agesno, &
20	tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, fluxbs, &
21	tsurf_new, dflux_s, dflux_l, &
22	alt, slope, cloudf, &
23	snowhgt, qsnow, to_ice, sissnow, &
24	alb3, runoff, &
25	flux_u1, flux_v1)
26
27	USE dimphy
28	USE geometry_mod, ONLY : longitude,latitude
29	USE surface_data, ONLY : type_ocean, calice, calsno, landice_opt, iflag_albcalc
30	USE fonte_neige_mod, ONLY : fonte_neige,run_off_lic,fqcalving_global,ffonte_global,fqfonte_global,runofflic_global
31	USE cpl_mod, ONLY : cpl_send_landice_fields
32	USE calcul_fluxs_mod
33	USE phys_local_var_mod, ONLY : zxrhoslic, zxustartlic, zxqsaltlic
34	USE phys_output_var_mod, ONLY : snow_o,zfra_o
35	!FC
36	USE ioipsl_getin_p_mod, ONLY : getin_p
37	USE lmdz_blowing_snow_ini, ONLY : c_esalt_bs, zeta_bs, pbst_bs, prt_bs, rhoice_bs, rhohard_bs
38	USE lmdz_blowing_snow_ini, ONLY : rhofresh_bs, tau_eqsalt_bs, tau_dens0_bs, tau_densmin_bs
39	#ifdef CPP_INLANDSIS
40	USE surf_inlandsis_mod, ONLY : surf_inlandsis
41	#endif
42
43	USE indice_sol_mod
44
45	! INCLUDE "indicesol.h"
46	INCLUDE "dimsoil.h"
47	INCLUDE "YOMCST.h"
48	INCLUDE "clesphys.h"
49
50	! Input variables
51	!****************************************************************************************
52	INTEGER, INTENT(IN) :: itime, knon
53	INTEGER, DIMENSION(klon), INTENT(in) :: knindex
54	REAL, INTENT(in) :: dtime
55	REAL, DIMENSION(klon), INTENT(IN) :: swnet ! net shortwave radiance
56	REAL, DIMENSION(klon), INTENT(IN) :: lwnet ! net longwave radiance
57	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
58	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
59	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
60	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow, precip_bs
61	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
62	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ
63	REAL, DIMENSION(klon), INTENT(IN) :: BcoefH, BcoefQ
64	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
65	REAL, DIMENSION(klon), INTENT(IN) :: AcoefQBS, BcoefQBS
66	REAL, DIMENSION(klon), INTENT(IN) :: ps
67	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness, qbs1
68	REAL, DIMENSION(klon), INTENT(IN) :: rugoro
69	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
70
71	LOGICAL, INTENT(IN) :: debut !true if first step
72	LOGICAL, INTENT(IN) :: lafin !true if last step
73	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
74	REAL, DIMENSION(klon), INTENT(IN) :: rmu0
75	REAL, DIMENSION(klon), INTENT(IN) :: lwdownm !ylwdown
76	REAL, DIMENSION(klon), INTENT(IN) :: albedo !mean albedo
77	REAL, DIMENSION(klon), INTENT(IN) :: pphi1
78	REAL, DIMENSION(klon), INTENT(IN) :: alt !mean altitude of the grid box
79	REAL, DIMENSION(klon), INTENT(IN) :: slope !mean slope in grid box
80	REAL, DIMENSION(klon), INTENT(IN) :: cloudf !total cloud fraction
81
82	! In/Output variables
83	!****************************************************************************************
84	REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol
85	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
86	REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
87
88	! Output variables
89	!****************************************************************************************
90	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
91	REAL, DIMENSION(klon), INTENT(OUT) :: z0m, z0h
92	!albedo SB >>>
93	! REAL, DIMENSION(klon), INTENT(OUT) :: alb1 ! new albedo in visible SW interval
94	! REAL, DIMENSION(klon), INTENT(OUT) :: alb2 ! new albedo in near IR interval
95	REAL, DIMENSION(6), INTENT(IN) :: SFRWL
96	REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir,alb_dif
97	!albedo SB <<<
98	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
99	REAL, DIMENSION(klon), INTENT(OUT) :: fluxbs
100	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
101	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
102	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
103
104	REAL, DIMENSION(klon), INTENT(OUT) :: alb3
105	REAL, DIMENSION(klon), INTENT(OUT) :: qsnow !column water in snow [kg/m2]
106	REAL, DIMENSION(klon), INTENT(OUT) :: snowhgt !Snow height (m)
107	REAL, DIMENSION(klon), INTENT(OUT) :: to_ice
108	REAL, DIMENSION(klon), INTENT(OUT) :: sissnow
109	REAL, DIMENSION(klon), INTENT(OUT) :: runoff !Land ice runoff
110
111
112	! Local variables
113	!****************************************************************************************
114	REAL, DIMENSION(klon) :: soilcap, soilflux
115	REAL, DIMENSION(klon) :: cal, beta, dif_grnd
116	REAL, DIMENSION(klon) :: zfra, alb_neig
117	REAL, DIMENSION(klon) :: radsol
118	REAL, DIMENSION(klon) :: u0, v0, u1_lay, v1_lay, ustar
119	INTEGER :: i,j,nt
120	REAL, DIMENSION(klon) :: fqfonte,ffonte
121	REAL, DIMENSION(klon) :: run_off_lic_frac
122	REAL, DIMENSION(klon) :: emis_new !Emissivity
123	REAL, DIMENSION(klon) :: swdown,lwdown
124	REAL, DIMENSION(klon) :: precip_snow_adv, snow_adv !Snow Drift precip./advection (not used in inlandsis)
125	REAL, DIMENSION(klon) :: erod !erosion of surface snow (flux, kg/m2/s like evap)
126	REAL, DIMENSION(klon) :: zsl_height, wind_velo !surface layer height, wind spd
127	REAL, DIMENSION(klon) :: dens_air, snow_cont_air !air density; snow content air
128	REAL, DIMENSION(klon) :: alb_soil !albedo of underlying ice
129	REAL, DIMENSION(klon) :: pexner !Exner potential
130	REAL :: pref
131	REAL, DIMENSION(klon,nsoilmx) :: tsoil0 !modif
132	REAL :: dtis ! subtimestep
133	LOGICAL :: debut_is, lafin_is ! debut and lafin for inlandsis
134
135	CHARACTER (len = 20) :: modname = 'surf_landice'
136	CHARACTER (len = 80) :: abort_message
137
138
139	REAL,DIMENSION(klon) :: alb1,alb2
140	REAL,DIMENSION(klon) :: precip_totsnow, evap_totsnow
141	REAL, DIMENSION (klon,6) :: alb6
142	REAL :: esalt
143	REAL :: lambdasalt,fluxsalt, csalt, nunu, aa, bb, cc
144	REAL :: tau_dens, maxerosion
145	REAL, DIMENSION(klon) :: ws1, rhod, rhos, ustart0, ustart, qsalt, hsalt
146	REAL, DIMENSION(klon) :: fluxbs_1, fluxbs_2, bsweight_fresh
147	LOGICAL, DIMENSION(klon) :: ok_remaining_freshsnow
148
149	! End definition
150	!****************************************************************************************
151	!FC
152	!FC
153	REAL,SAVE :: alb_vis_sno_lic
154	!$OMP THREADPRIVATE(alb_vis_sno_lic)
155	REAL,SAVE :: alb_nir_sno_lic
156	!$OMP THREADPRIVATE(alb_nir_sno_lic)
157	LOGICAL, SAVE :: firstcall = .TRUE.
158	!$OMP THREADPRIVATE(firstcall)
159
160
161	!FC firtscall initializations
162	!******************************************************************************************
163	IF (firstcall) THEN
164	alb_vis_sno_lic=0.77
165	CALL getin_p('alb_vis_sno_lic',alb_vis_sno_lic)
166	PRINT*, 'alb_vis_sno_lic',alb_vis_sno_lic
167	alb_nir_sno_lic=0.77
168	CALL getin_p('alb_nir_sno_lic',alb_nir_sno_lic)
169	PRINT*, 'alb_nir_sno_lic',alb_nir_sno_lic
170
171	firstcall=.false.
172	ENDIF
173	!******************************************************************************************
174
175	! Initialize output variables
176	alb3(:) = 999999.
177	alb2(:) = 999999.
178	alb1(:) = 999999.
179	fluxbs(:)=0.
180	runoff(:) = 0.
181	!****************************************************************************************
182	! Calculate total absorbed radiance at surface
183	!
184	!****************************************************************************************
185	radsol(:) = 0.0
186	radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
187
188	!****************************************************************************************
189
190	!****************************************************************************************
191	! landice_opt = 0 : soil_model, calcul_flux, fonte_neige, ...
192	! landice_opt = 1 : prepare and call INterace Lmdz SISvat (INLANDSIS)
193	!****************************************************************************************
194
195
196	IF (landice_opt .EQ. 1) THEN
197
198	!****************************************************************************************
199	! CALL to INLANDSIS interface
200	!****************************************************************************************
201	#ifdef CPP_INLANDSIS
202
203	debut_is=debut
204	lafin_is=.false.
205	! Suppose zero surface speed
206	u0(:) = 0.0
207	v0(:) = 0.0
208
209
210	CALL calcul_flux_wind(knon, dtime, &
211	u0, v0, u1, v1, gustiness, cdragm, &
212	AcoefU, AcoefV, BcoefU, BcoefV, &
213	p1lay, temp_air, &
214	flux_u1, flux_v1)
215
216
217	! Set constants and compute some input for SISVAT
218	! = 1000 hPa
219	! and calculate incoming flux for SW and LW interval: swdown, lwdown
220	swdown(:) = 0.0
221	lwdown(:) = 0.0
222	snow_cont_air(:) = 0. ! the snow content in air is not a prognostic variable of the model
223	alb_soil(:) = 0.4 ! before albedo(:) but here it is the ice albedo that we have to set
224	ustar(:) = 0.
225	pref = 100000.
226	DO i = 1, knon
227	swdown(i) = swnet(i)/(1-albedo(i))
228	lwdown(i) = lwdownm(i)
229	wind_velo(i) = u1(i)2 + v1(i)2
230	wind_velo(i) = wind_velo(i)**0.5
231	pexner(i) = (p1lay(i)/pref)**(RD/RCPD)
232	dens_air(i) = p1lay(i)/RD/temp_air(i) ! dry air density
233	zsl_height(i) = pphi1(i)/RG
234	tsoil0(i,:) = tsoil(i,:)
235	ustar(i)= (cdragm(i)(wind_velo(i)2))*0.5
236	END DO
237
238
239
240	dtis=dtime
241
242	IF (lafin) THEN
243	lafin_is=.true.
244	END IF
245
246	CALL surf_inlandsis(knon, rlon, rlat, knindex, itime, dtis, debut_is, lafin_is,&
247	rmu0, swdown, lwdown, albedo, pexner, ps, p1lay, precip_rain, precip_snow, &
248	zsl_height, wind_velo, ustar, temp_air, dens_air, spechum, tsurf,&
249	rugoro, snow_cont_air, alb_soil, alt, slope, cloudf, &
250	radsol, qsol, tsoil0, snow, zfra, snowhgt, qsnow, to_ice, sissnow,agesno, &
251	AcoefH, AcoefQ, BcoefH, BcoefQ, cdragm, cdragh, &
252	run_off_lic, fqfonte, ffonte, evap, erod, fluxsens, fluxlat,dflux_s, dflux_l, &
253	tsurf_new, alb1, alb2, alb3, alb6, &
254	emis_new, z0m, z0h, qsurf)
255
256	debut_is=.false.
257
258
259	! Treatment of snow melting and calving
260
261	! for consistency with standard LMDZ, add calving to run_off_lic
262	run_off_lic(:)=run_off_lic(:) + to_ice(:)
263
264	DO i = 1, knon
265	ffonte_global(knindex(i),is_lic) = ffonte(i)
266	fqfonte_global(knindex(i),is_lic) = fqfonte(i)! net melting= melting - refreezing
267	fqcalving_global(knindex(i),is_lic) = to_ice(i) ! flux
268	runofflic_global(knindex(i)) = run_off_lic(i)
269	ENDDO
270	! Here, we assume that the calving term is equal to the to_ice term
271	! (no ice accumulation)
272
273
274	#else
275	abort_message='Pb de coherence: landice_opt = 1 mais CPP_INLANDSIS = .false.'
276	CALL abort_physic(modname,abort_message,1)
277	#endif
278
279
280	ELSE
281
282	!****************************************************************************************
283	! Soil calculations
284	!
285	!****************************************************************************************
286
287	! EV: use calbeta
288	CALL calbeta(dtime, is_lic, knon, snow, qsol, beta, cal, dif_grnd)
289
290
291	! use soil model and recalculate properly cal
292	IF (soil_model) THEN
293	CALL soil(dtime, is_lic, knon, snow, tsurf, qsol, &
294	& longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux)
295	cal(1:knon) = RCPD / soilcap(1:knon)
296	radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
297	ELSE
298	cal = RCPD * calice
299	WHERE (snow > 0.0) cal = RCPD * calsno
300	ENDIF
301
302
303	!****************************************************************************************
304	! Calulate fluxes
305	!
306	!****************************************************************************************
307	! beta(:) = 1.0
308	! dif_grnd(:) = 0.0
309
310	! Suppose zero surface speed
311	u0(:)=0.0
312	v0(:)=0.0
313	u1_lay(:) = u1(:) - u0(:)
314	v1_lay(:) = v1(:) - v0(:)
315
316	CALL calcul_fluxs(knon, is_lic, dtime, &
317	tsurf, p1lay, cal, beta, cdragh, cdragh, ps, &
318	precip_rain, precip_snow, snow, qsurf, &
319	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
320	1.,AcoefH, AcoefQ, BcoefH, BcoefQ, &
321	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
322
323	CALL calcul_flux_wind(knon, dtime, &
324	u0, v0, u1, v1, gustiness, cdragm, &
325	AcoefU, AcoefV, BcoefU, BcoefV, &
326	p1lay, temp_air, &
327	flux_u1, flux_v1)
328
329
330	!****************************************************************************************
331	! Calculate albedo
332	!
333	!****************************************************************************************
334
335	!
336	!IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux"
337	! alb1(1 : knon) = 0.6 !IM cf FH/GK
338	! alb1(1 : knon) = 0.82
339	! alb1(1 : knon) = 0.77 !211003 Ksta0.77
340	! alb1(1 : knon) = 0.8 !KstaTER0.8 & LMD_ARMIP5
341	!IM: KstaTER0.77 & LMD_ARMIP6
342
343	! Attantion: alb1 and alb2 are not the same!
344	alb1(1:knon) = alb_vis_sno_lic
345	alb2(1:knon) = alb_nir_sno_lic
346
347
348	!****************************************************************************************
349	! Rugosity
350	!
351	!****************************************************************************************
352	z0m = z0m_landice
353	z0h = z0h_landice
354	!z0m = SQRT(z0m2+rugoro2)
355
356
357	!****************************************************************************************
358	! Simple blowing snow param
359	!****************************************************************************************
360	! we proceed in 2 steps:
361	! first we erode - if possible -the accumulated snow during the time step
362	! then we update the density of the underlying layer and see if we can also erode
363	! this layer
364
365
366	if (ok_bs) then
367	fluxbs(:)=0.
368	do j=1,klon
369	ws1(j)=(u1(j)2+v1(j)2)**0.5
370	ustar(j)=(cdragm(j)(u1(j)2+v1(j)2))*0.5
371	rhod(j)=p1lay(j)/RD/temp_air(j)
372	ustart0(j) =(log(2.868)-log(1.625))/0.085*sqrt(cdragm(j))
373	enddo
374
375	! 1st step: erosion of fresh snow accumulated during the time step
376	do j=1, knon
377	if (precip_snow(j) .GT. 0.) then
378	rhos(j)=rhofresh_bs
379	! blowing snow flux formula used in MAR
380	ustart(j)=ustart0(j)exp(max(rhoice_bs/rhofresh_bs-rhoice_bs/rhos(j),0.))exp(max(0.,rhos(j)-rhohard_bs))
381	! we have multiplied by exp to prevent erosion when rhos>rhohard_bs
382	! computation of qbs at the top of the saltation layer
383	! default formulation from MAR model (Amory et al. 2021, Gallee et al. 2001)
384	esalt=1./(c_esalt_bs*max(1.e-6,ustar(j)))
385	hsalt(j)=0.08436(max(1.e-6,ustar(j))*1.27)
386	qsalt(j)=(max(ustar(j)2-ustart(j)2,0.))/(RGhsalt(j))esalt
387	! calculation of erosion (flux positive towards the surface here)
388	! consistent with implicit resolution of turbulent mixing equation
389	! Nemoto and Nishimura 2004 show that steady-state saltation is achieved within a time tau_eqsalt_bs of about 10s
390	! we thus prevent snowerosion (snow particle transfer from the saltation layer to the first model level)
391	! integrated over tau_eqsalt_bs to exceed the total mass of snow particle in the saltation layer
392	! (rhoqsalthsalt)
393	! during this first step we also lower bound the erosion to the amount of fresh snow accumulated during the time step
394	maxerosion=min(precip_snow(j),hsalt(j)qsalt(j)rhod(j)/tau_eqsalt_bs)
395
396	fluxbs_1(j)=rhod(j)ws1(j)cdragh(j)zeta_bs(AcoefQBS(j)-qsalt(j)) &
397	/ (1.-rhod(j)ws1(j)cdragh(j)zeta_bsBcoefQBS(j)*dtime)
398	fluxbs_1(j)=max(-maxerosion,fluxbs_1(j))
399
400	if (precip_snow(j) .gt. abs(fluxbs_1(j))) then
401	ok_remaining_freshsnow(j)=.true.
402	bsweight_fresh(j)=1.
403	else
404	ok_remaining_freshsnow(j)=.false.
405	bsweight_fresh(j)=exp(-(abs(fluxbs_1(j))-precip_snow(j))/precip_snow(j))
406	endif
407	else
408	ok_remaining_freshsnow(j)=.false.
409	fluxbs_1(j)=0.
410	bsweight_fresh(j)=0.
411	endif
412	enddo
413
414
415	! we now compute the snow age of the overlying layer (snow surface after erosion of the fresh snow accumulated during the time step)
416	! this is done through the routine albsno
417	CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)+fluxbs_1(:))
418
419	! 2nd step:
420	! computation of threshold friction velocity
421	! which depends on surface snow density
422	do j = 1, knon
423	if (ok_remaining_freshsnow(j)) then
424	fluxbs_2(j)=0.
425	else
426	! we start eroding the underlying layer
427	! estimation of snow density
428	! snow density increases with snow age and
429	! increases even faster in case of sedimentation of blowing snow or rain
430	tau_dens=max(tau_densmin_bs, tau_dens0_bs*exp(-abs(precip_bs(j))/pbst_bs - &
431	abs(precip_rain(j))/prt_bs)*exp(-max(tsurf(j)-RTT,0.)))
432	rhos(j)=rhofresh_bs+(rhohard_bs-rhofresh_bs)(1.-exp(-agesno(j)86400.0/tau_dens))
433	! blowing snow flux formula used in MAR
434	ustart(j)=ustart0(j)exp(max(rhoice_bs/rhofresh_bs-rhoice_bs/rhos(j),0.))exp(max(0.,rhos(j)-rhohard_bs))
435	! we have multiplied by exp to prevent erosion when rhos>rhohard_bs
436	! computation of qbs at the top of the saltation layer
437	! default formulation from MAR model (Amory et al. 2021, Gallee et al. 2001)
438	esalt=1./(c_esalt_bs*max(1.e-6,ustar(j)))
439	hsalt(j)=0.08436(max(1.e-6,ustar(j))*1.27)
440	qsalt(j)=(max(ustar(j)2-ustart(j)2,0.))/(RGhsalt(j))esalt
441	! calculation of erosion (flux positive towards the surface here)
442	! consistent with implicit resolution of turbulent mixing equation
443	! Nemoto and Nishimura 2004 show that steady-state saltation is achieved within a time tau_eqsalt_bs of about 10s
444	! we thus prevent snowerosion (snow particle transfer from the saltation layer to the first model level)
445	! integrated over tau_eqsalt_bs to exceed the total mass of snow particle in the saltation layer
446	! (rhoqsalthsalt)
447	maxerosion=hsalt(j)qsalt(j)rhod(j)/tau_eqsalt_bs
448	fluxbs_2(j)=rhod(j)ws1(j)cdragh(j)zeta_bs(AcoefQBS(j)-qsalt(j)) &
449	/ (1.-rhod(j)ws1(j)cdragh(j)zeta_bsBcoefQBS(j)*dtime)
450	fluxbs_2(j)=max(-maxerosion,fluxbs_2(j))
451	endif
452	enddo
453
454
455
456
457	! final flux and outputs
458	do j=1, knon
459	! total flux is the erosion of fresh snow +
460	! a fraction of the underlying snow (if all the fresh snow has been eroded)
461	! the calculation of the fraction is quite delicate since we do not know
462	! how much time was needed to erode the fresh snow. We assume that this time
463	! is dtexp(-(abs(fluxbs1)-precipsnow)/precipsnow)=dtbsweight_fresh
464
465	fluxbs(j)=fluxbs_1(j)+fluxbs_2(j)*(1.-bsweight_fresh(j))
466	i = knindex(j)
467	zxustartlic(i) = ustart(j)
468	zxrhoslic(i) = rhos(j)
469	zxqsaltlic(i)=qsalt(j)
470	enddo
471
472
473	else ! not ok_bs
474	! those lines are useful to calculate the snow age
475	CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))
476
477	endif ! if ok_bs
478
479
480
481	!****************************************************************************************
482	! Calculate snow amount
483	!
484	!****************************************************************************************
485	IF (ok_bs) THEN
486	precip_totsnow(:)=precip_snow(:)+precip_bs(:)
487	evap_totsnow(:)=evap(:)-fluxbs(:) ! flux bs is positive towards the surface (snow erosion)
488	ELSE
489	precip_totsnow(:)=precip_snow(:)
490	evap_totsnow(:)=evap(:)
491	ENDIF
492
493
494	CALL fonte_neige(knon, is_lic, knindex, dtime, &
495	tsurf, precip_rain, precip_totsnow, &
496	snow, qsol, tsurf_new, evap_totsnow)
497
498
499	WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
500	zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0)))
501
502
503	END IF ! landice_opt
504
505
506	!****************************************************************************************
507	! Send run-off on land-ice to coupler if coupled ocean.
508	! run_off_lic has been calculated in fonte_neige or surf_inlandsis
509	! If landice_opt>=2, corresponding call is done from surf_land_orchidee
510	!****************************************************************************************
511	IF (type_ocean=='couple' .AND. landice_opt .LT. 2) THEN
512	! Compress fraction where run_off_lic is active (here all pctsrf(is_lic))
513	run_off_lic_frac(:)=0.0
514	DO j = 1, knon
515	i = knindex(j)
516	run_off_lic_frac(j) = pctsrf(i,is_lic)
517	ENDDO
518
519	CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic, run_off_lic_frac)
520	ENDIF
521
522	! transfer runoff rate [kg/m2/s](!) to physiq for output
523	runoff(1:knon)=run_off_lic(1:knon)/dtime
524
525	snow_o=0.
526	zfra_o = 0.
527	DO j = 1, knon
528	i = knindex(j)
529	snow_o(i) = snow(j)
530	zfra_o(i) = zfra(j)
531	ENDDO
532
533
534	!albedo SB >>>
535	select case(NSW)
536	case(2)
537	alb_dir(1:knon,1)=alb1(1:knon)
538	alb_dir(1:knon,2)=alb2(1:knon)
539	case(4)
540	alb_dir(1:knon,1)=alb1(1:knon)
541	alb_dir(1:knon,2)=alb2(1:knon)
542	alb_dir(1:knon,3)=alb2(1:knon)
543	alb_dir(1:knon,4)=alb2(1:knon)
544	case(6)
545	alb_dir(1:knon,1)=alb1(1:knon)
546	alb_dir(1:knon,2)=alb1(1:knon)
547	alb_dir(1:knon,3)=alb1(1:knon)
548	alb_dir(1:knon,4)=alb2(1:knon)
549	alb_dir(1:knon,5)=alb2(1:knon)
550	alb_dir(1:knon,6)=alb2(1:knon)
551
552	IF ((landice_opt .EQ. 1) .AND. (iflag_albcalc .EQ. 2)) THEN
553	alb_dir(1:knon,1)=alb6(1:knon,1)
554	alb_dir(1:knon,2)=alb6(1:knon,2)
555	alb_dir(1:knon,3)=alb6(1:knon,3)
556	alb_dir(1:knon,4)=alb6(1:knon,4)
557	alb_dir(1:knon,5)=alb6(1:knon,5)
558	alb_dir(1:knon,6)=alb6(1:knon,6)
559	ENDIF
560
561	end select
562	alb_dif=alb_dir
563	!albedo SB <<<
564
565
566	END SUBROUTINE surf_landice
567	!
568	!****************************************************************************************
569	!
570	END MODULE surf_landice_mod
571
572
573

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format