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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE ISBA_ALBEDO(HSNOW, OTR_ML,                               &
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                                PSNOWALB, PPSNV, PPSNG, PFALB, PFFV, PFFG, &
00008                                PGLOBAL_SW, PSNOWFREE_ALB,                 &
00009                                PSNOWFREE_ALB_VEG, PSNOWFREE_ALB_SOIL,     &
00010                                PALBNIR_TVEG, PALBVIS_TVEG,                &
00011                                PALBNIR_TSOIL, PALBVIS_TSOIL             )  
00012 !     ##########################################################################
00013 !
00014 !!****  *ISBA_ALBEDO*  
00015 !!
00016 !!    PURPOSE
00017 !!    -------
00018 !
00019 !     Calculates grid-averaged albedo and emissivity (according to snow scheme)
00020 !         
00021 !!    EXTERNAL
00022 !!    --------
00023 !!
00024 !!    none
00025 !!
00026 !!    IMPLICIT ARGUMENTS
00027 !!    ------------------ 
00028 !!      
00029 !!    AUTHOR
00030 !!    ------
00031 !!
00032 !!      S. Belair           * Meteo-France *
00033 !-------------------------------------------------------------------------------
00034 !
00035 !*       0.     DECLARATIONS
00036 !               ------------
00037 !
00038 !
00039 USE MODD_SURF_PAR,     ONLY : XUNDEF
00040 !
00041 USE MODI_ALBEDO_FROM_NIR_VIS
00042 !
00043 !
00044 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00045 USE PARKIND1  ,ONLY : JPRB
00046 !
00047 IMPLICIT NONE
00048 !
00049 !*      0.1    declarations of arguments
00050 !
00051  CHARACTER(LEN=*)    , INTENT(IN)   :: HSNOW      ! ISBA snow scheme
00052 LOGICAL,              INTENT(IN)   :: OTR_ML
00053 !
00054 REAL, DIMENSION(:,:), INTENT(IN)   :: PDIR_SW            ! direct incoming solar radiation
00055 REAL, DIMENSION(:,:), INTENT(IN)   :: PSCA_SW            ! diffus incoming solar radiation
00056 REAL, DIMENSION(:)  , INTENT(IN)   :: PSW_BANDS          ! mean wavelength of each shortwave band (m)
00057 INTEGER,              INTENT(IN)   :: KSW                ! number of short-wave spectral bands
00058 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBNIR            ! nearIR  total albedo
00059 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBVIS            ! visible total albedo
00060 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBUV             ! UV      total albedo
00061 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBNIR_VEG        ! nearIR  veg   albedo
00062 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBVIS_VEG        ! visible veg   albedo
00063 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBUV_VEG         ! UV      veg   albedo
00064 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBNIR_SOIL       ! nearIR  soil  albedo
00065 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBVIS_SOIL       ! visible soil  albedo
00066 REAL, DIMENSION(:)  , INTENT(IN)   :: PALBUV_SOIL        ! UV      soil  albedo
00067 REAL, DIMENSION(:)  , INTENT(IN)   :: PSNOWALB           ! Snow albedo
00068 REAL, DIMENSION(:)  , INTENT(IN)   :: PPSNV              ! fraction of the the veg.
00069 !                                                        ! covered by snow
00070 REAL, DIMENSION(:)  , INTENT(IN)   :: PPSNG              ! fraction of the the bare
00071 !                                                        ! ground covered by snow
00072 REAL, DIMENSION(:)  , INTENT(IN)   :: PFALB              ! Floodplain albedo
00073 REAL, DIMENSION(:)  , INTENT(IN)   :: PFFV               ! Floodplain fraction over vegetation
00074 REAL, DIMENSION(:)  , INTENT(IN)   :: PFFG               ! Floodplain fraction over the ground
00075 !
00076 REAL, DIMENSION(:)  , INTENT(OUT)  :: PGLOBAL_SW         ! global incoming SW rad.
00077 REAL, DIMENSION(:)  , INTENT(OUT)  :: PSNOWFREE_ALB      !snow free albedo 
00078 REAL, DIMENSION(:)  , INTENT(OUT)  :: PSNOWFREE_ALB_VEG  !snow free albedo of vegetation for EBA
00079 REAL, DIMENSION(:)  , INTENT(OUT)  :: PSNOWFREE_ALB_SOIL !snow free albedo of soil for EBA option
00080 REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBNIR_TVEG       ! nearIR  veg tot albedo
00081 REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBVIS_TVEG       ! visible veg tot albedo
00082 REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBNIR_TSOIL      ! nearIR  soil tot albedo
00083 REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBVIS_TSOIL      ! visible soil tot albedo
00084 !
00085 !-------------------------------------------------------------------------------
00086 !
00087 !*      0.     Local variables
00088 !              ---------------
00089 !
00090 INTEGER                          :: JLAYER
00091 INTEGER                          :: JSWB
00092 REAL, DIMENSION(SIZE(PALBNIR))      :: ZSW_UP
00093 REAL, DIMENSION(SIZE(PALBNIR),KSW)  :: ZDIR_ALB_WITHOUT_SNOW
00094 REAL, DIMENSION(SIZE(PALBNIR),KSW)  :: ZSCA_ALB_WITHOUT_SNOW
00095 REAL, DIMENSION(SIZE(PALBNIR),KSW)  :: ZDIR_ALB_VEG_WITHOUT_SNOW
00096 REAL, DIMENSION(SIZE(PALBNIR),KSW)  :: ZSCA_ALB_VEG_WITHOUT_SNOW
00097 REAL, DIMENSION(SIZE(PALBNIR),KSW)  :: ZDIR_ALB_SOIL_WITHOUT_SNOW
00098 REAL, DIMENSION(SIZE(PALBNIR),KSW)  :: ZSCA_ALB_SOIL_WITHOUT_SNOW
00099 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00100 !
00101 !-------------------------------------------------------------------------------
00102 !
00103 !*      2.     Compute snow-free albedo
00104 !              ------------------------
00105 !
00106 !* Snow-free surface albedo for each wavelength
00107 !
00108 IF (LHOOK) CALL DR_HOOK('ISBA_ALBEDO',0,ZHOOK_HANDLE)
00109 !
00110 IF (OTR_ML) THEN
00111   PALBNIR_TVEG (:) = ( 1.-PPSNV(:)-PFFV(:))*PALBNIR_VEG(:)  + PPSNV(:)*PSNOWALB(:) + PFFV(:)*PFALB(:)
00112   PALBNIR_TSOIL(:) = ( 1.-PPSNG(:)-PFFG(:))*PALBNIR_SOIL(:) + PPSNG(:)*PSNOWALB(:) + PFFG(:)*PFALB(:)   
00113   PALBVIS_TVEG (:) = ( 1.-PPSNV(:)-PFFV(:))*PALBVIS_VEG(:)  + PPSNV(:)*PSNOWALB(:) + PFFV(:)*PFALB(:)
00114   PALBVIS_TSOIL(:) = ( 1.-PPSNG(:)-PFFG(:))*PALBVIS_SOIL(:) + PPSNG(:)*PSNOWALB(:) + PFFG(:)*PFALB(:)
00115 ENDIF
00116 !
00117  CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS, PALBNIR, PALBVIS, PALBUV,         &
00118                            ZDIR_ALB_WITHOUT_SNOW, ZSCA_ALB_WITHOUT_SNOW )  
00119 !
00120 !* total shortwave incoming radiation
00121 !
00122   PGLOBAL_SW(:) = 0.
00123   DO JSWB=1,KSW
00124     PGLOBAL_SW(:) = PGLOBAL_SW(:) + (PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB))
00125   END DO
00126 !
00127 !* snow-free global albedo (needed by ISBA)
00128 !
00129   ZSW_UP(:) = 0. 
00130   DO JSWB=1,KSW
00131     ZSW_UP(:) =  ZSW_UP(:)                                       &
00132                  + ZDIR_ALB_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
00133                  + ZSCA_ALB_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)  
00134   END DO
00135   PSNOWFREE_ALB(:) = XUNDEF
00136   WHERE(PGLOBAL_SW(:)>0.)  
00137        PSNOWFREE_ALB(:) = ZSW_UP(:) / PGLOBAL_SW(:)
00138   ELSEWHERE
00139        PSNOWFREE_ALB(:) = ZDIR_ALB_WITHOUT_SNOW(:,1)
00140   END WHERE
00141 !
00142   IF(HSNOW == 'EBA') THEN
00143      CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS,            &
00144                PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, &
00145                ZDIR_ALB_VEG_WITHOUT_SNOW,            &
00146                ZSCA_ALB_VEG_WITHOUT_SNOW             )  
00147      ZSW_UP(:) = 0.
00148      DO JSWB=1,KSW
00149         ZSW_UP(:) =  ZSW_UP(:)                                           &
00150                      + ZDIR_ALB_VEG_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
00151                      + ZSCA_ALB_VEG_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)  
00152      END DO
00153      PSNOWFREE_ALB_VEG(:) = XUNDEF
00154      WHERE(PGLOBAL_SW(:)>0.)  PSNOWFREE_ALB_VEG(:) = ZSW_UP(:) / PGLOBAL_SW(:)
00155 !
00156      CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS,               &
00157                PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, &
00158                ZDIR_ALB_SOIL_WITHOUT_SNOW,              &
00159                ZSCA_ALB_SOIL_WITHOUT_SNOW               )  
00160      ZSW_UP(:) = 0.
00161      DO JSWB=1,KSW
00162         ZSW_UP(:) =  ZSW_UP(:)                                            &
00163                      + ZDIR_ALB_SOIL_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
00164                      + ZSCA_ALB_SOIL_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)  
00165      END DO
00166      PSNOWFREE_ALB_SOIL(:) = XUNDEF
00167      WHERE(PGLOBAL_SW(:)>0.)  PSNOWFREE_ALB_SOIL(:) = ZSW_UP(:) / PGLOBAL_SW(:)             
00168   ENDIF
00169 IF (LHOOK) CALL DR_HOOK('ISBA_ALBEDO',1,ZHOOK_HANDLE)
00170 !
00171 !-------------------------------------------------------------------------------
00172 !
00173 END SUBROUTINE ISBA_ALBEDO