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

Go to the documentation of this file.
00001 !     ######
00002 SUBROUTINE FAPAIR(PABC, PIA, PLAI, PXMUS, PSSA_SUP, PSSA_INF, &
00003            PB_SUP, PB_INF, PALB_VEG, PALB_SOIL, OSHADE,            &
00004            PFAPR, PFAPR_BS, PLAI_EFF, PIACAN,                      &
00005            PIACAN_SHADE, PIACAN_SUNLIT, PFRAC_SUN                  )
00006 !   #########################################################################
00007 !
00008 !!****  *FAPAIR*  
00009 !!
00010 !!    PURPOSE
00011 !!    -------
00012 !!    Calculates FAPAR and FAPIR of vegetation and bare soil.
00013 !!              
00014 !!**  METHOD
00015 !!    ------
00016 !!    Carrer et al. 
00017 !!
00018 !!    EXTERNAL
00019 !!    --------
00020 !!    none
00021 !!
00022 !!    IMPLICIT ARGUMENTS
00023 !!    ------------------
00024 !!      
00025 !!    USE MODD_SURF_PAR
00026 !!    USE MODD_CSTS
00027 !!    USE MODI_CCETR_PAIR
00028 !!
00029 !!    REFERENCE
00030 !!    ---------
00031 !!     Carrer et al. ??
00032 !!      
00033 !!    AUTHOR
00034 !!    ------
00035 !!      D. Carrer          * Meteo-France *
00036 !!
00037 !!    MODIFICATIONS
00038 !!    -------------
00039 !!      Original    01/04/2011 
00040 !!
00041 !-------------------------------------------------------------------------------
00042 USE MODD_SURF_PAR,       ONLY : XUNDEF
00043 USE MODD_CSTS,           ONLY : XI0
00044 USE MODD_CO2V_PAR,   ONLY : XK_SUP, XK_INF, XXSI_SUP, XXSI_INF 
00045 !
00046 USE MODI_CCETR_PAIR  
00047 !
00048 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00049 USE PARKIND1  ,ONLY : JPRB
00050 !
00051 !*       0.     DECLARATIONS
00052 !               ------------
00053 !
00054 IMPLICIT NONE
00055 !
00056 !*      0.1    declarations of arguments
00057 !
00058 REAL, DIMENSION(:), INTENT(IN) :: PABC    ! abscissa needed for integration
00059 !                                         ! of net assimilation and stomatal
00060 !                                         ! conductance over canopy depth
00061 REAL, DIMENSION(:), INTENT(IN) :: PIA     ! PIA   = absorbed PAR / PIR                               
00062 REAL, DIMENSION(:), INTENT(IN) :: PLAI    ! PLAI  = leaf area index
00063 REAL, DIMENSION(:), INTENT(IN) :: PXMUS   ! cosine of solar zenith angle
00064 REAL,               INTENT(IN) :: PSSA_SUP, PSSA_INF
00065 REAL, DIMENSION(:), INTENT(IN) :: PB_SUP, PB_INF 
00066 REAL, DIMENSION(:), INTENT(IN) :: PALB_VEG, PALB_SOIL
00067 LOGICAL, DIMENSION(:), INTENT(IN) :: OSHADE   ! OSHADE = if 1 shading activated
00068 !
00069 REAL, DIMENSION(:), INTENT(OUT) :: PFAPR
00070 REAL, DIMENSION(:), INTENT(OUT) :: PFAPR_BS
00071 REAL, DIMENSION(:), OPTIONAL,   INTENT(OUT) :: PLAI_EFF
00072 !
00073 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PIACAN ! PAR in the canopy at different gauss level
00074 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PIACAN_SHADE  ! PAR in the canopy at different gauss level
00075 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PIACAN_SUNLIT ! PAR in the canopy at different gauss level
00076 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PFRAC_SUN     ! fraction of sunlit leaves
00077 !
00078 !*      0.2    declarations of local variables
00079 !
00080 !
00081 REAL, DIMENSION(SIZE(PLAI))   :: ZXIA, ZXIA_SUP, ZKMUSP_SUP, ZKMUSP_INF
00082 REAL, DIMENSION(SIZE(PLAI))   :: ZB_DR_SUP, ZB_DR_INF, ZOMEGA_DR_SUP, ZOMEGA_DR_INF, 
00083                                  ZOMEGA_DF_SUP, ZOMEGA_DF_INF
00084 !                                ZXIA  = abs. radiation of vegetation
00085 REAL, DIMENSION(SIZE(PLAI))   :: ZTR, ZFD_SKY, ZFD_VEG, ZFD_SUP, ZLAI_EFF0, ZLAI_EFF
00086 !                                ZTR = transmittance       
00087 !REAL, DIMENSION(SIZE(PLAI))    :: ZXIA_SUNLIT, ZXIA_SHADE, ZLAI_SUNLIT, ZLAI_SHADE
00088 !                                 ZXIA_SUNLIT = absorbed PAR of sunlit leaves
00089 !                                 ZXIA_SHADE = absorbed PAR of shaded leaves
00090 !                                 ZLAI_SUNLIT = LAI of sunlit leaves
00091 !                                 ZLAI_SHADE = LAI of shaded leaves
00092 !REAL, DIMENSION(SIZE(PLAI))    :: ZRN_SUNLIT, ZRN_SHADE
00093 REAL, DIMENSION(SIZE(PLAI),SIZE(PABC)) :: ZIACAN, ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN
00094 REAL                           :: ZABC, ZWEIGHT, ZCOEF,  ZRATIO, ZTAU, ZSUP, ZINF, 
00095                                   ZSSA_SUP, ZSSA_INF, ZB_DF_SUP, ZB_DF_INF
00096 !                                            ZABC    = abscissa needed for integration
00097 !                                                     of net assimilation and stomatal 
00098 !                                                     conductance over canopy depth 
00099 !                                                     (working scalar)
00100 INTEGER                        :: JINT, I ! index for loops
00101 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00102 !-------------------------------------------------------------------------------
00103 IF (LHOOK) CALL DR_HOOK('FAPAIR',0,ZHOOK_HANDLE)
00104 !
00105 ! initialisation
00106 !
00107 ZTR(:)      = 1.0
00108 !
00109 ZXIA_SUP(:) = 0.
00110 !
00111 ZFD_SKY(:) = 0.
00112 ZFD_VEG(:)  = 0.
00113 ZFD_SUP(:)  = 0.
00114 !
00115 !ZXIA_SUNLIT(:) = 0.
00116 !ZXIA_SHADE(:)  = 0.
00117 !ZLAI_SUNLIT(:) = 0.
00118 !ZLAI_SHADE(:)  = 0.
00119 !
00120 ZLAI_EFF(:) = 0.
00121 !
00122 ZIACAN(:,:)        = 0.
00123 ZIACAN_SUNLIT(:,:) = 0.
00124 ZIACAN_SHADE(:,:)  = 0.
00125 ZFRAC_SUN(:,:)     = 0.
00126 !
00127 PFAPR(:)    = 0.
00128 PFAPR_BS(:) = 0.
00129 !PRN_SHADE(:) = 0.
00130 !PRN_SUNLIT(:) = 0.
00131 !
00132 !
00133 ZTAU = EXP(-0.1) !  AOD is arbitrary fixed to low value...
00134 !
00135 ! the global radiation is estimated as a fraction of 
00136 DO I=1,SIZE(PIA)
00137   IF (PIA(I) > 0.) THEN
00138     ! estimate fraction of diffuse radiation by Erbs (1982)
00139     ! 0.48 : factor to convert from the shortwave to the  PAR band [0.4-0.7µm]
00140     ZRATIO = PIA(I)/0.48/XI0/PXMUS(I)
00141     IF (ZRATIO < 0.22) THEN
00142       ZFD_SKY(I) = (1 - 0.09*ZRATIO)
00143     ELSE IF (ZRATIO < 0.8) THEN
00144       ZFD_SKY(I) = (0.9511 + (-0.1604 + (4.388 + (-16.64 + 12.34*ZRATIO)*ZRATIO)*ZRATIO)*ZRATIO)
00145     ELSE
00146       !!$ PXFD_SKY(I) = PIA(I)*0.165  ! original Erbs formulation
00147       !if clear sky, the diffuse fraction depends on aerosol load
00148       ZFD_SKY(I) = (1. - ZTAU) /(1. - (1.-PXMUS(I))*ZTAU)
00149     ENDIF
00150   ENDIF
00151 END DO
00152 !
00153 IF (PABC(SIZE(PABC)).GT.0.8) ZFD_VEG(:) = MIN(ZFD_SKY(:),1.)
00154 !
00155 ! set param sup / inf
00156 !
00157 ZSSA_SUP = SQRT(1.-PSSA_SUP)
00158 ZSSA_INF = SQRT(1.-PSSA_INF)
00159 !
00160 ZSUP = - 0.461 * XXSI_SUP + 3.8
00161 ZINF = - 0.461 * XXSI_INF + 3.8
00162 !
00163 DO I=1,SIZE(PIA)
00164   IF (PIA(I).NE.0.) THEN
00165     ZKMUSP_SUP(I) = EXP(-XK_SUP*(ACOS(PXMUS(I)))**ZSUP)
00166     ZKMUSP_INF(I) = EXP(-XK_INF*(ACOS(PXMUS(I)))**ZINF)
00167     ! direct case
00168     ! Directional albedo of upper/lower layer
00169     ZB_DR_SUP(I) = 1.-(1.-ZSSA_SUP)/(1.+2.*PXMUS(I)*ZSSA_SUP) 
00170     ZB_DR_INF(I) = 1.-(1.-ZSSA_SUP)/(1.+2.*PXMUS(I)*ZSSA_INF)
00171     ! CLUMPING INDEX 
00172     ZOMEGA_DR_SUP(I) = 1. / (1.+ PB_SUP(I)*ZKMUSP_SUP(I))
00173     ZOMEGA_DR_INF(I) = 1. / (1.+ PB_INF(I)*ZKMUSP_INF(I))
00174     ! diffus case
00175     ! CLUMPING INDEX
00176     ZOMEGA_DF_SUP(I) = (1.+PB_SUP(I)/2.)/(1.+PB_SUP(I))
00177     ZOMEGA_DF_INF(I) = (1.+PB_INF(I)/2.)/(1.+PB_INF(I))
00178   ENDIF
00179 ENDDO
00180 !
00181 ZB_DF_SUP = 1.-(1.-ZSSA_SUP)/(1.+ ZSSA_SUP)
00182 ZB_DF_INF = 1.-(1.-ZSSA_INF)/(1.+ ZSSA_INF)
00183 !
00184 ! Integration over the canopy: SIZE(PABC) increments
00185 ! are used to approximate the integral. And to calculate 
00186 ! absorded fluxes within the canopy and in the bare soil  
00187 DO JINT = SIZE(PABC),1,-1
00188 !
00189   ZABC = 1.
00190   IF (JINT.LT.SIZE(PABC)) ZABC = PABC(JINT+1)
00191   ZWEIGHT = ZABC - PABC(JINT)
00192   !
00193   IF (PABC(JINT).GT.0.8) THEN
00194     !  Compute transmittance of each level  
00195     CALL CCETR_PAIR (JINT, PABC(JINT), ZABC, PIA, PXMUS, ZB_DR_SUP, &
00196                      ZOMEGA_DR_SUP, ZOMEGA_DF_SUP, ZB_DF_SUP, PLAI, &
00197                      PALB_VEG, PALB_SOIL, ZFD_SKY, ZFD_VEG, ZTR,    &
00198                      ZXIA, ZLAI_EFF0              )
00199   ELSE
00200     CALL CCETR_PAIR (JINT, PABC(JINT), ZABC, PIA, PXMUS, ZB_DR_INF, &
00201                      ZOMEGA_DR_INF, ZOMEGA_DF_INF, ZB_DF_INF, PLAI, &
00202                      PALB_VEG, PALB_SOIL, ZFD_SKY, ZFD_VEG, ZTR,    &
00203                      ZXIA, ZLAI_EFF0              )
00204   ENDIF          
00205   ! 
00206   DO I=1,SIZE(PIA)
00207     !
00208     ZXIA(I)        = MAX(0.,ZXIA(I))
00209     ZIACAN(I,JINT) = MAX(0.,ZXIA(I)-ZXIA_SUP(I))
00210     ZXIA_SUP(I)    = ZXIA(I)
00211     !
00212     ZLAI_EFF0(I) = MAX(0.,ZLAI_EFF0(I))
00213     ZLAI_EFF(I)  = ZLAI_EFF(I) + ZLAI_EFF0(I)
00214     !
00215     !calculate a FAPAR/FAPIR of the entire canopy
00216     PFAPR(I)  = PFAPR(I) + ZIACAN(I,JINT)
00217     !
00218     !------------------------------------------------------
00219     ! If LSHADE=0 no shading, only sunlit leaves
00220     ! If LSHADE=1 shading
00221     ! PIACAN is used to calculate An of each level within the canopy in cotwores
00222     ! ZIACAN_SUNLIT used for net assimilation of a sunlit leave in COTWO
00223     ! ZIACAN_SHADE used  in A-gs for net assimilation of a shaded leave in COTWO
00224     IF (OSHADE(I)) THEN
00225       !
00226       !sunlit leaves
00227       !absorbed PAR of an equivalent canopy representative of the layer of leaves
00228       ZCOEF = (1.0-ZFD_SUP(I))/ZTR(I)+ ZFD_SUP(I)
00229       ZIACAN_SUNLIT(I,JINT) =             ZCOEF/(ZWEIGHT*MAX(0.0001,PLAI(I)))*ZIACAN(I,JINT)    
00230       !not sunlit leaves
00231       ZIACAN_SHADE(I,JINT)  = MAX(0.,ZFD_SUP(I)/(ZWEIGHT*MAX(0.0001,PLAI(I)))*ZIACAN(I,JINT))
00232       !
00233       !ZXIA_SUNLIT(I) = ZXIA_SUNLIT(I) + ZWEIGHT*ZTR(I)      *ZIACAN_SUNLIT(I,JINT)
00234       !ZLAI_SUNLIT(I) = ZLAI_SUNLIT(I) + ZWEIGHT*ZTR(I)*ZCOEF*PLAI(I)
00235       !
00236       !ZXIA_SHADE(I)  = ZXIA_SHADE(I)  + ZWEIGHT*(1-ZTR(I))           *ZIACAN_SHADE(I,JINT)
00237       !ZLAI_SHADE(I)  = ZLAI_SHADE(I)  + ZWEIGHT*(1-ZTR(I))*ZFD_SUP(I)*PLAI(I)
00238       !
00239       ZFRAC_SUN(I,JINT) = ZTR(I)  !fraction of sunlit leaves
00240       !      
00241     ELSE
00242       !
00243       ZIACAN_SUNLIT(I,JINT) = MAX(0.,ZIACAN(I,JINT)/(ZWEIGHT*MAX(0.0001,PLAI(I))))
00244       !ZLAI_SUNLIT(I) = ZLAI_SUNLIT(I) + ZWEIGHT*PLAI(I)
00245       !
00246     ENDIF
00247     !
00248     ZFD_SUP(I) = ZFD_VEG(I)
00249     !
00250     ENDDO
00251   !
00252 END DO
00253 !
00254 !
00255 WHERE (PIA(:).NE.0.)
00256   PFAPR(:) = PFAPR(:) / PIA(:)
00257   PFAPR_BS(:)=(1.-PALB_VEG(:))*(1-PALB_SOIL(:))*(1.+PALB_VEG(:)*PALB_SOIL(:))*ZTR(:)
00258   WHERE (PLAI(:).EQ.0) PFAPR_BS(:) = 1-PALB_SOIL(:)
00259 END WHERE
00260 !
00261 !WHERE (ZLAI_SHADE(:) .NE.0.) ZRN_SHADE(:)  = ZXIA_SHADE(:) / ZLAI_SHADE(:)
00262 !WHERE (ZLAI_SUNLIT(:).NE.0.) ZRN_SUNLIT(:) = ZXIA_SUNLIT(:)/ ZLAI_SUNLIT(:)
00263 !
00264 IF (PRESENT(PLAI_EFF))      PLAI_EFF      = ZLAI_EFF
00265 IF (PRESENT(PIACAN))        PIACAN        = ZIACAN
00266 IF (PRESENT(PIACAN_SUNLIT)) PIACAN_SUNLIT = ZIACAN_SUNLIT
00267 IF (PRESENT(PIACAN_SHADE))  PIACAN_SHADE  = ZIACAN_SHADE
00268 IF (PRESENT(PFRAC_SUN))     PFRAC_SUN     = ZFRAC_SUN
00269 !
00270 IF (LHOOK) CALL DR_HOOK('FAPAIR',1,ZHOOK_HANDLE)
00271 !
00272 END SUBROUTINE FAPAIR