Ignore:
Timestamp:
Jun 14, 2015, 9:13:32 PM (9 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes -r2237:2291 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phylmd/pbl_surface_mod.F90

    r2258 r2298  
    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
    … …  
    174144       zsig,      lwdown_m,  pphi,     cldt,          &
    175145       rain_f,    snow_f,    solsw_m,  sollw_m,       &
     146       gustiness,                                     &
    176147       t,         q,         u,        v,             &
    177148!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
    … …  
    181152!!!
    182153       pplay,     paprs,     pctsrf,                  &
    183 !albedo SB >>>
    184 !       ts,        alb1, alb2,ustar, u10m, v10m,wstar, &
    185154       ts,SFRWL,   alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
    186 !albedo SB <<<
    187155       cdragh,    cdragm,   zu1,    zv1,              &
    188 !albedo SB >>>
    189 !       alb1_m,    alb2_m,    zxsens,   zxevap,        &
    190156       alb_dir_m,    alb_dif_m,  zxsens,   zxevap,    &
    191 !albedo SB <<<
    192157       alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
    193158       zxtsol,    zxfluxlat, zt2m,     qsat2m,        &
    … …  
    204169!!!
    205170       zcoefh,    zcoefm,    slab_wfbils,             &
    206        qsol_d,    zq2m,      s_pblh,   s_plcl,        &
     171       qsol,    zq2m,      s_pblh,   s_plcl,        &
    207172!!!
    208173!!! jyg le 08/02/2012
    … …  
    211176       s_capCL,   s_oliqCL,  s_cteiCL, s_pblT,        &
    212177       s_therm,   s_trmb1,   s_trmb2,  s_trmb3,       &
    213        zxrugs,zustar,zu10m,  zv10m,    fder_print,    &
     178       zustar,zu10m,  zv10m,    fder_print,    &
    214179       zxqsurf,   rh2m,      zxfluxu,  zxfluxv,       &
    215        rugos_d,   agesno_d,  sollw,    solsw,         &
    216        d_ts,      evap_d,    fluxlat,  t2m,           &
     180       z0m, z0h,   agesno,  sollw,    solsw,         &
     181       d_ts,      evap,    fluxlat,  t2m,           &
    217182       wfbils,    wfbilo,    flux_t,   flux_u, flux_v,&
    218183       dflux_t,   dflux_q,   zxsnow,                  &
    … …  
    263228! pplay----input-R- pression au milieu de couche (Pa)
    264229! rlat-----input-R- latitude en degree
    265 ! rugos----input-R- longeur de rugosite (en m)
     230! z0m, z0h ----input-R- longeur de rugosite (en m)
    266231! Martin
    267232! zsig-----input-R- slope
    … …  
    334299    REAL, DIMENSION(klon),        INTENT(IN)        :: zsig    ! slope
    335300    REAL, DIMENSION(klon),        INTENT(IN)        :: lwdown_m ! downward longwave radiation at mean s   
     301    REAL, DIMENSION(klon),        INTENT(IN)        :: gustiness ! gustiness
     302
    336303    REAL, DIMENSION(klon),        INTENT(IN)        :: cldt    ! total cloud fraction
    337304    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: pphi    ! geopotential (m2/s2)
    … …  
    356323                                                                   !wake and off-wake regions
    357324!albedo SB >>>
    358 !    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb1    ! albedo in visible SW interval
    359 !    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb2    ! albedo in near infra-red SW interval
    360325    REAL, DIMENSIOn(6),intent(in) :: SFRWL
    361326    REAL, DIMENSION(klon, nsw, nbsrf), INTENT(INOUT)     :: alb_dir,alb_dif
    … …  
    382347    REAL, DIMENSION(klon),        INTENT(OUT)       :: zv1        ! v wind speed in first layer
    383348!albedo SB >>>
    384 !    REAL, DIMENSION(klon),        INTENT(OUT)       :: alb1_m     ! mean albedo
    385 !    in visible SW interval
    386 !    REAL, DIMENSION(klon),        INTENT(OUT)       :: alb2_m     ! mean albedo
    387 !    in near IR SW interval
    388349    REAL, DIMENSION(klon, nsw),        INTENT(OUT)       :: alb_dir_m,alb_dif_m
    389350!albedo SB <<<
    … …  
    434395!!!
    435396    REAL, DIMENSION(klon),        INTENT(OUT)       :: slab_wfbils! heat balance at surface only for slab at ocean points
    436     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)
    437398    REAL, DIMENSION(klon),        INTENT(OUT)       :: zq2m       ! water vapour at 2m, mean for each grid point
    438399    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_pblh     ! height of the planetary boundary layer(HPBL)
    … …  
    454415    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_trmb2    ! inhibition, mean for each grid point
    455416    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_trmb3    ! point Omega, mean for each grid point
    456     REAL, DIMENSION(klon),        INTENT(OUT)       :: zxrugs     ! rugosity at surface (m), mean for each grid point
    457417    REAL, DIMENSION(klon),        INTENT(OUT)       :: zustar     ! u*
    458418    REAL, DIMENSION(klon),        INTENT(OUT)       :: zu10m      ! u speed at 10m, mean for each grid point
    … …  
    463423    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxu    ! u wind tension, mean for each grid point
    464424    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxv    ! v wind tension, mean for each grid point
    465     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: rugos_d    ! rugosity length (m)
    466     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
    467427    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: solsw      ! net shortwave radiation at surface
    468428    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: sollw      ! net longwave radiation at surface
    469429    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: d_ts       ! change in temperature at surface
    470     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: evap_d     ! evaporation at surface
     430    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)       :: evap     ! evaporation at surface
    471431    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: fluxlat    ! latent flux
    472432    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: t2m        ! temperature at 2 meter height
    … …  
    519479    REAL                               :: f1 ! fraction de longeurs visibles parmi tout SW intervalle
    520480    REAL, DIMENSION(klon)              :: r_co2_ppm     ! taux CO2 atmosphere
    521     REAL, DIMENSION(klon)              :: yts, yrugos, ypct, yz0_new
     481    REAL, DIMENSION(klon)              :: yts, yz0m, yz0h, ypct
    522482!albedo SB >>>
    523 !   REAL, DIMENSION(klon)              :: yalb, yalb1, yalb2
    524483    REAL, DIMENSION(klon)              :: yalb,yalb_vis
    525484!albedo SB <<<
    … …  
    559518    REAL, DIMENSION(klon)              :: AcoefU, AcoefV, BcoefU, BcoefV
    560519    REAL, DIMENSION(klon)              :: ypsref
    561     REAL, DIMENSION(klon)              :: yevap, ytsurf_new, yalb1_new, yalb2_new, yalb3_new
     520    REAL, DIMENSION(klon)              :: yevap, ytsurf_new, yalb3_new
    562521!albedo SB >>>
    563522    REAL, DIMENSION(klon,nsw)          :: yalb_dir_new, yalb_dif_new
    … …  
    795754    REAL, DIMENSION(klon, nbsrf)       :: alb          ! mean albedo for whole SW interval
    796755    REAL, DIMENSION(klon)              :: ylwdown      ! jg : temporary (ysollwdown)
     756    REAL, DIMENSION(klon)              :: ygustiness      ! jg : temporary (ysollwdown)
    797757
    798758    REAL                               :: zx_qs1, zcor1, zdelta1
    … …  
    823783
    824784    IF (first_call) THEN
     785       print*,'PBL SURFACE AVEC GUSTINESS'
    825786       first_call=.FALSE.
    826787     
    … …  
    877838 zu1(:)=0. ; zv1(:)=0.
    878839!albedo SB >>>
    879 ! alb1_m(:)=0. ; alb2_m(:)=0. ; alb3_lic(:)=0.
    880840  alb_dir_m=0. ; alb_dif_m=0. ; alb3_lic(:)=0.
    881841!albedo SB <<<
    … …  
    890850 kh(:)=0. ; kh_x(:)=0. ; kh_w(:)=0.
    891851 slab_wfbils(:)=0.
    892  qsol_d(:)=0.
    893852 s_pblh(:)=0. ; s_pblh_x(:)=0. ; s_pblh_w(:)=0.
    894853 s_plcl(:)=0. ; s_plcl_x(:)=0. ; s_plcl_w(:)=0.
    … …  
    896855 s_therm(:)=0.
    897856 s_trmb1(:)=0. ; s_trmb2(:)=0. ; s_trmb3(:)=0.
    898  zxrugs(:)=0. ; zustar(:)=0.
     857 zustar(:)=0.
    899858 zu10m(:)=0. ; zv10m(:)=0.
    900859 fder_print(:)=0.
    901860 zxqsurf(:)=0.
    902861 zxfluxu(:,:)=0. ; zxfluxv(:,:)=0.
    903  rugos_d(:,:)=0. ; agesno_d(:,:)=0.
    904862 solsw(:,:)=0. ; sollw(:,:)=0.
    905863 d_ts(:,:)=0.
    906  evap_d(:,:)=0.
     864 evap(:,:)=0.
    907865 fluxlat(:,:)=0.
    908866 wfbils(:,:)=0. ; wfbilo(:,:)=0.
    … …  
    943901!!    cdragh = 0.0  ; cdragm = 0.0     ; dflux_t = 0.0   ; dflux_q = 0.0
    944902    ypct = 0.0    ; yts = 0.0        ; ysnow = 0.0
    945 !!    zv1 = 0.0     ; yqsurf = 0.0     ; yalb1 = 0.0     ; yalb2 = 0.0   
     903!!    zv1 = 0.0     ; yqsurf = 0.0
    946904!albedo SB >>>
    947 !    yqsurf = 0.0  ; yalb1 = 0.0      ; yalb2 = 0.0   
    948905    yqsurf = 0.0  ; yalb = 0.0 ; yalb_vis = 0.0
    949906!albedo SB <<<
    950907    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0   
    951     ysollw = 0.0  ; yrugos = 0.0     ; yu1 = 0.0   
     908    ysollw = 0.0  ; yz0m = 0.0 ; yz0h = 0.0    ; yu1 = 0.0   
    952909    yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0
    953910    ydelp = 0.0   ; yu = 0.0         ; yv = 0.0        ; yt = 0.0         
    … …  
    10771034!****************************************************************************************
    10781035
    1079     zxrugs(:) = 0.0
    10801036    DO nsrf = 1, nbsrf
    10811037       DO i = 1, klon
    1082           rugos(i,nsrf) = MAX(rugos(i,nsrf),0.000015)
    1083           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)
    10841040       ENDDO
    10851041    ENDDO
    … …  
    10871043! Mean calculations of albedo
    10881044!
    1089 ! Albedo at sub-surface
    1090 ! * alb1 : albedo in visible SW interval
    1091 ! * alb2 : albedo in near infrared SW interval
    10921045! * alb  : mean albedo for whole SW interval
    10931046!
    10941047! Mean albedo for grid point
    1095 ! * alb1_m : albedo in visible SW interval
    1096 ! * alb2_m : albedo in near infrared SW interval
    10971048! * alb_m  : mean albedo at whole SW interval
    1098 
    1099 !albedo SB >>>
    1100 !    alb1_m(:) = 0.0
    1101 !    alb2_m(:) = 0.0
    1102 !    DO nsrf = 1, nbsrf
    1103 !       DO i = 1, klon
    1104 !          alb1_m(i) = alb1_m(i) + alb1(i,nsrf) * pctsrf(i,nsrf)
    1105 !          alb2_m(i) = alb2_m(i) + alb2(i,nsrf) * pctsrf(i,nsrf)
    1106 !       ENDDO
    1107 !    ENDDO
    11081049
    11091050    alb_dir_m(:,:) = 0.0
    … …  
    11231064!    f1 = 1    ! put f1=1 to recreate old calculations
    11241065
    1125 !    DO nsrf = 1, nbsrf
    1126 !       DO i = 1, klon
    1127 !          alb(i,nsrf) = f1*alb1(i,nsrf) + (1-f1)*alb2(i,nsrf)
    1128 !       ENDDO
    1129 !    ENDDO
    1130 !
    1131 !    DO i = 1, klon
    1132 !       alb_m(i) = f1*alb1_m(i) + (1-f1)*alb2_m(i)
    1133 !    END DO
    1134 
    1135 
    11361066!f1 is already included with SFRWL values in each surf files
    11371067    alb=0.0
    … …  
    11771107       ENDDO
    11781108    ENDDO
    1179 
    11801109
    11811110!****************************************************************************************
    … …  
    12311160          yalb(j)    = alb(i,nsrf)
    12321161!albedo SB >>>
    1233 !         yalb1(j)   = alb1(i,nsrf)
    1234 !         yalb2(j)   = alb2(i,nsrf)
    12351162          yalb_vis(j) = alb_dir(i,1,nsrf)
    12361163          if(nsw==6)then
    … …  
    12441171          yfder(j)   = fder(i)
    12451172          ylwdown(j) = lwdown_m(i)
     1173          ygustiness(j) = gustiness(i)
    12461174          ysolsw(j)  = solsw(i,nsrf)
    12471175          ysollw(j)  = sollw(i,nsrf)
    1248           yrugos(j)  = rugos(i,nsrf)
     1176          yz0m(j)  = z0m(i,nsrf)
     1177          yz0h(j)  = z0h(i,nsrf)
    12491178          yrugoro(j) = rugoro(i)
    12501179          yu1(j)     = u(i,1)
    … …  
    13771306        CALL cdrag(knon, nsrf, &
    13781307            speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1),&
    1379             yts, yqsurf, yrugos, &
     1308            yts, yqsurf, yz0m, yz0h, &
    13801309            ycdragm, ycdragh, zri1, pref )
    13811310
    … …  
    14081337        CALL cdrag(knon, nsrf, &
    14091338            speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),&
    1410             yts_x, yqsurf, yrugos, &
     1339            yts_x, yqsurf, yz0m, yz0h, &
    14111340            ycdragm_x, ycdragh_x, zri1_x, pref_x )
    14121341
    … …  
    14221351        IF (prt_level >=10) print *,'clcdrag -> ycdragh_x ', ycdragh_x
    14231352!
    1424         CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
    1425             yu_w(:,1), yv_w(:,1), yt_w(:,1), yq_w(:,1), &
    1426             yts_w, yqsurf, yrugos, &
    1427             ycdragm_w, ycdragh_w )
     1353! Faire disparaitre les lignes commentees fin 2015 (le temps des tests)
     1354!        CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
     1355!            yu_w(:,1), yv_w(:,1), yt_w(:,1), yq_w(:,1), &
     1356!            yts_w, yqsurf, yz0m, &
     1357!            ycdragm_w, ycdragh_w )
     1358! Fuxing WANG, 04/03/2015, replace the clcdrag by the merged version: cdrag
     1359        DO i = 1, knon
     1360           zgeo1_w(i) = RD * yt_w(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
     1361                * (ypaprs(i,1)-ypplay(i,1))
     1362           speed_w(i) = SQRT(yu_w(i,1)**2+yv_w(i,1)**2)
     1363        END DO
     1364        CALL cdrag(knon, nsrf, &
     1365            speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),&
     1366            yts_w, yqsurf, yz0m, yz0h, &
     1367            ycdragm_w, ycdragh_w, zri1_w, pref_w )
     1368
    14281369! --- special Dice. JYG+MPL 25112013
    14291370        IF (ok_prescr_ust) then
    … …  
    14561397      print *,' args coef_diff_turb: yt ',  yt 
    14571398      print *,' args coef_diff_turb: yts ', yts 
    1458       print *,' args coef_diff_turb: yrugos ', yrugos 
     1399      print *,' args coef_diff_turb: yz0m ', yz0m 
    14591400      print *,' args coef_diff_turb: yqsurf ', yqsurf 
    14601401      print *,' args coef_diff_turb: ycdragm ', ycdragm
    … …  
    14631404       ENDIF
    14641405        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
    1465             ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, ycdragm, &
     1406            ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
    14661407            ycoefm, ycoefh, ytke)
    14671408       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
    … …  
    14841425      print *,' args coef_diff_turb: yt_x ',  yt_x 
    14851426      print *,' args coef_diff_turb: yts_x ', yts_x 
    1486       print *,' args coef_diff_turb: yrugos ', yrugos 
    14871427      print *,' args coef_diff_turb: yqsurf ', yqsurf 
    14881428      print *,' args coef_diff_turb: ycdragm_x ', ycdragm_x
    … …  
    14911431       ENDIF
    14921432        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
    1493             ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yrugos, yqsurf, ycdragm_x, &
     1433            ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yqsurf, ycdragm_x, &
    14941434            ycoefm_x, ycoefh_x, ytke_x)
    14951435       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
    … …  
    15111451      print *,' args coef_diff_turb: yt_w ',  yt_w 
    15121452      print *,' args coef_diff_turb: yts_w ', yts_w 
    1513       print *,' args coef_diff_turb: yrugos ', yrugos 
    15141453      print *,' args coef_diff_turb: yqsurf ', yqsurf 
    15151454      print *,' args coef_diff_turb: ycdragm_w ', ycdragm_w
    … …  
    15181457       ENDIF
    15191458        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
    1520             ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yrugos, yqsurf, ycdragm_w, &
     1459            ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yqsurf, ycdragm_w, &
    15211460            ycoefm_w, ycoefh_w, ytke_w)
    15221461       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
    … …  
    17791718          CALL stdlevvar(klon, knon, is_ter, zxli, &
    17801719               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
    1781                yts, yqsurf, yrugos, ypaprs(:,1), ypplay(:,1), &
     1720               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
    17821721               yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
    17831722         
    … …  
    18011740               AcoefH, AcoefQ, BcoefH, BcoefQ, &
    18021741               AcoefU, AcoefV, BcoefU, BcoefV, &
    1803                ypsref, yu1, yv1, yrugoro, pctsrf, &
     1742               ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
    18041743               ylwdown, yq2m, yt2m, &
    18051744               ysnow, yqsol, yagesno, ytsoil, &
    1806 !albedo SB >>>
    1807 !              yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
    1808                yz0_new, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
    1809 !albedo SB <<<
     1745               yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
    18101746               yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
    18111747               y_flux_u1, y_flux_v1 )
    … …  
    18181754!         ytsoil(:,:)=300.
    18191755!         yz0_new(:)=0.001
    1820 !         yalb1_new(:)=0.22
    1821 !         yalb2_new(:)=0.22
    18221756!         yevap(:)=flat/RLVTT
    18231757!         yfluxlat(:)=-flat
    … …  
    18411775               AcoefH, AcoefQ, BcoefH, BcoefQ, &
    18421776               AcoefU, AcoefV, BcoefU, BcoefV, &
    1843                ypsref, yu1, yv1, yrugoro, pctsrf, &
     1777               ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
    18441778               ysnow, yqsurf, yqsol, yagesno, &
    1845 !albedo SB >>>
    1846 !              ytsoil, yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
    1847                ytsoil, yz0_new, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
    1848 !albedo SB <<<
     1779               ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
    18491780               ytsurf_new, y_dflux_t, y_dflux_q, &
    18501781               yzsig, ycldt, &
    … …  
    18521783               yalb3_new, yrunoff, &
    18531784               y_flux_u1, y_flux_v1)
    1854           !CALL surf_landice(itap, dtime, knon, ni, &
    1855           !     ysolsw, ysollw, yts, ypplay(:,1), &
    1856           !     ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    1857           !     AcoefH, AcoefQ, BcoefH, BcoefQ, &
    1858           !     AcoefU, AcoefV, BcoefU, BcoefV, &
    1859           !     ypsref, yu1, yv1, yrugoro, pctsrf, &
    1860           !     ysnow, yqsurf, yqsol, yagesno, &
    1861           !     ytsoil, yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
    1862           !     ytsurf_new, y_dflux_t, y_dflux_q, &
    1863           !     y_flux_u1, y_flux_v1)
    18641785
    18651786!jyg<
    … …  
    18781799         
    18791800       CASE(is_oce)
    1880 !albedo SB >>>
    1881 !          CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb1, &
    18821801           CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb_vis, &
    1883 !albedo SB <<<
    1884                yrugos, ywindsp, rmu0, yfder, yts, &
     1802               ywindsp, rmu0, yfder, yts, &
    18851803               itap, dtime, jour, knon, ni, &
    1886                ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     1804               ypplay(:,1), zgeo1/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    18871805               AcoefH, AcoefQ, BcoefH, BcoefQ, &
    18881806               AcoefU, AcoefV, BcoefU, BcoefV, &
    1889                ypsref, yu1, yv1, yrugoro, pctsrf, &
     1807               ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
    18901808               ysnow, yqsurf, yagesno, &
    1891 !albedo SB >>>
    1892 !              yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
    1893                yz0_new, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
    1894 !albedo SB <<<
     1809               yz0m, yz0h, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
    18951810               ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
    18961811               y_flux_u1, y_flux_v1)
    … …  
    19141829          CALL surf_seaice( &
    19151830!albedo SB >>>
    1916 !               rlon, rlat, ysolsw, ysollw, yalb1, yfder, &
    19171831               rlon, rlat, ysolsw, ysollw, yalb_vis, yfder, &
    19181832!albedo SB <<<
    … …  
    19221836               AcoefH, AcoefQ, BcoefH, BcoefQ, &
    19231837               AcoefU, AcoefV, BcoefU, BcoefV, &
    1924                ypsref, yu1, yv1, yrugoro, pctsrf, &
     1838               ypsref, yu1, yv1, ygustiness, pctsrf, &
    19251839               ysnow, yqsurf, yqsol, yagesno, ytsoil, &
    19261840!albedo SB >>>
    1927 !               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
    1928                yz0_new, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
     1841               yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
    19291842!albedo SB <<<
    19301843               ytsurf_new, y_dflux_t, y_dflux_q, &
    … …  
    22982211          d_ts(i,nsrf) = y_d_ts(j)
    22992212!albedo SB >>>
    2300 !          alb1(i,nsrf) = yalb1_new(j) 
    2301 !          alb2(i,nsrf) = yalb2_new(j)
    23022213          do k=1,nsw
    23032214          alb_dir(i,k,nsrf) = yalb_dir_new(j,k)
    … …  
    23072218          snow(i,nsrf) = ysnow(j) 
    23082219          qsurf(i,nsrf) = yqsurf(j)
    2309           rugos(i,nsrf) = yz0_new(j)
     2220          z0m(i,nsrf) = yz0m(j)
     2221          z0h(i,nsrf) = yz0h(j)
    23102222          fluxlat(i,nsrf) = yfluxlat(j)
    23112223          agesno(i,nsrf) = yagesno(j) 
    … …  
    25192431       DO j=1, knon
    25202432          i = ni(j)
    2521           rugo1(j) = yrugos(j)
     2433          rugo1(j) = yz0m(j)
    25222434          IF(nsrf.EQ.is_oce) THEN
    2523              rugo1(j) = rugos(i,nsrf)
     2435             rugo1(j) = z0m(i,nsrf)
    25242436          ENDIF
    25252437          psfce(j)=ypaprs(j,1)
    … …  
    25362448        CALL stdlevvar(klon, knon, nsrf, zxli, &
    25372449            uzon, vmer, tair1, qair1, zgeo1, &
    2538             tairsol, qairsol, rugo1, psfce, patm, &
     2450            tairsol, qairsol, rugo1, rugo1, psfce, patm, &
    25392451            yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
    25402452       ELSE  !(iflag_split .eq.0)
    25412453        CALL stdlevvar(klon, knon, nsrf, zxli, &
    25422454            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
    2543             tairsol_x, qairsol, rugo1, psfce, patm, &
     2455            tairsol_x, qairsol, rugo1, rugo1, psfce, patm, &
    25442456            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x)
    25452457        CALL stdlevvar(klon, knon, nsrf, zxli, &
    25462458            uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
    2547             tairsol_w, qairsol, rugo1, psfce, patm, &
     2459            tairsol_w, qairsol, rugo1, rugo1, psfce, patm, &
    25482460            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
    25492461!!!
    … …  
    27712683!****************************************************************************************
    27722684   
     2685    z0m(:,nbsrf+1) = 0.0
     2686    z0h(:,nbsrf+1) = 0.0
     2687    DO nsrf = 1, nbsrf
     2688       DO i = 1, klon
     2689          z0m(i,nbsrf+1) = z0m(i,nbsrf+1) + z0m(i,nsrf)*pctsrf(i,nsrf)
     2690          z0h(i,nbsrf+1) = z0h(i,nbsrf+1) + z0h(i,nsrf)*pctsrf(i,nsrf)
     2691       ENDDO
     2692    ENDDO
     2693
    27732694!   print*,'OK pbl 7'
    27742695    zxfluxt(:,:) = 0.0 ; zxfluxq(:,:) = 0.0
    … …  
    29872908    zv1(:) = v(:,1)
    29882909
    2989 ! Some of the module declared variables are returned for printing in physiq.F
    2990     qsol_d(:)     = qsol(:)
    2991     evap_d(:,:)   = evap(:,:)
    2992     rugos_d(:,:)  = rugos(:,:)
    2993     agesno_d(:,:) = agesno(:,:)
    2994 
    29952910
    29962911  END SUBROUTINE pbl_surface
    … …  
    29982913!****************************************************************************************
    29992914!
    3000   SUBROUTINE pbl_surface_final(qsol_rst, fder_rst, snow_rst, qsurf_rst, &
    3001        evap_rst, rugos_rst, agesno_rst, ftsoil_rst)
     2915  SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst)
    30022916
    30032917    USE indice_sol_mod
    … …  
    30072921! Ouput variables
    30082922!****************************************************************************************
    3009     REAL, DIMENSION(klon), INTENT(OUT)                 :: qsol_rst
    30102923    REAL, DIMENSION(klon), INTENT(OUT)                 :: fder_rst
    30112924    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: snow_rst
    30122925    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: qsurf_rst
    3013     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: evap_rst
    3014     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: rugos_rst
    3015     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: agesno_rst
    30162926    REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(OUT) :: ftsoil_rst
    30172927
    … …  
    30212931!
    30222932!****************************************************************************************   
    3023     qsol_rst(:)       = qsol(:)
    30242933    fder_rst(:)       = fder(:)
    30252934    snow_rst(:,:)     = snow(:,:)
    30262935    qsurf_rst(:,:)    = qsurf(:,:)
    3027     evap_rst(:,:)     = evap(:,:)
    3028     rugos_rst(:,:)    = rugos(:,:)
    3029     agesno_rst(:,:)   = agesno(:,:)
    30302936    ftsoil_rst(:,:,:) = ftsoil(:,:,:)
    30312937
    … …  
    30352941!****************************************************************************************
    30362942!   DEALLOCATE(qsol, fder, snow, qsurf, evap, rugos, agesno, ftsoil)
    3037     IF (ALLOCATED(qsol)) DEALLOCATE(qsol)
    30382943    IF (ALLOCATED(fder)) DEALLOCATE(fder)
    30392944    IF (ALLOCATED(snow)) DEALLOCATE(snow)
    30402945    IF (ALLOCATED(qsurf)) DEALLOCATE(qsurf)
    3041     IF (ALLOCATED(evap)) DEALLOCATE(evap)
    3042     IF (ALLOCATED(rugos)) DEALLOCATE(rugos)
    3043     IF (ALLOCATED(agesno)) DEALLOCATE(agesno)
    30442946    IF (ALLOCATED(ftsoil)) DEALLOCATE(ftsoil)
    30452947
    … …  
    30502952
    30512953!albedo SB >>>
    3052 !  SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf, alb1, alb2, ustar, u10m, v10m, tke)
    3053 SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke) 
     2954SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, &
     2955     evap, z0m, z0h, agesno,                                  &
     2956     tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke) 
    30542957!albedo SB <<<
    30552958    ! Give default values where new fraction has appread
    … …  
    30702973    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: tsurf
    30712974!albedo SB >>>
    3072 !   REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: alb1, alb2
    30732975    REAL, DIMENSION(klon,nsw,nbsrf), INTENT(INOUT)       :: alb_dir, alb_dif
    30742976    INTEGER :: k
    30752977!albedo SB <<<
    30762978    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: ustar,u10m, v10m
     2979    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: evap, agesno
     2980    REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT)        :: z0m,z0h
    30772981    REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke
    30782982
    … …  
    31163020                qsurf(i,nsrf) = qsurf(i,nsrf_comp1)
    31173021                evap(i,nsrf)  = evap(i,nsrf_comp1)
    3118                 rugos(i,nsrf) = rugos(i,nsrf_comp1)
     3022                z0m(i,nsrf) = z0m(i,nsrf_comp1)
     3023                z0h(i,nsrf) = z0h(i,nsrf_comp1)
    31193024                tsurf(i,nsrf) = tsurf(i,nsrf_comp1)
    31203025!albedo SB >>>
    3121 !                alb1(i,nsrf)  = alb1(i,nsrf_comp1)
    3122 !                alb2(i,nsrf)  = alb2(i,nsrf_comp1)
    31233026                DO k=1,nsw
    31243027                 alb_dir(i,k,nsrf)=alb_dir(i,k,nsrf_comp1)
    … …  
    31373040                qsurf(i,nsrf) = qsurf(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + qsurf(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
    31383041                evap(i,nsrf)  = evap(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + evap(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    3139                 rugos(i,nsrf) = rugos(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + rugos(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
     3042                z0m(i,nsrf) = z0m(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + z0m(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
     3043                z0h(i,nsrf) = z0h(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + z0h(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
    31403044                tsurf(i,nsrf) = tsurf(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tsurf(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
    31413045!albedo SB >>>
    3142 !                alb1(i,nsrf)  = alb1(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb1(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    3143 !                alb2(i,nsrf)  = alb2(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb2(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    31443046                DO k=1,nsw
    31453047                 alb_dir(i,k,nsrf)=alb_dir(i,k,nsrf_comp2)*pctsrf_old(i,nsrf_comp2)+&
Note: See TracChangeset for help on using the changeset viewer.