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

Last change on this file since 5411 was 5295, checked in by abarral, 7 weeks ago

lint
F90 -> f90
finish removing svn !Id: headers, which were inconsistent
  • 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: 28.3 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, tempsmoothlic
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                 :: time_tempsmooth, coef_tempsmooth
186    REAL, DIMENSION(klon) :: precip_totsnow, evap_totsnow
187    REAL, DIMENSION (klon, 6) :: alb6
188    REAL :: esalt
189    REAL :: lambdasalt, fluxsalt, csalt, nunu, aa, bb, cc
190    REAL :: tau_dens, maxerosion
191    REAL, DIMENSION(klon) :: ws1, rhod, rhos, ustart0, ustart, qsalt, hsalt
192    REAL, DIMENSION(klon) :: fluxbs_1, fluxbs_2, bsweight_fresh
193    LOGICAL, DIMENSION(klon) :: ok_remaining_freshsnow
194    REAL :: ta1, ta2, ta3, z01, z02, z03, coefa, coefb, coefc, coefd
195
196
197    ! End definition
198    !****************************************************************************************
199    !FC
200    !FC
201    REAL, SAVE :: alb_vis_sno_lic
202    !$OMP THREADPRIVATE(alb_vis_sno_lic)
203    REAL, SAVE :: alb_nir_sno_lic
204    !$OMP THREADPRIVATE(alb_nir_sno_lic)
205    LOGICAL, SAVE :: firstcall = .TRUE.
206    !$OMP THREADPRIVATE(firstcall)
207
208
209    !FC firtscall initializations
210    !******************************************************************************************
211#ifdef ISO
212#ifdef ISOVERIF
213!     WRITE(*,*) 'surf_land_ice 1499'
214  DO i=1,knon
215    IF (iso_eau > 0) THEN
216      CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
217                                'surf_land_ice 126',errmax,errmaxrel)
218    ENDIF !IF (iso_eau > 0) THEN     
219  ENDDO !DO i=1,knon 
220#endif
221#endif
222
223    IF (firstcall) THEN
224      alb_vis_sno_lic = 0.77
225      CALL getin_p('alb_vis_sno_lic', alb_vis_sno_lic)
226      PRINT*, 'alb_vis_sno_lic', alb_vis_sno_lic
227      alb_nir_sno_lic = 0.77
228      CALL getin_p('alb_nir_sno_lic', alb_nir_sno_lic)
229      PRINT*, 'alb_nir_sno_lic', alb_nir_sno_lic
230
231      DO j=1,knon
232       i = knindex(j)
233       tempsmoothlic(i) = temp_air(j)
234      END DO
235      firstcall = .FALSE.
236    ENDIF
237    !******************************************************************************************
238
239    ! Initialize output variables
240    alb3(:) = 999999.
241    alb2(:) = 999999.
242    alb1(:) = 999999.
243    fluxbs(:) = 0.
244    runoff(:) = 0.
245    !****************************************************************************************
246    ! Calculate total absorbed radiance at surface
247
248    !****************************************************************************************
249    radsol(:) = 0.0
250    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
251
252    !****************************************************************************************
253
254    !****************************************************************************************
255    !  landice_opt = 0 : soil_model, calcul_flux, fonte_neige, ...
256    !  landice_opt = 1  : prepare and CALL INterace Lmdz SISvat (INLANDSIS)
257    !****************************************************************************************
258
259    IF (landice_opt == 1) THEN
260
261      !****************************************************************************************
262      ! CALL to INLANDSIS interface
263      !****************************************************************************************
264      IF (CPPKEY_INLANDSIS) THEN
265
266#ifdef ISO
267        CALL abort_physic('surf_landice 235','isotopes pas dans INLANDSIS',1)
268#endif
269
270        debut_is = debut
271        lafin_is = .FALSE.
272        ! Suppose zero surface speed
273        u0(:) = 0.0
274        v0(:) = 0.0
275
276        CALL calcul_flux_wind(knon, dtime, &
277                u0, v0, u1, v1, gustiness, cdragm, &
278                AcoefU, AcoefV, BcoefU, BcoefV, &
279                p1lay, temp_air, &
280                flux_u1, flux_v1)
281
282
283        ! Set constants and compute some input for SISVAT
284        ! = 1000 hPa
285        ! and calculate incoming flux for SW and LW interval: swdown, lwdown
286        swdown(:) = 0.0
287        lwdown(:) = 0.0
288        snow_cont_air(:) = 0.  ! the snow content in air is not a prognostic variable of the model
289        alb_soil(:) = 0.4 ! before albedo(:) but here it is the ice albedo that we have to set
290        ustar(:) = 0.
291        pref = 100000.
292        DO i = 1, knon
293          swdown(i) = swnet(i) / (1 - albedo(i))
294          lwdown(i) = lwdownm(i)
295          wind_velo(i) = u1(i)**2 + v1(i)**2
296          wind_velo(i) = wind_velo(i)**0.5
297          pexner(i) = (p1lay(i) / pref)**(RD / RCPD)
298          dens_air(i) = p1lay(i) / RD / temp_air(i)  ! dry air density
299          zsl_height(i) = pphi1(i) / RG
300          tsoil0(i, :) = tsoil(i, :)
301          ustar(i) = (cdragm(i) * (wind_velo(i)**2))**0.5
302        END DO
303
304        dtis = dtime
305
306        IF (lafin) THEN
307          lafin_is = .TRUE.
308        END IF
309
310        CALL surf_inlandsis(knon, rlon, rlat, knindex, itime, dtis, debut_is, lafin_is, &
311                rmu0, swdown, lwdown, albedo, pexner, ps, p1lay, precip_rain, precip_snow, &
312                zsl_height, wind_velo, ustar, temp_air, dens_air, spechum, tsurf, &
313                rugoro, snow_cont_air, alb_soil, alt, slope, cloudf, &
314                radsol, qsol, tsoil0, snow, zfra, snowhgt, qsnow, to_ice, sissnow, agesno, &
315                AcoefH, AcoefQ, BcoefH, BcoefQ, cdragm, cdragh, &
316                run_off_lic, fqfonte, ffonte, evap, erod, fluxsens, fluxlat, dflux_s, dflux_l, &
317                tsurf_new, alb1, alb2, alb3, alb6, &
318                emis_new, z0m, z0h, qsurf)
319
320        debut_is = .FALSE.
321
322
323        ! Treatment of snow melting and calving
324
325        ! for consistency with standard LMDZ, add calving to run_off_lic
326        run_off_lic(:) = run_off_lic(:) + to_ice(:)
327
328        DO i = 1, knon
329          ffonte_global(knindex(i), is_lic) = ffonte(i)
330          fqfonte_global(knindex(i), is_lic) = fqfonte(i)! net melting= melting - refreezing
331          fqcalving_global(knindex(i), is_lic) = to_ice(i) ! flux
332          runofflic_global(knindex(i)) = run_off_lic(i)
333        ENDDO
334        ! Here, we assume that the calving term is equal to the to_ice term
335        ! (no ice accumulation)
336
337      ELSE
338        abort_message = 'Pb de coherence: landice_opt = 1  mais CPP_INLANDSIS = .FALSE.'
339        CALL abort_physic(modname, abort_message, 1)
340      END IF
341
342    ELSE
343
344      !****************************************************************************************
345      ! Soil calculations
346
347      !****************************************************************************************
348
349      ! EV: use calbeta
350      CALL calbeta(dtime, is_lic, knon, snow, qsol, beta, cal, dif_grnd)
351
352
353      ! use soil model and recalculate properly cal
354      IF (soil_model) THEN
355        CALL soil(dtime, is_lic, knon, snow, tsurf, qsol, &
356                longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux)
357        cal(1:knon) = RCPD / soilcap(1:knon)
358        radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
359      ELSE
360        cal = RCPD * calice
361        WHERE (snow > 0.0) cal = RCPD * calsno
362      ENDIF
363
364
365      !****************************************************************************************
366      ! Calulate fluxes
367
368      !****************************************************************************************
369      !    beta(:) = 1.0
370      !    dif_grnd(:) = 0.0
371
372      ! Suppose zero surface speed
373      u0(:) = 0.0
374      v0(:) = 0.0
375      u1_lay(:) = u1(:) - u0(:)
376      v1_lay(:) = v1(:) - v0(:)
377
378      CALL calcul_fluxs(knon, is_lic, dtime, &
379              tsurf, p1lay, cal, beta, cdragh, cdragh, ps, &
380              precip_rain, precip_snow, snow, qsurf, &
381              radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
382              1., AcoefH, AcoefQ, BcoefH, BcoefQ, &
383              tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
384
385#ifdef ISO
386#ifdef ISOVERIF
387     !WRITE(*,*) 'surf_land_ice 1499'
388     DO i=1,knon
389       IF (iso_eau > 0) THEN
390         IF (snow(i) > ridicule) THEN
391           CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
392                                     'surf_land_ice 1151',errmax,errmaxrel)
393         ENDIF !IF ((snow(i) > ridicule)) THEN
394       ENDIF !IF (iso_eau > 0) THEN
395     ENDDO !DO i=1,knon 
396#endif
397
398    DO i=1,knon
399      snow_prec(i)=snow(i)
400      DO ixt=1,niso
401        xtsnow_prec(ixt,i)=xtsnow(ixt,i)
402      ENDDO !DO ixt=1,niso
403      ! initialisation:
404      fq_fonte_diag(i)=0.0
405      fqfonte_diag(i)=0.0
406      snow_evap_diag(i)=0.0
407    ENDDO !DO i=1,knon
408#endif         
409
410      CALL calcul_flux_wind(knon, dtime, &
411              u0, v0, u1, v1, gustiness, cdragm, &
412              AcoefU, AcoefV, BcoefU, BcoefV, &
413              p1lay, temp_air, &
414              flux_u1, flux_v1)
415
416
417      !****************************************************************************************
418      ! Calculate albedo
419
420      !****************************************************************************************
421
422      !IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux"
423      !       alb1(1 : knon)  = 0.6 !IM cf FH/GK
424      !       alb1(1 : knon)  = 0.82
425      !       alb1(1 : knon)  = 0.77 !211003 Ksta0.77
426      !       alb1(1 : knon)  = 0.8 !KstaTER0.8 & LMD_ARMIP5
427      !IM: KstaTER0.77 & LMD_ARMIP6
428
429      ! Attantion: alb1 and alb2 are not the same!
430      alb1(1:knon) = alb_vis_sno_lic
431      alb2(1:knon) = alb_nir_sno_lic
432
433
434      !****************************************************************************************
435      ! Rugosity
436
437      !****************************************************************************************
438
439      IF (z0m_landice > 0.) THEN
440        z0m(1:knon) = z0m_landice
441        z0h(1:knon) = z0h_landice
442      ELSE
443        ! parameterization of z0=f(T) following measurements in Adelie Land by Amory et al 2018
444        coefa = 0.1658 !0.1862 !Ant
445        coefb = -50.3869 !-55.7718 !Ant
446        ta1 = 253.15 !255. Ant
447        ta2 = 273.15
448        ta3 = 273.15 + 3
449        z01 = exp(coefa * ta1 + coefb) !~0.2 ! ~0.25 mm
450        z02 = exp(coefa * ta2 + coefb) !~6  !~7 mm
451        z03 = z01
452        coefc = log(z03 / z02) / (ta3 - ta2)
453        coefd = log(z03) - coefc * ta3
454        time_tempsmooth = 2. * 86400.
455        coef_tempsmooth = min(1., dtime / time_tempsmooth)
456        !coef_tempsmooth=0.
457        DO j = 1, knon
458          i=knindex(j)
459
460          tempsmoothlic(i) = temp_air(j) * coef_tempsmooth + tempsmoothlic(i) * (1. - coef_tempsmooth)
461          IF (tempsmoothlic(i) < ta1) THEN
462            z0m(j) = z01
463          ELSE IF (tempsmoothlic(i) >= ta1 .and. tempsmoothlic(i) < ta2) THEN
464            z0m(j) = exp(coefa * tempsmoothlic(i) + coefb)
465          ELSE IF (tempsmoothlic(i) >= ta2 .and. tempsmoothlic(i) < ta3) THEN
466            ! if st > 0, melting induce smooth surface
467            z0m(j) = exp(coefc * tempsmoothlic(i) + coefd)
468          ELSE
469            z0m(j) = z03
470          END IF
471          z0h(j) = z0m(j)
472        END DO
473
474      END IF
475
476
477      !****************************************************************************************
478      ! Simple blowing snow param
479      !****************************************************************************************
480      ! we proceed in 2 steps:
481      ! first we erode - if possible -the accumulated snow during the time step
482      ! then we update the density of the underlying layer and see if we can also erode
483      ! this layer
484
485      IF (ok_bs) THEN
486        fluxbs(:) = 0.
487        DO j = 1, knon
488          ws1(j) = (u1(j)**2 + v1(j)**2)**0.5
489          ustar(j) = (cdragm(j) * (u1(j)**2 + v1(j)**2))**0.5
490          rhod(j) = p1lay(j) / RD / temp_air(j)
491          ustart0(j) = (log(2.868) - log(1.625)) / 0.085 * sqrt(cdragm(j))
492        enddo
493
494        ! 1st step: erosion of fresh snow accumulated during the time step
495        DO j = 1, knon
496          IF (precip_snow(j) > 0.) THEN
497            rhos(j) = rhofresh_bs
498            ! blowing snow flux formula used in MAR
499            ustart(j) = ustart0(j) * exp(max(rhoice_bs / rhofresh_bs - rhoice_bs / rhos(j), 0.)) * exp(max(0., rhos(j) - rhohard_bs))
500            ! we have multiplied by exp to prevent erosion when rhos>rhohard_bs
501            ! computation of qbs at the top of the saltation layer
502            ! default formulation from MAR model (Amory et al. 2021, Gallee et al. 2001)
503            esalt = 1. / (c_esalt_bs * max(1.e-6, ustar(j)))
504            hsalt(j) = 0.08436 * (max(1.e-6, ustar(j))**1.27)
505            qsalt(j) = (max(ustar(j)**2 - ustart(j)**2, 0.)) / (RG * hsalt(j)) * esalt
506            ! calculation of erosion (flux positive towards the surface here)
507            ! consistent with implicit resolution of turbulent mixing equation
508            ! Nemoto and Nishimura 2004 show that steady-state saltation is achieved within a time tau_eqsalt_bs of about 10s
509            ! we thus prevent snowerosion (snow particle transfer from the saltation layer to the first model level)
510            ! integrated over tau_eqsalt_bs to exceed the total mass of snow particle in the saltation layer
511            ! (rho*qsalt*hsalt)
512            ! during this first step we also lower bound the erosion to the amount of fresh snow accumulated during the time step
513            maxerosion = min(precip_snow(j), hsalt(j) * qsalt(j) * rhod(j) / tau_eqsalt_bs)
514
515            fluxbs_1(j) = rhod(j) * ws1(j) * cdragh(j) * zeta_bs * (AcoefQBS(j) - qsalt(j)) &
516                    / (1. - rhod(j) * ws1(j) * cdragh(j) * zeta_bs * BcoefQBS(j) * dtime)
517            fluxbs_1(j) = max(-maxerosion, fluxbs_1(j))
518
519            IF (precip_snow(j) > abs(fluxbs_1(j))) THEN
520              ok_remaining_freshsnow(j) = .TRUE.
521              bsweight_fresh(j) = 1.
522            else
523              ok_remaining_freshsnow(j) = .FALSE.
524              bsweight_fresh(j) = exp(-(abs(fluxbs_1(j)) - precip_snow(j)) / precip_snow(j))
525            endif
526          else
527            ok_remaining_freshsnow(j) = .FALSE.
528            fluxbs_1(j) = 0.
529            bsweight_fresh(j) = 0.
530          endif
531        enddo
532
533
534        ! we now compute the snow age of the overlying layer (snow surface after erosion of the fresh snow accumulated during the time step)
535        ! this is done through the routine albsno
536        CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:) + fluxbs_1(:))
537
538        ! 2nd step:
539        ! computation of threshold friction velocity
540        ! which depends on surface snow density
541        DO j = 1, knon
542          IF (ok_remaining_freshsnow(j)) THEN
543            fluxbs_2(j) = 0.
544          else
545            ! we start eroding the underlying layer
546            ! estimation of snow density
547            ! snow density increases with snow age and
548            ! increases even faster in case of sedimentation of blowing snow or rain
549            tau_dens = max(tau_densmin_bs, tau_dens0_bs * exp(-abs(precip_bs(j)) / pbst_bs - &
550                    abs(precip_rain(j)) / prt_bs) * exp(-max(tsurf(j) - RTT, 0.)))
551            rhos(j) = rhofresh_bs + (rhohard_bs - rhofresh_bs) * (1. - exp(-agesno(j) * 86400.0 / tau_dens))
552            ! blowing snow flux formula used in MAR
553            ustart(j) = ustart0(j) * exp(max(rhoice_bs / rhofresh_bs - rhoice_bs / rhos(j), 0.)) * exp(max(0., rhos(j) - rhohard_bs))
554            ! we have multiplied by exp to prevent erosion when rhos>rhohard_bs
555            ! computation of qbs at the top of the saltation layer
556            ! default formulation from MAR model (Amory et al. 2021, Gallee et al. 2001)
557            esalt = 1. / (c_esalt_bs * max(1.e-6, ustar(j)))
558            hsalt(j) = 0.08436 * (max(1.e-6, ustar(j))**1.27)
559            qsalt(j) = (max(ustar(j)**2 - ustart(j)**2, 0.)) / (RG * hsalt(j)) * esalt
560            ! calculation of erosion (flux positive towards the surface here)
561            ! consistent with implicit resolution of turbulent mixing equation
562            ! Nemoto and Nishimura 2004 show that steady-state saltation is achieved within a time tau_eqsalt_bs of about 10s
563            ! we thus prevent snowerosion (snow particle transfer from the saltation layer to the first model level)
564            ! integrated over tau_eqsalt_bs to exceed the total mass of snow particle in the saltation layer
565            ! (rho*qsalt*hsalt)
566            maxerosion = hsalt(j) * qsalt(j) * rhod(j) / tau_eqsalt_bs
567            fluxbs_2(j) = rhod(j) * ws1(j) * cdragh(j) * zeta_bs * (AcoefQBS(j) - qsalt(j)) &
568                    / (1. - rhod(j) * ws1(j) * cdragh(j) * zeta_bs * BcoefQBS(j) * dtime)
569            fluxbs_2(j) = max(-maxerosion, fluxbs_2(j))
570          endif
571        enddo
572
573
574
575
576        ! final flux and outputs
577        DO j = 1, knon
578          ! total flux is the erosion of fresh snow +
579          ! a fraction of the underlying snow (if all the fresh snow has been eroded)
580          ! the calculation of the fraction is quite delicate since we do not know
581          ! how much time was needed to erode the fresh snow. We assume that this time
582          ! is dt*exp(-(abs(fluxbs1)-precipsnow)/precipsnow)=dt*bsweight_fresh
583
584          fluxbs(j) = fluxbs_1(j) + fluxbs_2(j) * (1. - bsweight_fresh(j))
585          i = knindex(j)
586          zxustartlic(i) = ustart(j)
587          zxrhoslic(i) = rhos(j)
588          zxqsaltlic(i) = qsalt(j)
589        enddo
590
591      else ! not ok_bs
592        ! those lines are useful to calculate the snow age
593        CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:))
594
595      endif ! if ok_bs
596
597
598
599      !****************************************************************************************
600      ! Calculate snow amount
601
602      !****************************************************************************************
603      IF (ok_bs) THEN
604        precip_totsnow(:) = precip_snow(:) + precip_bs(:)
605        evap_totsnow(:) = evap(:) - fluxbs(:) ! flux bs is positive towards the surface (snow erosion)
606      ELSE
607        precip_totsnow(:) = precip_snow(:)
608        evap_totsnow(:) = evap(:)
609      ENDIF
610
611      CALL fonte_neige(knon, is_lic, knindex, dtime, &
612      tsurf, precip_rain, precip_totsnow, &
613      snow, qsol, tsurf_new, evap_totsnow &
614#ifdef ISO   
615    ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag     &
616    ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag &
617#endif
618      )
619
620
621#ifdef ISO
622#ifdef ISOVERIF
623    DO i=1,knon 
624      IF (iso_eau > 0) THEN 
625        CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
626                                 'surf_landice_mod 217',errmax,errmaxrel)
627      ENDIF !IF (iso_eau > 0) THEN
628    ENDDO !DO i=1,knon
629#endif
630
631    CALL calcul_iso_surf_lic_vectall(klon,knon, &
632      evap,snow_evap_diag,Tsurf_new,snow, &
633      fq_fonte_diag,fqfonte_diag,dtime,t_coup, &
634      precip_snow,xtprecip_snow,precip_rain,xtprecip_rain, snow_prec,xtsnow_prec, &
635      xtspechum,spechum,ps,Rland_ice, &
636      xtevap,xtsnow,fqcalving_diag, &
637      knindex,is_lic,run_off_lic_diag,coeff_rel_diag &
638     )
639
640!        CALL fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
641
642#endif
643
644      WHERE (snow(1:knon) < 0.0001) agesno(1:knon) = 0.
645      zfra(1:knon) = MAX(0.0, MIN(1.0, snow(1:knon) / (snow(1:knon) + 10.0)))
646
647    END IF ! landice_opt
648
649
650    !****************************************************************************************
651    ! Send run-off on land-ice to coupler if coupled ocean.
652    ! run_off_lic has been calculated in fonte_neige or surf_inlandsis
653    ! If landice_opt>=2, corresponding CALL is done from surf_land_orchidee
654    !****************************************************************************************
655    IF (type_ocean=='couple' .AND. landice_opt < 2) THEN
656      ! Compress fraction where run_off_lic is active (here all pctsrf(is_lic))
657      run_off_lic_frac(:) = 0.0
658      DO j = 1, knon
659        i = knindex(j)
660        run_off_lic_frac(j) = pctsrf(i, is_lic)
661      ENDDO
662
663      CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic, run_off_lic_frac)
664    ENDIF
665
666    ! transfer runoff rate [kg/m2/s](!) to physiq for output
667    runoff(1:knon) = run_off_lic(1:knon) / dtime
668
669    snow_o = 0.
670    zfra_o = 0.
671    DO j = 1, knon
672      i = knindex(j)
673      snow_o(i) = snow(j)
674      zfra_o(i) = zfra(j)
675    ENDDO
676
677
678    !albedo SB >>>
679    select case(NSW)
680    case(2)
681      alb_dir(1:knon, 1) = alb1(1:knon)
682      alb_dir(1:knon, 2) = alb2(1:knon)
683    case(4)
684      alb_dir(1:knon, 1) = alb1(1:knon)
685      alb_dir(1:knon, 2) = alb2(1:knon)
686      alb_dir(1:knon, 3) = alb2(1:knon)
687      alb_dir(1:knon, 4) = alb2(1:knon)
688    case(6)
689      alb_dir(1:knon, 1) = alb1(1:knon)
690      alb_dir(1:knon, 2) = alb1(1:knon)
691      alb_dir(1:knon, 3) = alb1(1:knon)
692      alb_dir(1:knon, 4) = alb2(1:knon)
693      alb_dir(1:knon, 5) = alb2(1:knon)
694      alb_dir(1:knon, 6) = alb2(1:knon)
695
696      IF ((landice_opt == 1) .AND. (iflag_albcalc == 2)) THEN
697        alb_dir(1:knon, 1) = alb6(1:knon, 1)
698        alb_dir(1:knon, 2) = alb6(1:knon, 2)
699        alb_dir(1:knon, 3) = alb6(1:knon, 3)
700        alb_dir(1:knon, 4) = alb6(1:knon, 4)
701        alb_dir(1:knon, 5) = alb6(1:knon, 5)
702        alb_dir(1:knon, 6) = alb6(1:knon, 6)
703      ENDIF
704
705    end select
706    alb_dif = alb_dir
707    !albedo SB <<<
708
709  END SUBROUTINE surf_landice
710
711  !****************************************************************************************
712
713END MODULE surf_landice_mod
714
715
716
Note: See TracBrowser for help on using the repository browser.