source: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_landice_mod.F90 @ 5151

Last change on this file since 5151 was 5144, checked in by abarral, 3 months ago

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