condcq.f90

来自「CLM集合卡曼滤波数据同化算法」· F90 代码 · 共 54 行

  SUBROUTINE condcq (sigf,lsai,raw,rbw,rdw,rpp,&
                     wtaq,wtlq,wtgq,wtaq0,wtlq0,wtgq0,wtalq,wtgaq,wtglq)

!=======================================================================
!      Source file: condcq.f90
! Original version: Yongjiu Dai, September 15, 1999
!
! Provides dimensional and non-dimensional latent heat conductances
! for canopy and soil flux calculations. Latent fluxes differ from
! sensible due to stomatal resistance
!
!=======================================================================

  IMPLICIT NONE

! dummy argument
  real, INTENT(in) :: &
        sigf, &! fraction of veg cover, excluding snow-covered veg [-]
        lsai, &! leaf + stem area index
        raw,  &! aerodynamical resistance [s/m]
        rbw,  &! leaf boundary layer resistance [s/m]
        rdw,  &! latent heat resistance between ground and bottom of canopy
        rpp    ! fraction of potential evaporation from leaf [-]

  real, INTENT(out) :: &
        wtaq, &! latent heat conduactance for air [m/s]
        wtlq, &! latent heat conduactance for leaf [m/s]
        wtgq, &! latent heat conduactance for ground [m/s]
        wtaq0,&! normalized latent heat conduactance for air [-]
        wtlq0,&! normalized latent heat conduactance for leaf [-]
        wtgq0,&! normalized heat conduactance for ground [-]
        wtalq,&! normalized latent heat cond. for air and leaf [-]
        wtglq,&! normalized latent heat cond. for leaf and ground [-]
        wtgaq  ! normalized latent heat cond. for air and ground [-]

! local variables
  real  wtsqi   ! latent heat resistance for air, grd and leaf [-]
!-----------------------------------------------------------------------

        wtaq  = sigf/raw                      ! air
        wtlq  = sigf*lsai/rbw * rpp           ! leaf
        wtgq  = sigf/rdw                      ! ground
        wtsqi = 1./(wtaq+wtlq+wtgq)

        wtgq0 = wtgq*wtsqi                    ! ground
        wtlq0 = wtlq*wtsqi                    ! leaf
        wtaq0 = wtaq*wtsqi                    ! air

        wtglq = wtgq0+wtlq0                   ! ground + leaf
        wtgaq = wtaq0+wtgq0                   ! air + ground
        wtalq = wtaq0+wtlq0                   ! air + leaf

  END SUBROUTINE condcq