Ignore:
Timestamp:
Jul 18, 2001, 1:28:31 PM (23 years ago)
Author:
lmdzadmin
Message:

Phasage avec la version de PB pour le sol, dlw (juillet 2001)
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90

    r236 r258  
    192192  real, dimension(klon):: alb_ice
    193193  real, dimension(klon):: tsurf_temp
    194   real, allocatable, dimension(:), save :: alb_neig_grid
     194!!  real, allocatable, dimension(:), save :: alb_neig_grid
    195195  real, dimension(klon):: alb_neig, alb_eau
    196196  real, DIMENSION(klon):: zfra
    … …  
    294294!
    295295!!$ PB ATTENTION changement ordre des appels
    296     CALL albsno(klon,agesno,alb_neig_grid) 
     296!!$    CALL albsno(klon,agesno,alb_neig_grid) 
    297297
    298298    if (.not. ok_veget) then
    … …  
    337337     &   tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    338338
    339        DO ii = 1, knon
    340          index = knindex(ii)
    341          alb_neig(ii) = alb_neig_grid(index)
    342          agesno(index)  = (agesno(index) + (1.-agesno(index)/50.)*dtime/86400.)&
    343             &             * EXP(-1.*MAX(0.0,precip_snow(ii))*dtime/0.3)
    344          agesno(index) = MAX(agesno(index),0.0)
    345          IF(snow(ii) .LT. 0.0001) agesno(index) = 0.
    346        ENDDO
    347        zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
    348        alb_new = alb_neig*zfra + alb_new*(1.0-zfra)
    349        z0_new = SQRT(z0_new**2+rugoro**2)
     339!!$       DO ii = 1, knon
     340!!$         index = knindex(ii)
     341!!$         alb_neig(ii) = alb_neig_grid(index)
     342!!$         agesno(index)  = (agesno(index) + (1.-agesno(index)/50.)*dtime/86400.)&
     343!!$            &             * EXP(-1.*MAX(0.0,precip_snow(ii))*dtime/0.3)
     344!!$         agesno(index) = MAX(agesno(index),0.0)
     345!!$         IF(snow(ii) .LT. 0.0001) agesno(index) = 0.
     346!!$       ENDDO
     347
     348     call albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 
     349     where (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
     350     zfra = max(0.0,min(1.0,snow/(snow+10.0)))
     351     alb_new(1 : knon)  = alb_neig(1 : knon) *zfra + alb_new(1 : knon)*(1.0-zfra)
     352     z0_new = sqrt(z0_new**2+rugoro**2)
    350353
    351354    else
    352       CALL albsno(klon,agesno,alb_neig_grid) 
     355!!      CALL albsno(klon,agesno,alb_neig_grid) 
    353356!
    354357!  appel a sechiba
    … …  
    413416    beta = 1.
    414417    dif_grnd = 0.
     418    alb_neig(:) = 0.
     419    agesno(:) = 0.
    415420
    416421    call calcul_fluxs( klon, knon, nisurf, dtime, &
    … …  
    552557!
    553558!
    554       zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
    555       DO ii = 1, knon
    556         index = knindex(ii)
    557         alb_neig(ii) = alb_neig_grid(index)
    558       ENDDO
    559       alb_new = alb_neig*zfra + 0.6 * (1.0-zfra)
    560       
    561       z0_new = 0.001
     559     CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 
     560     WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
     561     zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
     562!!$     alb_new(1 : knon) = alb_neig(1 : knon) *zfra + 0.6 * (1.0-zfra)
     563     alb_new(1 : knon) = 0.6
     564     
     565     z0_new = 0.001
     566     z0_new = SQRT(z0_new**2+rugoro**2)
    562567
    563568  else if (nisurf == is_lic) then
    … …  
    601606! calcul albedo
    602607!
    603     zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
    604     DO ii = 1, knon
    605       index = knindex(ii)
    606       alb_neig(ii) = alb_neig_grid(index)
    607       agesno(index)  = (agesno(index) + (1.-agesno(index)/50.)*dtime/86400.)&
    608          &             * EXP(-1.*MAX(0.0,precip_snow(ii))*dtime/0.3)
    609       agesno(index) = MAX(agesno(index),0.0)
    610         IF(snow(ii) .LT. 0.0001) agesno(index) = 0.
    611     ENDDO
    612     alb_new = alb_neig*zfra + 0.6 * (1.0-zfra)
     608     CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 
     609     WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
     610     zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
     611!!$     alb_new(1 : knon)  = alb_neig(1 : knon)*zfra + 0.6 * (1.0-zfra)
     612     alb_new(1 : knon)  = 0.6
    613613!
    614614! Rugosite
    … …  
    19971997#include "YOETHF.inc"
    19981998#include "FCTTRE.inc"
     1999#include "indicesol.inc"
    19992000
    20002001! Parametres d'entree
    … …  
    20462047! Traitement neige et humidite du sol
    20472048!
    2048     if (nisurf == is_oce) then
    2049       snow = 0.
    2050       qsol = max_eau_sol
    2051     else
    2052       snow = snow + (precip_snow * dtime)
    2053       where (snow > epsilon(snow)) snow = max(0.0, snow - (evap * dtime))
    2054 !      snow = max(0.0, snow + (precip_snow - evap) * dtime)
    2055       qsol = qsol + (precip_rain - evap) * dtime
    2056     endif
     2049!!$  WRITE(*,*)'test calcul_flux, surface ', nisurf
     2050!!PB test
     2051!!$    if (nisurf == is_oce) then
     2052!!$      snow = 0.
     2053!!$      qsol = max_eau_sol
     2054!!$    else
     2055!!$      where (precip_snow > 0.) snow = snow + (precip_snow * dtime)
     2056!!$      where (snow > epsilon(snow)) snow = max(0.0, snow - (evap * dtime))
     2057!!$!      snow = max(0.0, snow + (precip_snow - evap) * dtime)
     2058!!$      where (precip_rain > 0.) qsol = qsol + (precip_rain - evap) * dtime
     2059!!$    endif
    20572060    IF (nisurf /= is_ter) qsol = max_eau_sol
    20582061
    … …  
    21612164!      qsol(i) = qsol(i) + (fq_fonte * dtime)
    21622165!    endif
    2163     if (nisurf == is_ter)  &
    2164      &  run_off(i) = run_off(i) + max(qsol(i) - max_eau_sol, 0.0)
    2165     qsol(i) = min(qsol(i), max_eau_sol)
     2166!!$    if (nisurf == is_ter)  &
     2167!!$     &  run_off(i) = run_off(i) + max(qsol(i) - max_eau_sol, 0.0)
     2168!!$    qsol(i) = min(qsol(i), max_eau_sol)
    21662169  ENDDO
    21672170
    … …  
    22632266!#########################################################################
    22642267!
    2265   SUBROUTINE albsno(klon, agesno,alb_neig_grid)
     2268  SUBROUTINE albsno(klon, knon,dtime,agesno,alb_neig_grid, precip_snow)
    22662269  IMPLICIT none
    22672270 
    2268   integer :: klon
     2271  INTEGER :: klon, knon
    22692272  INTEGER, PARAMETER :: nvm = 8
     2273  REAL   :: dtime
    22702274  REAL, dimension(klon,nvm) :: veget
    2271   REAL, DIMENSION(klon) :: alb_neig_grid, agesno
     2275  REAL, DIMENSION(klon) :: alb_neig_grid, agesno, precip_snow
    22722276 
    22732277  INTEGER :: i, nv
    … …  
    22802284  veget = 0.
    22812285  veget(:,1) = 1.     ! desert partout
    2282   DO i = 1, klon
     2286  DO i = 1, knon
    22832287    alb_neig_grid(i) = 0.0
    22842288  ENDDO
    22852289  DO nv = 1, nvm
    2286     DO i = 1, klon
     2290    DO i = 1, knon
    22872291      as = init(nv)+decay(nv)*EXP(-agesno(i)/5.)
    22882292      alb_neig_grid(i) = alb_neig_grid(i) + veget(i,nv)*as
    22892293    ENDDO
     2294  ENDDO
     2295!
     2296!! modilation en fonction de l'age de la neige
     2297!
     2298  DO i = 1, knon
     2299    agesno(i)  = (agesno(i) + (1.-agesno(i)/50.)*dtime/86400.)&
     2300            &             * EXP(-1.*MAX(0.0,precip_snow(i))*dtime/0.3)
     2301    agesno(i) =  MAX(agesno(i),0.0)
    22902302  ENDDO
    22912303 
    … …  
    23372349#include "YOETHF.inc"
    23382350#include "FCTTRE.inc"
     2351#include "indicesol.inc"
    23392352
    23402353! Parametres d'entree
    … …  
    24362449  enddo
    24372450
     2451
     2452  WHERE (precip_snow > 0.) snow = snow + (precip_snow * dtime)
     2453  WHERE (evap > 0 ) snow = MAX(0.0, snow - (evap * dtime))
     2454  qsol = qsol + (precip_rain - evap) * dtime
    24382455!
    24392456! Y'a-t-il fonte de neige?
    … …  
    24432460     & .AND. tsurf_new(i) >= RTT)
    24442461    if (neige_fond) then
    2445       tsurf_new(i) = RTT 
     2462      fq_fonte = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
     2463      snow(i) = max(0., snow(i) - fq_fonte)
     2464      qsol(i) = qsol(i) + fq_fonte
     2465      tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno 
     2466      IF (nisurf == is_sic .OR. nisurf == is_lic ) tsurf_new(i) = RTT -1.8
    24462467      d_ts(i) = tsurf_new(i) - tsurf(i)
    24472468!      zx_h_ts(i) = tsurf_new(i) * RCPD * zx_pkh(i)
    … …  
    24492470!== flux_q est le flux de vapeur d'eau: kg/(m**2 s)  positive vers bas
    24502471!== flux_t est le flux de cpt (energie sensible): j/(m**2 s)
    2451       evap(i) = - zx_mq(i) - zx_nq(i) * tsurf_new(i)
    2452       fluxlat(i) = - evap(i) * zx_sl(i)
    2453       fluxsens(i) = zx_mh(i) + zx_nh(i) * tsurf_new(i)
     2472!!$      evap(i) = - zx_mq(i) - zx_nq(i) * tsurf_new(i)
     2473!!$      fluxlat(i) = - evap(i) * zx_sl(i)
     2474!!$      fluxsens(i) = zx_mh(i) + zx_nh(i) * tsurf_new(i)
    24542475! Derives des flux dF/dTs (W m-2 K-1):
    2455       dflux_s(i) = zx_nh(i)
    2456       dflux_l(i) = (zx_sl(i) * zx_nq(i))
    2457       bilan_f = radsol(i) + fluxsens(i) - (zx_sl(i) * evap (i)) - &
    2458      &          dif_grnd(i) * (tsurf_new(i) - t_grnd) - &
    2459      &          RCPD * (zx_pkh(i))/cal(i)/dtime * (tsurf_new(i) - tsurf(i))
    2460       bilan_f = max(0., bilan_f)
    2461       fq_fonte = bilan_f / zx_sl(i)
    2462       snow(i) = max(0., snow(i) - fq_fonte * dtime)
    2463       qsol(i) = qsol(i) + (fq_fonte * dtime)
    2464       if (nisurf == is_ter)  &
    2465      &  run_off(i) = run_off(i) + max(qsol(i) - max_eau_sol, 0.0)
    2466       qsol(i) = min(qsol(i), max_eau_sol)
    2467     endif
     2476!!$      dflux_s(i) = zx_nh(i)
     2477!!$      dflux_l(i) = (zx_sl(i) * zx_nq(i))
     2478!!$      bilan_f = radsol(i) + fluxsens(i) - (zx_sl(i) * evap (i)) - &
     2479!!$     &          dif_grnd(i) * (tsurf_new(i) - t_grnd) - &
     2480!!$     &          RCPD * (zx_pkh(i))/cal(i)/dtime * (tsurf_new(i) - tsurf(i))
     2481!!$      bilan_f = max(0., bilan_f)
     2482!!$      fq_fonte = bilan_f / zx_sl(i)
     2483    endif
     2484    IF (nisurf == is_ter)  &
     2485       &  run_off(i) = run_off(i) + MAX(qsol(i) - max_eau_sol, 0.0)
     2486    qsol(i) = MIN(qsol(i), max_eau_sol)
    24682487  enddo
    24692488
Note: See TracChangeset for help on using the changeset viewer.