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

Go to the documentation of this file.
00001 !!   ###############################
00002      SUBROUTINE CH_BVOCEM_n(PSW_FORBIO,PRHOA,PSFTS)
00003 !!   ###############################
00004 !!
00005 !!***  *BVOCEM*
00006 !! 
00007 !!    PURPOSE
00008 !!    -------
00009 !!    Calculate the biogenic emission fluxes according to the 
00010 !!    subgrid vegetation given by the soil interface
00011 !!
00012 !!    METHOD
00013 !!    ------
00014 !!
00015 !!
00016 !!    AUTHOR
00017 !!    ------
00018 !!    F. Solmon (LA) & V. Masson (CNRM)
00019 !!    
00020 !!    MODIFICATIONS
00021 !!    -------------
00022 !!    Original: 25/10/00
00023 !!    P. Tulet  30/07/03 externalisation of biogenics fluxes (2D => 1D)
00024 !!
00025 !!
00026 !!    EXTERNAL
00027 !!    --------
00028 USE MODI_VEGTYPE_TO_PATCH
00029 !!
00030 !!    IMPLICIT ARGUMENTS
00031 !!    ------------------
00032 USE MODD_GR_BIOG_n 
00033 USE MODD_BVOC_PAR
00034 USE MODD_CSTS,ONLY : XMD, XAVOGADRO
00035 USE MODD_CO2V_PAR
00036 USE MODD_SURF_PAR,ONLY:XUNDEF
00037 USE MODD_ISBA_n, ONLY : NPATCH, CPHOTO, XPATCH, XVEGTYPE, XABC, XPOI, XTG
00038 USE MODD_ISBA_PAR
00039 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_TREE, NVT_CONI, NVT_EVER, &
00040                                 NVT_GRAS, NVT_TROG, NVT_PARK, NVT_C3, NVT_C4,&
00041                                 NVT_IRR
00042 USE MODD_CH_ISBA_n,ONLY : NSV_CHSBEG, NSV_CHSEND, NBEQ, CSV
00043 !!
00044 !!
00045 !------------------------------------------------------------------------------
00046 !
00047 !*       0.   DECLARATIONS
00048 !        -----------------
00049 !
00050 !
00051 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00052 USE PARKIND1  ,ONLY : JPRB
00053 !
00054 IMPLICIT NONE
00055 
00056 REAL, DIMENSION(:,:), INTENT(IN)    :: PSW_FORBIO
00057 REAL, DIMENSION(:),   INTENT(IN)    :: PRHOA
00058 REAL, DIMENSION(:,:), INTENT(INOUT) :: PSFTS
00059 !
00060 !*       0.1  declaration of arguments
00061 !
00062 !*   0.1 Declaration of local variables
00063 !
00064 REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZRAD_PAR,  ZLCOR_RAD
00065 !                            PAR radiation in case of ISBA-STD use
00066 !
00067 REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZFISO_FOR  , ZFMONO_FOR,   
00068                                        ZFISO_GRASS, ZFMONO_GRASS, 
00069                                        ZFISO_CROP , ZFMONO_CROP     
00070 !                                Fluxes coming from different landuse
00071 REAL, DIMENSION(SIZE(PSW_FORBIO,1), NVEGTYPE) :: ZTCOR ,ZTCORM
00072 !
00073 REAL, DIMENSION(SIZE(PSW_FORBIO,1),SIZE(XABC),NVEGTYPE) :: ZBVOCPAR 
00074 !                                PAR at gauss level in micromolphot/m2/s
00075 !
00076 REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZISOPOT, ZMONOPOT
00077 !
00078 INTEGER:: KNGAUSS     
00079 !                        nbre of gauss level in integration
00080 !                        index of patch corresponding to forest(+ligneaous)
00081 INTEGER:: JPATCH, JSV
00082 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00083 !
00084 !------------------------------------------------------------------------------
00085 !
00086 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N',0,ZHOOK_HANDLE)
00087 !
00088 !* 1. Contribution of forest and ligneous vegetation 
00089 !   from ISOPOT and MONOPOT maps 
00090 !   ------------------------------------------------
00091 !
00092 !* 1.0 Preliminary : patch index corresponding to forest
00093 !
00094 !2.Contribution of other types of vegetation than forest, consider the vegtype fraction in the pixel 
00095 !------------------------------------------------------------------------------------------
00096 !
00097 !* 2.0 Preliminary : patch index corresponding to grassland, crops (C3+C4)
00098 !
00099 !1.1.1 Using ISBA_Ags explicit light attenuation 
00100 ! number of g Gauss level for the integration 
00101 IF (CPHOTO/='NON') THEN
00102   KNGAUSS = SIZE(XABC)
00103 ELSE
00104   !1.1.2 using isba std version 
00105   ZRAD_PAR (:)= 0.
00106   DO JPATCH = 1,NPATCH
00107     ZRAD_PAR (:)= ZRAD_PAR (:) +(PSW_FORBIO(:,JPATCH)*XPATCH(:,JPATCH) ) * XPARCF * 4.7 
00108   END DO
00109   ZLCOR_RAD (:) = ZLCOR_FUNC(ZRAD_PAR(:))
00110 ENDIF
00111 !  
00112 !
00113  CALL BY_PATCH(NVT_TREE, ZTCOR(:,NVT_TREE), ZTCORM(:,NVT_TREE))
00114  CALL BY_PATCH(NVT_CONI, ZTCOR(:,NVT_CONI), ZTCORM(:,NVT_CONI))
00115  CALL BY_PATCH(NVT_EVER, ZTCOR(:,NVT_EVER), ZTCORM(:,NVT_EVER))
00116  CALL BY_PATCH(NVT_GRAS, ZTCOR(:,NVT_GRAS), ZTCORM(:,NVT_GRAS))
00117  CALL BY_PATCH(NVT_TROG, ZTCOR(:,NVT_TROG), ZTCORM(:,NVT_TROG))
00118  CALL BY_PATCH(NVT_PARK, ZTCOR(:,NVT_PARK), ZTCORM(:,NVT_PARK))
00119  CALL BY_PATCH(NVT_C3  , ZTCOR(:,NVT_C3)  , ZTCORM(:,NVT_C3)  )
00120  CALL BY_PATCH(NVT_C4  , ZTCOR(:,NVT_C4)  , ZTCORM(:,NVT_C4)  )
00121  CALL BY_PATCH(NVT_IRR , ZTCOR(:,NVT_IRR) , ZTCORM(:,NVT_IRR) )
00122 !
00123 !
00124 ZISOPOT (:) = XISOPOT (:) / (XVEGTYPE(:,NVT_TREE) + XVEGTYPE(:,NVT_CONI) + XVEGTYPE(:,NVT_EVER))
00125 ZMONOPOT(:) = XMONOPOT(:) / (XVEGTYPE(:,NVT_TREE) + XVEGTYPE(:,NVT_CONI) + XVEGTYPE(:,NVT_EVER)) 
00126  CALL BY_VEG(NVT_TREE, NVT_CONI, NVT_EVER, ZISOPOT, ZMONOPOT, ZFISO_FOR, ZFMONO_FOR)
00127 !
00128 ZISOPOT (:) = XISOPOT_GRASS
00129 ZMONOPOT(:) = XMONOPOT_GRASS
00130  CALL BY_VEG(NVT_GRAS, NVT_TROG, NVT_PARK, ZISOPOT, ZMONOPOT, ZFISO_GRASS, ZFMONO_GRASS)
00131 !
00132 ZISOPOT (:) = XISOPOT_CROP
00133 ZMONOPOT(:) = XMONOPOT_CROP
00134  CALL BY_VEG(NVT_C3, NVT_C4, NVT_IRR, ZISOPOT, ZMONOPOT, ZFISO_CROP, ZFMONO_CROP)
00135 !
00136 !---------------------------------------------------------------------------------------
00137 !
00138 !3.Summation of different contribution for fluxes 
00139 !------------------------------------------------
00140 !
00141 !isoprene in ppp.m.s-1
00142 XFISO (:)=(3.0012E-10/3600.) * ( ZFISO_FOR (:) + ZFISO_GRASS (:)+ ZFISO_CROP (:) ) + 1E-17
00143 !monoterpenes
00144 XFMONO(:)=(1.5006E-10/3600.) * ( ZFMONO_FOR(:) + ZFMONO_GRASS(:)+ ZFMONO_CROP(:) ) + 1E-17
00145 !
00146 ! conversion in molecules/m2/s
00147 !
00148 XFISO(:)  = XFISO(:)  * XAVOGADRO * PRHOA(:) / XMD
00149 XFMONO(:) = XFMONO(:) * XAVOGADRO * PRHOA(:) / XMD
00150 !
00151 DO JSV=NSV_CHSBEG,NSV_CHSEND
00152   IF (CSV(JSV) == "BIO") THEN
00153     ! RELACS CASE
00154     PSFTS(:,JSV) = PSFTS(:,JSV) + (XFISO(:) + XFMONO(:)) 
00155   ELSE IF (CSV(JSV) == "ISO" .OR. CSV(JSV) == "ISOP") THEN
00156     ! RACM CASE
00157     PSFTS(:,JSV) = PSFTS(:,JSV) + XFISO(:)  
00158   ELSE IF (CSV(JSV) == "API"  .OR. CSV(JSV) == "LIM" .OR. &
00159            CSV(JSV) == "BIOL" .OR. CSV(JSV) == "BIOH" ) THEN
00160     ! RACM CASE
00161     ! CACM or RELACS 2 CASE     
00162     PSFTS(:,JSV) = PSFTS(:,JSV) + 0.5 * XFMONO(:) 
00163   ENDIF
00164 END DO
00165 !
00166 !**********************************************************************************
00167 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N',1,ZHOOK_HANDLE)
00168 CONTAINS
00169 !
00170 SUBROUTINE BY_PATCH(NVT_VEGTYPE,PTCOR,PTCORM)
00171 !
00172 IMPLICIT NONE
00173 !
00174 INTEGER, INTENT(IN) :: NVT_VEGTYPE
00175 REAL, DIMENSION(:), INTENT(OUT) :: PTCOR
00176 REAL, DIMENSION(:), INTENT(OUT) :: PTCORM
00177 !
00178 REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZBVOCSG
00179 REAL, DIMENSION(SIZE(PSW_FORBIO,1),SIZE(XABC)) :: ZBVOCPAR 
00180 INTEGER:: IPATCH, JLAYER, IT
00181 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00182 !
00183 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:BY_PATCH',0,ZHOOK_HANDLE)
00184 !
00185 IPATCH = VEGTYPE_TO_PATCH(NVT_VEGTYPE, NPATCH)
00186 !
00187 PTCOR  (:) = 0.
00188 PTCORM (:) = 0.
00189 DO IT=1,SIZE(XTG,1)
00190   IF (XTG(IT,1,IPATCH).LE.1000.) THEN
00191     PTCORM(IT)=ZTCORM0_FUNC(XTG(IT,1,IPATCH))
00192     PTCOR (IT)=ZTCOR0_FUNC (XTG(IT,1,IPATCH))
00193   ENDIF
00194 ENDDO
00195 !
00196 IF (CPHOTO/='NON') THEN
00197   !PAR over Forest canopies, in micro-molE.m-2.s-1 
00198   ZBVOCPAR(:,:) = XIACAN(:,:,IPATCH)*4.7
00199   !Calculation of radiative attenuation effect in the canopy on correction factor
00200   ZBVOCSG(:) = 0.
00201   DO JLAYER=1,KNGAUSS
00202     ZBVOCSG(:) = ZBVOCSG(:) + XPOI(JLAYER) * ZLCOR_FUNC(ZBVOCPAR(:,JLAYER)) 
00203   ENDDO
00204   PTCOR(:) = PTCOR(:) * ZBVOCSG(:)
00205 ELSE
00206   PTCOR(:) = PTCOR(:) * XCANFAC * ZLCOR_RAD(:)
00207 ENDIF
00208 !
00209 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:BY_PATCH',1,ZHOOK_HANDLE)
00210 !
00211 END SUBROUTINE BY_PATCH
00212 !--------------------------------------------------------------------------
00213 SUBROUTINE BY_VEG(NVT_V1, NVT_V2, NVT_V3, &
00214                   PISOPOT, PMONOPOT, PFISO, PFMONO)
00215 !
00216 IMPLICIT NONE
00217 !
00218 INTEGER, INTENT(IN) :: NVT_V1
00219 INTEGER, INTENT(IN) :: NVT_V2
00220 INTEGER, INTENT(IN) :: NVT_V3
00221 REAL, DIMENSION(:), INTENT(IN) :: PISOPOT
00222 REAL, DIMENSION(:), INTENT(IN) :: PMONOPOT
00223 REAL, DIMENSION(:), INTENT(OUT) :: PFISO
00224 REAL, DIMENSION(:), INTENT(OUT) :: PFMONO
00225 !
00226 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00227 !
00228 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:BY_VEG',0,ZHOOK_HANDLE)
00229 !
00230 !isoprene flux 
00231 !!
00232 !! warning, XISOPOT external map accounts for the total forest fraction
00233 WHERE ( XVEGTYPE(:,NVT_V1) + XVEGTYPE(:,NVT_V2) + XVEGTYPE(:,NVT_V3) > 0. )
00234   !
00235   PFISO(:) = PISOPOT(:) *                   &
00236      ( ZTCOR(:,NVT_V1) * XVEGTYPE(:,NVT_V1) &
00237       +ZTCOR(:,NVT_V2) * XVEGTYPE(:,NVT_V2) &
00238       +ZTCOR(:,NVT_V3) * XVEGTYPE(:,NVT_V3) )
00239   !
00240   PFMONO(:) = PMONOPOT(:) *                  &
00241      ( ZTCORM(:,NVT_V1) * XVEGTYPE(:,NVT_V1) &
00242       +ZTCORM(:,NVT_V2) * XVEGTYPE(:,NVT_V2) &
00243       +ZTCORM(:,NVT_V3) * XVEGTYPE(:,NVT_V3) )
00244              
00245   !
00246 ENDWHERE
00247 !
00248 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:BY_VEG',1,ZHOOK_HANDLE)
00249 !
00250 END SUBROUTINE BY_VEG
00251 !--------------------------------------------------------------------------
00252 FUNCTION ZLCOR_FUNC(ZX)
00253 
00254 REAL, DIMENSION(:)          :: ZX
00255 REAL, DIMENSION(SIZE(ZX))   :: ZLCOR_FUNC
00256 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00257 !
00258 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:ZLCOR_FUNC',0,ZHOOK_HANDLE)
00259 ZLCOR_FUNC(:)=0.
00260 ZLCOR_FUNC(:) = ZX(:)*XISO_CL*XISO_ALF/(1+(XISO_ALF**2)*(ZX(:)**2))**0.5
00261 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:ZLCOR_FUNC',1,ZHOOK_HANDLE)
00262 !
00263 END FUNCTION ZLCOR_FUNC
00264 !---------------------------------------------------------------------------
00265 FUNCTION ZTCOR0_FUNC(ZX)
00266 
00267 REAL, PARAMETER             :: R   = 8.314
00268 REAL          :: ZX
00269 REAL   :: ZTCOR0_FUNC
00270 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00271 
00272 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:ZTCOR0_FUNC',0,ZHOOK_HANDLE)
00273 !
00274 ZTCOR0_FUNC=0.
00275 ZTCOR0_FUNC = EXP(XISO_CT1*(ZX-XISO_BTS)/(R*XISO_BTS*ZX))     &
00276           /(1+EXP(XISO_CT2*(ZX-XISO_BTM)/(R*XISO_BTS*ZX)))
00277        !
00278 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:ZTCOR0_FUNC',1,ZHOOK_HANDLE)
00279 END FUNCTION ZTCOR0_FUNC
00280 !---------------------------------------------------------------------------
00281 FUNCTION ZTCORM0_FUNC(ZX)
00282 
00283 REAL           :: ZX
00284 REAL  :: ZTCORM0_FUNC
00285 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00286 
00287 !      
00288 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:ZTCORM0_FUNC',0,ZHOOK_HANDLE)
00289 ZTCORM0_FUNC= 0.
00290 ZTCORM0_FUNC = EXP(XMONO_BETA*(ZX-XMONO_T3))
00291 IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:ZTCORM0_FUNC',1,ZHOOK_HANDLE)
00292 !
00293 END FUNCTION ZTCORM0_FUNC
00294 !
00295 !---------------------------------------------------------------------------
00296 !
00297 END SUBROUTINE CH_BVOCEM_n