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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE FLAKE_ALBEDO( PDIR_SW   , PSCA_SW , KSW,      &
00003                                PDIR_ALB  , PSCA_ALB,           &
00004                                PGLOBAL_SW, PALB                )
00005 !     ##########################################################################
00006 !
00007 !!****  *FLAKE_ALBEDO*  
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !
00012 !     Calculates  albedo and emissivity 
00013 !         
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!    none
00018 !!
00019 !!    IMPLICIT ARGUMENTS
00020 !!    ------------------ 
00021 !!      
00022 !!    AUTHOR
00023 !!    ------
00024 !!
00025 !!      P. Le Moigne           * Meteo-France *
00026 !-------------------------------------------------------------------------------
00027 !
00028 !*       0.     DECLARATIONS
00029 !               ------------
00030 !
00031 !
00032 USE MODD_SURF_PAR,     ONLY : XUNDEF
00033 !
00034 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00035 USE PARKIND1  ,ONLY : JPRB
00036 !
00037 IMPLICIT NONE
00038 !
00039 !*      0.1    declarations of arguments
00040 !
00041 REAL, DIMENSION(:,:), INTENT(IN)   :: PDIR_SW            ! direct incoming solar radiation
00042 REAL, DIMENSION(:,:), INTENT(IN)   :: PSCA_SW            ! diffuse incoming solar radiation
00043 REAL, DIMENSION(:,:), INTENT(IN)   :: PDIR_ALB           ! direct  albedo
00044 REAL, DIMENSION(:,:), INTENT(IN)   :: PSCA_ALB           ! diffuse albedo
00045 INTEGER,              INTENT(IN)   :: KSW                ! number of short-wave spectral bands
00046 !
00047 REAL, DIMENSION(:)  , INTENT(OUT)  :: PGLOBAL_SW         ! global incoming SW rad.
00048 REAL, DIMENSION(:)  , INTENT(OUT)  :: PALB               ! albedo 
00049 !
00050 !-------------------------------------------------------------------------------
00051 !
00052 !*      0.     Local variables
00053 !              ---------------
00054 !
00055 INTEGER                          :: JSWB
00056 REAL, DIMENSION(SIZE(PDIR_SW))      :: ZSW_UP
00057 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00058 !
00059 !-------------------------------------------------------------------------------
00060 !
00061 !*      1.     surface albedo for each wavelength
00062 !              ----------------------------------
00063 !
00064 IF (LHOOK) CALL DR_HOOK('FLAKE_ALBEDO',0,ZHOOK_HANDLE)
00065 !
00066 !* total shortwave incoming radiation
00067 !
00068   PGLOBAL_SW(:) = 0.
00069   DO JSWB=1,KSW
00070     PGLOBAL_SW(:) = PGLOBAL_SW(:) + (PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB))
00071   END DO
00072 !
00073 !* global albedo
00074 !
00075   ZSW_UP(:) = 0. 
00076   DO JSWB=1,KSW
00077     ZSW_UP(:) =  ZSW_UP(:)                            &
00078                  + PDIR_ALB(:,JSWB) * PDIR_SW(:,JSWB) &
00079                  + PSCA_ALB(:,JSWB) * PSCA_SW(:,JSWB)  
00080   END DO
00081 
00082   PALB(:) = XUNDEF
00083   WHERE(PGLOBAL_SW(:)>0.)  
00084        PALB(:) = ZSW_UP(:) / PGLOBAL_SW(:)
00085   ELSEWHERE
00086        PALB(:) = PDIR_ALB(:,1)
00087   END WHERE
00088 !
00089 IF (LHOOK) CALL DR_HOOK('FLAKE_ALBEDO',1,ZHOOK_HANDLE)
00090 !
00091 !-------------------------------------------------------------------------------
00092 !
00093 END SUBROUTINE FLAKE_ALBEDO