SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/garden_properties.F90
Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE GARDEN_PROPERTIES(PDIR_SW, PSCA_SW, PSW_BANDS, KSW,      &
00003                                    PTS, PEMIS, PALB                       )  
00004 !     ##########################################################################
00005 !
00006 !!****  *GARDEN_PROPERTIES*  
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !
00011 !     Calculates grid-averaged albedo and emissivity (according to snow scheme)
00012 !         
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!    none
00017 !!
00018 !!    IMPLICIT ARGUMENTS
00019 !!    ------------------ 
00020 !!      
00021 !!    AUTHOR
00022 !!    ------
00023 !!
00024 !!      S. Belair           * Meteo-France *
00025 !-------------------------------------------------------------------------------
00026 !
00027 !*       0.     DECLARATIONS
00028 !               ------------
00029 !
00030 USE MODD_SURF_PAR, ONLY : XUNDEF
00031 !
00032 USE MODD_TEB_VEG_n,         ONLY : CISBA, LTR_ML
00033 USE MODD_TEB_GARDEN_n,      ONLY : TSNOW, XALBNIR, XALBVIS, XALBUV,    &
00034                                    XALBNIR_VEG, XALBVIS_VEG, XALBUV_VEG,      &
00035                                    XALBNIR_SOIL, XALBVIS_SOIL, XALBUV_SOIL,   &
00036                                    XALBNIR_TVEG, XALBVIS_TVEG,       &
00037                                    XALBNIR_TSOIL, XALBVIS_TSOIL,   &                                   
00038                                    XVEG, XLAI, XZ0, XEMIS, XTG,       &
00039                                    XPSN, XPSNV, XPSNG, XPSNV_A,  &
00040                                    XSNOWFREE_ALB_VEG, XSNOWFREE_ALB_SOIL,     &
00041                                    XSNOWFREE_ALB  
00042 !
00043 USE MODI_ISBA_PROPERTIES
00044 !
00045 !
00046 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00047 USE PARKIND1  ,ONLY : JPRB
00048 !
00049 IMPLICIT NONE
00050 !
00051 !*      0.1    declarations of arguments
00052 !
00053 REAL, DIMENSION(:,:), INTENT(IN)   :: PDIR_SW            ! direct incoming solar radiation
00054 REAL, DIMENSION(:,:), INTENT(IN)   :: PSCA_SW            ! diffus incoming solar radiation
00055 REAL, DIMENSION(:)  , INTENT(IN)   :: PSW_BANDS          ! mean wavelength of each shortwave band (m)
00056 INTEGER,              INTENT(IN)   :: KSW                ! number of short-wave spectral bands
00057 !
00058 REAL, DIMENSION(:)  , INTENT(OUT)  :: PTS                ! radiative surface temperature
00059 REAL, DIMENSION(:)  , INTENT(OUT)  :: PEMIS              ! green areas emissivity
00060 REAL, DIMENSION(:)  , INTENT(OUT)  :: PALB               ! green areas albedo
00061 !
00062 !-------------------------------------------------------------------------------
00063 !
00064 !*      0.2    Local variables
00065 !              ---------------
00066 !
00067 INTEGER                        :: JLAYER
00068 INTEGER                        :: JSWB
00069 !
00070 REAL, DIMENSION(SIZE(PALB))    :: ZTSNOSNOW ! surf. temp. on snow free part
00071 REAL, DIMENSION(SIZE(PALB))    :: ZTSSNOW   ! surf. temp. on snow covered part
00072 REAL, DIMENSION(SIZE(PALB))    :: ZANOSNOW  ! snow-free surface albedo
00073 REAL, DIMENSION(SIZE(PALB))    :: ZASNOW    ! snow albedo
00074 REAL, DIMENSION(SIZE(PALB))    :: ZENOSNOW  ! snow-free surface emissivity
00075 REAL, DIMENSION(SIZE(PALB))    :: ZESNOW    ! snow emissivity
00076 !
00077 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00078 !-------------------------------------------------------------------------------
00079 !
00080 IF (LHOOK) CALL DR_HOOK('GARDEN_PROPERTIES',0,ZHOOK_HANDLE)
00081 !
00082 !*      1.     Set physical values for points where there is no garden
00083 !              -------------------------------------------------------
00084 !
00085 ! This way, ISBA can run without problem for these points
00086 !
00087  CALL FLAG_TEB_GARDEN_n(1)
00088 !
00089 !
00090 !*      2.     Computes several properties of gardens
00091 !              --------------------------------------
00092 !
00093  CALL ISBA_PROPERTIES(CISBA, LTR_ML, TSNOW, 1,                            &
00094                      PDIR_SW, PSCA_SW, PSW_BANDS, KSW,                   &
00095                      XALBNIR(:), XALBVIS(:), XALBUV(:),                  &
00096                      XALBNIR_VEG(:), XALBVIS_VEG(:), XALBUV_VEG(:),      &
00097                      XALBNIR_SOIL(:), XALBVIS_SOIL(:), XALBUV_SOIL(:),   &
00098                      XVEG(:), XLAI(:), XZ0(:), XEMIS(:),XTG(:,1),          &
00099                      ZASNOW, ZANOSNOW, ZESNOW, ZENOSNOW, ZTSSNOW, ZTSNOSNOW,      &
00100                      XSNOWFREE_ALB_VEG, XSNOWFREE_ALB_SOIL,                       &
00101                      XALBNIR_TVEG, XALBVIS_TVEG, XALBNIR_TSOIL, XALBVIS_TSOIL,    &
00102                      XPSN(:), XPSNV_A(:), XPSNG(:), XPSNV(:)          )  
00103 !
00104 XSNOWFREE_ALB = ZANOSNOW
00105 !
00106 !* averaged albedo
00107 PALB =  XPSN(:) * ZASNOW              + (1.-XPSN(:)) * ZANOSNOW
00108 !* averaged emissivity
00109 PEMIS=  XPSN(:) * ZESNOW              + (1.-XPSN(:)) * ZENOSNOW
00110 !* averaged surface radiative temperature
00111 !  (recomputed from emitted long wave)
00112 PTS  =((XPSN(:) * ZESNOW * ZTSSNOW**4 + (1.-XPSN(:)) * ZENOSNOW * ZTSNOSNOW**4) / PEMIS)**0.25
00113 IF (LHOOK) CALL DR_HOOK('GARDEN_PROPERTIES',1,ZHOOK_HANDLE)
00114 !
00115 !-------------------------------------------------------------------------------
00116 !
00117 END SUBROUTINE GARDEN_PROPERTIES