Changeset 2227 for LMDZ5/trunk


Ignore:
Timestamp:
Mar 12, 2015, 12:07:43 PM (10 years ago)
Author:
Laurent Fairhead
Message:

New ocean albedo.

To activate the new scheme, put iflag_albedo=1 in physiq.def

To activate chlorophyll concentration effect on albedo,
put ok_chlorophyll=y in def file

and download file named chlorophyll.nc
chlorophyll.nc has the same dimension as the model grid with 12 months data,
(i=lon, j=lat, L=1:12) and can be degraded from the original file of dimension
i=1:4320 , j=1:2160 , L=1:12
ada:/workgpfs/rech/psl/rpsl949/clima/chlor_seasonal_clim_seawifs.nc

For 96X96 resolution, chlorophyll.nc file is in
ada:/workgpfs/rech/psl/rpsl949/clima/chlorophyll.nc

  1. Baek
Location:
LMDZ5/trunk/libf/phylmd
Files:
3 added
12 edited

Legend:

Unmodified
Added
Removed

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

    r2209 r2227  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44MODULE change_srf_frac_mod
    … …  
    1212
    1313  SUBROUTINE change_srf_frac(itime, dtime, jour, &
    14        pctsrf, alb1, alb2, tsurf, ustar, u10m, v10m, pbl_tke)
     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 <<<
     18   
     19
     20
    1521!
    1622! This subroutine is called from physiq.F at each timestep.
    … …  
    3238    INCLUDE "iniprint.h"
    3339    INCLUDE "YOMCST.h"
     40!albedo SB >>>
     41    include "clesphys.h"
     42!albedo SB <<<
     43
     44
    3445
    3546! Input arguments
    … …  
    4354   
    4455    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf ! sub-surface fraction
    45     REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb1   ! albedo first interval in SW spektrum
    46     REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb2   ! albedo second interval in SW spektrum
     56!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
     59    REAL, DIMENSION(klon,nsw,nbsrf), INTENT(INOUT) :: alb_dir,alb_dif
     60!albedo SB <<<
     61
    4762    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: tsurf
    4863    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: ustar
    … …  
    160175!
    161176!****************************************************************************************
    162        CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb1, alb2, ustar, u10m, v10m, pbl_tke)
     177
     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
     184
    163185
    164186    ELSE

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

    r2136 r2227  
    7474       REAL freq_COSP
    7575       LOGICAL :: ok_cosp,ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP
    76        INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo,NSW
     76       INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo, NSW, iflag_albedo
     77       LOGICAL :: ok_chlorophyll
    7778       LOGICAL :: ok_strato
    7879       LOGICAL :: ok_hines, ok_gwd_rando
    … …  
    116117     &     , ok_lic_melt,           aer_type                            &
    117118     &     , iflag_rrtm, ok_strato,ok_hines, ok_qch4                    &
    118      &     , iflag_ice_thermo, ok_gwd_rando, NSW                        &
    119      &     , ok_conserv_q, ok_all_xml
     119     &     , iflag_ice_thermo, ok_gwd_rando, NSW, iflag_albedo          &
     120     &     , ok_chlorophyll,ok_conserv_q, ok_all_xml
    120121     
    121122       save /clesphys/

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

    r2205 r2227  
    110110    integer,SAVE        :: iflag_radia_omp
    111111    integer,SAVE        :: iflag_rrtm_omp
     112    integer,SAVE        :: iflag_albedo_omp !albedo SB
     113    logical,save        :: ok_chlorophyll_omp ! albedo SB 
    112114    integer,SAVE        :: NSW_omp
    113115    integer,SAVE        :: iflag_cldth_omp, ip_ebil_phy_omp
    … …  
    889891    NSW_omp = 6
    890892    call getin('NSW',NSW_omp)
     893!albedo SB >>>
     894    iflag_albedo_omp = 0
     895    call getin('iflag_albedo',iflag_albedo_omp)
     896
     897    ok_chlorophyll_omp=.false.
     898    call getin('ok_chlorophyll',ok_chlorophyll_omp)
     899!albedo SB <<<
    891900
    892901    !
    … …  
    21352144    write(lunout,*)' iflag_rrtm = ', iflag_rrtm
    21362145    write(lunout,*)' NSW = ', NSW
     2146    write(lunout,*)' iflag_albedo = ', iflag_albedo !albedo SB
     2147    write(lunout,*)' ok_chlorophyll =',ok_chlorophyll ! albedo SB
    21372148    write(lunout,*)' iflag_ratqs = ', iflag_ratqs
    21382149    write(lunout,*)' seuil_inversion = ', seuil_inversion

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

    r2088 r2227  
    482482  falb1(:,is_oce) = 0.5;  falb1(:,is_sic) = 0.6
    483483  falb2 = falb1
     484!albedo SB >>>
     485  falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
     486  falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
     487!albedo SB <<<
    484488  evap(:,:) = 0.
    485489  DO i=1,nbsrf; qsolsrf(:,i)=150.; END DO

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

    r2209 r2227  
    181181!!!
    182182       pplay,     paprs,     pctsrf,                  &
    183        ts,        alb1, alb2,ustar, u10m, v10m,wstar, &
     183!albedo SB >>>
     184!       ts,        alb1, alb2,ustar, u10m, v10m,wstar, &
     185       ts,SFRWL,   alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
     186!albedo SB <<<
    184187       cdragh,    cdragm,   zu1,    zv1,              &
    185        alb1_m,    alb2_m,    zxsens,   zxevap,        &
     188!albedo SB >>>
     189!       alb1_m,    alb2_m,    zxsens,   zxevap,        &
     190       alb_dir_m,    alb_dif_m,  zxsens,   zxevap,    &
     191!albedo SB <<<
    186192       alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
    187193       zxtsol,    zxfluxlat, zt2m,     qsat2m,        &
    … …  
    349355    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: delta_tsurf !surface temperature difference between
    350356                                                                   !wake and off-wake regions
    351     REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb1    ! albedo in visible SW interval
    352     REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb2    ! albedo in near infra-red SW interval
     357!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
     360    REAL, DIMENSIOn(6),intent(in) :: SFRWL
     361    REAL, DIMENSION(klon, nsw, nbsrf), INTENT(INOUT)     :: alb_dir,alb_dif
     362!albedo SB <<<
    353363!jyg Pourquoi ustar et wstar sont-elles INOUT ?
    354364    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: ustar   ! u* (m/s)
    … …  
    371381    REAL, DIMENSION(klon),        INTENT(OUT)       :: zu1        ! u wind speed in first layer
    372382    REAL, DIMENSION(klon),        INTENT(OUT)       :: zv1        ! v wind speed in first layer
    373     REAL, DIMENSION(klon),        INTENT(OUT)       :: alb1_m     ! mean albedo in visible SW interval
    374     REAL, DIMENSION(klon),        INTENT(OUT)       :: alb2_m     ! mean albedo in near IR SW interval
     383!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
     388    REAL, DIMENSION(klon, nsw),        INTENT(OUT)       :: alb_dir_m,alb_dif_m
     389!albedo SB <<<
    375390    ! Martin
    376391    REAL, DIMENSION(klon),        INTENT(OUT)       :: alb3_lic
    … …  
    505520    REAL, DIMENSION(klon)              :: r_co2_ppm     ! taux CO2 atmosphere
    506521    REAL, DIMENSION(klon)              :: yts, yrugos, ypct, yz0_new
    507     REAL, DIMENSION(klon)              :: yalb, yalb1, yalb2
     522!albedo SB >>>
     523!   REAL, DIMENSION(klon)              :: yalb, yalb1, yalb2
     524    REAL, DIMENSION(klon)              :: yalb,yalb_vis
     525!albedo SB <<<
    508526    REAL, DIMENSION(klon)              :: yu1, yv1
    509527    REAL, DIMENSION(klon)              :: ysnow, yqsurf, yagesno, yqsol
    … …  
    542560    REAL, DIMENSION(klon)              :: ypsref
    543561    REAL, DIMENSION(klon)              :: yevap, ytsurf_new, yalb1_new, yalb2_new, yalb3_new
     562!albedo SB >>>
     563    REAL, DIMENSION(klon,nsw)          :: yalb_dir_new, yalb_dif_new
     564!albedo SB <<<
    544565    REAL, DIMENSION(klon)              :: ztsol
    545566    REAL, DIMENSION(klon)              :: alb_m  ! mean albedo for whole SW interval
    … …  
    855876 cdragh(:)=0. ; cdragm(:)=0.
    856877 zu1(:)=0. ; zv1(:)=0.
    857  alb1_m(:)=0. ; alb2_m(:)=0. ; alb3_lic(:)=0.
     878!albedo SB >>>
     879! alb1_m(:)=0. ; alb2_m(:)=0. ; alb3_lic(:)=0.
     880  alb_dir_m=0. ; alb_dif_m=0. ; alb3_lic(:)=0.
     881!albedo SB <<<
    858882 zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0.
    859883 d_t_w(:,:)=0. ; d_q_w(:,:)=0. ; d_t_x(:,:)=0. ; d_q_x(:,:)=0.
    … …  
    920944    ypct = 0.0    ; yts = 0.0        ; ysnow = 0.0
    921945!!    zv1 = 0.0     ; yqsurf = 0.0     ; yalb1 = 0.0     ; yalb2 = 0.0   
    922     yqsurf = 0.0  ; yalb1 = 0.0      ; yalb2 = 0.0   
     946!albedo SB >>>
     947!    yqsurf = 0.0  ; yalb1 = 0.0      ; yalb2 = 0.0   
     948    yqsurf = 0.0  ; yalb = 0.0 ; yalb_vis = 0.0
     949!albedo SB <<<
    923950    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0   
    924951    ysollw = 0.0  ; yrugos = 0.0     ; yu1 = 0.0   
    … …  
    10701097! * alb_m  : mean albedo at whole SW interval
    10711098
    1072     alb1_m(:) = 0.0
    1073     alb2_m(:) = 0.0
    1074     DO nsrf = 1, nbsrf
     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
     1108
     1109    alb_dir_m(:,:) = 0.0
     1110    alb_dif_m(:,:) = 0.0
     1111    DO k = 1, nsw
     1112     DO nsrf = 1, nbsrf
    10751113       DO i = 1, klon
    1076           alb1_m(i) = alb1_m(i) + alb1(i,nsrf) * pctsrf(i,nsrf)
    1077           alb2_m(i) = alb2_m(i) + alb2(i,nsrf) * pctsrf(i,nsrf)
     1114          alb_dir_m(i,k) = alb_dir_m(i,k) + alb_dir(i,k,nsrf) * pctsrf(i,nsrf)
     1115          alb_dif_m(i,k) = alb_dif_m(i,k) + alb_dif(i,k,nsrf) * pctsrf(i,nsrf)
    10781116       ENDDO
     1117     ENDDO
    10791118    ENDDO
    10801119
    10811120! We here suppose the fraction f1 of incoming radiance of visible radiance
    10821121! as a fraction of all shortwave radiance
    1083     f1 = 0.5 
     1122    f1 = 0.5
    10841123!    f1 = 1    ! put f1=1 to recreate old calculations
    10851124
    1086     DO nsrf = 1, nbsrf
    1087        DO i = 1, klon
    1088           alb(i,nsrf) = f1*alb1(i,nsrf) + (1-f1)*alb2(i,nsrf)
    1089        ENDDO
     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
     1136!f1 is already included with SFRWL values in each surf files
     1137    alb=0.0
     1138    DO k=1,nsw
     1139      DO nsrf = 1, nbsrf
     1140        DO i = 1, klon
     1141            alb(i,nsrf) = alb(i,nsrf) + alb_dir(i,k,nsrf)*SFRWL(k)
     1142        ENDDO
     1143      ENDDO
    10901144    ENDDO
    10911145
    1092     DO i = 1, klon
    1093        alb_m(i) = f1*alb1_m(i) + (1-f1)*alb2_m(i)
    1094     END DO
     1146    alb_m=0.0
     1147    DO k = 1,nsw
     1148      DO i = 1, klon
     1149        alb_m(i) = alb_m(i) + alb_dir_m(i,k)*SFRWL(k)
     1150      END DO
     1151    ENDDO
     1152!albedo SB <<<
     1153
     1154
    10951155
    10961156! Calculation of mean temperature at surface grid points
    … …  
    11701230          yqsurf(j)  = qsurf(i,nsrf)
    11711231          yalb(j)    = alb(i,nsrf)
    1172           yalb1(j)   = alb1(i,nsrf)
    1173           yalb2(j)   = alb2(i,nsrf)
     1232!albedo SB >>>
     1233!         yalb1(j)   = alb1(i,nsrf)
     1234!         yalb2(j)   = alb2(i,nsrf)
     1235          yalb_vis(j) = alb_dir(i,1,nsrf)
     1236          if(nsw==6)then
     1237            yalb_vis(j)=(alb_dir(i,1,nsrf)*SFRWL(1)+alb_dir(i,2,nsrf)*SFRWL(2) &
     1238              +alb_dir(i,3,nsrf)*SFRWL(3))/(SFRWL(1)+SFRWL(2)+SFRWL(3))
     1239          endif
     1240!albedo SB <<<
    11741241          yrain_f(j) = rain_f(i)
    11751242          ysnow_f(j) = snow_f(i)
    … …  
    17101777               ylwdown, yq2m, yt2m, &
    17111778               ysnow, yqsol, yagesno, ytsoil, &
    1712                yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
     1779!albedo SB >>>
     1780!              yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
     1781               yz0_new, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
     1782!albedo SB <<<
    17131783               yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
    17141784               y_flux_u1, y_flux_v1 )
    … …  
    17461816               ypsref, yu1, yv1, yrugoro, pctsrf, &
    17471817               ysnow, yqsurf, yqsol, yagesno, &
    1748                ytsoil, yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
     1818!albedo SB >>>
     1819!              ytsoil, yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
     1820               ytsoil, yz0_new, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
     1821!albedo SB <<<
    17491822               ytsurf_new, y_dflux_t, y_dflux_q, &
    17501823               yzsig, ycldt, &
    … …  
    17781851         
    17791852       CASE(is_oce)
    1780           CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb1, &
     1853!albedo SB >>>
     1854!          CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb1, &
     1855           CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb_vis, &
     1856!albedo SB <<<
    17811857               yrugos, ywindsp, rmu0, yfder, yts, &
    17821858               itap, dtime, jour, knon, ni, &
    … …  
    17861862               ypsref, yu1, yv1, yrugoro, pctsrf, &
    17871863               ysnow, yqsurf, yagesno, &
    1788                yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
     1864!albedo SB >>>
     1865!              yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
     1866               yz0_new, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
     1867!albedo SB <<<
    17891868               ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
    17901869               y_flux_u1, y_flux_v1)
    … …  
    18071886       CASE(is_sic)
    18081887          CALL surf_seaice( &
    1809                rlon, rlat, ysolsw, ysollw, yalb1, yfder, &
     1888!albedo SB >>>
     1889!               rlon, rlat, ysolsw, ysollw, yalb1, yfder, &
     1890               rlon, rlat, ysolsw, ysollw, yalb_vis, yfder, &
     1891!albedo SB <<<
    18101892               itap, dtime, jour, knon, ni, &
    18111893               lafin, &
    … …  
    18151897               ypsref, yu1, yv1, yrugoro, pctsrf, &
    18161898               ysnow, yqsurf, yqsol, yagesno, ytsoil, &
    1817                yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
     1899!albedo SB >>>
     1900!               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
     1901               yz0_new, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
     1902!albedo SB <<<
    18181903               ytsurf_new, y_dflux_t, y_dflux_q, &
    18191904               y_flux_u1, y_flux_v1)
    … …  
    21852270          evap(i,nsrf) = - flux_q(i,1,nsrf)                  !jyg
    21862271          d_ts(i,nsrf) = y_d_ts(j)
    2187           alb1(i,nsrf) = yalb1_new(j) 
    2188           alb2(i,nsrf) = yalb2_new(j)
     2272!albedo SB >>>
     2273!          alb1(i,nsrf) = yalb1_new(j) 
     2274!          alb2(i,nsrf) = yalb2_new(j)
     2275          do k=1,nsw
     2276          alb_dir(i,k,nsrf) = yalb_dir_new(j,k)
     2277          alb_dif(i,k,nsrf) = yalb_dif_new(j,k)
     2278          enddo
     2279!albedo SB <<<
    21892280          snow(i,nsrf) = ysnow(j) 
    21902281          qsurf(i,nsrf) = yqsurf(j)
    … …  
    29303021!****************************************************************************************
    29313022!
    2932   SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf, alb1, alb2, ustar, u10m, v10m, tke)
    2933 
     3023
     3024!albedo SB >>>
     3025!  SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf, alb1, alb2, ustar, u10m, v10m, tke)
     3026SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke) 
     3027!albedo SB <<<
    29343028    ! Give default values where new fraction has appread
    29353029
    … …  
    29483042!****************************************************************************************
    29493043    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: tsurf
    2950     REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: alb1, alb2
     3044!albedo SB >>>
     3045!   REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: alb1, alb2
     3046    REAL, DIMENSION(klon,nsw,nbsrf), INTENT(INOUT)       :: alb_dir, alb_dif
     3047    INTEGER :: k
     3048!albedo SB <<<
    29513049    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: ustar,u10m, v10m
    29523050    REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke
    … …  
    29933091                rugos(i,nsrf) = rugos(i,nsrf_comp1)
    29943092                tsurf(i,nsrf) = tsurf(i,nsrf_comp1)
    2995                 alb1(i,nsrf)  = alb1(i,nsrf_comp1)
    2996                 alb2(i,nsrf)  = alb2(i,nsrf_comp1)
     3093!albedo SB >>>
     3094!                alb1(i,nsrf)  = alb1(i,nsrf_comp1)
     3095!                alb2(i,nsrf)  = alb2(i,nsrf_comp1)
     3096                DO k=1,nsw
     3097                 alb_dir(i,k,nsrf)=alb_dir(i,k,nsrf_comp1)
     3098                 alb_dif(i,k,nsrf)=alb_dif(i,k,nsrf_comp1)
     3099                ENDDO
     3100!albedo SB <<<
    29973101                ustar(i,nsrf)  = ustar(i,nsrf_comp1)
    29983102                u10m(i,nsrf)  = u10m(i,nsrf_comp1)
    … …  
    30083112                rugos(i,nsrf) = rugos(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + rugos(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
    30093113                tsurf(i,nsrf) = tsurf(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tsurf(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
    3010                 alb1(i,nsrf)  = alb1(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb1(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    3011                 alb2(i,nsrf)  = alb2(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb2(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
     3114!albedo SB >>>
     3115!                alb1(i,nsrf)  = alb1(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb1(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
     3116!                alb2(i,nsrf)  = alb2(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb2(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
     3117                DO k=1,nsw
     3118                 alb_dir(i,k,nsrf)=alb_dir(i,k,nsrf_comp2)*pctsrf_old(i,nsrf_comp2)+&
     3119                                        alb_dir(i,k,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
     3120                 alb_dif(i,k,nsrf)=alb_dif(i,k,nsrf_comp2)*pctsrf_old(i,nsrf_comp2)+&
     3121                                        alb_dif(i,k,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
     3122                ENDDO
     3123!albedo SB <<<
    30123124                ustar(i,nsrf)  = ustar(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + ustar(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    30133125                u10m(i,nsrf)  = u10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)

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

    r2205 r2227  
    3030      REAL, ALLOCATABLE, SAVE :: falb1(:,:), falb2(:,:)
    3131!$OMP THREADPRIVATE(falb1, falb2)
     32
     33!albedo SB >>>
     34      REAL, ALLOCATABLE, SAVE :: falb_dif(:,:,:), falb_dir(:,:,:)
     35      real, allocatable, save :: chl_con(:)
     36!$OMP THREADPRIVATE(falb_dir,falb_dif,chl_con)
     37!albedo SB <<<
     38
     39
    3240      REAL, ALLOCATABLE, SAVE :: rain_fall(:), snow_fall(:)
    3341!$OMP THREADPRIVATE( rain_fall, snow_fall)
    … …  
    261269!$OMP THREADPRIVATE(albsol1,albsol2)
    262270
     271!albedo SB >>>
     272      REAL,ALLOCATABLE,SAVE :: albsol_dif(:,:),albsol_dir(:,:)
     273!$OMP THREADPRIVATE(albsol_dif,albsol_dir)
     274!albedo SB <<<
     275
     276
    263277      REAL, ALLOCATABLE, SAVE:: wo(:, :, :)
    264278      ! column-density of ozone in a layer, in kilo-Dobsons
    … …  
    404418      ALLOCATE(falb1(klon,nbsrf))
    405419      ALLOCATE(falb2(klon,nbsrf))
     420!albedo SB >>>
     421      ALLOCATE(falb_dir(klon,nsw,nbsrf),falb_dif(klon,nsw,nbsrf))
     422      ALLOCATE(chl_con(klon))
     423!albedo SB <<<
    406424      ALLOCATE(rain_fall(klon))
    407425      ALLOCATE(snow_fall(klon))
    … …  
    501519      ALLOCATE(paire_ter(klon))
    502520      ALLOCATE(albsol1(klon), albsol2(klon))
     521!albedo SB >>>
     522      ALLOCATE(albsol_dir(klon,nsw),albsol_dif(klon,nsw))
     523!albedo SB <<<
    503524
    504525      if (read_climoz <= 1) then
    … …  
    634655      deallocate(paire_ter)
    635656      deallocate(albsol1, albsol2)
     657!albedo SB >>>
     658      deallocate(albsol_dir,albsol_dif,falb_dir,falb_dif,chl_con)
     659!albedo SB <<<
    636660      deallocate(wo)
    637661      deallocate(clwcon0,rnebcon0)

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

    r2224 r2227  
    865865
    866866  REAL zzz
     867!albedo SB >>>
     868  real,dimension(6),save :: SFRWL
     869!albedo SB <<<
    867870
    868871  !======================================================================
    … …  
    13491352     mskocean_beta=.FALSE.
    13501353
     1354!albedo SB >>>
     1355     select case(nsw)
     1356     case(2)
     1357     SFRWL(1)=0.45538747
     1358     SFRWL(2)=0.54461211
     1359     case(4)
     1360     SFRWL(1)=0.45538747
     1361     SFRWL(2)=0.32870591
     1362     SFRWL(3)=0.18568763
     1363     SFRWL(4)=3.02191470E-02
     1364     case(6)
     1365     SFRWL(1)=1.28432794E-03
     1366     SFRWL(2)=0.12304168
     1367     SFRWL(3)=0.33106142
     1368     SFRWL(4)=0.32870591
     1369     SFRWL(5)=0.18568763
     1370     SFRWL(6)=3.02191470E-02
     1371     end select
     1372
     1373
     1374!albedo SB <<<
     1375
    13511376     OPEN(99,file='beta_crf.data',status='old', &
    13521377          form='formatted',err=9999)
    … …  
    13851410  !
    13861411  CALL change_srf_frac(itap, dtime, days_elapsed+1,  &
    1387        pctsrf, falb1, falb2, ftsol, ustar, u10m, v10m, pbl_tke)
    1388 
     1412!albedo SB >>>
     1413!       pctsrf, falb1, falb2, ftsol, ustar, u10m, v10m, pbl_tke)
     1414       pctsrf, falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke)
     1415!albedo SB <<<
    13891416
    13901417  ! Update time and other variables in Reprobus
    … …  
    18201847!>nrlmd+jyg
    18211848          pplay,     paprs,     pctsrf,             &
    1822           ftsol,falb1,falb2,ustar,u10m,v10m,wstar,  &
     1849!albedo SB >>>
     1850!          ftsol,falb1,falb2,ustar,u10m,v10m,wstar,  &
     1851          ftsol,SFRWL,falb_dir,falb_dif,ustar,u10m,v10m,wstar, &
     1852!albedo SB <<<
    18231853          cdragh,    cdragm,  u1,    v1,            &
    1824           albsol1,   albsol2,   sens,    evap,      &
     1854!albedo SB >>>
     1855!          albsol1,   albsol2,   sens,    evap,      &
     1856          albsol_dir,   albsol_dif,   sens,    evap,   & 
     1857!albedo SB <<<
    18251858          albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
    18261859          zxtsol,    zxfluxlat, zt2m,    qsat2m,  &
    … …  
    18881921        call writefield_phy('q_seri',q_seri,llm)
    18891922     endif
     1923
     1924
     1925!albedo SB >>>
     1926 albsol1=0.
     1927 albsol2=0.
     1928 falb1=0.
     1929 falb2=0.
     1930select case(nsw)
     1931case(2)
     1932 albsol1=albsol_dir(:,1)
     1933 albsol2=albsol_dir(:,2)
     1934 falb1=falb_dir(:,1,:)
     1935 falb2=falb_dir(:,2,:)
     1936case(4)
     1937 albsol1=albsol_dir(:,1)
     1938 albsol2=albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3)+albsol_dir(:,4)*SFRWL(4)
     1939 albsol2=albsol2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
     1940 falb1=falb_dir(:,1,:)
     1941 falb2=falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3)+falb_dir(:,4,:)*SFRWL(4)
     1942 falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
     1943case(6)
     1944 albsol1=albsol_dir(:,1)*SFRWL(1)+albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3)
     1945 albsol1=albsol1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
     1946 albsol2=albsol_dir(:,4)*SFRWL(4)+albsol_dir(:,5)*SFRWL(5)+albsol_dir(:,6)*SFRWL(6)
     1947 albsol2=albsol2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
     1948 falb1=falb_dir(:,1,:)*SFRWL(1)+falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3)
     1949 falb1=falb1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
     1950 falb2=falb_dir(:,4,:)*SFRWL(4)+falb_dir(:,5,:)*SFRWL(5)+falb_dir(:,6,:)*SFRWL(6)
     1951 falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
     1952end select
     1953!albedo SB <<<
     1954
    18901955
    18911956     CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, &
    … …  
    33003365  IF (MOD(itaprad,radpas).EQ.0) THEN
    33013366
    3302      DO i = 1, klon
    3303         albsol1(i) = falb1(i,is_oce) * pctsrf(i,is_oce) &
    3304              + falb1(i,is_lic) * pctsrf(i,is_lic) &
    3305              + falb1(i,is_ter) * pctsrf(i,is_ter) &
    3306              + falb1(i,is_sic) * pctsrf(i,is_sic)
    3307         albsol2(i) = falb2(i,is_oce) * pctsrf(i,is_oce) &
    3308              + falb2(i,is_lic) * pctsrf(i,is_lic) &
    3309              + falb2(i,is_ter) * pctsrf(i,is_ter) &
    3310              + falb2(i,is_sic) * pctsrf(i,is_sic)
    3311      ENDDO
     3367!albedo SB >>> 
     3368  if(ok_chlorophyll)then
     3369  print*,"-- reading chlorophyll"
     3370  call readchlorophyll(debut)
     3371  endif
     3372  !do i=1,klon
     3373  !if(chl_con(i)>1.) print*,i,chl_con(i),pctsrf(i,is_ter)
     3374  !enddo
     3375!albedo SB <<<
     3376
     3377!albedo SB >>>
     3378!     DO i = 1, klon
     3379!        albsol1(i) = falb1(i,is_oce) * pctsrf(i,is_oce) &
     3380!             + falb1(i,is_lic) * pctsrf(i,is_lic) &
     3381!             + falb1(i,is_ter) * pctsrf(i,is_ter) &
     3382!             + falb1(i,is_sic) * pctsrf(i,is_sic)
     3383!        albsol2(i) = falb2(i,is_oce) * pctsrf(i,is_oce) &
     3384!             + falb2(i,is_lic) * pctsrf(i,is_lic) &
     3385!             + falb2(i,is_ter) * pctsrf(i,is_ter) &
     3386!             + falb2(i,is_sic) * pctsrf(i,is_sic)
     3387!     ENDDO
     3388!albedo SB <<<
    33123389
    33133390     if (mydebug) then
    … …  
    33573434        CALL radlwsw &
    33583435             (dist, rmu0, fract,  &
    3359              paprs, pplay,zxtsol,albsol1, albsol2,  &
     3436!albedo SB >>>
     3437!             paprs, pplay,zxtsol,albsol1, albsol2,  &
     3438             paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif,  &
     3439!albedo SB <<<
    33603440             t_seri,q_seri,wo, &
    33613441             cldfrarad, cldemirad, cldtaurad, &
    … …  
    34103490              CALL radlwsw &
    34113491                   (dist, rmu0, fract,  &
    3412                    paprs, pplay,zxtsol,albsol1, albsol2,  &
     3492!albedo SB >>>
     3493!                   paprs, pplay,zxtsol,albsol1, albsol2,  &
     3494                   paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
     3495!albedo SB <<<
    34133496                   t_seri,q_seri,wo, &
    34143497                   cldfra, cldemi, cldtau, &

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

    r2192 r2227  
    1010SUBROUTINE radlwsw( &
    1111   dist, rmu0, fract, &
    12    paprs, pplay,tsol,alb1, alb2, &
     12!albedo SB >>>
     13!  paprs, pplay,tsol,alb1, alb2, &
     14   paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, &
     15!albedo SB <<<
    1316   t,q,wo,&
    1417   cldfra, cldemi, cldtaupd,&
    … …  
    174177  REAL,    INTENT(in)  :: rmu0(KLON), fract(KLON)
    175178  REAL,    INTENT(in)  :: paprs(KLON,KLEV+1), pplay(KLON,KLEV)
    176   REAL,    INTENT(in)  :: alb1(KLON), alb2(KLON), tsol(KLON)
     179!albedo SB >>>
     180! REAL,    INTENT(in)  :: alb1(KLON), alb2(KLON), tsol(KLON)
     181  REAL,    INTENT(in)  :: tsol(KLON)
     182  REAL,    INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW)
     183  real, intent(in) :: SFRWL(6)
     184!albedo SB <<<
    177185  REAL,    INTENT(in)  :: t(KLON,KLEV), q(KLON,KLEV)
    178186
    … …  
    418426!     zfract(i) = 1.     !!!!!!  essai MPL 19052010
    419427      zrmu0(i) = rmu0(iof+i)
    420       PALBD(i,1) = alb1(iof+i)
    421       PALBD(i,2) = alb2(iof+i)
    422 !
    423          PALBD_NEW(i,1) = alb1(iof+i)   !!!!! A REVOIR (MPL) PALBD_NEW en fonction bdes SW
    424          do kk=2,NSW
    425            PALBD_NEW(i,kk) = alb2(iof+i)
    426          enddo
    427       PALBP(i,1) = alb1(iof+i)
    428       PALBP(i,2) = alb2(iof+i)
    429 !
    430          PALBP_NEW(i,1) = alb1(iof+i)     !!!!! A REVOIR (MPL) PALBP_NEW en fonction bdes SW
    431          do kk=2,NSW
    432            PALBP_NEW(i,kk) = alb2(iof+i)
    433          enddo
     428
     429
     430!albedo SB >>>
     431!      PALBD(i,1) = alb1(iof+i)
     432!      PALBD(i,2) = alb2(iof+i)
     433!         PALBD_NEW(i,1) = alb1(iof+i)   !!!!! A REVOIR (MPL) PALBD_NEW en
     434!         fonction bdes SW
     435!         do kk=2,NSW
     436!           PALBD_NEW(i,kk) = alb2(iof+i)
     437!         enddo
     438!      PALBP(i,1) = alb1(iof+i)
     439!      PALBP(i,2) = alb2(iof+i)
     440!
     441!         PALBP_NEW(i,1) = alb1(iof+i)     !!!!! A REVOIR (MPL) PALBP_NEW en
     442!         fonction bdes SW
     443!         do kk=2,NSW
     444!           PALBP_NEW(i,kk) = alb2(iof+i)
     445!         enddo
     446
     447      if(iflag_rrtm==0)then
     448        select case(nsw)
     449        case(2)
     450          PALBD(i,1)=alb_dif(iof+i,1)
     451          PALBD(i,2)=alb_dif(iof+i,2)
     452          PALBP(i,1)=alb_dir(iof+i,1)
     453          PALBP(i,2)=alb_dir(iof+i,2)
     454        case(4)
     455          PALBD(i,1)=alb_dif(iof+i,1)
     456          PALBD(i,2)=(alb_dif(iof+i,2)*SFRWL(2)+alb_dif(iof+i,3)*SFRWL(3) &
     457                 +alb_dif(iof+i,4)*SFRWL(4))/(SFRWL(2)+SFRWL(3)+SFRWL(4))
     458          PALBP(i,1)=alb_dir(iof+i,1)
     459          PALBP(i,2)=(alb_dir(iof+i,2)*SFRWL(2)+alb_dir(iof+i,3)*SFRWL(3) &
     460                 +alb_dir(iof+i,4)*SFRWL(4))/(SFRWL(2)+SFRWL(3)+SFRWL(4))
     461        case(6)
     462          PALBD(i,1)=(alb_dif(iof+i,1)*SFRWL(1)+alb_dif(iof+i,2)*SFRWL(2) &
     463                 +alb_dif(iof+i,3)*SFRWL(3))/(SFRWL(1)+SFRWL(2)+SFRWL(3))
     464          PALBD(i,2)=(alb_dif(iof+i,4)*SFRWL(4)+alb_dif(iof+i,5)*SFRWL(5) &
     465                 +alb_dif(iof+i,6)*SFRWL(6))/(SFRWL(4)+SFRWL(5)+SFRWL(6))
     466          PALBP(i,1)=(alb_dir(iof+i,1)*SFRWL(1)+alb_dir(iof+i,2)*SFRWL(2)  &
     467                 +alb_dir(iof+i,3)*SFRWL(3))/(SFRWL(1)+SFRWL(2)+SFRWL(3))
     468          PALBP(i,2)=(alb_dir(iof+i,4)*SFRWL(4)+alb_dir(iof+i,5)*SFRWL(5)  &
     469                 +alb_dir(iof+i,6)*SFRWL(6))/(SFRWL(4)+SFRWL(5)+SFRWL(6))
     470        end select
     471      elseif(iflag_rrtm==1)then
     472        DO kk=1,NSW
     473         PALBD_NEW(i,kk)=alb_dif(iof+i,kk)
     474         PALBP_NEW(i,kk)=alb_dir(iof+i,kk)
     475        ENDDO
     476      endif
     477!albedo SB <<<
     478
     479
     480
     481
    434482      PEMIS(i) = 1.0    !!!!! A REVOIR (MPL)
    435483      PVIEW(i) = 1.66

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

    r2188 r2227  
    1717       lwdown_m, q2m, t2m, &
    1818       snow, qsol, agesno, tsoil, &
    19        z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
     19!albedo SB >>>
     20!      z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
     21       z0_new, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &   
     22!albedo SB <<<
    2023       qsurf, tsurf_new, dflux_s, dflux_l, &
    2124       flux_u1, flux_v1 )
    … …  
    3538    INCLUDE "dimsoil.h"
    3639    INCLUDE "YOMCST.h"
     40!albedo SB >>>
     41    INCLUDE "clesphys.h"
     42!albedo SB <<<
    3743
    3844! Input variables 
    … …  
    7177!****************************************************************************************
    7278    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
    73     REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new ! albdeo for shortwave interval 1(visible)
    74     REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new ! albedo for shortwave interval 2(near infrared)
     79!albedo SB >>>
     80!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new ! albdeo for shortwave interval 1(visible)
     81!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new ! albedo for shortwave interval 2(near infrared)
     82    REAL, DIMENSION(6), INTENT(IN) :: SFRWL
     83    REAL, DIMENSION(klon,nsw), INTENT(OUT)       :: alb_dir_new,alb_dif_new
     84!albedo SB <<<
    7585    REAL, DIMENSION(klon), INTENT(OUT)       :: evap
    7686    REAL, DIMENSION(klon), INTENT(OUT)       :: fluxsens, fluxlat
    … …  
    8999    REAL, DIMENSION(klon) :: u0, v0     ! surface speed
    90100    INTEGER               :: i
     101
     102!albedo SB >>>
     103    REAL, DIMENSION(klon)      :: alb1_new,alb2_new
     104!albedo SB <<<
    91105
    92106
    … …  
    165179         p1lay, temp_air, &
    166180         flux_u1, flux_v1)
     181
     182!albedo SB >>>
     183
     184
     185     select case(NSW)
     186     case(2)
     187       alb_dir_new(1:knon,1)=alb1_new(1:knon)
     188       alb_dir_new(1:knon,2)=alb2_new(1:knon)
     189     case(4)
     190       alb_dir_new(1:knon,1)=alb1_new(1:knon)
     191       alb_dir_new(1:knon,2)=alb2_new(1:knon)
     192       alb_dir_new(1:knon,3)=alb2_new(1:knon)
     193       alb_dir_new(1:knon,4)=alb2_new(1:knon)
     194     case(6)
     195       alb_dir_new(1:knon,1)=alb1_new(1:knon)
     196       alb_dir_new(1:knon,2)=alb1_new(1:knon)
     197       alb_dir_new(1:knon,3)=alb1_new(1:knon)
     198       alb_dir_new(1:knon,4)=alb2_new(1:knon)
     199       alb_dir_new(1:knon,5)=alb2_new(1:knon)
     200       alb_dir_new(1:knon,6)=alb2_new(1:knon)
     201     end select
     202alb_dif_new=alb_dir_new
     203!albedo SB <<<
     204
     205
    167206   
    168207  END SUBROUTINE surf_land

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

    r1907 r2227  
    1717       ps, u1, v1, rugoro, pctsrf, &
    1818       snow, qsurf, qsol, agesno, &
    19        tsoil, z0_new, alb1, alb2, evap, fluxsens, fluxlat, &
     19!albedo SB >>>
     20!      tsoil, z0_new, alb1, alb2, evap, fluxsens, fluxlat, &
     21       tsoil, z0_new, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, &
     22!albedo SB <<<
    2023       tsurf_new, dflux_s, dflux_l, &
    2124       slope, cloudf, &
    … …  
    8083    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
    8184    REAL, DIMENSION(klon), INTENT(OUT)            :: z0_new
    82     REAL, DIMENSION(klon), INTENT(OUT)            :: alb1  ! new albedo in visible SW interval
    83     REAL, DIMENSION(klon), INTENT(OUT)            :: alb2  ! new albedo in near IR interval
     85!albedo SB >>>
     86!    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1  ! new albedo in visible SW interval
     87!    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2  ! new albedo in near IR interval
     88    REAL, DIMENSION(6), INTENT(IN)              ::SFRWL
     89    REAL, DIMENSION(klon,nsw), INTENT(OUT)        ::alb_dir,alb_dif
     90!albedo SB <<<
    8491    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
    8592    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
    … …  
    116123    CHARACTER (len = 20)                      :: modname = 'surf_landice'
    117124    CHARACTER (len = 80)                      :: abort_message
     125
     126!albedo SB >>>
     127    real,dimension(klon) :: alb1,alb2
     128!albedo SB <<<
    118129
    119130! End definition
    … …  
    315326
    316327
     328!albedo SB >>>
     329     select case(NSW)
     330     case(2)
     331       alb_dir(1:knon,1)=alb1(1:knon)
     332       alb_dir(1:knon,2)=alb2(1:knon)
     333     case(4)
     334       alb_dir(1:knon,1)=alb1(1:knon)
     335       alb_dir(1:knon,2)=alb2(1:knon)
     336       alb_dir(1:knon,3)=alb2(1:knon)
     337       alb_dir(1:knon,4)=alb2(1:knon)
     338     case(6)
     339       alb_dir(1:knon,1)=alb1(1:knon)
     340       alb_dir(1:knon,2)=alb1(1:knon)
     341       alb_dir(1:knon,3)=alb1(1:knon)
     342       alb_dir(1:knon,4)=alb2(1:knon)
     343       alb_dir(1:knon,5)=alb2(1:knon)
     344       alb_dir(1:knon,6)=alb2(1:knon)
     345     end select
     346alb_dif=alb_dir
     347!albedo SB <<<
     348
     349
     350
     351
    317352  END SUBROUTINE surf_landice
    318353!

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

    r2209 r2227  
    1616       ps, u1, v1, rugoro, pctsrf, &
    1717       snow, qsurf, agesno, &
    18        z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
     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 <<<
    1922       tsurf_new, dflux_s, dflux_l, lmt_bils, &
    2023       flux_u1, flux_v1)
    … …  
    7275!****************************************************************************************
    7376    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
    74     REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
    75     REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
     77!albedo SB >>>
     78!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
     79!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
     80    REAL, DIMENSION(6), INTENT(IN)          :: SFRWL
     81    REAL, DIMENSION(klon,nsw), INTENT(OUT)       :: alb_dir_new,alb_dif_new
     82!albedo SB <<<     
    7683    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
    7784    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    … …  
    8289! Local variables
    8390!****************************************************************************************
    84     INTEGER               :: i
     91    INTEGER               :: i, k
    8592    REAL                  :: tmp
    8693    REAL, PARAMETER       :: cepdu2=(0.1)**2
    … …  
    155162!
    156163!****************************************************************************************
     164!albedo SB >>>
     165
     166
     167  if(iflag_albedo==1)then
     168    call ocean_albedo(knon,rmu0,knindex,windsp,SFRWL,alb_dir_new,alb_dif_new)
     169  else
    157170    IF (cycle_diurne) THEN
    158171       CALL alboc_cd(rmu0,alb_eau)
    … …  
    162175
    163176    DO i =1, knon
    164        alb1_new(i) = alb_eau(knindex(i))
     177      do  k=1,nsw
     178       alb_dir_new(i,k) = alb_eau(knindex(i))
     179      enddo
    165180    ENDDO
    166     alb2_new(1:knon) = alb1_new(1:knon)
     181     alb_dif_new=0.05 !alb_dir_new
     182endif
     183
     184!albedo SB <<<
    167185
    168186!****************************************************************************************

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

    r2209 r2227  
     1!
     2! $Id$
    13!
    24MODULE surf_seaice_mod
    … …  
    1719       ps, u1, v1, rugoro, pctsrf, &
    1820       snow, qsurf, qsol, agesno, tsoil, &
    19        z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
     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 <<<
    2025       tsurf_new, dflux_s, dflux_l, &
    2126       flux_u1, flux_v1)
    … …  
    3439!
    3540    INCLUDE "dimsoil.h"
     41    INCLUDE "clesphys.h"
    3642
    3743! Input arguments
    … …  
    6773!****************************************************************************************
    6874    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
    69     REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
    70     REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
     75!albedo SB >>>
     76!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
     77!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
     78    REAL, DIMENSION(6), INTENT(IN)    :: SFRWL
     79    REAL, DIMENSION(klon,nsw), INTENT(OUT)   :: alb_dir_new,alb_dif_new
     80!albedo SB <<<
    7181    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
    7282    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    … …  
    7888    REAL, DIMENSION(klon)  :: radsol
    7989
     90!albedo SB >>>
     91    REAL, DIMENSION(klon) :: alb1_new,alb2_new
     92!albedo SB <<<
    8093!
    8194! End definitions
    … …  
    140153    z0_new = SQRT(z0_new**2+rugoro**2)
    141154
     155
     156!albedo SB >>>
     157     select case(NSW)
     158     case(2)
     159       alb_dir_new(1:knon,1)=alb1_new(1:knon)
     160       alb_dir_new(1:knon,2)=alb2_new(1:knon)
     161     case(4)
     162       alb_dir_new(1:knon,1)=alb1_new(1:knon)
     163       alb_dir_new(1:knon,2)=alb2_new(1:knon)
     164       alb_dir_new(1:knon,3)=alb2_new(1:knon)
     165       alb_dir_new(1:knon,4)=alb2_new(1:knon)
     166     case(6)
     167       alb_dir_new(1:knon,1)=alb1_new(1:knon)
     168       alb_dir_new(1:knon,2)=alb1_new(1:knon)
     169       alb_dir_new(1:knon,3)=alb1_new(1:knon)
     170       alb_dir_new(1:knon,4)=alb2_new(1:knon)
     171       alb_dir_new(1:knon,5)=alb2_new(1:knon)
     172       alb_dir_new(1:knon,6)=alb2_new(1:knon)
     173     end select
     174alb_dif_new=alb_dir_new
     175!albedo SB <<<
     176
     177
     178
     179
    142180  END SUBROUTINE surf_seaice
    143181!
Note: See TracChangeset for help on using the changeset viewer.