ch_dep_isba.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_dep_isba(KK, PK, PEK, D, DM, CHIK, PUSTAR, PTA, PPA, PTRAD, KSIZE  )  
!###########################################################                      
!!
!!    PURPOSE
!!    -------
!!      
!!    Compute dry deposition velocity for chemical species on nature area    
!!
!!    AUTHOR
!!    ------
!!      P.Tulet      * Laboratoire d'Aerologie*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original      20/02/97 
!!      Modification  21/07/00  (Guenais/Tulet) add deposition on town  and
!!                                              vegetation class   
!!      Modification  18/01/01  (Solmon/Tulet) patch dry deposition
!!      Modification  18/07/03  (Tulet) surface externalization
!!      Modification  01/2004   (Tulet Masson) removes patch calculation
!!      Modification  03/2006   (Le Moigne) pb in where test with some
!!                            compilation options
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_diag_n, ONLY : diag_t
USE modd_diag_misc_isba_n, ONLY : diag_misc_isba_t
USE modd_isba_n, ONLY : isba_k_t, isba_p_t, isba_pe_t
USE modd_ch_isba_n, ONLY : ch_isba_t
!
USE modd_data_cover_par, ONLY : nvt_no, nvt_rock
!
USE modd_isba_par
USE modd_data_cover_par
USE modd_csts
USE modd_ch_isba,     ONLY : xrcclayso2, xrcclayo3, xrcsandso2, xrcsando3, &
                             xrcsnowso2, xrcsnowo3, xlandrext  
!
USE modd_ch_surf
USE modd_surf_par,   ONLY: xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
TYPE(isba_k_t), INTENT(INOUT) :: KK
TYPE(isba_p_t), INTENT(INOUT) :: PK
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
TYPE(ch_isba_t), INTENT(INOUT) :: CHIK

TYPE(diag_t), INTENT(INOUT) :: D
TYPE(diag_misc_isba_t), INTENT(INOUT) :: DM
!
REAL, DIMENSION(:),     INTENT(IN)  :: PUSTAR       ! friction velocity
REAL, DIMENSION(:),     INTENT(IN)  :: PTA          ! air temperature forcing (K)
REAL, DIMENSION(:),     INTENT(IN)  :: PPA          ! surface atmospheric pressure
REAL, DIMENSION(:),     INTENT(IN)  :: PTRAD        ! radiative temperature  (K)
!
INTEGER, INTENT(IN) :: KSIZE
!
!*       0.2   Declarations of local variables :
!
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZDIFFMOLVAL
! Molecular diffusivity
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZSCMDT 
! Sc(:)hmidt number
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZNATRB 
! nature quasi-laminar  resistances
!
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZHENRYVALCOR
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZSTOMRC 
! stomatal surface  resistance
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZMESORC 
! mesophyl  resistance
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZEXTRC   
!  leaf uptake external surface  resistance
!
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZSOILRC 
! bare soil surface  resistance
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZNATRC
! nature surface resistances where vegetation is
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZSNOWRC 
! snow surface  resistance
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZCLAYRC 
! clay surface  resistance
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZSANDRC 
! sand surface  resistance
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZBARERC
! nature surface resistances for bare soils
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZROCKRC
! nature surface resistances for rocks
!
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZRES_VEGTYPE
REAL             , DIMENSION(SIZE(PTRAD),KSIZE) :: ZRES_SNOWTYPE
!
!  final nature resistance by vegtype
REAL, DIMENSION(SIZE(PTRAD))      :: ZTYPE1_SAND, ZTYPE1_CLAY, ZTYPE1_SNOW ! Type soil 1
REAL, DIMENSION(SIZE(PTRAD))      :: ZUSTAR
REAL, DIMENSION(SIZE(PTRAD))      :: ZDIFFMOLH2O
!  final nature resistance
REAL, DIMENSION(SIZE(PTRAD))      :: ZLANDEXT
! computed Rext from Wesely tabulations (89)
REAL, DIMENSION(SIZE(PTRAD))      :: ZINCRC 
! in-canopy transport  resistance
REAL, DIMENSION(SIZE(PTRAD))      :: ZCOEF1, ZCOEF2, ZCOEF3, ZCOEF4, ZCOEF5, ZINV1, ZINV2
REAL, DIMENSION(SIZE(PTRAD))      :: ZTCOR
!
REAL, DIMENSION(KSIZE) :: ZVAR1, ZVAR2, ZFACT1
!
REAL :: ZTYPE2_SAND, ZTYPE2_CLAY, ZTYPE2_SNOW ! Type soil 2
!
INTEGER :: JSV, JI
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!============================================================================
!
!            Primilary
!            ---------
!Default values
!--------------
!
IF (lhook) CALL dr_hook('CH_DEP_ISBA',0,zhook_handle)
!
! Default type soil
! TYPE1 = RCCLAY(SO2) = 1000
! TYPE2 = RCCLAY(O3) = 100
IF (xrcclayo3.NE.xundef) THEN
  ztype2_clay = xrcclayo3 
ELSE
  ztype2_clay = 100.
ENDIF
!
! TYPE1 = RCSAND(SO2) = 1000
! TYPE2 = RCSAND(O3) = 200
IF (xrcsando3.NE.xundef) THEN
  ztype2_sand = xrcsando3
ELSE
  ztype2_sand = 200.
ENDIF
!
! TYPE1 = RCSNOW(SO2)
! TYPE2 = RCSNOW(O3) 
IF (xrcsnowo3 /=xundef) THEN
  ztype2_snow = xrcsnowo3 
ELSE
  ztype2_snow = 2000.
ENDIF
!
DO ji = 1, SIZE(pek%XVEG)
  !
  IF (xrcclayso2.NE.xundef) THEN
    ztype1_clay(ji) = xrcclayso2 
  ELSE
    ztype1_clay(ji) = 1000.
  ENDIF
  !
  IF (xrcsandso2.NE.xundef) THEN
    ztype1_sand(ji) = xrcsandso2 
  ELSE
    ztype1_sand(ji) = 1000.
  ENDIF
  !
  IF (xrcsnowso2/=xundef) THEN
    ztype1_snow(ji) = xrcsnowso2
  ELSEIF (ptrad(ji) > 275.) THEN
    ztype1_snow(ji) = 540.
  ELSE
    ztype1_snow(ji) = 70. * (275. - ptrad(ji))
  ENDIF
  !
  !  
  zustar(ji) = max(pustar(ji), 1e-9)
  !
  zcoef5(ji) = 1./(xkarman*zustar(ji))
  !
  !        3.2.5 In-canopy transport resistance
  !              ------------------------------
  !
  IF (pek%XVEG(ji) > 0.) THEN
    zincrc(ji) = 14. * pek%XLAI(ji) * 4. * pek%XZ0(ji) / zustar(ji)
  ELSE
    zincrc(ji) = 1e-4
  ENDIF
  !
  !
  ! computed Rext from Wesely tabulations (89)
  !
  IF ( xlandrext.NE.xundef ) THEN
    ! user value
    zlandext(ji) = xlandrext
  ELSEIF (pek%XLAI(ji) /= xundef) THEN
    ! computed value
    zlandext(ji) = 6000. -  4000. * tanh( 1.6 * (pek%XLAI(ji) - 1.6) )
  ELSE
    zlandext(ji) = 9999.
  END IF
  !
  !
  zcoef1(ji) = 1./298. - 1./pta(ji)
  !
  zdiffmolh2o(ji)  = 2.22e-05 + 1.46e-07 * (pta(ji) * (ppa(ji)/xp00)**(xrd/xcpd) - 273.)  
  zcoef2(ji) = dm%XRS(ji) * zdiffmolh2o(ji)
  !
  zcoef3(ji) = 1./zlandext(ji)
  !
  IF ( ptrad(ji) < 271.) THEN
    zcoef4(ji) = 1000. * exp(-ptrad(ji) + 269.) 
  ELSE
    zcoef4(ji) = 0.
  ENDIF
  !
  ztcor(ji) = min(2.5e3, zcoef4(ji))
  !
  !
  zinv1(ji) = 1.e-5/chik%XSOILRC_SO2(ji)
  !
  zinv2(ji) = 1./chik%XSOILRC_O3(ji)
  !
ENDDO
!
!
DO jsv = 1, ksize
  !
  zvar1(jsv) = xsrealreactval(jsv) / 3000.
  zvar2(jsv) = xsrealreactval(jsv) * 100.
  !
  zfact1(jsv) = 1.46e-07 * sqrt(18. / xsrealmassmolval(jsv))
  !
ENDDO
!
!============================================================================
!
DO jsv = 1, ksize
  !
  DO ji = 1, SIZE(pta)
    !
    !       2.0  Quasi-laminar resistance 
    !            ------------------------      
    !
    !         compute molecular diffusivity for each species (Langevin, 1905)
    !         ----------------------------------------------
    !
    zdiffmolval(ji,jsv) = 2.22e-05 + (pta(ji) - 273.0) * zfact1(jsv)
    !
    !         computation of Rb for each cover type
    !         -------------------------------------
    !
    zscmdt(ji,jsv) = 0.15e-4 / zdiffmolval(ji,jsv)
    znatrb(ji,jsv) = ((zscmdt(ji,jsv)/0.72)**(2./3.)) * zcoef5(ji)
    !
    IF (pek%XLAI(ji)/=xundef) znatrb(ji,jsv) = 2. * znatrb(ji,jsv)
    !
  ENDDO
  !
ENDDO
!
DO jsv = 1, ksize
  !
  DO ji = 1, SIZE(pta)
    !
    !============================================================================
    !
    !       3.0  Surface resistance on NATURE
    !            --------------------------------
    !
    !        3.0.1 Stomatal resistance
    !              -------------------
    !     
    !ZEXTRC_O3(:) = 1./(1./(3.*ZLANDEXT(:) + 1./3000.)) 
    !
    zhenryvalcor(ji,jsv) = xsrealhenryval(jsv,1) * exp(xsrealhenryval(jsv,2) * zcoef1(ji))
    !
    IF (dm%XRS(ji)>0.) THEN
      ! 
      zstomrc(ji,jsv) = zcoef2(ji) / zdiffmolval(ji,jsv)   
      !
      !        3.2.2 Mesophyl resistance
      !              -------------------
      !
      zmesorc(ji,jsv) = 1. / ( zhenryvalcor(ji,jsv)/3000. + zvar2(jsv) )
      !
    ELSE
      !
      zstomrc(ji,jsv) = 9999.
      !
      zmesorc(ji,jsv) = 9999.
      !
    ENDIF
    !
    !        3.2.4 External leaf uptake resistance (Wesely, 1989)
    !              -------------------------------
    !
    IF (d%XHU(ji) >= 1.) THEN ! for dew-wetted surface
      !
      ! compute Rext for any species exept O3
      ! taking acount of (Walmsley, Wesely, 95, technical note, Atm Env vol 30)
      zextrc(ji,jsv) = 1./( zcoef3(ji) + 1.0e-7*zhenryvalcor(ji,jsv) + zvar1(jsv) )
      !
    ELSEIF ( dm%XRS(ji) > 0. ) THEN
      !
      zextrc(ji,jsv) = zlandext(ji) / ( 1.0e-5 * zhenryvalcor(ji,jsv) + xsrealreactval(jsv) )
      !
    ELSE
      !
      zextrc(ji,jsv) = 9999. 
      !
    ENDIF
    !
    !         Temperature correction
    !         ----------------------
    !
    zextrc(ji,jsv) = zextrc(ji,jsv) + zcoef4(ji)
    !
  ENDDO
  !
ENDDO
!
DO jsv = 1, ksize
  !
  DO ji = 1, SIZE(pta)
    !    
    !        3.2.6 Surface  resistance on soil under veg
    !              ------------------------------------- 
    !
    zsoilrc(ji,jsv) = 1. / ( zhenryvalcor(ji,jsv)*zinv1(ji) + xsrealreactval(jsv)*zinv2(ji) )  
    !
    IF ( zstomrc(ji,jsv)>0. .AND. zincrc(ji)>0. .AND. zextrc(ji,jsv)>0. ) THEN
      !
      !          3.2.7 Compute  surface resistance on vegetation
      !                -----------------------------------------
      !
      znatrc(ji,jsv) = 1./ &
        ( 1./(zstomrc(ji,jsv)+zmesorc(ji,jsv)) + 1./(zincrc(ji)+zsoilrc(ji,jsv)) + 1./zextrc(ji,jsv) )  
      !
    ELSE
      znatrc(ji,jsv) = 1.e-4 
    ENDIF
    !
    !       3.3  Surface  resistance on NATURE with NO VEG (bare soil, rock, snow) 
    !            -----------------------------------------------------------------
    !
    !          3.3.1 Surface  resistance on clay
    !                ---------------------------
    !
    zclayrc(ji,jsv) = ( 1.e5 * ztype1_clay(ji) * ztype2_clay ) / &
        ( zhenryvalcor(ji,jsv)*ztype2_clay + ztype1_clay(ji)*1.e5*xsrealreactval(jsv) )  
    !
    !          3.3.2 Surface  resistance on sand
    !                ---------------------------
    !
    zsandrc(ji,jsv) = ( 1.e5 * ztype1_sand(ji) * ztype2_sand ) / &
        ( zhenryvalcor(ji,jsv)*ztype2_sand + ztype1_sand(ji)*1.e5*xsrealreactval(jsv) )  
    !
    !          3.3.3 Compute surface resistance on bare soil
    !                ---------------------------------------
    !
    zbarerc(ji,jsv) = 1./ ( kk%XSAND(ji,1)/zsandrc(ji,jsv) + (1.-kk%XSAND(ji,1))/zclayrc(ji,jsv) )  
    !
    !          3.3.4 Surface temperature correction 
    !                ------------------------------
    !
    zbarerc(ji,jsv) = zbarerc(ji,jsv) + ztcor(ji)
    !
    !          3.3.5 Compute surface resistance on ROCK AREA
    !                ---------------------------------------
    !
    zrockrc(ji,jsv) = ( 1.e5 * chik%XSOILRC_SO2(ji) * chik%XSOILRC_O3(ji) ) / &
         (zhenryvalcor(ji,jsv)*chik%XSOILRC_O3(ji) + chik%XSOILRC_SO2(ji)*1.e5*xsrealreactval(jsv) )
    !  
    !          3.3.6 Surface temperature correction 
    !                ------------------------------
    !
    zrockrc(ji,jsv) = zrockrc(ji,jsv) + ztcor(ji)
    !
    !       3.4  Surface resistance on snow
    !            ----------------------------------
    !
    !          3.4.1 Compute surface resistance on snow
    !                ----------------------------------
    !
    zsnowrc(ji,jsv) = ( 1.e5 * ztype1_snow(ji) * ztype2_snow ) / &
        ( zhenryvalcor(ji,jsv)*ztype2_snow + ztype1_snow(ji)*1.e5*xsrealreactval(jsv) )  
    !
    !          3.4.2 Surface temperature correction 
    !                ------------------------------
    !
    zsnowrc(ji,jsv) = zsnowrc(ji,jsv) + ztcor(ji)
    !
    !       3.5  Surface resistance on snow (eternal or explicit)
    !            --------------------------------------------
    !
    ! add rocks into bare soil resistance computation, when present
    IF ( pk%XVEGTYPE_PATCH(ji,nvt_rock)>0. ) THEN 
      zbarerc(ji,jsv) = ( pk%XVEGTYPE_PATCH(ji,nvt_no)+pk%XVEGTYPE_PATCH(ji,nvt_rock) ) / &
            ( pk%XVEGTYPE_PATCH(ji,nvt_no)/zbarerc(ji,jsv) + pk%XVEGTYPE_PATCH(ji,nvt_rock)/zrockrc(ji,jsv) )
    ENDIF
    !
    ! computes resistance due to soil and vegetation
    znatrc(ji,jsv) = 1./ ( pek%XVEG(ji)/znatrc(ji,jsv) + (1.-pek%XVEG(ji))/zbarerc(ji,jsv) ) 
    ! 
  ENDDO
  !
ENDDO
!
DO jsv = 1, ksize
  !
  DO ji = 1, SIZE(pta)
    !    
    !---------------------------------------------------------------------
    !
    !       4.0  Compute nature resistance 
    !            --------------------------
    !
    zres_vegtype(ji,jsv) = pek%XRESA(ji) + znatrb(ji,jsv) + znatrc(ji,jsv)
    zres_snowtype(ji,jsv) = pek%XRESA(ji) + znatrb(ji,jsv) + zsnowrc(ji,jsv)
    !
    chik%XDEP(ji,jsv) = ( 1-pek%XPSN(ji) )/zres_vegtype(ji,jsv) + pek%XPSN(ji)/zres_snowtype(ji,jsv)  
    !
  ENDDO
  !
ENDDO
!
IF (lhook) CALL dr_hook('CH_DEP_ISBA',1,zhook_handle)
!
!---------------------------------------------------------------------
!
END SUBROUTINE ch_dep_isba