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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE ALBEDO_FROM_NIR_VIS(PSW_BANDS,PALBNIR,PALBVIS,PALBUV,PDIR_ALB,PSCA_ALB)
00003 !     ###########################################################################
00004 !
00005 !!****  *ALBEDO_FROM_NIR_VIS* - routine to initialize albedo for
00006 !!                              any wavelength from near-infra-red,
00007 !!                              visible and UV albedo
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !!
00012 !!**  METHOD
00013 !!    ------
00014 !!
00015 !!    EXTERNAL
00016 !!    --------
00017 !!
00018 !!
00019 !!    IMPLICIT ARGUMENTS
00020 !!    ------------------
00021 !!
00022 !!    REFERENCE
00023 !!    ---------
00024 !!
00025 !!
00026 !!    AUTHOR
00027 !!    ------
00028 !!      V. Masson   *Meteo France*      
00029 !!
00030 !!    MODIFICATIONS
00031 !!    -------------
00032 !!      Original    02/2003 
00033 !-------------------------------------------------------------------------------
00034 !
00035 !*       0.    DECLARATIONS
00036 !              ------------
00037 !
00038 USE MODD_ISBA_PAR,   ONLY : XRED_EDGE, XUV_EDGE
00039 USE MODD_SURF_PAR,   ONLY : XUNDEF
00040 !
00041 !
00042 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00043 USE PARKIND1  ,ONLY : JPRB
00044 !
00045 IMPLICIT NONE
00046 !
00047 !*       0.1   Declarations of arguments
00048 !              -------------------------
00049 !
00050 REAL, DIMENSION(:),   INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
00051 REAL, DIMENSION(:),   INTENT(IN) :: PALBNIR   ! near infra-red albedo
00052 REAL, DIMENSION(:),   INTENT(IN) :: PALBVIS   ! visible albedo
00053 REAL, DIMENSION(:),   INTENT(IN) :: PALBUV    ! UV albedo
00054 REAL, DIMENSION(:,:), INTENT(OUT):: PDIR_ALB  ! direct  albedo for each wavelength
00055 REAL, DIMENSION(:,:), INTENT(OUT):: PSCA_ALB  ! diffuse albedo for each wavelength
00056 !
00057 !*       0.2   Declarations of local variables
00058 !              -------------------------------
00059 !
00060 INTEGER :: ISWB ! number of SW spectral bands
00061 INTEGER :: JSWB ! loop counter on number of SW spectral bands
00062 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00063 !-------------------------------------------------------------------------------
00064 !
00065 IF (LHOOK) CALL DR_HOOK('ALBEDO_FROM_NIR_VIS',0,ZHOOK_HANDLE)
00066 ISWB = SIZE(PSW_BANDS)
00067 !
00068 PDIR_ALB(:,:) = XUNDEF
00069 PSCA_ALB(:,:) = XUNDEF
00070 !
00071 IF (ISWB==1) THEN
00072   WHERE(PALBNIR(:)/= XUNDEF) PDIR_ALB(:,1) = 0.5*(PALBNIR(:)+PALBVIS(:))
00073 ELSE 
00074   DO JSWB=1,ISWB
00075     IF (PSW_BANDS(JSWB)>XRED_EDGE ) THEN      ! XRED_EDGE=0.7 micro-m
00076       PDIR_ALB(:,JSWB) = PALBNIR(:)
00077     ELSE IF (PSW_BANDS(JSWB)<XUV_EDGE ) THEN  ! XUV_EDGE=0.25 micro-m
00078       PDIR_ALB(:,JSWB) = PALBUV (:)
00079     ELSE
00080       PDIR_ALB(:,JSWB) = PALBVIS(:)
00081     END IF
00082   END DO
00083 END IF
00084 !
00085 PSCA_ALB(:,:) = PDIR_ALB(:,:)
00086 IF (LHOOK) CALL DR_HOOK('ALBEDO_FROM_NIR_VIS',1,ZHOOK_HANDLE)
00087 !-------------------------------------------------------------------------------
00088 !
00089 END SUBROUTINE ALBEDO_FROM_NIR_VIS