SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/isba

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE ISBA_PROPERTIES(HISBA, OTR_ML, TPSNOW, KPATCH,           &
00003                                  PDIR_SW, PSCA_SW, PSW_BANDS, KSW,        &
00004                                  PALBNIR, PALBVIS, PALBUV,                &
00005                                  PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG,    &
00006                                  PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, &
00007                                  PVEG, PLAI, PZ0, PEMIS, PTG,             &
00008                                  PASNOW, PANOSNOW, PESNOW, PENOSNOW,      &
00009                                  PTSSNOW, PTSNOSNOW,                      &
00010                                  PSNOWFREE_ALB_VEG, PSNOWFREE_ALB_SOIL,   &
00011                                  PALBNIR_TVEG, PALBVIS_TVEG,              &
00012                                  PALBNIR_TSOIL, PALBVIS_TSOIL,            &
00013                                  PPSN, PPSNV_A, PPSNG, PPSNV              )  
00014 !     ##########################################################################
00015 !
00016 !!****  *ISBA_PROPERTIES*  
00017 !!
00018 !!    PURPOSE
00019 !!    -------
00020 !
00021 !     Calculates grid-averaged albedo and emissivity (according to snow scheme)
00022 !         
00023 !!    EXTERNAL
00024 !!    --------
00025 !!
00026 !!    none
00027 !!
00028 !!    IMPLICIT ARGUMENTS
00029 !!    ------------------ 
00030 !!      
00031 !!    AUTHOR
00032 !!    ------
00033 !!
00034 !!      S. Belair           * Meteo-France *
00035 !-------------------------------------------------------------------------------
00036 !
00037 !*       0.     DECLARATIONS
00038 !               ------------
00039 !
00040 USE MODD_TYPE_SNOW
00041 USE MODD_SNOW_PAR   , ONLY : XEMISSN, XEMCRIN, XSNOWDMIN, &
00042                                XRHOSMAX_ES, XRHOSMIN_ES  
00043 USE MODD_WATER_PAR  , ONLY : XEMISWAT
00044 !
00045 USE MODI_ISBA_SNOW_FRAC
00046 USE MODI_ISBA_ALBEDO
00047 !
00048 !
00049 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00050 USE PARKIND1  ,ONLY : JPRB
00051 !
00052 IMPLICIT NONE
00053 !
00054 !*      0.1    declarations of arguments
00055 !
00056  CHARACTER(LEN=*)    , INTENT(IN)   :: HISBA      ! ISBA scheme
00057 LOGICAL             , INTENT(IN)   :: OTR_ML     ! new radiative transfert
00058 TYPE(SURF_SNOW),      INTENT(IN)   :: TPSNOW     ! ISBA snow scheme
00059 INTEGER,              INTENT(IN)   :: KPATCH     ! patch being treated
00060 !
00061 REAL, DIMENSION(:,:), INTENT(IN)   :: PDIR_SW            ! direct incoming solar radiation
00062 REAL, DIMENSION(:,:), INTENT(IN)   :: PSCA_SW            ! diffus incoming solar radiation
00063 REAL, DIMENSION(:)  , INTENT(IN)   :: PSW_BANDS          ! mean wavelength of each shortwave band (m)
00064 INTEGER,              INTENT(IN)   :: KSW                ! number of short-wave spectral bands
00065 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBNIR            ! nearIR  total albedo
00066 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBVIS            ! visible total albedo
00067 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBUV             ! UV      total albedo
00068 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBNIR_VEG        ! nearIR  veg   albedo
00069 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBVIS_VEG        ! visible veg   albedo
00070 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBUV_VEG         ! UV      veg   albedo
00071 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBNIR_SOIL       ! nearIR  soil  albedo
00072 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBVIS_SOIL       ! visible soil  albedo
00073 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBUV_SOIL        ! UV      soil  albedo
00074 !
00075 REAL, DIMENSION(:)  , INTENT(IN)   :: PVEG  ! PVEG = fraction of vegetation
00076 REAL, DIMENSION(:)  , INTENT(IN)   :: PLAI  ! PLAI = leaf area index
00077 REAL, DIMENSION(:)  , INTENT(IN)   :: PZ0   ! PZ0  = roughness length for momentum
00078 REAL, DIMENSION(:)  , INTENT(IN)   :: PEMIS ! PEMIS = emissivity
00079 REAL, DIMENSION(:)  , INTENT(IN)   :: PTG   !             
00080 !
00081 REAL, DIMENSION(:)  , INTENT(OUT)  :: PASNOW    ! = snow albedo
00082 REAL, DIMENSION(:)  , INTENT(OUT)  :: PANOSNOW  ! = snow free albedo 
00083 REAL, DIMENSION(:)  , INTENT(OUT)  :: PESNOW    ! = snow emissivity
00084 REAL, DIMENSION(:)  , INTENT(OUT)  :: PENOSNOW  ! = snow free emissivity
00085 REAL, DIMENSION(:)  , INTENT(OUT)  :: PTSSNOW   ! = snow radiative temperature
00086 REAL, DIMENSION(:)  , INTENT(OUT)  :: PTSNOSNOW ! = snow free radiative temperature
00087 REAL, DIMENSION(:)  , INTENT(OUT)  :: PSNOWFREE_ALB_VEG  !snow free albedo of vegetation for EBA
00088 REAL, DIMENSION(:)  , INTENT(OUT)  :: PSNOWFREE_ALB_SOIL !snow free albedo of soil for EBA option
00089 REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBNIR_TVEG       ! nearIR  veg tot albedo
00090 REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBVIS_TVEG       ! visible veg tot albedo
00091 REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBNIR_TSOIL      ! nearIR  soil tot albedo
00092 REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBVIS_TSOIL      ! visible soil tot albedo
00093 !
00094 REAL, DIMENSION(:)  , INTENT(OUT):: PPSN    ! PPSN = grid fraction covered by snow
00095 REAL, DIMENSION(:)  , INTENT(OUT):: PPSNG   ! PPSNG = fraction of the ground covered by snow
00096 REAL, DIMENSION(:)  , INTENT(OUT):: PPSNV   ! PPSNV = fraction of the veg covered by snow 
00097 REAL, DIMENSION(:)  , INTENT(OUT):: PPSNV_A !fraction of the the vegetation covered by snow for EBA scheme
00098 !
00099 !*      0.2    declarations of local variables
00100 !
00101 REAL, DIMENSION(SIZE(PDIR_SW,1)) :: ZGLOBAL_SW                 ! global incoming SW rad.
00102 REAL, DIMENSION(SIZE(PALBNIR))   :: ZALBF
00103 REAL, DIMENSION(SIZE(PALBNIR))   :: ZFFV
00104 REAL, DIMENSION(SIZE(PALBNIR))   :: ZFFG
00105 !
00106 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00107 !-------------------------------------------------------------------------------
00108 !
00109 IF (LHOOK) CALL DR_HOOK('ISBA_PROPERTIES',0,ZHOOK_HANDLE)
00110  CALL ISBA_SNOW_FRAC(TPSNOW%SCHEME,                                        &
00111                     TPSNOW%WSNOW(:,:,KPATCH), TPSNOW%RHO(:,:,KPATCH),     &
00112                     TPSNOW%ALB  (:,KPATCH), PVEG, PLAI, PZ0,              &
00113                     PPSN, PPSNV_A, PPSNG, PPSNV                           )  
00114 !
00115 !-------------------------------------------------------------------------------
00116 !*      2.     Compute snow-free albedo
00117 !              ------------------------
00118 !
00119 !* Snow-free surface albedo for each wavelength
00120 !
00121 ZALBF         = 0.
00122 ZFFV          = 0.
00123 ZFFG          = 0.
00124 !
00125  CALL ISBA_ALBEDO(TPSNOW%SCHEME, OTR_ML,                                    &
00126                    PDIR_SW, PSCA_SW, PSW_BANDS, KSW,                       &
00127                    PALBNIR, PALBVIS, PALBUV,                               &
00128                    PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG,                   &
00129                    PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL,                &
00130                    TPSNOW%ALB(:,1), PPSNV, PPSNG, ZALBF, ZFFV, ZFFG,       &
00131                    ZGLOBAL_SW, PANOSNOW,                                   &
00132                    PSNOWFREE_ALB_VEG, PSNOWFREE_ALB_SOIL,                  &
00133                    PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL)
00134 
00135 !-------------------------------------------------------------------------------
00136 !
00137 !*      3.     Compute aggeragted albedo and emissivity
00138 !              ----------------------------------------
00139 !
00140 IF(TPSNOW%SCHEME == '3-L' .OR. TPSNOW%SCHEME == 'CRO' .OR. HISBA == 'DIF')THEN
00141 !
00142 ! NON-SNOW covered Grid averaged albedo and emissivity for explicit snow scheme:
00143 !
00144    PASNOW(:) = TPSNOW%ALB(:,KPATCH)
00145    PESNOW(:) = TPSNOW%EMIS(:,KPATCH)
00146    PENOSNOW(:) = PEMIS(:)
00147 
00148    PTSSNOW(:)   = TPSNOW%TS(:,KPATCH)
00149    PTSNOSNOW(:) = PTG(:)
00150 
00151 ELSE
00152 !
00153 ! Grid averaged albedo and emissivity for composite snow scheme:
00154 !
00155    IF(TPSNOW%SCHEME =='EBA') THEN
00156 !
00157       PASNOW(:) = TPSNOW%ALB(:,KPATCH)
00158       PESNOW(:) = XEMCRIN
00159       PENOSNOW(:) = PEMIS(:)
00160 
00161       PTSSNOW(:)   = PTG(:)
00162       PTSNOSNOW(:) = PTG(:)
00163 
00164 
00165    ELSE
00166 
00167       PASNOW(:) = TPSNOW%ALB(:,KPATCH)
00168       PESNOW(:) = XEMISSN
00169       PENOSNOW(:) = PEMIS(:)
00170 
00171       PTSSNOW(:)   = PTG(:)
00172       PTSNOSNOW(:) = PTG(:)
00173 
00174    ENDIF
00175 !
00176 ENDIF
00177 IF (LHOOK) CALL DR_HOOK('ISBA_PROPERTIES',1,ZHOOK_HANDLE)
00178 !
00179 !-------------------------------------------------------------------------------
00180 !
00181 END SUBROUTINE ISBA_PROPERTIES