ch_bvocemn.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!!   ###############################
     SUBROUTINE ch_bvocem_n (SV, NGB, GB, IO, S, NP, NPE, PSW_FORBIO, PRHOA, PSFTS)
!!   ###############################
!!
!!***  *BVOCEM*
!! 
!!    PURPOSE
!!    -------
!!    Calculate the biogenic emission fluxes according to the 
!!    subgrid vegetation given by the soil interface
!!
!!    METHOD
!!    ------
!!
!!
!!    AUTHOR
!!    ------
!!    F. Solmon (LA) & V. Masson (CNRM)
!!    
!!    MODIFICATIONS
!!    -------------
!!    Original: 25/10/00
!!    P. Tulet  30/07/03 externalisation of biogenics fluxes (2D => 1D)
!!    R. Alkama 04/2012  add 7 new vegtype (19 instead 12)
!!
!!    EXTERNAL
!!    --------
!
USE modd_sv_n, ONLY : sv_t
!
USE modd_gr_biog_n, ONLY : gr_biog_t, gr_biog_np_t
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_s_t, isba_np_t, isba_npe_t
!
USE modi_vegtype_to_patch
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
USE modd_bvoc_par
USE modd_csts,ONLY : xmd, xavogadro
USE modd_co2v_par
USE modd_surf_par,ONLY:xundef
USE modd_isba_par
USE modd_data_cover_par, ONLY : nvegtype, nvt_tebd, nvt_bone, nvt_trbe, &
                                nvt_trbd, nvt_tebe, nvt_tene, nvt_bobd, &
                                nvt_bond, nvt_shrb, nvt_bogr, nvt_gras, & 
                                nvt_trog, nvt_park, nvt_fltr, nvt_flgr, &
                                nvt_c3, nvt_c3w, nvt_c3s, nvt_c4, nvt_irr 
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
!------------------------------------------------------------------------------
!
!*       0.   DECLARATIONS
!        -----------------
!
IMPLICIT NONE
!
TYPE(sv_t), INTENT(INOUT) :: SV
TYPE(gr_biog_np_t), INTENT(INOUT) :: NGB
TYPE(gr_biog_t), INTENT(INOUT) :: GB
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(isba_s_t), INTENT(INOUT) :: S
TYPE(isba_np_t), INTENT(INOUT) :: NP
TYPE(isba_npe_t), INTENT(INOUT) :: NPE
!
REAL, DIMENSION(:,:), INTENT(IN)    :: PSW_FORBIO
REAL, DIMENSION(:),   INTENT(IN)    :: PRHOA
REAL, DIMENSION(:,:), INTENT(INOUT) :: PSFTS
!
!*       0.1  declaration of arguments
!
!*   0.1 Declaration of local variables
!
REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZRAD_PAR,  ZLCOR_RAD
!                            PAR radiation in case of ISBA-STD use
!
REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZFISO_FOR  , ZFMONO_FOR,   &
                                       ZFISO_GRASS, ZFMONO_GRASS, &
                                       ZFISO_CROP , ZFMONO_CROP     
!                                Fluxes coming from different landuse
REAL, DIMENSION(SIZE(PSW_FORBIO,1), NVEGTYPE) :: ZTCOR ,ZTCORM
!
REAL, DIMENSION(SIZE(PSW_FORBIO,1),SIZE(S%XABC),NVEGTYPE) :: ZBVOCPAR 
!                                PAR at gauss level in micromolphot/m2/s
!
REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZISOPOT, ZMONOPOT, ZRATIO
!
INTEGER:: KNGAUSS     
!                        nbre of gauss level in integration
!                        index of patch corresponding to forest(+ligneaous)
INTEGER:: JP, JSV, IMASK, JI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('CH_BVOCEM_N',0,zhook_handle)
!
!* 1. Contribution of forest and ligneous vegetation 
!   from ISOPOT and MONOPOT maps 
!   ------------------------------------------------
!
!* 1.0 Preliminary : patch index corresponding to forest
!
!2.Contribution of other types of vegetation than forest, consider the vegtype fraction in the pixel 
!------------------------------------------------------------------------------------------
!
!* 2.0 Preliminary : patch index corresponding to grassland, crops (C3+C4)
!
!1.1.1 Using ISBA_Ags explicit light attenuation 
! number of g Gauss level for the integration 
IF (io%CPHOTO/='NON') THEN
  kngauss = SIZE(s%XABC)
ELSE
  !1.1.2 using isba std version 
  zrad_par(:)= 0.
  DO jp = 1,io%NPATCH
    zrad_par(:)= zrad_par(:) +(psw_forbio(:,jp)*s%XPATCH(:,jp) ) * xparcf * 4.7 
  END DO
  zlcor_rad(:) = zlcor_func(zrad_par(:))
ENDIF
!  
!
 CALL by_patch(nvt_tebd, ztcor(:,nvt_tebd), ztcorm(:,nvt_tebd))
 CALL by_patch(nvt_bone, ztcor(:,nvt_bone), ztcorm(:,nvt_bone))
 CALL by_patch(nvt_trbe, ztcor(:,nvt_trbe), ztcorm(:,nvt_trbe))
 CALL by_patch(nvt_trbd, ztcor(:,nvt_trbd), ztcorm(:,nvt_trbd))
 CALL by_patch(nvt_tebe, ztcor(:,nvt_tebe), ztcorm(:,nvt_tebe))
 CALL by_patch(nvt_tene, ztcor(:,nvt_tene), ztcorm(:,nvt_tene))
 CALL by_patch(nvt_bobd, ztcor(:,nvt_bobd), ztcorm(:,nvt_bobd))
 CALL by_patch(nvt_bond, ztcor(:,nvt_bond), ztcorm(:,nvt_bond))
 CALL by_patch(nvt_shrb, ztcor(:,nvt_shrb), ztcorm(:,nvt_shrb))
 CALL by_patch(nvt_bogr, ztcor(:,nvt_bogr), ztcorm(:,nvt_bogr))
 CALL by_patch(nvt_gras, ztcor(:,nvt_gras), ztcorm(:,nvt_gras))
 CALL by_patch(nvt_trog, ztcor(:,nvt_trog), ztcorm(:,nvt_trog))
IF (nvt_park/=0) THEN
  CALL by_patch(nvt_park, ztcor(:,nvt_park), ztcorm(:,nvt_park))
ELSEIF (nvt_fltr/=0 .AND. nvt_flgr/=0) THEN
  CALL by_patch(nvt_fltr, ztcor(:,nvt_fltr), ztcorm(:,nvt_fltr))
  CALL by_patch(nvt_flgr, ztcor(:,nvt_flgr), ztcorm(:,nvt_flgr))
ENDIF
IF (nvt_c3/=0) THEN
  CALL by_patch(nvt_c3  , ztcor(:,nvt_c3)  , ztcorm(:,nvt_c3)  )
ELSEIF (nvt_c3w/=0.AND.nvt_c3s/=0) THEN
  CALL by_patch(nvt_c3w , ztcor(:,nvt_c3w) , ztcorm(:,nvt_c3w) )
  CALL by_patch(nvt_c3s , ztcor(:,nvt_c3s) , ztcorm(:,nvt_c3s) )
ENDIF
 CALL by_patch(nvt_c4  , ztcor(:,nvt_c4)  , ztcorm(:,nvt_c4)  )
IF (nvt_irr/=0) CALL by_patch(nvt_irr , ztcor(:,nvt_irr) , ztcorm(:,nvt_irr) )
!
!
zratio(:) = s%XVEGTYPE(:,nvt_tebd) + s%XVEGTYPE(:,nvt_bone) + s%XVEGTYPE(:,nvt_trbe) + &
             s%XVEGTYPE(:,nvt_trbd) + s%XVEGTYPE(:,nvt_tebe) + s%XVEGTYPE(:,nvt_tene) + &
             s%XVEGTYPE(:,nvt_bobd) + s%XVEGTYPE(:,nvt_bond) + s%XVEGTYPE(:,nvt_shrb)
!
WHERE (zratio(:)/=0.)
  zisopot(:) = gb%XISOPOT (:) / zratio(:)
  zmonopot(:) = gb%XMONOPOT(:) / zratio(:) 
ELSEWHERE
  zisopot(:) = 0.
  zmonopot(:) = 0.
END WHERE
!                       
 CALL by_veg9(nvt_tebd, nvt_bone, nvt_trbe, nvt_trbd, nvt_tebe, nvt_tene, nvt_bobd, &
             nvt_bond, nvt_shrb, nvt_fltr, zisopot, zmonopot, zfiso_for, zfmono_for)
!
zisopot(:) = xisopot_grass
zmonopot(:) = xmonopot_grass
IF (nvt_park/=0) THEN
  CALL by_veg4(nvt_gras, nvt_trog, nvt_park, nvt_bogr, zisopot, zmonopot, zfiso_grass, zfmono_grass)
ELSEIF (nvt_flgr/=0) THEN
  CALL by_veg4(nvt_gras, nvt_trog, nvt_flgr, nvt_bogr, zisopot, zmonopot, zfiso_grass, zfmono_grass)
ENDIF
!
zisopot(:) = xisopot_crop
zmonopot(:) = xmonopot_crop!
IF (nvt_c3/=0 .AND. nvt_irr/=0) THEN
  CALL by_veg3(nvt_c3, nvt_c4, nvt_irr, zisopot, zmonopot, zfiso_crop, zfmono_crop)
ELSEIF (nvt_c3w/=0 .AND. nvt_c3s/=0) THEN
  CALL by_veg3(nvt_c3w, nvt_c3s, nvt_c4, zisopot, zmonopot, zfiso_crop, zfmono_crop)
ENDIF
!
!---------------------------------------------------------------------------------------
!
!3.Summation of different contribution for fluxes 
!------------------------------------------------
!
!isoprene in ppp.m.s-1
gb%XFISO (:)=(3.0012e-10/3600.) * ( zfiso_for(:) + zfiso_grass(:) + zfiso_crop(:) ) + 1e-17
!monoterpenes
gb%XFMONO(:)=(1.5006e-10/3600.) * ( zfmono_for(:) + zfmono_grass(:)+ zfmono_crop(:) ) + 1e-17
!
! conversion in molecules/m2/s
!
gb%XFISO(:)  = gb%XFISO(:)  * xavogadro * prhoa(:) / xmd
gb%XFMONO(:) = gb%XFMONO(:) * xavogadro * prhoa(:) / xmd
!
DO jsv=sv%NSV_CHSBEG,sv%NSV_CHSEND
  IF (sv%CSV(jsv) == "BIO") THEN
    ! RELACS CASE
    psfts(:,jsv) = psfts(:,jsv) + (gb%XFISO(:) + gb%XFMONO(:)) 
  ELSE IF (sv%CSV(jsv) == "ISO" .OR. sv%CSV(jsv) == "ISOP") THEN
    ! RACM CASE
    psfts(:,jsv) = psfts(:,jsv) + gb%XFISO(:)  
  ELSE IF (sv%CSV(jsv) == "API"  .OR. sv%CSV(jsv) == "LIM" .OR. &
           sv%CSV(jsv) == "BIOL" .OR. sv%CSV(jsv) == "BIOH" ) THEN
    ! RACM CASE
    ! CACM or RELACS 2 CASE     
    psfts(:,jsv) = psfts(:,jsv) + 0.5 * gb%XFMONO(:) 
  ENDIF
END DO
!
!**********************************************************************************
IF (lhook) CALL dr_hook('CH_BVOCEM_N',1,zhook_handle)
CONTAINS
!
SUBROUTINE by_patch(NVT_VEGTYPE,PTCOR,PTCORM)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: NVT_VEGTYPE
REAL, DIMENSION(:), INTENT(OUT) :: PTCOR
REAL, DIMENSION(:), INTENT(OUT) :: PTCORM
!
REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZBVOCSG
REAL, DIMENSION(SIZE(PSW_FORBIO,1),SIZE(S%XABC)) :: ZBVOCPAR 
INTEGER:: IPATCH, JLAYER, IT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('CH_BVOCEM_N:BY_PATCH',0,zhook_handle)
!
ipatch = vegtype_to_patch(nvt_vegtype, io%NPATCH)
!
ptcor(:) = 0.
ptcorm(:) = 0.
zbvocpar(:,:) = 0.
!
DO it=1,SIZE(npe%AL(ipatch)%XTG,1)
  !
  imask = np%AL(ipatch)%NR_P(it)
  IF (npe%AL(ipatch)%XTG(it,1).LE.1000.) THEN
    ptcorm(imask) = ztcorm0_func(npe%AL(ipatch)%XTG(it,1))
    ptcor(imask) = ztcor0_func(npe%AL(ipatch)%XTG(it,1))
  ENDIF
  !PAR over Forest canopies, in micro-molE.m-2.s-1
  IF (io%CPHOTO/='NON') THEN
    zbvocpar(imask,:) = ngb%AL(ipatch)%XIACAN(it,:)*4.7
  ENDIF
ENDDO
!
IF (io%CPHOTO/='NON') THEN
  !Calculation of radiative attenuation effect in the canopy on correction factor
  zbvocsg(:) = 0.
  DO jlayer=1,kngauss
    zbvocsg(:) = zbvocsg(:) + s%XPOI(jlayer) * zlcor_func(zbvocpar(:,jlayer)) 
  ENDDO
  ptcor(:) = ptcor(:) * zbvocsg(:)
ELSE
  ptcor(:) = ptcor(:) * xcanfac * zlcor_rad(:)
ENDIF
!
IF (lhook) CALL dr_hook('CH_BVOCEM_N:BY_PATCH',1,zhook_handle)
!
END SUBROUTINE by_patch
!--------------------------------------------------------------------------
SUBROUTINE by_veg3(NVT_V1, NVT_V2, NVT_V3, &
                  PISOPOT, PMONOPOT, PFISO, PFMONO)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: NVT_V1
INTEGER, INTENT(IN) :: NVT_V2
INTEGER, INTENT(IN) :: NVT_V3
REAL, DIMENSION(:), INTENT(IN) :: PISOPOT
REAL, DIMENSION(:), INTENT(IN) :: PMONOPOT
REAL, DIMENSION(:), INTENT(OUT) :: PFISO
REAL, DIMENSION(:), INTENT(OUT) :: PFMONO
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('CH_BVOCEM_N:BY_VEG3',0,zhook_handle)
!
!isoprene flux 
!!
!! warning, XISOPOT external map accounts for the total forest fraction
WHERE ( s%XVEGTYPE(:,nvt_v1) + s%XVEGTYPE(:,nvt_v2) + s%XVEGTYPE(:,nvt_v3) > 0. )
  !
  pfiso(:) = pisopot(:) *                   &
     ( ztcor(:,nvt_v1) * s%XVEGTYPE(:,nvt_v1) &
      +ztcor(:,nvt_v2) * s%XVEGTYPE(:,nvt_v2) &
      +ztcor(:,nvt_v3) * s%XVEGTYPE(:,nvt_v3) )
  !
  pfmono(:) = pmonopot(:) *                  &
     ( ztcorm(:,nvt_v1) * s%XVEGTYPE(:,nvt_v1) &
      +ztcorm(:,nvt_v2) * s%XVEGTYPE(:,nvt_v2) &
      +ztcorm(:,nvt_v3) * s%XVEGTYPE(:,nvt_v3) )          
  !
ELSEWHERE
  !
  pfiso(:) = 0.
  pfmono(:) = 0.
  !
END WHERE
!
IF (lhook) CALL dr_hook('CH_BVOCEM_N:BY_VEG3',1,zhook_handle)
!
END SUBROUTINE by_veg3
!--------------------------------------------------------------------------
SUBROUTINE by_veg4(NVT_V1, NVT_V2, NVT_V3, NVT_V4,&
                  PISOPOT, PMONOPOT, PFISO, PFMONO)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: NVT_V1
INTEGER, INTENT(IN) :: NVT_V2
INTEGER, INTENT(IN) :: NVT_V3
INTEGER, INTENT(IN) :: NVT_V4
REAL, DIMENSION(:), INTENT(IN) :: PISOPOT
REAL, DIMENSION(:), INTENT(IN) :: PMONOPOT
REAL, DIMENSION(:), INTENT(OUT) :: PFISO
REAL, DIMENSION(:), INTENT(OUT) :: PFMONO
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('CH_BVOCEM_N:BY_VEG4',0,zhook_handle)
!
!isoprene flux 
!!
!! warning, XISOPOT external map accounts for the total forest fraction
WHERE ( s%XVEGTYPE(:,nvt_v1) + s%XVEGTYPE(:,nvt_v2) + s%XVEGTYPE(:,nvt_v3) &
       +s%XVEGTYPE(:,nvt_v4) > 0. )
  !
  pfiso(:) = pisopot(:) *                   &
     ( ztcor(:,nvt_v1) * s%XVEGTYPE(:,nvt_v1) &
      +ztcor(:,nvt_v2) * s%XVEGTYPE(:,nvt_v2) &
      +ztcor(:,nvt_v3) * s%XVEGTYPE(:,nvt_v3) &
      +ztcor(:,nvt_v4) * s%XVEGTYPE(:,nvt_v4) )
  !
  pfmono(:) = pmonopot(:) *                  &
     ( ztcorm(:,nvt_v1) * s%XVEGTYPE(:,nvt_v1) &
      +ztcorm(:,nvt_v2) * s%XVEGTYPE(:,nvt_v2) &
      +ztcorm(:,nvt_v3) * s%XVEGTYPE(:,nvt_v3) &
      +ztcorm(:,nvt_v4) * s%XVEGTYPE(:,nvt_v4) )            
  !
ELSEWHERE
  !
  pfiso(:) = 0.
  pfmono(:) = 0.
  !
END WHERE
!
IF (lhook) CALL dr_hook('CH_BVOCEM_N:BY_VEG4',1,zhook_handle)
!
END SUBROUTINE by_veg4
!--------------------------------------------------------------------------
SUBROUTINE by_veg9(NVT_V1, NVT_V2, NVT_V3, NVT_V4, NVT_V5, NVT_V6,     &
               NVT_V7, NVT_V8, NVT_V9, NVT_V10, PISOPOT, PMONOPOT, PFISO, PFMONO)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: NVT_V1
INTEGER, INTENT(IN) :: NVT_V2
INTEGER, INTENT(IN) :: NVT_V3
INTEGER, INTENT(IN) :: NVT_V4
INTEGER, INTENT(IN) :: NVT_V5
INTEGER, INTENT(IN) :: NVT_V6
INTEGER, INTENT(IN) :: NVT_V7
INTEGER, INTENT(IN) :: NVT_V8
INTEGER, INTENT(IN) :: NVT_V9
INTEGER, INTENT(IN) :: NVT_V10
REAL, DIMENSION(:), INTENT(IN) :: PISOPOT
REAL, DIMENSION(:), INTENT(IN) :: PMONOPOT
REAL, DIMENSION(:), INTENT(OUT) :: PFISO
REAL, DIMENSION(:), INTENT(OUT) :: PFMONO
!
REAL :: ZSUM
INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('CH_BVOCEM_N:BY_VEG9',0,zhook_handle)
!
DO jj=1,SIZE(ztcor,1)
  !
  zsum = s%XVEGTYPE(jj,nvt_v1) + s%XVEGTYPE(jj,nvt_v2) + s%XVEGTYPE(jj,nvt_v3) &
        +s%XVEGTYPE(jj,nvt_v4) + s%XVEGTYPE(jj,nvt_v5) + s%XVEGTYPE(jj,nvt_v6) &
        +s%XVEGTYPE(jj,nvt_v7) + s%XVEGTYPE(jj,nvt_v8) + s%XVEGTYPE(jj,nvt_v9)
  IF (nvt_v10/=0) zsum = zsum + s%XVEGTYPE(jj,nvt_v10)
  !
  !isoprene flux 
  !!
  !! warning, XISOPOT external map accounts for the total forest fraction
  IF ( zsum > 0. ) THEN
    !
    pfiso(jj) = pisopot(jj) *                   &
     ( ztcor(jj,nvt_v1) * s%XVEGTYPE(jj,nvt_v1) &
      +ztcor(jj,nvt_v2) * s%XVEGTYPE(jj,nvt_v2) &
      +ztcor(jj,nvt_v3) * s%XVEGTYPE(jj,nvt_v3) &
      +ztcor(jj,nvt_v4) * s%XVEGTYPE(jj,nvt_v4) &
      +ztcor(jj,nvt_v5) * s%XVEGTYPE(jj,nvt_v5) &
      +ztcor(jj,nvt_v6) * s%XVEGTYPE(jj,nvt_v6) &
      +ztcor(jj,nvt_v7) * s%XVEGTYPE(jj,nvt_v7) &
      +ztcor(jj,nvt_v8) * s%XVEGTYPE(jj,nvt_v8) &
      +ztcor(jj,nvt_v9) * s%XVEGTYPE(jj,nvt_v9) )
    !
    IF (nvt_v10/=0) pfiso(jj) = pfiso(jj) + pisopot(jj) * ztcor(jj,nvt_v10) * s%XVEGTYPE(jj,nvt_v10)
    !
    pfmono(jj) = pmonopot(jj) *                  &
     ( ztcorm(jj,nvt_v1) * s%XVEGTYPE(jj,nvt_v1) &
      +ztcorm(jj,nvt_v2) * s%XVEGTYPE(jj,nvt_v2) &
      +ztcorm(jj,nvt_v3) * s%XVEGTYPE(jj,nvt_v3) &
      +ztcorm(jj,nvt_v4) * s%XVEGTYPE(jj,nvt_v4) & 
      +ztcorm(jj,nvt_v5) * s%XVEGTYPE(jj,nvt_v5) & 
      +ztcorm(jj,nvt_v6) * s%XVEGTYPE(jj,nvt_v6) & 
      +ztcorm(jj,nvt_v7) * s%XVEGTYPE(jj,nvt_v7) & 
      +ztcorm(jj,nvt_v8) * s%XVEGTYPE(jj,nvt_v8) &
      +ztcorm(jj,nvt_v9) * s%XVEGTYPE(jj,nvt_v9) ) 
    !
    IF (nvt_v10/=0) pfmono(jj) = pfmono(jj) + pmonopot(jj) * ztcorm(jj,nvt_v10) * s%XVEGTYPE(jj,nvt_v10)
    !
  ELSE
    !
    pfiso(jj) = 0.
    pfmono(jj) = 0.
    !
  ENDIF
  !
ENDDO
!
IF (lhook) CALL dr_hook('CH_BVOCEM_N:BY_VEG9',1,zhook_handle)
!
END SUBROUTINE by_veg9
!--------------------------------------------------------------------------
FUNCTION zlcor_func(ZX)

REAL, DIMENSION(:)          :: ZX
REAL, DIMENSION(SIZE(ZX))   :: ZLCOR_FUNC
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('CH_BVOCEM_N:ZLCOR_FUNC',0,zhook_handle)
zlcor_func(:)=0.
zlcor_func(:) = zx(:)*xiso_cl*xiso_alf/(1+(xiso_alf**2)*(zx(:)**2))**0.5
IF (lhook) CALL dr_hook('CH_BVOCEM_N:ZLCOR_FUNC',1,zhook_handle)
!
END FUNCTION zlcor_func
!---------------------------------------------------------------------------
FUNCTION ztcor0_func(ZX)

REAL, PARAMETER             :: R   = 8.314
REAL          :: ZX
REAL   :: ZTCOR0_FUNC
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('CH_BVOCEM_N:ZTCOR0_FUNC',0,zhook_handle)
!
ztcor0_func=0.
ztcor0_func = exp(xiso_ct1*(zx-xiso_bts)/(r*xiso_bts*zx))     &
          /(1+exp(xiso_ct2*(zx-xiso_btm)/(r*xiso_bts*zx)))
       !
IF (lhook) CALL dr_hook('CH_BVOCEM_N:ZTCOR0_FUNC',1,zhook_handle)
END FUNCTION ztcor0_func
!---------------------------------------------------------------------------
FUNCTION ztcorm0_func(ZX)

REAL           :: ZX
REAL  :: ZTCORM0_FUNC
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!      
IF (lhook) CALL dr_hook('CH_BVOCEM_N:ZTCORM0_FUNC',0,zhook_handle)
ztcorm0_func= 0.
ztcorm0_func = exp(xmono_beta*(zx-xmono_t3))
IF (lhook) CALL dr_hook('CH_BVOCEM_N:ZTCORM0_FUNC',1,zhook_handle)
!
END FUNCTION ztcorm0_func
!
!---------------------------------------------------------------------------
!
END SUBROUTINE ch_bvocem_n