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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE AVG_ALBEDO_EMIS_GARDEN(HALBEDO,          &
00003                                  PVEG,PZ0,PLAI,PTG1,        &
00004                                  PSW_BANDS,                 &
00005                                  PALBNIR_VEG,PALBVIS_VEG,   &
00006                                  PALBUV_VEG,                &
00007                                  PALBNIR_SOIL,PALBVIS_SOIL, &
00008                                  PALBUV_SOIL,               &
00009                                  PEMIS_ECO,                 &
00010                                  TPSNOW,                    &
00011                                  PALBNIR_ECO,PALBVIS_ECO,   &
00012                                  PALBUV_ECO,                &
00013                                  PDIR_ALB,PSCA_ALB,         &
00014                                  PEMIS,PTSRAD               )  
00015 !     ###################################################
00016 !
00017 !!**** ** computes radiative fields used in GARDEN
00018 !!
00019 !!    PURPOSE
00020 !!    -------
00021 !!
00022 !!    METHOD
00023 !!    ------
00024 !!   
00025 !!    EXTERNAL
00026 !!    --------
00027 !!
00028 !!    IMPLICIT ARGUMENTS
00029 !!    ------------------
00030 !!
00031 !!    REFERENCE
00032 !!    ---------
00033 !!
00034 !!    AUTHOR
00035 !!    ------
00036 !!
00037 !!    V. Masson        Meteo-France
00038 !!
00039 !!    MODIFICATION
00040 !!    ------------
00041 !!
00042 !!    Original    01/2004
00043 !!     A. Bogatchev 09/2005 EBA snow option
00044 !!     B. Decharme  2008    The fraction of vegetation covered by snow must be
00045 !                            <= to XPSNG
00046 !----------------------------------------------------------------------------
00047 !
00048 !*    0.     DECLARATION
00049 !            -----------
00050 !
00051 USE MODD_SURF_PAR,  ONLY : XUNDEF
00052 !
00053 USE MODD_TYPE_SNOW
00054 !
00055 USE MODD_SNOW_PAR,   ONLY : XEMISSN
00056 USE MODD_SURF_PAR,   ONLY : XUNDEF
00057 !
00058 USE MODD_TEB_GARDEN_n,    ONLY : TSNOW, XPSN, XPSNV_A, XPSNG, XPSNV
00059 !
00060 USE MODI_ALBEDO
00061 USE MODI_ALBEDO_FROM_NIR_VIS
00062 USE MODI_ISBA_SNOW_FRAC
00063 !
00064 !
00065 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00066 USE PARKIND1  ,ONLY : JPRB
00067 !
00068 IMPLICIT NONE
00069 !
00070 !*    0.1    Declaration of arguments
00071 !            ------------------------
00072 !
00073  CHARACTER(LEN=4),       INTENT(IN)   :: HALBEDO     ! albedo type
00074 ! Albedo dependance with surface soil water content
00075 !   "EVOL" = albedo evolves with soil wetness
00076 !   "DRY " = constant albedo value for dry soil
00077 !   "WET " = constant albedo value for wet soil
00078 !   "MEAN" = constant albedo value for medium soil wetness
00079 !
00080 REAL, DIMENSION(:),   INTENT(IN)   :: PVEG        ! vegetation fraction
00081 REAL, DIMENSION(:),   INTENT(IN)   :: PZ0         ! roughness length
00082 REAL, DIMENSION(:),   INTENT(IN)   :: PLAI        ! leaf area index
00083 REAL, DIMENSION(:),   INTENT(IN)   :: PTG1        ! soil surface temperature
00084 REAL, DIMENSION(:),     INTENT(IN)   :: PSW_BANDS   ! middle wavelength of each band 
00085 
00086 REAL, DIMENSION(:),   INTENT(IN)   :: PALBNIR_VEG ! near-infra-red albedo of vegetation
00087 REAL, DIMENSION(:),   INTENT(IN)   :: PALBVIS_VEG ! visible albedo of vegetation
00088 REAL, DIMENSION(:),   INTENT(IN)   :: PALBUV_VEG  ! UV albedo of vegetation
00089 REAL, DIMENSION(:),   INTENT(IN)   :: PALBNIR_SOIL! near-infra-red albedo of soil
00090 REAL, DIMENSION(:),   INTENT(IN)   :: PALBVIS_SOIL! visible albedo of soil
00091 REAL, DIMENSION(:),   INTENT(IN)   :: PALBUV_SOIL ! UV albedo of soil
00092 REAL, DIMENSION(:),   INTENT(IN)   :: PEMIS_ECO   ! emissivity (soil+vegetation)
00093 TYPE(SURF_SNOW),        INTENT(IN)   :: TPSNOW      ! prognostic snow cover
00094 !
00095 REAL, DIMENSION(:),   INTENT(OUT)  :: PALBNIR_ECO ! near-infra-red albedo (soil+vegetation)
00096 REAL, DIMENSION(:),   INTENT(OUT)  :: PALBVIS_ECO ! visible albedo (soil+vegetation)
00097 REAL, DIMENSION(:),   INTENT(OUT)  :: PALBUV_ECO  ! UV albedo (soil+vegetation)
00098 !
00099 REAL, DIMENSION(:,:),   INTENT(OUT)  :: PDIR_ALB    ! averaged direct albedo  (per wavelength)
00100 REAL, DIMENSION(:,:),   INTENT(OUT)  :: PSCA_ALB    ! averaged diffuse albedo (per wavelength)
00101 REAL, DIMENSION(:),     INTENT(OUT)  :: PEMIS       ! averaged emissivity
00102 REAL, DIMENSION(:),     INTENT(OUT)  :: PTSRAD      ! averaged radiaitve temp.
00103 !
00104 !
00105 !*    0.2    Declaration of local variables
00106 !            ------------------------------
00107 !
00108 !
00109 REAL, DIMENSION(SIZE(PALBNIR_VEG)) :: ZALBNIR ! near-infra-red albedo with snow
00110 REAL, DIMENSION(SIZE(PALBVIS_VEG)) :: ZALBVIS ! visible albedo with snow
00111 REAL, DIMENSION(SIZE(PALBUV_VEG )) :: ZALBUV  ! UV albedo with snow
00112 !
00113 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00114 !-------------------------------------------------------------------------------
00115 !
00116 !
00117 !*    1.      averaged albedo on natural continental surfaces (except prognostic snow)
00118 !             -----------------------------------------------
00119 !
00120 IF (LHOOK) CALL DR_HOOK('AVG_ALBEDO_EMIS_GARDEN',0,ZHOOK_HANDLE)
00121  CALL ALBEDO(HALBEDO,                                    &
00122               PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG,    &
00123               PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL,      &
00124               PALBVIS_ECO,PALBNIR_ECO,PALBUV_ECO          )  
00125 
00126 !
00127 !*    2.      averaged albedo and emis. on natural continental surfaces (with prognostic snow)
00128 !             ---------------------------------------------------------
00129 !
00130 ZALBNIR(:)=0.
00131 ZALBVIS(:)=0.
00132 ZALBUV (:)=0.
00133 !
00134 PDIR_ALB(:,:)=0.
00135 PSCA_ALB(:,:)=0.
00136 PEMIS   (:)  =0.
00137 PTSRAD  (:)  =0.
00138 !   
00139 !
00140   CALL ISBA_SNOW_FRAC(TSNOW%SCHEME,           &
00141          TSNOW%WSNOW(:,:,1), TSNOW%RHO(:,:,1),&
00142          TSNOW%ALB  (:,1),                    &
00143          PVEG(:), PLAI(:), PZ0(:),            &
00144          XPSN(:), XPSNV_A(:),                 &
00145          XPSNG(:), XPSNV(:)                   )
00146 !
00147  WHERE (PVEG(:)/=XUNDEF)
00148 !
00149 ! albedo on this tile
00150 !
00151     ZALBNIR(:) = (1.-XPSN(:))*PALBNIR_ECO(:) &
00152                 +    XPSN(:) *TPSNOW%ALB (:,1)  
00153       
00154     ZALBVIS(:) = (1.-XPSN(:))*PALBVIS_ECO(:) &
00155                 +    XPSN(:) *TPSNOW%ALB (:,1)  
00156       
00157     ZALBUV(:)  = (1.-XPSN(:))*PALBUV_ECO (:) &
00158                 +    XPSN(:) *TPSNOW%ALB (:,1)  
00159   END WHERE
00160 !
00161 !* albedo for each wavelength
00162 !
00163   CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS,ZALBNIR, ZALBVIS, ZALBUV,  &
00164                            PDIR_ALB(:,:), PSCA_ALB(:,:)         )  
00165 !
00166 ! emissivity
00167 !
00168   WHERE (PEMIS_ECO(:)/=XUNDEF)
00169     PEMIS(:)   = (1.-XPSN(:))*PEMIS_ECO  (:) &
00170                 +    XPSN(:) *XEMISSN  
00171   END WHERE
00172 !
00173 !* radiative surface temperature
00174 !
00175   IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA') THEN
00176     PTSRAD(:) = PTG1(:)
00177   ELSE IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
00178     WHERE (PEMIS_ECO(:)/=XUNDEF)
00179     PTSRAD(:) =( ( (1.-XPSN(:))*PEMIS      (:)       *PTG1     (:)**4         &
00180                   +    XPSN(:) *TPSNOW%EMIS(:,1)*TPSNOW%TS(:,1)**4 ) )**0.25  &
00181                              / PEMIS(:)**0.25  
00182     END WHERE
00183   END IF
00184 !
00185 IF (LHOOK) CALL DR_HOOK('AVG_ALBEDO_EMIS_GARDEN',1,ZHOOK_HANDLE)
00186 !
00187 !-------------------------------------------------------------------------------
00188 !
00189 END SUBROUTINE AVG_ALBEDO_EMIS_GARDEN