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

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