SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/albedo.F90 Source File

Go to the documentation of this file.
00001 !      ###########
00002 MODULE MODI_ALBEDO
00003 !      ###########
00004 !
00005 INTERFACE ALBEDO
00006 !
00007 !
00008       SUBROUTINE ALBEDO_1D(HALBEDO,                                      &
00009                              PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG,      &
00010                              PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL,        &
00011                              PALBVIS_ECO ,PALBNIR_ECO, PALBUV_ECO,         &
00012                              PSNOW, OMASK                                  )  
00013 !
00014 !
00015 !*      0.1    declarations of arguments
00016 !              -------------------------
00017 !
00018  CHARACTER(LEN=*),       INTENT(IN)   :: HALBEDO
00019 ! Albedo dependance wxith surface soil water content
00020 !   "EVOL" = albedo evolves with soil wetness
00021 !   "DRY " = constant albedo value for dry soil
00022 !   "WET " = constant albedo value for wet soil
00023 !   "MEAN" = constant albedo value for medium soil wetness
00024 !
00025 REAL, DIMENSION(:), INTENT(IN)  :: PALBVIS_VEG ! visible, near infra-red and UV
00026 REAL, DIMENSION(:), INTENT(IN)  :: PALBNIR_VEG ! albedo of the vegetation
00027 REAL, DIMENSION(:), INTENT(IN)  :: PALBUV_VEG  !
00028 REAL, DIMENSION(:), INTENT(IN)  :: PVEG        ! fraction of vegetation
00029 REAL, DIMENSION(:), INTENT(IN)  :: PALBVIS_SOIL! visible, near infra-red and UV
00030 REAL, DIMENSION(:), INTENT(IN)  :: PALBNIR_SOIL! soil albedo
00031 REAL, DIMENSION(:), INTENT(IN)  :: PALBUV_SOIL !
00032 !
00033 REAL, DIMENSION(:), INTENT(INOUT) :: PALBVIS_ECO ! visible, near infra-red and UV
00034 REAL, DIMENSION(:), INTENT(INOUT) :: PALBNIR_ECO ! averaged albedo
00035 REAL, DIMENSION(:), INTENT(INOUT) :: PALBUV_ECO  !
00036 REAL,    DIMENSION(:), INTENT(IN), OPTIONAL  :: PSNOW ! fraction of permanent snow and ice
00037 LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL  :: OMASK ! mask where computations are done
00038 !
00039 END SUBROUTINE ALBEDO_1D
00040 !
00041 !
00042       SUBROUTINE ALBEDO_1D_PATCH(HALBEDO,                                &
00043                              PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG,      &
00044                              PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL,        &
00045                              PALBVIS_ECO ,PALBNIR_ECO, PALBUV_ECO,         &
00046                              PVEGTYPE, OMASK                               )  
00047 !
00048 !
00049 !*      0.1    declarations of arguments
00050 !              -------------------------
00051 !
00052 !
00053  CHARACTER(LEN=*),       INTENT(IN)   :: HALBEDO
00054 ! Albedo dependance wxith surface soil water content
00055 !   "EVOL" = albedo evolves with soil wetness
00056 !   "DRY " = constant albedo value for dry soil
00057 !   "WET " = constant albedo value for wet soil
00058 !   "MEAN" = constant albedo value for medium soil wetness
00059 !
00060 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBVIS_VEG ! visible, near infra-red and UV
00061 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBNIR_VEG ! albedo of the vegetation
00062 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBUV_VEG  !
00063 REAL, DIMENSION(:,:), INTENT(IN)  :: PVEG        ! fraction of vegetation
00064 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBVIS_SOIL! visible, near infra-red and UV
00065 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBNIR_SOIL! soil albedo
00066 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBUV_SOIL !
00067 !
00068 REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBVIS_ECO ! visible, near infra-red and UV
00069 REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBNIR_ECO ! averaged albedo
00070 REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBUV_ECO  !
00071 REAL,    DIMENSION(:,:), INTENT(IN), OPTIONAL :: PVEGTYPE ! vegetation type
00072 LOGICAL, DIMENSION(:),   INTENT(IN), OPTIONAL :: OMASK    ! mask where computations are done
00073 !
00074 END SUBROUTINE ALBEDO_1D_PATCH
00075 !
00076 END INTERFACE
00077 !
00078 END MODULE MODI_ALBEDO
00079 !
00080 !     ####################################################################
00081       SUBROUTINE ALBEDO_1D(HALBEDO,                                      &
00082                              PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG,      &
00083                              PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL,        &
00084                              PALBVIS_ECO ,PALBNIR_ECO, PALBUV_ECO,         &
00085                              PSNOW, OMASK                                  )  
00086 !     ####################################################################
00087 !
00088 !!****  *ALBEDO*  
00089 !!
00090 !!    PURPOSE
00091 !!    -------
00092 !       computes the albedo of the natural continental parts, from
00093 ! vegetation albedo and soil albedo.
00094 ! Soil albedo is estimated from sand fraction.
00095 ! A correction due to the soil humidity is used.
00096 !
00097 !     
00098 !!**  METHOD
00099 !!    ------
00100 !
00101 !!    EXTERNAL
00102 !!    --------
00103 !!
00104 !!    IMPLICIT ARGUMENTS
00105 !!    ------------------ 
00106 !!
00107 !!      
00108 !!    REFERENCE
00109 !!    ---------
00110 !!
00111 !!      
00112 !!    AUTHOR
00113 !!    ------
00114 !!      V. Masson           * Meteo-France *
00115 !!
00116 !!    MODIFICATIONS
00117 !!    -------------
00118 !!      Original    17/12/99 
00119 !!                  01/2004  Externalization (V. Masson)
00120 !-------------------------------------------------------------------------------
00121 !
00122 !*       0.     DECLARATIONS
00123 !               ------------
00124 !
00125 USE MODD_SNOW_PAR, ONLY : XANSMAX
00126 !
00127 !
00128 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00129 USE PARKIND1  ,ONLY : JPRB
00130 !
00131 IMPLICIT NONE
00132 !
00133 !*      0.1    declarations of arguments
00134 !              -------------------------
00135 !
00136  CHARACTER(LEN=*),       INTENT(IN)   :: HALBEDO
00137 ! Albedo dependance wxith surface soil water content
00138 !   "EVOL" = albedo evolves with soil wetness
00139 !   "DRY " = constant albedo value for dry soil
00140 !   "WET " = constant albedo value for wet soil
00141 !   "MEAN" = constant albedo value for medium soil wetness
00142 !
00143 REAL, DIMENSION(:), INTENT(IN)  :: PALBVIS_VEG ! visible, near infra-red and UV
00144 REAL, DIMENSION(:), INTENT(IN)  :: PALBNIR_VEG ! albedo of the vegetation
00145 REAL, DIMENSION(:), INTENT(IN)  :: PALBUV_VEG  !
00146 REAL, DIMENSION(:), INTENT(IN)  :: PVEG        ! fraction of vegetation
00147 REAL, DIMENSION(:), INTENT(IN)  :: PALBVIS_SOIL! visible, near infra-red and UV
00148 REAL, DIMENSION(:), INTENT(IN)  :: PALBNIR_SOIL! soil albedo
00149 REAL, DIMENSION(:), INTENT(IN)  :: PALBUV_SOIL !
00150 !
00151 REAL, DIMENSION(:), INTENT(INOUT) :: PALBVIS_ECO ! visible, near infra-red and UV
00152 REAL, DIMENSION(:), INTENT(INOUT) :: PALBNIR_ECO ! averaged albedo
00153 REAL, DIMENSION(:), INTENT(INOUT) :: PALBUV_ECO  !
00154 REAL,    DIMENSION(:), INTENT(IN), OPTIONAL  :: PSNOW ! fraction of permanent snow and ice
00155 LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL  :: OMASK ! mask where computations are done
00156 !
00157 !*      0.2    declarations of local variables
00158 !              -------------------------------
00159 !
00160 REAL, DIMENSION(SIZE(PVEG)) :: ZSNOW
00161 LOGICAL, DIMENSION(SIZE(PVEG)) :: GMASK
00162 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00163 !-------------------------------------------------------------------------------
00164 !
00165 IF (LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D',0,ZHOOK_HANDLE)
00166 IF (HALBEDO=='USER' .AND. LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D',1,ZHOOK_HANDLE)
00167 IF (HALBEDO=='USER') RETURN
00168 !
00169 GMASK=.TRUE.
00170 IF (PRESENT(OMASK)) GMASK=OMASK
00171 !
00172 ZSNOW(:) = 0.
00173 IF (PRESENT(PSNOW)) ZSNOW(:) = PSNOW(:)
00174 !
00175 WHERE (GMASK(:)) 
00176   PALBVIS_ECO (:) = ( (1.-PVEG(:)) * PALBVIS_SOIL(:) &
00177                        +    PVEG(:)  * PALBVIS_VEG (:))&
00178                      * (1-ZSNOW(:))                    &
00179                     + XANSMAX  * ZSNOW(:)    
00180 !
00181   PALBNIR_ECO (:) = ( (1.-PVEG(:)) * PALBNIR_SOIL(:) &
00182                        +    PVEG(:)  * PALBNIR_VEG (:))&
00183                      * (1-ZSNOW(:))                    &
00184                     + XANSMAX  * ZSNOW(:)    
00185 !
00186   PALBUV_ECO (:)  = ( (1.-PVEG(:)) * PALBUV_SOIL(:)  &
00187                        +    PVEG(:)  * PALBUV_VEG (:)) &
00188                      * (1-ZSNOW(:))                    &
00189                     + XANSMAX  * ZSNOW(:)    
00190 END WHERE
00191 IF (LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D',1,ZHOOK_HANDLE)
00192 !-------------------------------------------------------------------------------
00193 !
00194 END SUBROUTINE ALBEDO_1D
00195 !
00196 !     ####################################################################
00197       SUBROUTINE ALBEDO_1D_PATCH(HALBEDO,                                &
00198                              PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG,      &
00199                              PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL,        &
00200                              PALBVIS_ECO ,PALBNIR_ECO, PALBUV_ECO,         &
00201                              PVEGTYPE, OMASK                               )  
00202 !     ####################################################################
00203 !
00204 !!****  *ALBEDO*  
00205 !!
00206 !!    PURPOSE
00207 !!    -------
00208 !  computes the albedo of for different types (patches) 
00209 ! of natural continental parts, from
00210 ! vegetation albedo and soil albedo.
00211 ! Soil albedo is estimated from sand fraction.
00212 ! A correction due to the soil humidity is used.
00213 !
00214 !     
00215 !!**  METHOD
00216 !!    ------
00217 !
00218 !!    EXTERNAL
00219 !!    --------
00220 !!
00221 !!    IMPLICIT ARGUMENTS
00222 !!    ------------------ 
00223 !!
00224 !!      
00225 !!    REFERENCE
00226 !!    ---------
00227 !!
00228 !!      
00229 !!    AUTHOR
00230 !!    ------
00231 !!      F.Solmon  /  V. Masson          
00232 !!
00233 !!    MODIFICATIONS
00234 !!    -------------
00235 !!      Original     
00236 !!                  01/2004  Externalization (V. Masson)
00237 !-------------------------------------------------------------------------------
00238 !
00239 !*       0.     DECLARATIONS
00240 !               ------------
00241 !
00242 USE MODD_DATA_COVER_PAR, ONLY : NVT_SNOW
00243 USE MODD_SNOW_PAR,       ONLY : XANSMAX
00244 USE MODD_SURF_PAR,       ONLY : XUNDEF
00245 !
00246 USE MODI_VEGTYPE_TO_PATCH
00247 USE MODI_SURF_PATCH
00248 !
00249 !
00250 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00251 USE PARKIND1  ,ONLY : JPRB
00252 !
00253 IMPLICIT NONE
00254 !
00255 !*      0.1    declarations of arguments
00256 !              -------------------------
00257 !
00258  CHARACTER(LEN=*),       INTENT(IN)   :: HALBEDO
00259 ! Albedo dependance wxith surface soil water content
00260 !   "EVOL" = albedo evolves with soil wetness
00261 !   "DRY " = constant albedo value for dry soil
00262 !   "WET " = constant albedo value for wet soil
00263 !   "MEAN" = constant albedo value for medium soil wetness
00264 !
00265 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBVIS_VEG ! visible, near infra-red and UV
00266 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBNIR_VEG ! albedo of the vegetation
00267 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBUV_VEG  !
00268 REAL, DIMENSION(:,:), INTENT(IN)  :: PVEG        ! fraction of vegetation
00269 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBVIS_SOIL! visible, near infra-red and UV
00270 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBNIR_SOIL! soil albedo
00271 REAL, DIMENSION(:,:), INTENT(IN)  :: PALBUV_SOIL !
00272 !
00273 REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBVIS_ECO ! visible, near infra-red and UV
00274 REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBNIR_ECO ! averaged albedo
00275 REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBUV_ECO  !
00276 REAL,    DIMENSION(:,:), INTENT(IN), OPTIONAL :: PVEGTYPE ! vegetation type
00277 LOGICAL, DIMENSION(:),   INTENT(IN), OPTIONAL :: OMASK    ! mask where computations are done
00278 !
00279 !
00280 !*      0.2    declarations of local variables
00281 !              -------------------------------
00282 !
00283 LOGICAL, DIMENSION(SIZE(PVEG,1)) :: GMASK
00284 !
00285 REAL, DIMENSION(SIZE(PVEG,1),SIZE(PVEG,2))  ::ZPATCH, ZSNOWPATCH 
00286 INTEGER :: ISNOWPATCH !patch index for snow 
00287 INTEGER :: IPATCH     ! number of patches
00288 INTEGER :: JPATCH     !loop index for patches
00289 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00290 !-------------------------------------------------------------------------------
00291 !
00292 IF (LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D_PATCH',0,ZHOOK_HANDLE)
00293 IF (HALBEDO=='USER' .AND. LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D_PATCH',1,ZHOOK_HANDLE)
00294 IF (HALBEDO=='USER') RETURN
00295 !
00296 GMASK(:) = .TRUE.
00297 IF (PRESENT(OMASK)) GMASK(:) = OMASK(:)
00298 !
00299 IPATCH = SIZE(PVEG,2)
00300 
00301 DO JPATCH=1,IPATCH
00302   WHERE (GMASK(:))
00303     PALBVIS_ECO (:,JPATCH) = XUNDEF
00304     PALBNIR_ECO (:,JPATCH) = XUNDEF
00305     PALBUV_ECO  (:,JPATCH) = XUNDEF
00306   END WHERE
00307 END DO
00308 !
00309 !
00310 !
00311 ZSNOWPATCH (:,:) =0.
00312 !
00313 IF (PRESENT(PVEGTYPE)) THEN
00314   ! calculation of patch surfaces  (weights for average)
00315   CALL SURF_PATCH(IPATCH,PVEGTYPE,ZPATCH)
00316   ! permanent snow fraction in the corresponding patch
00317   ISNOWPATCH= VEGTYPE_TO_PATCH (NVT_SNOW,IPATCH)
00318   WHERE(GMASK(:) .AND. ZPATCH(:,ISNOWPATCH)>0.)
00319     ZSNOWPATCH (:,ISNOWPATCH)=PVEGTYPE(:,NVT_SNOW)/ZPATCH(:,ISNOWPATCH)
00320   END WHERE
00321 END IF
00322 !
00323 
00324 DO JPATCH=1,IPATCH
00325   WHERE (GMASK(:) .AND. PVEG(:,JPATCH)/=XUNDEF)
00326 
00327     PALBVIS_ECO (:,JPATCH) =(  (1.-PVEG(:,JPATCH)) * PALBVIS_SOIL(:,JPATCH)  &
00328            +    PVEG(:,JPATCH)  * PALBVIS_VEG (:,JPATCH))                      &
00329            * (1-ZSNOWPATCH(:,JPATCH))                                          &
00330            + XANSMAX  * ZSNOWPATCH(:,JPATCH)   
00331     !
00332     PALBNIR_ECO (:,JPATCH) =(  (1.-PVEG(:,JPATCH)) * PALBNIR_SOIL(:,JPATCH)  &
00333            +      PVEG(:,JPATCH)  * PALBNIR_VEG (:,JPATCH))                    &
00334            * (1-ZSNOWPATCH(:,JPATCH))                                          &
00335            + XANSMAX  * ZSNOWPATCH(:,JPATCH)   
00336     !
00337     PALBUV_ECO  (:,JPATCH) =(  (1.-PVEG(:,JPATCH)) * PALBUV_SOIL (:,JPATCH)  &
00338            +      PVEG(:,JPATCH)  * PALBUV_VEG  (:,JPATCH))                    &
00339            * (1-ZSNOWPATCH(:,JPATCH))                                          &
00340            + XANSMAX  * ZSNOWPATCH(:,JPATCH)   
00341   END WHERE
00342 END DO
00343 IF (LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D_PATCH',1,ZHOOK_HANDLE)
00344 !-------------------------------------------------------------------------------
00345 !
00346 END SUBROUTINE ALBEDO_1D_PATCH