Changeset 2243


Ignore:
Timestamp:
Mar 24, 2015, 2:28:51 PM (10 years ago)
Author:
fhourdin
Message:

Revisite de la formule des flux de surface
(en priorité sur l'océan) en tenant compte des bourrasques de
vent et de la différence entre les hauteurs de rugosités pour
la quantité de mouvement, l'enthalpie et éventuellement l'humidité.

Etape 2 :

  • Séparation des z0 pour la quantité de mouvement et l'enthalpie.

rugs (ou frugs, rugos, yrugos ...) disparait au profit de z0m, z0h.
Les variables qui étaient à la fois dans pbl_surface_init et

  • dans l'interface de pbl_surface sont suprimées de pbl_surface_init.

On travaille directement pour ces variables (evap, z0, qsol, agesno)
avec les versions de phys_state_var_mod (qui étaient
précédemment dans phys_local_var_mod

  • Nouveaux paramètres de contrôle :
    • iflag_z0_oce (par défaut 0, et seule option active jusque là)
    • z0m_seaice_omp, z0h_seaice_omp, comme leur nom l'indique (utilisées dans surf_landice
    • z0min appliqué sur z0m et z0h dans pbl_surface
  • Introduction des fonction phyeta0_get et phyetat0_srf pour lire

les conditions de initiales dans startphy.
Du coup une seule ligne suffit pour lire et contrôler d'éventuels
problèmes.

  • Pour la variable fxrugs, elle est remplacée par z0m(:,nbsrf+1)

Ce choix déjà utilisé pour d'autres variables pourrait être
systématiser pour alléger l'interface de pbl_surface_mod.

  • Dans les sorties, les variables rugs* ont été remplacées par

des z0m* et z0h*

  • Nettoyage des anciens alb1/alb2 dans les lectures/écritures

des états de redémarrage (et dans pbl_surface_mod.F90).

Location:
LMDZ5/trunk/libf/phylmd
Files:
22 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/cdrag.F90

    r2232 r2243  
    44 SUBROUTINE cdrag( knon,  nsrf,   &
    55     speed, t1,    q1,    zgeop1, &
    6      psol,  tsurf, qsurf, rugos,  &
     6     psol,  tsurf, qsurf, z0m, z0h,  &
    77     pcfm,  pcfh,  zri,   pref )
    88
    … …  
    4545! tsurf---input-R- temperature de l'air a la surface
    4646! qsurf---input-R- humidite de l'air a la surface
    47 ! rugos---input-R- rugosite
     47! z0m, z0h---input-R- rugosite
    4848!! u1, v1 are removed, speed is used. Fuxing WANG, 04/03/2015,
    4949!! u1------input-R- vent zonal au 1er niveau du modele
    … …  
    7171  REAL, DIMENSION(klon), INTENT(IN)        :: tsurf ! Surface temperature (K)
    7272  REAL, DIMENSION(klon), INTENT(IN)        :: qsurf ! Surface humidity (Kg/Kg)
    73   REAL, DIMENSION(klon), INTENT(IN)        :: rugos ! Rugosity at surface (m)
     73  REAL, DIMENSION(klon), INTENT(IN)        :: z0m, z0h ! Rugosity at surface (m)
    7474!  paprs, pplay u1, v1: to be deleted
    7575!  they were in the old clcdrag. Fuxing WANG, 04/03/2015
    … …  
    113113  REAL, DIMENSION(klon) :: zcfh1, zcfh2 ! Drag coefficient for heat flux
    114114  LOGICAL, PARAMETER    :: zxli=.FALSE. ! calcul des cdrags selon Laurent Li
    115   REAL, DIMENSION(klon) :: zcdn         ! Drag coefficient in neutral conditions
     115  REAL, DIMENSION(klon) :: zcdn_m, zcdn_h         ! Drag coefficient in neutral conditions
    116116!
    117117! Fonctions thermodynamiques et fonctions d'instabilite
    … …  
    174174          *(1.+RETV*max(q1(i),0.0)) ! negative q1 set to zero
    175175     zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd)
    176      zcdn(i) = (CKAP/LOG(1.+zgeop1(i)/(RG*rugos(i))))**2
     176
     177
     178! Coefficients CD neutres pour m et h
     179     zcdn_m(i) = (CKAP/LOG(1.+zgeop1(i)/(RG*z0m(i))))**2
     180     zcdn_h(i) = (CKAP/LOG(1.+zgeop1(i)/(RG*z0h(i))))**2
    177181
    178182     IF (zri(i) .GT. 0.) THEN      ! situation stable
    … …  
    181185           zscf = SQRT(1.+CD*ABS(zri(i)))
    182186           friv = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), f_ri_cd_min)
    183            zcfm1(i) = zcdn(i) * friv
     187           zcfm1(i) = zcdn_m(i) * friv
    184188           frih = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), f_ri_cd_min )
    185189!!$ PB     zcfh1(i) = zcdn(i) * frih
    186190!!$ PB     zcfh1(i) = f_cdrag_stable * zcdn(i) * frih
    187            zcfh1(i) = f_cdrag_ter * zcdn(i) * frih
    188            IF(nsrf.EQ.is_oce) zcfh1(i) = f_cdrag_oce * zcdn(i) * frih
     191           zcfh1(i) = f_cdrag_ter * zcdn_h(i) * frih
     192           IF(nsrf.EQ.is_oce) zcfh1(i) = f_cdrag_oce * zcdn_h(i) * frih
    189193!!$ PB
    190194           pcfm(i) = zcfm1(i)
    191195           pcfh(i) = zcfh1(i)
    192196        ELSE
    193            pcfm(i) = zcdn(i)* fsta(zri(i))
    194            pcfh(i) = zcdn(i)* fsta(zri(i))
     197           pcfm(i) = zcdn_m(i)* fsta(zri(i))
     198           pcfh(i) = zcdn_h(i)* fsta(zri(i))
    195199        ENDIF
    196200     ELSE                          ! situation instable
    197201        IF (.NOT.zxli) THEN
    198            zucf = 1./(1.+3.0*CB*CC*zcdn(i)*SQRT(ABS(zri(i)) &
    199                 *(1.0+zgeop1(i)/(RG*rugos(i)))))
    200            zcfm2(i) = zcdn(i)*amax1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
    201 !!$ PB     zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),f_ri_cd_min)
    202            zcfh2(i) = f_cdrag_ter*zcdn(i)*amax1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
     202           zucf = 1./(1.+3.0*CB*CC*zcdn_m(i)*SQRT(ABS(zri(i)) &
     203                *(1.0+zgeop1(i)/(RG*z0m(i)))))
     204           zcfm2(i) = zcdn_m(i)*amax1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
     205!!$ PB     zcfh2(i) = zcdn_h(i)*amax1((1.-3.0*cb*zri(i)*zucf),f_ri_cd_min)
     206           zcfh2(i) = f_cdrag_ter*zcdn_h(i)*amax1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
    203207           pcfm(i) = zcfm2(i)
    204208           pcfh(i) = zcfh2(i)
    205209        ELSE
    206            pcfm(i) = zcdn(i)* fins(zri(i))
    207            pcfh(i) = zcdn(i)* fins(zri(i))
     210           pcfm(i) = zcdn_m(i)* fins(zri(i))
     211           pcfh(i) = zcdn_h(i)* fins(zri(i))
    208212        ENDIF
    209213! cdrah sur l'ocean cf. Miller et al. (1992)
    210         zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
    211         IF(nsrf.EQ.is_oce) pcfh(i) =f_cdrag_oce* zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
     214        zcr = (0.0016/(zcdn_m(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
     215        IF(nsrf.EQ.is_oce) pcfh(i) =f_cdrag_oce* zcdn_h(i)*(1.0+zcr**1.25)**(1./1.25)
    212216     ENDIF
    213217  END DO

  • LMDZ5/trunk/libf/phylmd/change_srf_frac_mod.F90

    r2227 r2243  
    1212
    1313  SUBROUTINE change_srf_frac(itime, dtime, jour, &
    14 !albedo SB >>>
    15 !       pctsrf, alb1, alb2, tsurf, ustar, u10m, v10m, pbl_tke)
    16         pctsrf, alb_dir, alb_dif, tsurf, ustar, u10m, v10m, pbl_tke)
    17 !albedo SB <<<
     14        pctsrf, evap, z0m, z0h, agesno,              &
     15        alb_dir, alb_dif, tsurf, ustar, u10m, v10m, pbl_tke)
    1816   
    1917
    … …  
    5452   
    5553    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf ! sub-surface fraction
     54    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: evap, agesno ! sub-surface fraction
     55    REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT) :: z0m,z0h ! sub-surface fraction
    5656!albedo SB >>>
    57 !   REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb1   ! albedo first interval in SW spektrum
    58 !   REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb2   ! albedo second interval in SW spektrum
    5957    REAL, DIMENSION(klon,nsw,nbsrf), INTENT(INOUT) :: alb_dir,alb_dif
    6058!albedo SB <<<
    … …  
    176174!****************************************************************************************
    177175
    178 !albedo SB >>>
    179 ! CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb1, alb2, ustar,
    180 ! u10m, v10m, pbl_tke)
    181        CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb_dir,alb_dif, ustar, u10m, v10m, pbl_tke)
    182 !albedo SB <<<
    183 
     176       CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old,        &
     177           evap, z0m, z0h, agesno,                                &
     178           tsurf, alb_dir,alb_dif, ustar, u10m, v10m, pbl_tke)
    184179
    185180

  • LMDZ5/trunk/libf/phylmd/clesphys.h

    r2240 r2243  
    4545       Real f_cdrag_ter,f_cdrag_oce
    4646       REAL min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce
    47        INTEGER iflag_gusts
     47       REAL z0m_seaice,z0h_seaice
     48       INTEGER iflag_gusts,iflag_z0_oce
    4849
    4950! Rugoro
    50        Real f_rugoro
     51       Real f_rugoro,z0min
    5152
    5253!IM lev_histhf  : niveau sorties 6h
    … …  
    9495     &     , cdmmax, cdhmax, ksta, ksta_ter, f_ri_cd_min                &
    9596     &     , fmagic, pmagic                                             &
    96      &     , f_cdrag_ter,f_cdrag_oce,f_rugoro                           &
     97     &     , f_cdrag_ter,f_cdrag_oce,f_rugoro,z0min                     &
    9798     &     , min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce              &
     99     &     , z0m_seaice,z0h_seaice                                      &
    98100     &     , pasphys            , freq_outNMC, freq_calNMC              &
    99101     &     , lonmin_ins, lonmax_ins, latmin_ins, latmax_ins             &
    … …  
    119121     &     , ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP                     &
    120122     &     , ip_ebil_phy                                                &
    121      &     , iflag_gusts                                                 &
     123     &     , iflag_gusts ,iflag_z0_oce                                  &
    122124     &     , ok_lic_melt,           aer_type                            &
    123125     &     , iflag_rrtm, ok_strato,ok_hines, ok_qch4                    &

  • LMDZ5/trunk/libf/phylmd/coef_diff_turb_mod.F90

    r1932 r2243  
    1313!
    1414  SUBROUTINE coef_diff_turb(dtime, nsrf, knon, ni, &
    15        ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, ycdragm, &
     15       ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
    1616       ycoefm, ycoefh ,yq2)
    1717 
    … …  
    3434    REAL, DIMENSION(klon,klev), INTENT(IN)     :: yu, yv
    3535    REAL, DIMENSION(klon,klev), INTENT(IN)     :: yq, yt
    36     REAL, DIMENSION(klon), INTENT(IN)          :: yts, yrugos, yqsurf
     36    REAL, DIMENSION(klon), INTENT(IN)          :: yts, yqsurf
    3737    REAL, DIMENSION(klon), INTENT(IN)          :: ycdragm
    3838
    … …  
    7070    CALL coefkz(nsrf, knon, ypaprs, ypplay, &
    7171         ksta, ksta_ter, &
    72          yts, yrugos, yu, yv, yt, yq, &
     72         yts, yu, yv, yt, yq, &
    7373         yqsurf, &
    7474         ycoefm, ycoefh)
    … …  
    181181  SUBROUTINE coefkz(nsrf, knon, paprs, pplay, &
    182182       ksta, ksta_ter, &
    183        ts, rugos, &
     183       ts, &
    184184       u,v,t,q, &
    185185       qsurf, &
    … …  
    200200! pplay----input-R- pression au milieu de chaque couche (en Pa)
    201201! ts-------input-R- temperature du sol (en Kelvin)
    202 ! rugos----input-R- longeur de rugosite (en m)
    203202! u--------input-R- vitesse u
    204203! v--------input-R- vitesse v
    … …  
    223222    REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
    224223    REAL, DIMENSION(klon,klev), INTENT(IN)   :: u, v, t, q
    225     REAL, DIMENSION(klon), INTENT(IN)        :: rugos
    226224    REAL, DIMENSION(klon), INTENT(IN)        :: qsurf
    227225

  • LMDZ5/trunk/libf/phylmd/conf_phys_m.F90

    r2240 r2243  
    117117
    118118    Real,SAVE           :: f_cdrag_ter_omp,f_cdrag_oce_omp
    119     Real,SAVE           :: f_rugoro_omp   
     119    Real,SAVE           :: f_rugoro_omp   , z0min_omp
     120    Real,SAVE           :: z0m_seaice_omp,z0h_seaice_omp
    120121    REAL,SAVE           :: min_wind_speed_omp,f_gust_wk_omp,f_gust_bl_omp,f_qsat_oce_omp
    121     INTEGER,SAVE        :: iflag_gusts_omp
     122    INTEGER,SAVE        :: iflag_gusts_omp,iflag_z0_oce_omp
    122123
    123124    ! Local
    … …  
    16691670    call getin('f_gust_wk',f_gust_wk_omp)
    16701671    !
    1671     print*,'CONFPHYS OOK avant gust'
     1672    iflag_z0_oce_omp=0
     1673    call getin('iflag_z0_oce',iflag_z0_oce_omp)
     1674    !
    16721675    iflag_gusts_omp=0
    16731676    call getin('iflag_gusts',iflag_gusts_omp)
    … …  
    16761679    call getin('min_wind_speed',min_wind_speed_omp)
    16771680
    1678     !
    1679     ! RUGORO
    1680     !Config Key  = f_rugoro
    1681     !Config Desc =
    1682     !Config Def  = 0.
    1683     !Config Help =
    1684     !
     1681    z0m_seaice_omp = 0.002 ; call getin('z0m_seaice',z0m_seaice_omp)
     1682    z0h_seaice_omp = 0.002 ; call getin('z0h_seaice',z0h_seaice_omp)
     1683
    16851684    f_rugoro_omp = 0.
    16861685    call getin('f_rugoro',f_rugoro_omp)
     1686
     1687    z0min_omp = 0.000015
     1688    call getin('z0min',z0min_omp)
     1689
    16871690
    16881691    ! PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
    … …  
    20412044    min_wind_speed=min_wind_speed_omp
    20422045    iflag_gusts=iflag_gusts_omp
     2046    iflag_z0_oce=iflag_z0_oce_omp
     2047
     2048
     2049    z0m_seaice=z0m_seaice_omp
     2050    z0h_seaice=z0h_seaice_omp
    20432051
    20442052    f_rugoro=f_rugoro_omp
     2053
     2054    z0min=z0min_omp
    20452055    supcrit1 = supcrit1_omp
    20462056    supcrit2 = supcrit2_omp
    … …  
    22302240    write(lunout,*)' f_cdrag_oce = ',f_cdrag_oce
    22312241    write(lunout,*)' f_rugoro = ',f_rugoro
     2242    write(lunout,*)' z0min = ',z0min
    22322243    write(lunout,*)' supcrit1 = ', supcrit1
    22332244    write(lunout,*)' supcrit2 = ', supcrit2

  • LMDZ5/trunk/libf/phylmd/dyn1d/lmdz1d.F90

    r2239 r2243  
    671671              ! 6 albedo, mais on peut quand meme tourner avec
    672672              ! moins. Seules les 2 ou 4 premiers seront lus
    673         falb1 = albedo                           
    674         falb2 = albedo                           
    675673        falb_dir=albedo
    676674        falb_dif=albedo
    … …  
    705703! rlon,rlat,zmasq,pctsrf(:,is_ter),pctsrf(:,is_lic),pctsrf(:,is_oce)
    706704! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
    707 ! qsol,falb1(:,nsrf),falb2(:,nsrf),evap(:,nsrf),snow(:,nsrf)
     705! qsol,falb_dir(:,nsrf),falb_dif(:,nsrf),evap(:,nsrf),snow(:,nsrf)
    708706! radsol,solsw,sollw,fder,rain_fall,snow_fall,frugs(:,nsrf)
    709707! agesno(:,nsrf),zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro
    … …  
    718716! (desallocations)
    719717        print*,'callin surf final'
    720           call pbl_surface_final(qsol, fder, snsrf, qsurfsrf,               &
    721      &                                    evap, frugs, agesno, tsoil)
     718          call pbl_surface_final( fder, snsrf, qsurfsrf, tsoil)
    722719        print*,'after surf final'
    723720          CALL fonte_neige_final(run_off_lic_0)

  • LMDZ5/trunk/libf/phylmd/etat0_netcdf.F90

    r2239 r2243  
    5454#include "dimsoil.h"
    5555#include "temps.h"
    56   REAL,    DIMENSION(klon)                 :: tsol, qsol
     56  REAL,    DIMENSION(klon)                 :: tsol
    5757  REAL,    DIMENSION(klon)                 :: sn, rugmer, run_off_lic_0
    5858  REAL,    DIMENSION(iip1,jjp1)            :: orog, rugo, psol
    … …  
    6161  REAL,    DIMENSION(iip1,jjm ,llm)        :: vvent
    6262  REAL,    DIMENSION(:,:,:,:), ALLOCATABLE :: q3d
    63   REAL,    DIMENSION(klon,nbsrf)           :: qsolsrf, snsrf, evap
    64   REAL,    DIMENSION(klon,nbsrf)           :: frugs, agesno
     63  REAL,    DIMENSION(klon,nbsrf)           :: qsolsrf, snsrf
    6564  REAL,    DIMENSION(klon,nsoilmx,nbsrf)   :: tsoil
    6665
    … …  
    480479  DO i=1,nbsrf; ftsol(:,i) = tsol; END DO
    481480  DO i=1,nbsrf; snsrf(:,i) = sn;   END DO
    482   falb1(:,is_ter) = 0.08; falb1(:,is_lic) = 0.6
    483   falb1(:,is_oce) = 0.5;  falb1(:,is_sic) = 0.6
    484   falb2 = falb1
    485481!albedo SB >>>
    486482  falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
    487483  falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
    488484!albedo SB <<<
    489   evap(:,:) = 0.
     485  fevap(:,:) = 0.
    490486  DO i=1,nbsrf; qsolsrf(:,i)=150.; END DO
    491487  DO i=1,nbsrf; DO j=1,nsoilmx; tsoil(:,j,i) = tsol; END DO; END DO
    … …  
    495491  q_ancien = 0.
    496492  agesno = 0.
    497   frugs(:,is_oce) = rugmer(:)
    498   frugs(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
    499   frugs(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
    500   frugs(:,is_sic) = 0.001
     493
     494  z0m(:,is_oce) = rugmer(:)
     495  z0m(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
     496  z0m(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
     497  z0m(:,is_sic) = 0.001
     498  z0h(:,:)=z0m(:,:)
     499
    501500  fder = 0.0
    502501  clwcon = 0.0
    … …  
    526525
    527526  CALL fonte_neige_init(run_off_lic_0)
    528   CALL pbl_surface_init( qsol, fder, snsrf, qsolsrf, evap, frugs, agesno, tsoil )
     527  CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
    529528  CALL phyredem( "startphy.nc" )
    530529

  • LMDZ5/trunk/libf/phylmd/pbl_surface_mod.F90

    r2241 r2243  
    2929
    3030! Declaration of variables saved in restart file
    31   REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: qsol   ! water height in the soil (mm)
    32   !$OMP THREADPRIVATE(qsol)
    3331  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: fder   ! flux drift
    3432  !$OMP THREADPRIVATE(fder)
    … …  
    3735  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: qsurf  ! humidity at surface
    3836  !$OMP THREADPRIVATE(qsurf)
    39   REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: evap   ! evaporation at surface
    40   !$OMP THREADPRIVATE(evap)
    41   REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: rugos  ! rugosity at surface (m)
    42   !$OMP THREADPRIVATE(rugos)
    43   REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: agesno ! age of snow at surface
    44   !$OMP THREADPRIVATE(agesno)
    45 ! Correction pour le cas AMMA (PRIVATE)
    4637  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: ftsoil ! soil temperature
    4738  !$OMP THREADPRIVATE(ftsoil)
    … …  
    5142!****************************************************************************************
    5243!
    53   SUBROUTINE pbl_surface_init(qsol_rst, fder_rst, snow_rst, qsurf_rst,&
    54        evap_rst, rugos_rst, agesno_rst, ftsoil_rst)
     44  SUBROUTINE pbl_surface_init(fder_rst, snow_rst, qsurf_rst, ftsoil_rst)
    5545
    5646! This routine should be called after the restart file has been read.
    … …  
    6555! Input variables
    6656!****************************************************************************************
    67     REAL, DIMENSION(klon), INTENT(IN)                 :: qsol_rst
    6857    REAL, DIMENSION(klon), INTENT(IN)                 :: fder_rst
    6958    REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: snow_rst
    7059    REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: qsurf_rst
    71     REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: evap_rst
    72     REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: rugos_rst
    73     REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: agesno_rst
    7460    REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(IN) :: ftsoil_rst
    7561
    … …  
    8672!
    8773!****************************************************************************************   
    88     ALLOCATE(qsol(klon), stat=ierr)
    89     IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
    90 
    9174    ALLOCATE(fder(klon), stat=ierr)
    9275    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
    … …  
    9881    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
    9982
    100     ALLOCATE(evap(klon,nbsrf), stat=ierr)
    101     IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
    102 
    103     ALLOCATE(rugos(klon,nbsrf), stat=ierr)
    104     IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
    105 
    106     ALLOCATE(agesno(klon,nbsrf), stat=ierr)
    107     IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
    108 
    10983    ALLOCATE(ftsoil(klon,nsoilmx,nbsrf), stat=ierr)
    11084    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
    11185
    11286
    113     qsol(:)       = qsol_rst(:)
    11487    fder(:)       = fder_rst(:)
    11588    snow(:,:)     = snow_rst(:,:)
    11689    qsurf(:,:)    = qsurf_rst(:,:)
    117     evap(:,:)     = evap_rst(:,:)
    118     rugos(:,:)    = rugos_rst(:,:)
    119     agesno(:,:)   = agesno_rst(:,:)
    12090    ftsoil(:,:,:) = ftsoil_rst(:,:,:)
    12191
    … …  
    199169!!!
    200170       zcoefh,    zcoefm,    slab_wfbils,             &
    201        qsol_d,    zq2m,      s_pblh,   s_plcl,        &
     171       qsol,    zq2m,      s_pblh,   s_plcl,        &
    202172!!!
    203173!!! jyg le 08/02/2012
    … …  
    206176       s_capCL,   s_oliqCL,  s_cteiCL, s_pblT,        &
    207177       s_therm,   s_trmb1,   s_trmb2,  s_trmb3,       &
    208        zxrugs,zustar,zu10m,  zv10m,    fder_print,    &
     178       zustar,zu10m,  zv10m,    fder_print,    &
    209179       zxqsurf,   rh2m,      zxfluxu,  zxfluxv,       &
    210        rugos_d,   agesno_d,  sollw,    solsw,         &
    211        d_ts,      evap_d,    fluxlat,  t2m,           &
     180       z0m, z0h,   agesno,  sollw,    solsw,         &
     181       d_ts,      evap,    fluxlat,  t2m,           &
    212182       wfbils,    wfbilo,    flux_t,   flux_u, flux_v,&
    213183       dflux_t,   dflux_q,   zxsnow,                  &
    … …  
    258228! pplay----input-R- pression au milieu de couche (Pa)
    259229! rlat-----input-R- latitude en degree
    260 ! rugos----input-R- longeur de rugosite (en m)
     230! z0m, z0h ----input-R- longeur de rugosite (en m)
    261231! Martin
    262232! zsig-----input-R- slope
    … …  
    425395!!!
    426396    REAL, DIMENSION(klon),        INTENT(OUT)       :: slab_wfbils! heat balance at surface only for slab at ocean points
    427     REAL, DIMENSION(klon),        INTENT(OUT)       :: qsol_d     ! water height in the soil (mm)
     397    REAL, DIMENSION(klon),        INTENT(OUT)       :: qsol     ! water height in the soil (mm)
    428398    REAL, DIMENSION(klon),        INTENT(OUT)       :: zq2m       ! water vapour at 2m, mean for each grid point
    429399    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_pblh     ! height of the planetary boundary layer(HPBL)
    … …  
    445415    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_trmb2    ! inhibition, mean for each grid point
    446416    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_trmb3    ! point Omega, mean for each grid point
    447     REAL, DIMENSION(klon),        INTENT(OUT)       :: zxrugs     ! rugosity at surface (m), mean for each grid point
    448417    REAL, DIMENSION(klon),        INTENT(OUT)       :: zustar     ! u*
    449418    REAL, DIMENSION(klon),        INTENT(OUT)       :: zu10m      ! u speed at 10m, mean for each grid point
    … …  
    454423    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxu    ! u wind tension, mean for each grid point
    455424    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxv    ! v wind tension, mean for each grid point
    456     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: rugos_d    ! rugosity length (m)
    457     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: agesno_d   ! age of snow at surface
     425    REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT)     :: z0m,z0h      ! rugosity length (m)
     426    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)       :: agesno   ! age of snow at surface
    458427    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: solsw      ! net shortwave radiation at surface
    459428    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: sollw      ! net longwave radiation at surface
    460429    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: d_ts       ! change in temperature at surface
    461     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: evap_d     ! evaporation at surface
     430    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)       :: evap     ! evaporation at surface
    462431    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: fluxlat    ! latent flux
    463432    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: t2m        ! temperature at 2 meter height
    … …  
    510479    REAL                               :: f1 ! fraction de longeurs visibles parmi tout SW intervalle
    511480    REAL, DIMENSION(klon)              :: r_co2_ppm     ! taux CO2 atmosphere
    512     REAL, DIMENSION(klon)              :: yts, yrugos, ypct, yz0_new
     481    REAL, DIMENSION(klon)              :: yts, yz0m, yz0h, ypct
    513482!albedo SB >>>
    514483    REAL, DIMENSION(klon)              :: yalb,yalb_vis
    … …  
    881850 kh(:)=0. ; kh_x(:)=0. ; kh_w(:)=0.
    882851 slab_wfbils(:)=0.
    883  qsol_d(:)=0.
    884852 s_pblh(:)=0. ; s_pblh_x(:)=0. ; s_pblh_w(:)=0.
    885853 s_plcl(:)=0. ; s_plcl_x(:)=0. ; s_plcl_w(:)=0.
    … …  
    887855 s_therm(:)=0.
    888856 s_trmb1(:)=0. ; s_trmb2(:)=0. ; s_trmb3(:)=0.
    889  zxrugs(:)=0. ; zustar(:)=0.
     857 zustar(:)=0.
    890858 zu10m(:)=0. ; zv10m(:)=0.
    891859 fder_print(:)=0.
    892860 zxqsurf(:)=0.
    893861 zxfluxu(:,:)=0. ; zxfluxv(:,:)=0.
    894  rugos_d(:,:)=0. ; agesno_d(:,:)=0.
    895862 solsw(:,:)=0. ; sollw(:,:)=0.
    896863 d_ts(:,:)=0.
    897  evap_d(:,:)=0.
     864 evap(:,:)=0.
    898865 fluxlat(:,:)=0.
    899866 wfbils(:,:)=0. ; wfbilo(:,:)=0.
    … …  
    939906!albedo SB <<<
    940907    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0   
    941     ysollw = 0.0  ; yrugos = 0.0     ; yu1 = 0.0   
     908    ysollw = 0.0  ; yz0m = 0.0 ; yz0h = 0.0    ; yu1 = 0.0   
    942909    yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0
    943910    ydelp = 0.0   ; yu = 0.0         ; yv = 0.0        ; yt = 0.0         
    … …  
    10671034!****************************************************************************************
    10681035
    1069     zxrugs(:) = 0.0
    10701036    DO nsrf = 1, nbsrf
    10711037       DO i = 1, klon
    1072           rugos(i,nsrf) = MAX(rugos(i,nsrf),0.000015)
    1073           zxrugs(i) = zxrugs(i) + rugos(i,nsrf)*pctsrf(i,nsrf)
     1038          z0m(i,nsrf) = MAX(z0m(i,nsrf),z0min)
     1039          z0h(i,nsrf) = MAX(z0h(i,nsrf),z0min)
    10741040       ENDDO
    10751041    ENDDO
    … …  
    12081174          ysolsw(j)  = solsw(i,nsrf)
    12091175          ysollw(j)  = sollw(i,nsrf)
    1210           yrugos(j)  = rugos(i,nsrf)
     1176          yz0m(j)  = z0m(i,nsrf)
     1177          yz0h(j)  = z0h(i,nsrf)
    12111178          yrugoro(j) = rugoro(i)
    12121179          yu1(j)     = u(i,1)
    … …  
    13391306        CALL cdrag(knon, nsrf, &
    13401307            speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1),&
    1341             yts, yqsurf, yrugos, &
     1308            yts, yqsurf, yz0m, yz0h, &
    13421309            ycdragm, ycdragh, zri1, pref )
    13431310
    … …  
    13701337        CALL cdrag(knon, nsrf, &
    13711338            speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),&
    1372             yts_x, yqsurf, yrugos, &
     1339            yts_x, yqsurf, yz0m, yz0h, &
    13731340            ycdragm_x, ycdragh_x, zri1_x, pref_x )
    13741341
    … …  
    13861353        CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
    13871354            yu_w(:,1), yv_w(:,1), yt_w(:,1), yq_w(:,1), &
    1388             yts_w, yqsurf, yrugos, &
     1355            yts_w, yqsurf, yz0m, &
    13891356            ycdragm_w, ycdragh_w )
     1357
    13901358! --- special Dice. JYG+MPL 25112013
    13911359        IF (ok_prescr_ust) then
    … …  
    14181386      print *,' args coef_diff_turb: yt ',  yt 
    14191387      print *,' args coef_diff_turb: yts ', yts 
    1420       print *,' args coef_diff_turb: yrugos ', yrugos 
     1388      print *,' args coef_diff_turb: yz0m ', yz0m 
    14211389      print *,' args coef_diff_turb: yqsurf ', yqsurf 
    14221390      print *,' args coef_diff_turb: ycdragm ', ycdragm
    … …  
    14251393       ENDIF
    14261394        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
    1427             ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, ycdragm, &
     1395            ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
    14281396            ycoefm, ycoefh, ytke)
    14291397       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
    … …  
    14461414      print *,' args coef_diff_turb: yt_x ',  yt_x 
    14471415      print *,' args coef_diff_turb: yts_x ', yts_x 
    1448       print *,' args coef_diff_turb: yrugos ', yrugos 
    14491416      print *,' args coef_diff_turb: yqsurf ', yqsurf 
    14501417      print *,' args coef_diff_turb: ycdragm_x ', ycdragm_x
    … …  
    14531420       ENDIF
    14541421        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
    1455             ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yrugos, yqsurf, ycdragm_x, &
     1422            ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yqsurf, ycdragm_x, &
    14561423            ycoefm_x, ycoefh_x, ytke_x)
    14571424       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
    … …  
    14731440      print *,' args coef_diff_turb: yt_w ',  yt_w 
    14741441      print *,' args coef_diff_turb: yts_w ', yts_w 
    1475       print *,' args coef_diff_turb: yrugos ', yrugos 
    14761442      print *,' args coef_diff_turb: yqsurf ', yqsurf 
    14771443      print *,' args coef_diff_turb: ycdragm_w ', ycdragm_w
    … …  
    14801446       ENDIF
    14811447        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
    1482             ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yrugos, yqsurf, ycdragm_w, &
     1448            ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yqsurf, ycdragm_w, &
    14831449            ycoefm_w, ycoefh_w, ytke_w)
    14841450       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
    … …  
    17411707          CALL stdlevvar(klon, knon, is_ter, zxli, &
    17421708               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
    1743                yts, yqsurf, yrugos, ypaprs(:,1), ypplay(:,1), &
     1709               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
    17441710               yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
    17451711         
    … …  
    17661732               ylwdown, yq2m, yt2m, &
    17671733               ysnow, yqsol, yagesno, ytsoil, &
    1768                yz0_new, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
     1734               yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
    17691735               yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
    17701736               y_flux_u1, y_flux_v1 )
    … …  
    18001766               ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
    18011767               ysnow, yqsurf, yqsol, yagesno, &
    1802 !albedo SB >>>
    1803 !              ytsoil, yz0_new, yevap, yfluxsens, yfluxlat, &
    1804                ytsoil, yz0_new, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
    1805 !albedo SB <<<
     1768               ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
    18061769               ytsurf_new, y_dflux_t, y_dflux_q, &
    18071770               yzsig, ycldt, &
    … …  
    18251788         
    18261789       CASE(is_oce)
    1827 !albedo SB >>>
    18281790           CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb_vis, &
    1829 !albedo SB <<<
    1830                yrugos, ywindsp, rmu0, yfder, yts, &
     1791               ywindsp, rmu0, yfder, yts, &
    18311792               itap, dtime, jour, knon, ni, &
    18321793               ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    … …  
    18351796               ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
    18361797               ysnow, yqsurf, yagesno, &
    1837 !albedo SB >>>
    1838                yz0_new, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
    1839 !albedo SB <<<
     1798               yz0m, yz0h, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
    18401799               ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
    18411800               y_flux_u1, y_flux_v1)
    … …  
    18691828               ysnow, yqsurf, yqsol, yagesno, ytsoil, &
    18701829!albedo SB >>>
    1871                yz0_new, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
     1830               yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
    18721831!albedo SB <<<
    18731832               ytsurf_new, y_dflux_t, y_dflux_q, &
    … …  
    22482207          snow(i,nsrf) = ysnow(j) 
    22492208          qsurf(i,nsrf) = yqsurf(j)
    2250           rugos(i,nsrf) = yz0_new(j)
     2209          z0m(i,nsrf) = yz0m(j)
     2210          z0h(i,nsrf) = yz0h(j)
    22512211          fluxlat(i,nsrf) = yfluxlat(j)
    22522212          agesno(i,nsrf) = yagesno(j) 
    … …  
    24602420       DO j=1, knon
    24612421          i = ni(j)
    2462           rugo1(j) = yrugos(j)
     2422          rugo1(j) = yz0m(j)
    24632423          IF(nsrf.EQ.is_oce) THEN
    2464              rugo1(j) = rugos(i,nsrf)
     2424             rugo1(j) = z0m(i,nsrf)
    24652425          ENDIF
    24662426          psfce(j)=ypaprs(j,1)
    … …  
    24772437        CALL stdlevvar(klon, knon, nsrf, zxli, &
    24782438            uzon, vmer, tair1, qair1, zgeo1, &
    2479             tairsol, qairsol, rugo1, psfce, patm, &
     2439            tairsol, qairsol, rugo1, rugo1, psfce, patm, &
    24802440            yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
    24812441       ELSE  !(iflag_split .eq.0)
    24822442        CALL stdlevvar(klon, knon, nsrf, zxli, &
    24832443            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
    2484             tairsol_x, qairsol, rugo1, psfce, patm, &
     2444            tairsol_x, qairsol, rugo1, rugo1, psfce, patm, &
    24852445            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x)
    24862446        CALL stdlevvar(klon, knon, nsrf, zxli, &
    24872447            uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
    2488             tairsol_w, qairsol, rugo1, psfce, patm, &
     2448            tairsol_w, qairsol, rugo1, rugo1, psfce, patm, &
    24892449            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
    24902450!!!
    … …  
    27122672!****************************************************************************************
    27132673   
     2674    z0m(:,nbsrf+1) = 0.0
     2675    z0h(:,nbsrf+1) = 0.0
     2676    DO nsrf = 1, nbsrf
     2677       DO i = 1, klon
     2678          z0m(i,nbsrf+1) = z0m(i,nbsrf+1) + z0m(i,nsrf)*pctsrf(i,nsrf)
     2679          z0h(i,nbsrf+1) = z0h(i,nbsrf+1) + z0h(i,nsrf)*pctsrf(i,nsrf)
     2680       ENDDO
     2681    ENDDO
     2682
    27142683!   print*,'OK pbl 7'
    27152684    zxfluxt(:,:) = 0.0 ; zxfluxq(:,:) = 0.0
    … …  
    29282897    zv1(:) = v(:,1)
    29292898
    2930 ! Some of the module declared variables are returned for printing in physiq.F
    2931     qsol_d(:)     = qsol(:)
    2932     evap_d(:,:)   = evap(:,:)
    2933     rugos_d(:,:)  = rugos(:,:)
    2934     agesno_d(:,:) = agesno(:,:)
    2935 
    29362899
    29372900  END SUBROUTINE pbl_surface
    … …  
    29392902!****************************************************************************************
    29402903!
    2941   SUBROUTINE pbl_surface_final(qsol_rst, fder_rst, snow_rst, qsurf_rst, &
    2942        evap_rst, rugos_rst, agesno_rst, ftsoil_rst)
     2904  SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst)
    29432905
    29442906    USE indice_sol_mod
    … …  
    29482910! Ouput variables
    29492911!****************************************************************************************
    2950     REAL, DIMENSION(klon), INTENT(OUT)                 :: qsol_rst
    29512912    REAL, DIMENSION(klon), INTENT(OUT)                 :: fder_rst
    29522913    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: snow_rst
    29532914    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: qsurf_rst
    2954     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: evap_rst
    2955     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: rugos_rst
    2956     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: agesno_rst
    29572915    REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(OUT) :: ftsoil_rst
    29582916
    … …  
    29622920!
    29632921!****************************************************************************************   
    2964     qsol_rst(:)       = qsol(:)
    29652922    fder_rst(:)       = fder(:)
    29662923    snow_rst(:,:)     = snow(:,:)
    29672924    qsurf_rst(:,:)    = qsurf(:,:)
    2968     evap_rst(:,:)     = evap(:,:)
    2969     rugos_rst(:,:)    = rugos(:,:)
    2970     agesno_rst(:,:)   = agesno(:,:)
    29712925    ftsoil_rst(:,:,:) = ftsoil(:,:,:)
    29722926
    … …  
    29762930!****************************************************************************************
    29772931!   DEALLOCATE(qsol, fder, snow, qsurf, evap, rugos, agesno, ftsoil)
    2978     IF (ALLOCATED(qsol)) DEALLOCATE(qsol)
    29792932    IF (ALLOCATED(fder)) DEALLOCATE(fder)
    29802933    IF (ALLOCATED(snow)) DEALLOCATE(snow)
    29812934    IF (ALLOCATED(qsurf)) DEALLOCATE(qsurf)
    2982     IF (ALLOCATED(evap)) DEALLOCATE(evap)
    2983     IF (ALLOCATED(rugos)) DEALLOCATE(rugos)
    2984     IF (ALLOCATED(agesno)) DEALLOCATE(agesno)
    29852935    IF (ALLOCATED(ftsoil)) DEALLOCATE(ftsoil)
    29862936
    … …  
    29912941
    29922942!albedo SB >>>
    2993 SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke) 
     2943SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, &
     2944     evap, z0m, z0h, agesno,                                  &
     2945     tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke) 
    29942946!albedo SB <<<
    29952947    ! Give default values where new fraction has appread
    … …  
    30142966!albedo SB <<<
    30152967    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: ustar,u10m, v10m
     2968    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: evap, agesno
     2969    REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT)        :: z0m,z0h
    30162970    REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke
    30172971
    … …  
    30553009                qsurf(i,nsrf) = qsurf(i,nsrf_comp1)
    30563010                evap(i,nsrf)  = evap(i,nsrf_comp1)
    3057                 rugos(i,nsrf) = rugos(i,nsrf_comp1)
     3011                z0m(i,nsrf) = z0m(i,nsrf_comp1)
     3012                z0h(i,nsrf) = z0h(i,nsrf_comp1)
    30583013                tsurf(i,nsrf) = tsurf(i,nsrf_comp1)
    30593014!albedo SB >>>
    … …  
    30743029                qsurf(i,nsrf) = qsurf(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + qsurf(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
    30753030                evap(i,nsrf)  = evap(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + evap(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    3076                 rugos(i,nsrf) = rugos(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + rugos(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
     3031                z0m(i,nsrf) = z0m(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + z0m(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
     3032                z0h(i,nsrf) = z0h(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + z0h(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
    30773033                tsurf(i,nsrf) = tsurf(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tsurf(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
    30783034!albedo SB >>>

  • LMDZ5/trunk/libf/phylmd/phyaqua_mod.F90

    r2209 r2243  
    4848    REAL :: run_off_lic_0(nlon)
    4949    REAL :: qsolsrf(nlon, nbsrf), snsrf(nlon, nbsrf)
    50     REAL :: frugs(nlon, nbsrf)
    51     REAL :: agesno(nlon, nbsrf)
    5250    REAL :: tsoil(nlon, nsoilmx, nbsrf)
    5351    REAL :: tslab(nlon), seaice(nlon)
    54     REAL evap(nlon, nbsrf), fder(nlon)
     52    REAL fder(nlon)
    5553
    5654
    … …  
    6765    REAL tsurf
    6866    REAL time, timestep, day, day0
    69     REAL qsol_f, qsol(nlon)
     67    REAL qsol_f
    7068    REAL rugsrel(nlon)
    7169    ! real zmea(nlon),zstd(nlon),zsig(nlon)
    … …  
    328326    seaice(:) = 0.
    329327    run_off_lic_0 = 0.
    330     evap = 0.
     328    fevap = 0.
    331329
    332330
    … …  
    336334    qsolsrf(:, :) = qsol(1) ! humidite du sol des sous surface
    337335    snsrf(:, :) = 0. ! couverture de neige des sous surface
    338     frugs(:, :) = rugos ! couverture de neige des sous surface
    339 
    340 
    341     CALL pbl_surface_init(qsol, fder, snsrf, qsolsrf, evap, frugs, agesno, &
    342       tsoil)
     336    z0m(:, :) = rugos ! couverture de neige des sous surface
     337    z0h=z0m
     338
     339
     340    CALL pbl_surface_init(fder, snsrf, qsolsrf, tsoil)
    343341
    344342    PRINT *, 'iniaqua: before phyredem'

  • LMDZ5/trunk/libf/phylmd/phyetat0.F90

    r2241 r2243  
    1010  USE surface_data,     ONLY : type_ocean, version_ocean
    1111  USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, dtime, &
     12       qsol, fevap, z0m, z0h, agesno, &
    1213       du_gwd_rando, dv_gwd_rando, entr_therm, f0, fm_therm, &
    1314       falb_dir, falb_dif, &
    … …  
    4647  REAL tsoil(klon, nsoilmx, nbsrf)
    4748  REAL qsurf(klon, nbsrf)
    48   REAL qsol(klon)
    4949  REAL snow(klon, nbsrf)
    50   REAL evap(klon, nbsrf)
    5150  real fder(klon)
    52   REAL frugs(klon, nbsrf)
    53   REAL agesno(klon, nbsrf)
    5451  REAL run_off_lic_0(klon)
    5552  REAL fractint(klon)
    … …  
    7471  CHARACTER*7 str7
    7572  CHARACTER*2 str2
    76   LOGICAL :: found
     73  LOGICAL :: found,phyetat0_get,phyetat0_srf
    7774
    7875  ! FH1D
    … …  
    392389  ! Lecture de evaporation: 
    393390
    394   CALL get_field("EVAP", evap(:, 1), found)
     391  CALL get_field("EVAP", fevap(:, 1), found)
    395392  IF (.NOT. found) THEN
    396393     PRINT*, 'phyetat0: Le champ <EVAP> est absent'
    … …  
    402399        ENDIF
    403400        WRITE(str2, '(i2.2)') nsrf
    404         CALL get_field("EVAP"//str2, evap(:, nsrf))
     401        CALL get_field("EVAP"//str2, fevap(:, nsrf))
    405402        xmin = 1.0E+20
    406403        xmax = -1.0E+20
    407404        DO i = 1, klon
    408            xmin = MIN(evap(i, nsrf), xmin)
    409            xmax = MAX(evap(i, nsrf), xmax)
     405           xmin = MIN(fevap(i, nsrf), xmin)
     406           xmax = MAX(fevap(i, nsrf), xmax)
    410407        ENDDO
    411         PRINT*, 'evap du sol EVAP**:', nsrf, xmin, xmax
     408        PRINT*, 'fevap du sol EVAP**:', nsrf, xmin, xmax
    412409     ENDDO
    413410  ELSE
    … …  
    417414     xmax = -1.0E+20
    418415     DO i = 1, klon
    419         xmin = MIN(evap(i, 1), xmin)
    420         xmax = MAX(evap(i, 1), xmax)
     416        xmin = MIN(fevap(i, 1), xmin)
     417        xmax = MAX(fevap(i, 1), xmax)
    421418     ENDDO
    422419     PRINT*, 'Evap du sol <EVAP>', xmin, xmax
    423420     DO nsrf = 2, nbsrf
    424421        DO i = 1, klon
    425            evap(i, nsrf) = evap(i, 1)
     422           fevap(i, nsrf) = fevap(i, 1)
    426423        ENDDO
    427424     ENDDO
    … …  
    532529  ! Lecture de la longueur de rugosite
    533530
    534   CALL get_field("RUG", frugs(:, 1), found)
    535   IF (.NOT. found) THEN
    536      PRINT*, 'phyetat0: Le champ <RUG> est absent'
    537      PRINT*, '          Mais je vais essayer de lire RUG**'
     531IF (1==0) THEN ! A DERTRUIRE TOUT DE SUITE
    538532     DO nsrf = 1, nbsrf
    539533        IF (nsrf.GT.99) THEN
    … …  
    542536        ENDIF
    543537        WRITE(str2, '(i2.2)') nsrf
    544         CALL get_field("RUG"//str2, frugs(:, nsrf))
    545         xmin = 1.0E+20
    546         xmax = -1.0E+20
    547         DO i = 1, klon
    548            xmin = MIN(frugs(i, nsrf), xmin)
    549            xmax = MAX(frugs(i, nsrf), xmax)
    550         ENDDO
    551         PRINT*, 'rugosite du sol RUG**:', nsrf, xmin, xmax
    552      ENDDO
     538! Retrocompatibilite. A nettoyer fin 2015
     539        CALL get_field("RUG"//str2, z0m(:, nsrf),found)
     540        IF (found) THEN
     541            z0h(:,nsrf)=z0m(:,nsrf)
     542            PRINT*,'Lecture de ',"RUG"//str2,' -> z0m/z0h (obsolete)'
     543        ELSE
     544            CALL get_field("Z0m"//str2, z0m(:, nsrf), found)
     545            IF (.NOT.found) Z0m=1.e-3 ! initialisation à 1mm au cas ou.
     546            CALL get_field("Z0h"//str2, z0h(:, nsrf), found)
     547            IF (.NOT.found) Z0h=1.e-3 ! initialisation à 1mm au cas ou.
     548        ENDIF
     549        PRINT*, 'rugosite Z0m',nsrf,minval(z0m(:, nsrf)),maxval(z0m(:, nsrf))
     550        PRINT*, 'rugosite Z0h',nsrf,minval(z0h(:, nsrf)),maxval(z0h(:, nsrf))
     551
     552     ENDDO
     553ELSE
     554  PRINT*,'AVANT phyetat0_srf'
     555  found=phyetat0_srf(1,z0m,"RUG","Z0m ancien",0.001)
     556  PRINT*,'APRES phyetat0_srf'
     557  IF (found) THEN
     558     z0h(:,1:nbsrf)=z0m(:,1:nbsrf)
    553559  ELSE
    554      PRINT*, 'phyetat0: Le champ <RUG> est present'
    555      PRINT*, '          J ignore donc les autres RUG**'
    556      xmin = 1.0E+20
    557      xmax = -1.0E+20
    558      DO i = 1, klon
    559         xmin = MIN(frugs(i, 1), xmin)
    560         xmax = MAX(frugs(i, 1), xmax)
    561      ENDDO
    562      PRINT*, 'rugosite <RUG>', xmin, xmax
    563      DO nsrf = 2, nbsrf
    564         DO i = 1, klon
    565            frugs(i, nsrf) = frugs(i, 1)
    566         ENDDO
    567      ENDDO
    568   ENDIF
     560     found=phyetat0_srf(1,z0m,"Z0m","Roughness length, momentum ",0.001)
     561     found=phyetat0_srf(1,z0h,"Z0h","Roughness length, enthalpy ",0.001)
     562  ENDIF
     563ENDIF
    569564
    570565  ! Lecture de l'age de la neige:
    … …  
    585580           agesno = 50.0
    586581        ENDIF
    587         xmin = 1.0E+20
    588         xmax = -1.0E+20
    589         DO i = 1, klon
    590            xmin = MIN(agesno(i, nsrf), xmin)
    591            xmax = MAX(agesno(i, nsrf), xmax)
    592         ENDDO
    593         PRINT*, 'Age de la neige AGESNO**:', nsrf, xmin, xmax
     582        PRINT*, 'agesno',nsrf,minval(agesno(:, nsrf)),maxval(agesno(:, nsrf))
    594583     ENDDO
    595584  ELSE
    … …  
    610599  ENDIF
    611600
    612   CALL get_field("ZMEA", zmea)
    613   xmin = 1.0E+20
    614   xmax = -1.0E+20
    615   DO i = 1, klon
    616      xmin = MIN(zmea(i), xmin)
    617      xmax = MAX(zmea(i), xmax)
    618   ENDDO
    619   PRINT*, 'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
     601!  CALL get_field("ZMEA", zmea)
     602!  PRINT*, 'OROGRAPHIE SOUS-MAILLE zmea:',minval(zmea(:)),maxval(zmea(:))
     603  found=phyetat0_get(1,zmea,"ZMEA","mean orography",0.)
    620604
    621605  CALL get_field("ZSTD", zstd)
    622   xmin = 1.0E+20
    623   xmax = -1.0E+20
    624   DO i = 1, klon
    625      xmin = MIN(zstd(i), xmin)
    626      xmax = MAX(zstd(i), xmax)
    627   ENDDO
    628   PRINT*, 'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
     606  PRINT*, 'OROGRAPHIE SOUS-MAILLE zstd:',minval(zstd(:)),maxval(zstd(:))
    629607
    630608  CALL get_field("ZSIG", zsig)
    631   xmin = 1.0E+20
    632   xmax = -1.0E+20
    633   DO i = 1, klon
    634      xmin = MIN(zsig(i), xmin)
    635      xmax = MAX(zsig(i), xmax)
    636   ENDDO
    637   PRINT*, 'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
     609  PRINT*, 'OROGRAPHIE SOUS-MAILLE zsig:',minval(zsig(:)),maxval(zsig(:))
    638610
    639611  CALL get_field("ZGAM", zgam)
    640   xmin = 1.0E+20
    641   xmax = -1.0E+20
    642   DO i = 1, klon
    643      xmin = MIN(zgam(i), xmin)
    644      xmax = MAX(zgam(i), xmax)
    645   ENDDO
    646   PRINT*, 'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
     612  PRINT*, 'OROGRAPHIE SOUS-MAILLE zgam:',minval(zgam(:)),maxval(zgam(:))
    647613
    648614  CALL get_field("ZTHE", zthe)
    649   xmin = 1.0E+20
    650   xmax = -1.0E+20
    651   DO i = 1, klon
    652      xmin = MIN(zthe(i), xmin)
    653      xmax = MAX(zthe(i), xmax)
    654   ENDDO
    655   PRINT*, 'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
     615  PRINT*, 'OROGRAPHIE SOUS-MAILLE zthe:',minval(zthe(:)),maxval(zthe(:))
    656616
    657617  CALL get_field("ZPIC", zpic)
    658   xmin = 1.0E+20
    659   xmax = -1.0E+20
    660   DO i = 1, klon
    661      xmin = MIN(zpic(i), xmin)
    662      xmax = MAX(zpic(i), xmax)
    663   ENDDO
    664   PRINT*, 'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
     618  PRINT*, 'OROGRAPHIE SOUS-MAILLE zpic:',minval(zpic(:)),maxval(zpic(:))
    665619
    666620  CALL get_field("ZVAL", zval)
    667   xmin = 1.0E+20
    668   xmax = -1.0E+20
    669   DO i = 1, klon
    670      xmin = MIN(zval(i), xmin)
    671      xmax = MAX(zval(i), xmax)
    672   ENDDO
    673   PRINT*, 'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
     621  PRINT*, 'OROGRAPHIE SOUS-MAILLE zval:',minval(zval(:)),maxval(zval(:))
    674622
    675623  CALL get_field("RUGSREL", rugoro)
    676   xmin = 1.0E+20
    677   xmax = -1.0E+20
    678   DO i = 1, klon
    679      xmin = MIN(rugoro(i), xmin)
    680      xmax = MAX(rugoro(i), xmax)
    681   ENDDO
    682   PRINT*, 'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
     624  PRINT*, 'Rugosite relief (ecart-type) rugsrel:',minval(rugoro(:)),maxval(rugoro(:))
    683625
    684626  ancien_ok = .TRUE.
    … …  
    718660     PRINT*, "Depart legerement fausse. Mais je continue"
    719661  ENDIF
    720   xmin = 1.0E+20
    721   xmax = -1.0E+20
    722   xmin = MINval(clwcon)
    723   xmax = MAXval(clwcon)
    724   PRINT*, 'Eau liquide convective (ecart-type) clwcon:', xmin, xmax
     662  PRINT*,'Eau liquide convective (ecart-type) clwcon:',MINval(clwcon),MAXval(clwcon)
     663
    725664
    726665  rnebcon = 0.
    … …  
    730669     PRINT*, "Depart legerement fausse. Mais je continue"
    731670  ENDIF
    732   xmin = 1.0E+20
    733   xmax = -1.0E+20
    734   xmin = MINval(rnebcon)
    735   xmax = MAXval(rnebcon)
    736   PRINT*, 'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax
     671  PRINT*, 'Nebulosite convective (ecart-type) rnebcon:',MINval(rnebcon),MAXval(rnebcon)
    737672
    738673  ! Lecture ratqs
    … …  
    744679     PRINT*, "Depart legerement fausse. Mais je continue"
    745680  ENDIF
    746   xmin = 1.0E+20
    747   xmax = -1.0E+20
    748   xmin = MINval(ratqs)
    749   xmax = MAXval(ratqs)
    750   PRINT*, '(ecart-type) ratqs:', xmin, xmax
     681  PRINT*, '(ecart-type) ratqs:', MINval(ratqs),MAXval(ratqs)
    751682
    752683  ! Lecture run_off_lic_0
    … …  
    758689     run_off_lic_0 = 0.
    759690  ENDIF
    760   xmin = 1.0E+20
    761   xmax = -1.0E+20
    762   xmin = MINval(run_off_lic_0)
    763   xmax = MAXval(run_off_lic_0)
    764   PRINT*, '(ecart-type) run_off_lic_0:', xmin, xmax
     691  PRINT*, '(ecart-type) run_off_lic_0:', MINval(run_off_lic_0),MAXval(run_off_lic_0)
    765692
    766693  ! Lecture de l'energie cinetique turbulente
    … …  
    778705           pbl_tke(:, :, nsrf)=1.e-8
    779706        ENDIF
    780         xmin = 1.0E+20
    781         xmax = -1.0E+20
    782         DO k = 1, klev+1
    783            DO i = 1, klon
    784               xmin = MIN(pbl_tke(i, k, nsrf), xmin)
    785               xmax = MAX(pbl_tke(i, k, nsrf), xmax)
    786            ENDDO
    787         ENDDO
    788         PRINT*, 'Turbulent kinetic energyl TKE**:', nsrf, xmin, xmax
     707        PRINT*, 'Turbulent kinetic energyl TKE**:', nsrf, minval(pbl_tke(:,:,nsrf)),maxval(pbl_tke(:,:, nsrf))
     708
    789709     ENDDO
    790710  ENDIF
    … …  
    806726        wake_delta_pbl_tke(:,:,nsrf)=0.
    807727      ENDIF
    808       xmin = 1.0E+20
    809       xmax = -1.0E+20
    810       DO k = 1, klev+1
    811         DO i = 1, klon
    812           xmin = MIN(wake_delta_pbl_tke(i,k,nsrf),xmin)
    813           xmax = MAX(wake_delta_pbl_tke(i,k,nsrf),xmax)
    814         ENDDO
    815       ENDDO
    816       PRINT*,'TKE difference (w)-(x) DELTATKE**:', nsrf, xmin, xmax
     728      PRINT*,'TKE difference (w)-(x) DELTATKE**:', nsrf,       &
     729      minval(wake_delta_pbl_tke(:,:,nsrf)),maxval(wake_delta_pbl_tke(:,:, nsrf))
     730
    817731    ENDDO
    818732
    … …  
    831745        delta_tsurf(:,nsrf)=0.
    832746     ELSE
    833         xmin = 1.0E+20
    834         xmax = -1.0E+20
    835          DO i = 1, klon
    836             xmin = MIN(delta_tsurf(i, nsrf), xmin)
    837             xmax = MAX(delta_tsurf(i, nsrf), xmax)
    838          ENDDO
    839         PRINT*, 'delta_tsurf:', xmin, xmax
     747        PRINT*, 'delta_tsurf:', nsrf,       &
     748      minval(delta_tsurf(:,nsrf)),maxval(delta_tsurf(:, nsrf))
    840749     ENDIF
    841750    ENDDO  ! nsrf = 1, nbsrf
    … …  
    849758     zmax0=40.
    850759  ENDIF
    851   xmin = 1.0E+20
    852   xmax = -1.0E+20
    853   xmin = MINval(zmax0)
    854   xmax = MAXval(zmax0)
    855   PRINT*, '(ecart-type) zmax0:', xmin, xmax
     760  PRINT*, '(ecart-type) zmax0:', MINval(zmax0),MAXval(zmax0)
    856761
    857762  !           f0(ig)=1.e-5
    … …  
    863768     f0=1.e-5
    864769  ENDIF
    865   xmin = 1.0E+20
    866   xmax = -1.0E+20
    867   xmin = MINval(f0)
    868   xmax = MAXval(f0)
    869   PRINT*, '(ecart-type) f0:', xmin, xmax
     770  PRINT*, '(ecart-type) f0:', MINval(f0),MAXval(f0)
    870771
    871772  ! sig1 or ema_work1
    … …  
    878779     sig1=0.
    879780  ELSE
    880      xmin = 1.0E+20
    881      xmax = -1.0E+20
    882      DO k = 1, klev
    883         DO i = 1, klon
    884            xmin = MIN(sig1(i, k), xmin)
    885            xmax = MAX(sig1(i, k), xmax)
    886         ENDDO
    887      ENDDO
    888      PRINT*, 'sig1:', xmin, xmax
     781     PRINT*, 'sig1:',minval(sig1(:,:)),maxval(sig1(:,:))
    889782  ENDIF
    890783
    … …  
    898791     w01=0.
    899792  ELSE
    900      xmin = 1.0E+20
    901      xmax = -1.0E+20
    902      DO k = 1, klev
    903         DO i = 1, klon
    904            xmin = MIN(w01(i, k), xmin)
    905            xmax = MAX(w01(i, k), xmax)
    906         ENDDO
    907      ENDDO
    908      PRINT*, 'w01:', xmin, xmax
     793     PRINT*, 'w01:', minval(w01(:,:)),maxval(w01(:,:))
    909794  ENDIF
    910795
    … …  
    917802     wake_deltat=0.
    918803  ELSE
    919      xmin = 1.0E+20
    920      xmax = -1.0E+20
    921      DO k = 1, klev
    922         DO i = 1, klon
    923            xmin = MIN(wake_deltat(i, k), xmin)
    924            xmax = MAX(wake_deltat(i, k), xmax)
    925         ENDDO
    926      ENDDO
    927      PRINT*, 'wake_deltat:', xmin, xmax
     804     PRINT*, 'wake_deltat:',  minval(wake_deltat(:,:)),maxval(wake_deltat(:,:))
    928805  ENDIF
    929806
    930807  ! wake_deltaq
    931808
    932   CALL get_field("WAKE_DELTAQ", wake_deltaq, found)
    933   IF (.NOT. found) THEN
    934      PRINT*, "phyetat0: Le champ <WAKE_DELTAQ> est absent"
    935      PRINT*, "Depart legerement fausse. Mais je continue"
    936      wake_deltaq=0.
    937   ELSE
    938      xmin = 1.0E+20
    939      xmax = -1.0E+20
    940      DO k = 1, klev
    941         DO i = 1, klon
    942            xmin = MIN(wake_deltaq(i, k), xmin)
    943            xmax = MAX(wake_deltaq(i, k), xmax)
    944         ENDDO
    945      ENDDO
    946      PRINT*, 'wake_deltaq:', xmin, xmax
    947   ENDIF
     809  found=phyetat0_get(klev,wake_deltaq,"WAKE_DELTAQ","Delta hum. wake/env",0.)
     810! CALL get_field("WAKE_DELTAQ", wake_deltaq, found)
     811! IF (.NOT. found) THEN
     812!    PRINT*, "phyetat0: Le champ <WAKE_DELTAQ> est absent"
     813!    PRINT*, "Depart legerement fausse. Mais je continue"
     814!    wake_deltaq=0.
     815! ELSE
     816!    PRINT*, 'wake_deltaq:',  minval(wake_deltaq(:,:)),maxval(wake_deltaq(:,:))
     817! ENDIF
    948818
    949819  ! wake_s
    … …  
    955825     wake_s=0.
    956826  ENDIF
    957   xmin = 1.0E+20
    958   xmax = -1.0E+20
    959   xmin = MINval(wake_s)
    960   xmax = MAXval(wake_s)
    961   PRINT*, '(ecart-type) wake_s:', xmin, xmax
     827  PRINT*, '(ecart-type) wake_s:', MINval(wake_s),MAXval(wake_s)
    962828
    963829  ! wake_cstar
    … …  
    969835     wake_cstar=0.
    970836  ENDIF
    971   xmin = 1.0E+20
    972   xmax = -1.0E+20
    973   xmin = MINval(wake_cstar)
    974   xmax = MAXval(wake_cstar)
    975   PRINT*, '(ecart-type) wake_cstar:', xmin, xmax
     837  PRINT*, '(ecart-type) wake_cstar:', MINval(wake_cstar),MAXval(wake_cstar)
    976838
    977839  ! wake_pe
    … …  
    11631025  ! Initialize module pbl_surface_mod
    11641026
    1165   CALL pbl_surface_init(qsol, fder, snow, qsurf, &
    1166        evap, frugs, agesno, tsoil)
     1027  CALL pbl_surface_init(fder, snow, qsurf, tsoil)
    11671028
    11681029  ! Initialize module ocean_cpl_mod for the case of coupled ocean
    … …  
    11771038
    11781039END SUBROUTINE phyetat0
     1040
     1041!===================================================================
     1042FUNCTION phyetat0_get(nlev,field,name,descr,default)
     1043!===================================================================
     1044! Lecture d'un champ avec contrôle
     1045! Function logique dont le resultat indique si la lecture
     1046! s'est bien passée
     1047! On donne une valeur par defaut dans le cas contraire
     1048!===================================================================
     1049
     1050USE iostart, ONLY : get_field
     1051USE dimphy, only: klon
     1052
     1053IMPLICIT NONE
     1054INCLUDE "iniprint.h"
     1055
     1056LOGICAL phyetat0_get
     1057
     1058! arguments
     1059INTEGER,INTENT(IN) :: nlev
     1060CHARACTER*(*),INTENT(IN) :: name,descr
     1061REAL,INTENT(IN) :: default
     1062REAL,DIMENSION(klon,nlev),INTENT(INOUT) :: field
     1063
     1064! Local variables
     1065LOGICAL found
     1066
     1067   CALL get_field(name, field, found)
     1068   IF (.NOT. found) THEN
     1069     WRITE(lunout,*) "phyetat0: Le champ <",name,"> est absent"
     1070     WRITE(lunout,*) "Depart legerement fausse. Mais je continue"
     1071     field(:,:)=default
     1072   ENDIF
     1073   WRITE(lunout,*) name, descr, MINval(field),MAXval(field)
     1074   phyetat0_get=found
     1075
     1076RETURN
     1077END FUNCTION phyetat0_get
     1078
     1079!================================================================
     1080FUNCTION phyetat0_srf(nlev,field,name,descr,default)
     1081!===================================================================
     1082! Lecture d'un champ par sous-surface avec contrôle
     1083! Function logique dont le resultat indique si la lecture
     1084! s'est bien passée
     1085! On donne une valeur par defaut dans le cas contraire
     1086!===================================================================
     1087
     1088USE iostart, ONLY : get_field
     1089USE dimphy, only: klon
     1090USE indice_sol_mod, only: nbsrf
     1091
     1092IMPLICIT NONE
     1093INCLUDE "iniprint.h"
     1094
     1095LOGICAL phyetat0_srf
     1096! arguments
     1097INTEGER,INTENT(IN) :: nlev
     1098CHARACTER*(*),INTENT(IN) :: name,descr
     1099REAL,INTENT(IN) :: default
     1100REAL,DIMENSION(klon,nlev,nbsrf),INTENT(INOUT) :: field
     1101
     1102! Local variables
     1103LOGICAL found,phyetat0_get
     1104INTEGER nsrf
     1105CHARACTER*2 str2
     1106 
     1107     IF (nbsrf.GT.99) THEN
     1108        WRITE(lunout,*) "Trop de sous-mailles"
     1109        call abort_gcm("phyetat0", "", 1)
     1110     ENDIF
     1111
     1112     DO nsrf = 1, nbsrf
     1113        WRITE(str2, '(i2.2)') nsrf
     1114        found= phyetat0_get(nlev,field(:,:, nsrf), &
     1115        name//str2,descr//" srf:"//str2,default)
     1116     ENDDO
     1117
     1118     phyetat0_srf=found
     1119
     1120RETURN
     1121END FUNCTION phyetat0_srf
     1122

  • LMDZ5/trunk/libf/phylmd/phyredem.F90

    r2241 r2243  
    3636  REAL tsoil(klon, nsoilmx, nbsrf)
    3737  REAL qsurf(klon, nbsrf)
    38   REAL qsol(klon)
    3938  REAL snow(klon, nbsrf)
    40   REAL evap(klon, nbsrf)
    4139  real fder(klon)
    42   REAL frugs(klon, nbsrf)
    43   REAL agesno(klon, nbsrf)
    4440  REAL run_off_lic_0(klon)
    4541  REAL trs(klon, nbtr)
    … …  
    6056  ! Get variables which will be written to restart file from module
    6157  ! pbl_surface_mod
    62   CALL pbl_surface_final(qsol, fder, snow, qsurf,  &
    63        evap, frugs, agesno, tsoil)
     58  CALL pbl_surface_final(fder, snow, qsurf,  tsoil)
    6459
    6560  ! Get a variable calculated in module fonte_neige_mod
    … …  
    191186        WRITE(str2, '(i2.2)') nsrf
    192187        CALL put_field("EVAP"//str2, "Evaporation de surface No."//str2 &
    193              , evap(:, nsrf))
     188             , fevap(:, nsrf))
    194189     ELSE
    195190        PRINT*, "Trop de sous-mailles"
    … …  
    226221     IF (nsrf.LE.99) THEN
    227222        WRITE(str2, '(i2.2)') nsrf
    228         CALL put_field("RUG"//str2, "rugosite de surface No."//str2, &
    229              frugs(:, nsrf))
     223        CALL put_field("Z0m"//str2, "rugosite de surface No."//str2, &
     224             z0m(:, nsrf))
     225        CALL put_field("Z0h"//str2, "rugosite de surface No."//str2, &
     226             z0h(:, nsrf))
    230227     ELSE
    231228        PRINT*, "Trop de sous-mailles"
    … …  
    269266
    270267  CALL put_field("VANCIEN", "", v_ancien)
    271 
    272   CALL put_field("RUGMER", "Longueur de rugosite sur mer", &
    273        frugs(:, is_oce))
    274268
    275269  CALL put_field("CLWCON", "Eau liquide convective", clwcon)

  • LMDZ5/trunk/libf/phylmd/phys_local_var_mod.F90

    r2194 r2243  
    239239      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cdragm, cdragh
    240240!$OMP THREADPRIVATE(cdragm, cdragh)
    241       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cldh, cldl, cldm, cldq, cldt, qsat2m, qsol
    242 !$OMP THREADPRIVATE(cldh, cldl, cldm, cldq, cldt, qsat2m, qsol)
     241      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cldh, cldl, cldm, cldq, cldt, qsat2m
     242!$OMP THREADPRIVATE(cldh, cldl, cldm, cldq, cldt, qsat2m )
    243243      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cldhjn, cldljn, cldmjn,cldtjn
    244244!$OMP THREADPRIVATE(cldhjn, cldljn, cldmjn, cldtjn)
    … …  
    265265      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfqcalving
    266266!$OMP THREADPRIVATE(zxfqcalving)
    267       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfluxlat, zxrugs, zxtsol, snow_lsc, zxfqfonte
    268 !$OMP THREADPRIVATE(zxfluxlat, zxrugs, zxtsol, snow_lsc, zxfqfonte)
     267      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfluxlat, zxtsol, snow_lsc, zxfqfonte
     268!$OMP THREADPRIVATE(zxfluxlat, zxtsol, snow_lsc, zxfqfonte)
    269269      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxqsurf, rain_lsc
    270270!$OMP THREADPRIVATE(zxqsurf, rain_lsc)
    … …  
    328328      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: fsolsw, wfbils, wfbilo
    329329!$OMP THREADPRIVATE(fsolsw, wfbils, wfbilo)
    330       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: t2m, fevap, fluxlat, fsollw,evap_pot
    331 !$OMP THREADPRIVATE(t2m, fevap, fluxlat, fsollw,evap_pot)
     330      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: t2m, fluxlat, fsollw,evap_pot
     331!$OMP THREADPRIVATE(t2m, fluxlat, fsollw,evap_pot)
    332332      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dnwd, dnwd0, upwd, omega
    333333!$OMP THREADPRIVATE(dnwd, dnwd0, upwd, omega)
    … …  
    343343      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: wake_omg, zx_rh
    344344!$OMP THREADPRIVATE(wake_omg, zx_rh)
    345       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: frugs, agesno
    346 !$OMP THREADPRIVATE(frugs, agesno)
    347345      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: pmflxr, pmflxs, prfl, psfl, fraca
    348346!$OMP THREADPRIVATE(pmflxr, pmflxs, prfl, psfl, fraca)
    … …  
    501499      ALLOCATE(ale_wake(klon), alp_wake(klon), bils(klon))
    502500      ALLOCATE(cdragm(klon), cdragh(klon), cldh(klon), cldl(klon))
    503       ALLOCATE(cldm(klon), cldq(klon), cldt(klon), qsat2m(klon), qsol(klon))
     501      ALLOCATE(cldm(klon), cldq(klon), cldt(klon), qsat2m(klon))
    504502      ALLOCATE(cldhjn(klon), cldljn(klon), cldmjn(klon), cldtjn(klon))
    505503      ALLOCATE(JrNt(klon))
    … …  
    516514      ALLOCATE(slab_wfbils(klon), tpot(klon), tpote(klon), ue(klon))
    517515      ALLOCATE(uq(klon), ve(klon), vq(klon), zxffonte(klon))
    518       ALLOCATE(zxfqcalving(klon), zxfluxlat(klon), zxrugs(klon))
     516      ALLOCATE(zxfqcalving(klon), zxfluxlat(klon))
    519517      ALLOCATE(zxtsol(klon), snow_lsc(klon), zxfqfonte(klon), zxqsurf(klon))
    520518      ALLOCATE(rain_lsc(klon))
    … …  
    557555      ALLOCATE(pmfd(klon, klev), pmfu(klon, klev))
    558556
    559       ALLOCATE(t2m(klon, nbsrf), fevap(klon, nbsrf), fluxlat(klon, nbsrf))
    560       ALLOCATE(frugs(klon, nbsrf), agesno(klon, nbsrf), fsollw(klon, nbsrf))
     557      ALLOCATE(t2m(klon, nbsrf), fluxlat(klon, nbsrf))
     558      ALLOCATE(fsollw(klon, nbsrf))
    561559      ALLOCATE(fsolsw(klon, nbsrf), wfbils(klon, nbsrf), wfbilo(klon, nbsrf))
    562560      ALLOCATE(evap_pot(klon, nbsrf))
    … …  
    701699      DEALLOCATE(ale_wake, alp_wake, bils)
    702700      DEALLOCATE(cdragm, cdragh, cldh, cldl)
    703       DEALLOCATE(cldm, cldq, cldt, qsat2m, qsol)
     701      DEALLOCATE(cldm, cldq, cldt, qsat2m)
    704702      DEALLOCATE(cldljn, cldmjn, cldhjn, cldtjn, JrNt)
    705703      DEALLOCATE(dthmin, evap, fder, plcl, plfc)
    … …  
    714712      DEALLOCATE(slab_wfbils, tpot, tpote, ue)
    715713      DEALLOCATE(uq, ve, vq, zxffonte)
    716       DEALLOCATE(zxfqcalving, zxfluxlat, zxrugs)
     714      DEALLOCATE(zxfqcalving, zxfluxlat)
    717715      DEALLOCATE(zxtsol, snow_lsc, zxfqfonte, zxqsurf)
    718716      DEALLOCATE(rain_lsc)
    … …  
    755753      DEALLOCATE(pmfd, pmfu)
    756754
    757       DEALLOCATE(t2m, fevap, fluxlat)
    758       DEALLOCATE(frugs, agesno, fsollw, evap_pot)
     755      DEALLOCATE(t2m, fluxlat)
     756      DEALLOCATE(fsollw, evap_pot)
    759757      DEALLOCATE(fsolsw, wfbils, wfbilo)
    760758

  • LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90

    r2240 r2243  
    779779  TYPE(ctrl_out), SAVE :: o_dtsvdfi = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    780780    'dtsvdfi', 'Boundary-layer dTs(g)', 'K/s', (/ ('', i=1, 9) /))
    781   TYPE(ctrl_out), SAVE :: o_rugs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    782     'rugs', 'rugosity', '-', (/ ('', i=1, 9) /))
     781  TYPE(ctrl_out), SAVE :: o_z0m = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     782    'z0m', 'roughness length, momentum', '-', (/ ('', i=1, 9) /))
     783  TYPE(ctrl_out), SAVE :: o_z0h = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     784    'z0h', 'roughness length, enthalpy', '-', (/ ('', i=1, 9) /))
    783785  TYPE(ctrl_out), SAVE :: o_topswad = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    784786    'topswad', 'ADE at TOA', 'W/m2', (/ ('', i=1, 9) /))
    … …  
    10241026      ctrl_out((/ 3, 10, 10, 10, 10, 10, 11, 11, 11 /),'snow_sic',"Snow", "kg/m2", (/ ('', i=1, 9) /)) /)
    10251027
    1026   TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_rugs_srf     = (/ &
    1027       ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'rugs_ter', "Surface roughness "//clnsurf(1),"m", (/ ('', i=1, 9) /)), &
    1028       ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'rugs_lic', "Surface roughness "//clnsurf(2),"m", (/ ('', i=1, 9) /)), &
    1029       ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'rugs_oce', "Surface roughness "//clnsurf(3),"m", (/ ('', i=1, 9) /)), &
    1030       ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'rugs_sic', "Surface roughness "//clnsurf(4),"m", (/ ('', i=1, 9) /)) /)
     1028  TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_z0m_srf     = (/ &
     1029      ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'z0m_ter', "Surface roughness "//clnsurf(1),"m", (/ ('', i=1, 9) /)), &
     1030      ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'z0m_lic', "Surface roughness "//clnsurf(2),"m", (/ ('', i=1, 9) /)), &
     1031      ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'z0m_oce', "Surface roughness "//clnsurf(3),"m", (/ ('', i=1, 9) /)), &
     1032      ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'z0m_sic', "Surface roughness "//clnsurf(4),"m", (/ ('', i=1, 9) /)) /)
     1033
     1034  TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_z0h_srf     = (/ &
     1035      ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'z0h_ter', "Surface roughness "//clnsurf(1),"m", (/ ('', i=1, 9) /)), &
     1036      ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'z0h_lic', "Surface roughness "//clnsurf(2),"m", (/ ('', i=1, 9) /)), &
     1037      ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'z0h_oce', "Surface roughness "//clnsurf(3),"m", (/ ('', i=1, 9) /)), &
     1038      ctrl_out((/ 3, 6, 10, 10, 10, 10, 11, 11, 11 /),'z0h_sic', "Surface roughness "//clnsurf(4),"m", (/ ('', i=1, 9) /)) /)
    10311039
    10321040  TYPE(ctrl_out), SAVE :: o_alb1 = ctrl_out((/ 3, 10, 10, 10, 10, 10, 11, 11, 11 /), &

  • LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90

    r2240 r2243  
    8888         o_SWdownOR, o_LWdownOR, o_snowl, &
    8989         o_solldown, o_dtsvdfo, o_dtsvdft, &
    90          o_dtsvdfg, o_dtsvdfi, o_rugs, o_od550aer, &
     90         o_dtsvdfg, o_dtsvdfi, o_z0m, o_z0h, o_od550aer, &
    9191         o_od865aer, o_absvisaer, o_od550lt1aer, &
    9292         o_sconcso4, o_sconcno3, o_sconcoa, o_sconcbc, &
    … …  
    113113         o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, &
    114114         o_rnebls, o_rhum, o_ozone, o_ozone_light, &
    115          o_dtphy, o_dqphy, o_albe_srf, o_rugs_srf, &
     115         o_dtphy, o_dqphy, o_albe_srf, o_z0m_srf, o_z0h_srf, &
    116116         o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, &
    117117         o_tke_max, o_kz, o_kz_max, o_clwcon, &
    … …  
    154154
    155155    USE phys_state_var_mod, only: pctsrf, paire_ter, rain_fall, snow_fall, &
     156         qsol, z0m, z0h, fevap, agesno, &
    156157         nday_rain, rain_con, snow_con, &
    157158         topsw, toplw, toplw0, swup, swdn, &
    … …  
    176177
    177178    USE phys_local_var_mod, only: zxfluxlat, slp, zxtsol, zt2m, &
    178          t2m_min_mon, t2m_max_mon, &
    179          zu10m, zv10m, zq2m, zustar, zxqsurf, qsol, &
    180          rain_lsc, snow_lsc, evap, bils, sens, fder, &
     179         t2m_min_mon, t2m_max_mon, evap, &
     180         zu10m, zv10m, zq2m, zustar, zxqsurf, &
     181         rain_lsc, snow_lsc, bils, sens, fder, &
    181182         zxffonte, zxfqcalving, zxfqfonte, fluxu, &
    182183         fluxv, zxsnow, qsnow, snowhgt, to_ice, &
    183184         sissnow, runoff, albsol3_lic, evap_pot, &
    184          t2m, fevap, fluxt, fluxlat, fsollw, fsolsw, &
     185         t2m, fluxt, fluxlat, fsollw, fsolsw, &
    185186         wfbils, wfbilo, cdragm, cdragh, cldl, cldm, &
    186187         cldh, cldt, JrNt, cldljn, cldmjn, cldhjn, &
    … …  
    197198         weak_inversion, dthmin, cldtau, cldemi, &
    198199         pmflxr, pmflxs, prfl, psfl, re, fl, rh2m, &
    199          qsat2m, tpote, tpot, d_ts, zxrugs, od550aer, &
     200         qsat2m, tpote, tpot, d_ts, od550aer, &
    200201         od865aer, absvisaer, od550lt1aer, sconcso4, sconcno3, &
    201202         sconcoa, sconcbc, sconcss, sconcdust, concso4, concno3, &
    … …  
    212213         ec550aer, flwc, fiwc, t_seri, theta, q_seri, &
    213214         ql_seri, zphi, u_seri, v_seri, omega, cldfra, &
    214          rneb, rnebjn, zx_rh, frugs, agesno, d_t_dyn, d_q_dyn, &
     215         rneb, rnebjn, zx_rh, d_t_dyn, d_q_dyn, &
    215216         d_u_dyn, d_v_dyn, d_t_con, d_t_ajsb, d_t_ajs, &
    216217         d_u_ajs, d_v_ajs, &
    … …  
    810811       CALL histwrite_phy(o_dtsvdfg,  d_ts(:,is_lic))
    811812       CALL histwrite_phy(o_dtsvdfi, d_ts(:,is_sic))
    812        CALL histwrite_phy(o_rugs, zxrugs)
     813       CALL histwrite_phy(o_z0m, z0m(:,nbsrf+1))
     814       CALL histwrite_phy(o_z0h, z0h(:,nbsrf+1))
    813815       ! OD550 per species
    814816!--OLIVIER
    … …  
    975977          IF (vars_defined) zx_tmp_fi2d(1 : klon) = falb1( 1 : klon, nsrf)
    976978          CALL histwrite_phy(o_albe_srf(nsrf), zx_tmp_fi2d)
    977           IF (vars_defined) zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
    978           CALL histwrite_phy(o_rugs_srf(nsrf), zx_tmp_fi2d)
     979          IF (vars_defined) zx_tmp_fi2d(1 : klon) = z0m( 1 : klon, nsrf)
     980          CALL histwrite_phy(o_z0m_srf(nsrf), zx_tmp_fi2d)
     981          IF (vars_defined) zx_tmp_fi2d(1 : klon) = z0h( 1 : klon, nsrf)
     982          CALL histwrite_phy(o_z0h_srf(nsrf), zx_tmp_fi2d)
    979983          IF (vars_defined) zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf)
    980984          CALL histwrite_phy(o_ages_srf(nsrf), zx_tmp_fi2d)

  • LMDZ5/trunk/libf/phylmd/phys_state_var_mod.F90

    r2240 r2243  
    2424      REAL, ALLOCATABLE, SAVE :: ftsol(:,:)
    2525!$OMP THREADPRIVATE(ftsol)
     26      REAL,ALLOCATABLE,SAVE :: qsol(:),fevap(:,:),z0m(:,:),z0h(:,:),agesno(:,:)
     27!$OMP THREADPRIVATE(qsol,fevap,z0m,z0h,agesno)
    2628!      character(len=6), SAVE :: ocean
    2729!!!!!!$OMP THREADPRIVATE(ocean)
    … …  
    418420      ALLOCATE(pctsrf(klon,nbsrf))
    419421      ALLOCATE(ftsol(klon,nbsrf))
     422      ALLOCATE(qsol(klon),fevap(klon,nbsrf))
     423      ALLOCATE(z0m(klon,nbsrf+1),z0h(klon,nbsrf+1),agesno(klon,nbsrf))
    420424      ALLOCATE(falb1(klon,nbsrf))
    421425      ALLOCATE(falb2(klon,nbsrf))
    … …  
    589593
    590594      deallocate(rlat, rlon, pctsrf, ftsol, falb1, falb2)
     595      deallocate(qsol,fevap,z0m,z0h,agesno)
    591596      deallocate(rain_fall, snow_fall, solsw, sollw, radsol)
    592597      deallocate(zmea, zstd, zsig, zgam)

  • LMDZ5/trunk/libf/phylmd/physiq.F90

    r2241 r2243  
    14131413  !
    14141414  CALL change_srf_frac(itap, dtime, days_elapsed+1,  &
    1415        pctsrf, falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke)
     1415       pctsrf, fevap, z0m, z0h, agesno,              &
     1416       falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke)
    14161417
    14171418  ! Update time and other variables in Reprobus
    … …  
    18061807  !   s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
    18071808  !   s_therm,   s_trmb1,   s_trmb2, s_trmb3,
    1808   !   zxrugs,    zu10m,     zv10m,   fder,
     1809  !   zu10m,     zv10m,   fder,
    18091810  !   zxqsurf,   rh2m,      zxfluxu, zxfluxv,
    18101811  !   frugs,     agesno,    fsollw,  fsolsw,
    … …  
    18831884          s_capCL,   s_oliqCL,  s_cteiCL,s_pblT, &
    18841885          s_therm,   s_trmb1,   s_trmb2, s_trmb3, &
    1885           zxrugs,    zustar, zu10m,     zv10m,   fder, &
     1886          zustar, zu10m,     zv10m,   fder, &
    18861887          zxqsurf,   rh2m,      zxfluxu, zxfluxv, &
    1887           frugs,     agesno,    fsollw,  fsolsw, &
     1888          z0m, z0h,     agesno,    fsollw,  fsolsw, &
    18881889          d_ts,      fevap,     fluxlat, t2m, &
    18891890          wfbils,    wfbilo,    fluxt,   fluxu,  fluxv, &

  • LMDZ5/trunk/libf/phylmd/screenc.F90

    r2232 r2243  
    44      SUBROUTINE screenc(klon, knon, nsrf, zxli, &
    55                         speed, temp, q_zref, zref, &
    6                          ts, qsurf, rugos, psol, &
     6                         ts, qsurf, z0m, z0h, psol, &
    77                         ustar, testar, qstar, okri, ri1, &
    88                         pref, delu, delte, delq)
    … …  
    3030! ts------input-R- temperature de l'air a la surface
    3131! qsurf---input-R- humidite relative a la surface
    32 ! rugos---input-R- rugosite
     32! z0m, z0h---input-R- rugosite
    3333! psol----input-R- pression au sol
    3434! ustar---input-R- facteur d'echelle pour le vent
    … …  
    4848      REAL, dimension(klon), intent(in) :: speed, temp, q_zref
    4949      REAL, intent(in) :: zref
    50       REAL, dimension(klon), intent(in) :: ts, qsurf, rugos, psol
     50      REAL, dimension(klon), intent(in) :: ts, qsurf, z0m, z0h, psol
    5151      REAL, dimension(klon), intent(in) :: ustar, testar, qstar, ri1         
    5252!
    … …  
    7575      CALL cdrag (knon, nsrf, &
    7676                    speed, temp, q_zref, gref, &
    77                     psol, ts, qsurf, rugos, &
     77                    psol, ts, qsurf, z0m, z0h, &
    7878                    cdram, cdrah, zri1, pref)
    7979      DO i = 1, knon

  • LMDZ5/trunk/libf/phylmd/stdlevvar.F90

    r2232 r2243  
    44      SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
    55                           u1, v1, t1, q1, z1, &
    6                            ts1, qsurf, rugos, psol, pat1, &
     6                           ts1, qsurf, z0m, z0h, psol, pat1, &
    77                           t_2m, q_2m, t_10m, q_10m, u_10m, ustar)
    88      IMPLICIT NONE
    … …  
    3232! ts1-----input-R- temperature de l'air a la surface
    3333! qsurf---input-R- humidite relative a la surface
    34 ! rugos---input-R- rugosite
     34! z0m, z0h---input-R- rugosite
    3535! psol----input-R- pression au sol
    3636! pat1----input-R- pression au 1er niveau du modele
    … …  
    4747      LOGICAL, intent(in) :: zxli
    4848      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1
    49       REAL, dimension(klon), intent(in) :: qsurf, rugos
     49      REAL, dimension(klon), intent(in) :: qsurf, z0m, z0h
    5050      REAL, dimension(klon), intent(in) :: psol, pat1
    5151!
    … …  
    103103! &                   cdram, cdrah, cdran, zri1, pref)           
    104104! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
     105
    105106      CALL cdrag(knon, nsrf, &
    106107 &                   speed, t1, q1, z1, &
    107  &                   psol, ts1, qsurf, rugos, &
     108 &                   psol, ts1, qsurf, z0m, z0h, &
    108109 &                   cdram, cdrah, zri1, pref)
    109110
    … …  
    139140      zref = 2.0
    140141      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
    141  &                 ts1, qsurf, rugos, lmon, &
     142 &                 ts1, qsurf, z0m, lmon, &
    142143 &                 ustar, testar, qstar, zref, &
    143144 &                 delu, delte, delq)
    … …  
    160161        CALL screenc(klon, knon, nsrf, zxli, &
    161162 &                   u_zref, temp, q_zref, zref, &
    162  &                   ts1, qsurf, rugos, psol, &           
     163 &                   ts1, qsurf, z0m, z0h, psol, &           
    163164 &                   ustar, testar, qstar, okri, ri1, &
    164165 &                   pref, delu, delte, delq)
    … …  
    241242      zref = 10.0
    242243      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
    243  &                 ts1, qsurf, rugos, lmon, &
     244 &                 ts1, qsurf, z0m, lmon, &
    244245 &                 ustar, testar, qstar, zref, &
    245246 &                 delu, delte, delq)
    … …  
    262263        CALL screenc(klon, knon, nsrf, zxli, &
    263264 &                   u_zref, temp, q_zref, zref, &
    264  &                   ts1, qsurf, rugos, psol, &
     265 &                   ts1, qsurf, z0m, z0h, psol, &
    265266 &                   ustar, testar, qstar, okri, ri1, &
    266267 &                   pref, delu, delte, delq)

  • LMDZ5/trunk/libf/phylmd/surf_land_mod.F90

    r2241 r2243  
    1717       lwdown_m, q2m, t2m, &
    1818       snow, qsol, agesno, tsoil, &
    19        z0_new, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &   
     19       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &   
    2020       qsurf, tsurf_new, dflux_s, dflux_l, &
    2121       flux_u1, flux_v1 )
    … …  
    7373! Output variables
    7474!****************************************************************************************
    75     REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
     75    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
    7676!albedo SB >>>
    7777!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new ! albdeo for shortwave interval 1(visible)
    … …  
    140140            evap, fluxsens, fluxlat, &             
    141141            tsol_rad, tsurf_new, alb1_new, alb2_new, &
    142             emis_new, z0_new, qsurf)       
     142            emis_new, z0m, qsurf)       
     143        z0h(1:knon)=z0m(1:knon) ! En attendant mieux
    143144
    144145! 
    … …  
    146147! 
    147148       DO i=1,knon
    148           z0_new(i) = MAX(1.5e-05,SQRT(z0_new(i)**2 + rugoro(i)**2))
     149          z0m(i) = MAX(1.5e-05,SQRT(z0m(i)**2 + rugoro(i)**2))
    149150       ENDDO
    150151
    … …  
    159160            u1, v1, gustiness, rugoro, swnet, lwnet, &
    160161            snow, qsol, agesno, tsoil, &
    161             qsurf, z0_new, alb1_new, alb2_new, evap, &
     162            qsurf, z0m, alb1_new, alb2_new, evap, &
    162163            fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
     164        z0h(1:knon)=z0m(1:knon) ! En attendant mieux
    163165
    164166    ENDIF ! ok_veget

  • LMDZ5/trunk/libf/phylmd/surf_landice_mod.F90

    r2241 r2243  
    1717       ps, u1, v1, gustiness, rugoro, pctsrf, &
    1818       snow, qsurf, qsol, agesno, &
    19        tsoil, z0_new, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, &
     19       tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, &
    2020       tsurf_new, dflux_s, dflux_l, &
    2121       slope, cloudf, &
    … …  
    7979!****************************************************************************************
    8080    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
    81     REAL, DIMENSION(klon), INTENT(OUT)            :: z0_new
     81    REAL, DIMENSION(klon), INTENT(OUT)            :: z0m, z0h
    8282!albedo SB >>>
    8383!    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1  ! new albedo in visible SW interval
    … …  
    191191            run_off_lic, evap, fluxsens, fluxlat, dflux_s, dflux_l, &       
    192192            tsurf_new, alb1, alb2, alb3, &
    193             emis_new, z0_new, qsurf)
     193            emis_new, z0m, qsurf)
     194       z0h(1:knon)=z0m(1:knon) ! en attendant mieux
    194195       
    195196       ! Suppose zero surface speed
    … …  
    287288!
    288289!****************************************************************************************
    289     z0_new(:) = MAX(1.E-3,rugoro(:))
     290    z0m=1.e-3
     291    z0h = z0m
     292    z0m = SQRT(z0m**2+rugoro**2)
     293
    290294    END IF ! ok_snow
    291295

  • LMDZ5/trunk/libf/phylmd/surf_ocean_mod.F90

    r2240 r2243  
    99!
    1010  SUBROUTINE surf_ocean(rlon, rlat, swnet, lwnet, alb1, &
    11        rugos, windsp, rmu0, fder, tsurf_in, &
     11       windsp, rmu0, fder, tsurf_in, &
    1212       itime, dtime, jour, knon, knindex, &
    1313       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
    … …  
    1616       ps, u1, v1, gustiness, rugoro, pctsrf, &
    1717       snow, qsurf, agesno, &
    18 !albedo SB >>>
    19 !      z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
    20        z0_new, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &
    21 !albedo SB <<<
     18       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &
    2219       tsurf_new, dflux_s, dflux_l, lmt_bils, &
    2320       flux_u1, flux_v1)
    … …  
    4946    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
    5047    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
    51     REAL, DIMENSION(klon), INTENT(IN)        :: rugos
    5248    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
    5349    REAL, DIMENSION(klon), INTENT(IN)        :: rmu0 
    … …  
    7470! Output variables
    7571!****************************************************************************************
    76     REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
     72    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
    7773!albedo SB >>>
    7874!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
    … …  
    188184!
    189185!****************************************************************************************
     186IF (iflag_z0_oce==0) THEN
    190187    DO i = 1, knon
    191188       tmp = MAX(cepdu2,u1(i)**2+v1(i)**2)
    192        z0_new(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
     189       z0m(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
    193190            +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
    194        z0_new(i) = MAX(1.5e-05,z0_new(i))
     191       z0m(i) = MAX(1.5e-05,z0m(i))
    195192    ENDDO   
     193    z0h(1:knon)=z0m(1:knon) ! En attendant mieux
     194
     195ELSE
     196       STOP'Alina, au boulot :)'
     197ENDIF
    196198!
    197199!****************************************************************************************

  • LMDZ5/trunk/libf/phylmd/surf_seaice_mod.F90

    r2240 r2243  
    1919       ps, u1, v1, gustiness, rugoro, pctsrf, &
    2020       snow, qsurf, qsol, agesno, tsoil, &
    21 !albedo SB >>>
    22 !      z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
    23        z0_new, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, & 
    24 !albedo SB <<<
     21       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, & 
    2522       tsurf_new, dflux_s, dflux_l, &
    2623       flux_u1, flux_v1)
    … …  
    7269! Output arguments
    7370!****************************************************************************************
    74     REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
     71    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
    7572!albedo SB >>>
    7673!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
    … …  
    150147!
    151148!****************************************************************************************
    152     z0_new = 0.002
    153     z0_new = SQRT(z0_new**2+rugoro**2)
    154149
     150    z0m=z0m_seaice
     151    z0h = z0h_seaice
    155152
    156153!albedo SB >>>
Note: See TracChangeset for help on using the changeset viewer.