cbl_within_canopy.F90 Source File


This file depends on

sourcefile~~cbl_within_canopy.f90~~EfferentGraph sourcefile~cbl_within_canopy.f90 cbl_within_canopy.F90 sourcefile~cable_common.f90 cable_common.F90 sourcefile~cbl_within_canopy.f90->sourcefile~cable_common.f90 sourcefile~cable_define_types.f90 cable_define_types.F90 sourcefile~cbl_within_canopy.f90->sourcefile~cable_define_types.f90 sourcefile~cbl_qsat.f90 cbl_qsat.F90 sourcefile~cbl_within_canopy.f90->sourcefile~cbl_qsat.f90 sourcefile~cable_runtime_opts_mod.f90 cable_runtime_opts_mod.F90 sourcefile~cable_common.f90->sourcefile~cable_runtime_opts_mod.f90 sourcefile~cable_climate_type_mod.f90 cable_climate_type_mod.F90 sourcefile~cable_define_types.f90->sourcefile~cable_climate_type_mod.f90 sourcefile~cable_climate_type_mod.f90->sourcefile~cable_common.f90 sourcefile~grid_constants_cbl.f90 grid_constants_cbl.F90 sourcefile~cable_climate_type_mod.f90->sourcefile~grid_constants_cbl.f90

Files dependent on this one

sourcefile~~cbl_within_canopy.f90~~AfferentGraph sourcefile~cbl_within_canopy.f90 cbl_within_canopy.F90 sourcefile~cable_canopy.f90 cable_canopy.F90 sourcefile~cable_canopy.f90->sourcefile~cbl_within_canopy.f90 sourcefile~cbl_model_driver_offline.f90 cbl_model_driver_offline.F90 sourcefile~cbl_model_driver_offline.f90->sourcefile~cable_canopy.f90 sourcefile~cable_mpimaster.f90 cable_mpimaster.F90 sourcefile~cable_mpimaster.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_mpiworker.f90 cable_mpiworker.F90 sourcefile~cable_mpiworker.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_serial.f90 cable_serial.F90 sourcefile~cable_serial.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_offline_driver.f90 cable_offline_driver.F90 sourcefile~cable_offline_driver.f90->sourcefile~cable_serial.f90

Source Code

MODULE cable_within_canopy_module
  
  IMPLICIT NONE

  PUBLIC within_canopy
  PRIVATE

CONTAINS

SUBROUTINE within_canopy( mp, CRMH2o, Crmair, CTETENA, CTETENB, CTETENC, CLAI_thresh, &
                           CCAPP, CTFRZ, rad,rough, air, met, veg, canopy, ssnow, gbhu, gbhf,    &
                           qstvair, rt0, rhlitt, relitt )
  
  USE cable_common_module, ONLY : cable_user

  USE cable_def_types_mod, ONLY : r_2

  USE cable_def_types_mod, ONLY : canopy_type, air_type, met_type,             &
                                  radiation_type, roughness_type,              &
                                  veg_parameter_type, soil_snow_type

USE cbl_qsat_module, ONLY: qsatfjh, qsatfjh2

  TYPE (radiation_type), INTENT(INOUT) :: rad
  TYPE (roughness_type), INTENT(INOUT) :: rough
  TYPE (air_type),       INTENT(INOUT) :: air
  TYPE (met_type),       INTENT(INOUT) :: met
  TYPE (canopy_type),    INTENT(INOUT) :: canopy
  TYPE(soil_snow_type),  INTENT(INOUT) :: ssnow
  TYPE (veg_parameter_type), INTENT(INOUT)    :: veg

  INTEGER, INTENT(IN) :: mp
  REAL,  INTENT(INOUT)  :: qstvair(mp)        ! sat spec humidity at leaf temperature
  REAL, INTENT(IN) :: CRMH2o, Crmair, CTETENA, CTETENB, CTETENC
  REAL, INTENT(IN) :: CLAI_thresh, CCAPP, CTFRZ

  REAL(r_2), INTENT(IN), DIMENSION(:,:) ::                                    &
       gbhu,    &  ! forcedConvectionBndryLayerCond
       gbhf        ! freeConvectionBndryLayerCond

  REAL, INTENT(IN), DIMENSION(mp) ::                                       &
       rt0,     &  ! resistance from ground to canopy air
       rhlitt,  &  ! additional litter resistance for heat (=0 by default)
       relitt      ! additional litter resistance for water

  REAL, DIMENSION(mp) ::                                                      &
       rrsw,             & ! recipr. stomatal resistance for water
       rrbw,             & ! recipr. leaf boundary layer resistance for water
       dmah,             & ! A_{H} in eq. 3.41 in SCAM, CSIRO tech report 132
       dmbh,             & ! B_{H} in eq. 3.41 in SCAM, CSIRO tech report 132
       dmch,             & ! C_{H} in eq. 3.41 in SCAM, CSIRO tech report 132
       dmae,             & ! A_{E} in eq. 3.41 in SCAM, CSIRO tech report 132
       dmbe,             & ! B_{E} in eq. 3.41 in SCAM, CSIRO tech report 132
       dmce                ! C_{E} in eq. 3.41 in SCAM, CSIRO tech report 132

  REAL  :: lower_limit, upper_limit
  REAL, DIMENSION(mp) :: fix_eqn,fix_eqn2

  INTEGER :: j

  !INH: rhlitt=relitt=0. if litter resistance not active but case included
  !dmah through to dmce are not A_{H} through C_{E} as per Eqn 3.40
  !in SCAM documentation but rt0*((1+esp)/rs + 1/rb)*A_{H} etc.
  !
  !changes from v1.4 for %cls package, litter and Or hydrology

  rrbw = SUM(gbhu+gbhf,2)/air%cmolar  ! MJT

  ! leaf stomatal resistance for water
  rrsw = SUM(canopy%gswx,2)/air%cmolar ! MJT

  IF (cable_user%or_evap) THEN
     fix_eqn(:) = rt0(:)*(REAL(ssnow%satfrac(:))/(rt0(:)+REAL(ssnow%rtevap_sat(:))) + &
          (1-REAL(ssnow%satfrac(:)))/(rt0(:)+REAL(ssnow%rtevap_unsat(:))))
     !lakes/ice rtevap=0 and wetfac is .ne. 1
     fix_eqn(:) = ssnow%wetfac(:) * fix_eqn(:)*ssnow%cls(:)   !INH correction. & M.Dekker +d wetfac

     fix_eqn2(:) = rt0(:) / (rt0(:) + REAL(ssnow%rt_qh_sublayer) )

  ELSE  !with INH corrections for litter and cls

     fix_eqn(:) = ssnow%cls(:)*rt0(:)/(rt0(:)+relitt(:))
     WHERE (ssnow%potev>0.) fix_eqn(:)=fix_eqn(:)*ssnow%wetfac(:)
     fix_eqn2(:) = rt0(:)/(rt0(:)+rhlitt(:))

  END IF

  DO j=1,mp

     IF(veg%meth(j) > 0 .AND. canopy%vlaiw(j) > CLAI_THRESH .AND.              &
          rough%hruff(j) > rough%z0soilsn(j) ) THEN

        !   use the dispersion matrix (DM) to find the air temperature
        !   and specific humidity
        !   (Raupach, Finkele and Zhang 1997, pp 17)
        ! leaf boundary layer resistance for water
        ! A_{H} in eq. 3.41, SCAM manual, CSIRO tech doc 132
        dmah(j) = (rt0(j)+fix_eqn2(j)*rough%rt1(j))*((1.+air%epsi(j))*rrsw(j) + rrbw(j))  &
             + air%epsi(j) * (rt0(j)*rough%rt1(j))*(rrbw(j)*rrsw(j))

        ! B_{H} in eq. 3.41, SCAM manual, CSIRO tech doc 132
        dmbh(j) = (-air%rlam(j)/CCAPP)*(rt0(j)*rough%rt1(j))*(rrbw(j)*rrsw(j))

        ! C_{H} in eq. 3.41, SCAM manual, CSIRO tech doc 132
        dmch(j) = ((1.+air%epsi(j))*rrsw(j) + rrbw(j))*rt0(j)*rough%rt1(j)*   &
             (canopy%fhv(j) + canopy%fhs(j))/(air%rho(j)*CCAPP)

        ! A_{E} in eq. 3.41, SCAM manual, CSIRO tech doc 132
        dmae(j) = (-air%epsi(j)*CCAPP/air%rlam(j))*(rt0(j)*rough%rt1(j)) *   &
             (rrbw(j)*rrsw(j))

        ! B_{E} in eq. 3.41, SCAM manual, CSIRO tech doc 132
        dmbe(j) = ( rt0(j) + fix_eqn(j) * rough%rt1(j) ) *               &
             ( (1.+air%epsi(j) ) * rrsw(j) + rrbw(j) ) +                 &
             ( rt0(j) * rough%rt1(j) ) * ( rrbw(j) * rrsw(j) )

        ! C_{E} in eq. 3.41, SCAM manual, CSIRO tech doc 132
        ! INH: includes modifications for %cls
        dmce(j) = ((1.+air%epsi(j))*rrsw(j) + rrbw(j))*rt0(j)*rough%rt1(j)*   &
             (canopy%fev(j) + canopy%fes(j)/ssnow%cls(j)) /                   &
             (air%rho(j)*air%rlam(j))

        ! Within canopy air temperature:
        met%tvair(j) = met%tk(j) + ( dmbe(j) * dmch(j) - dmbh(j) * dmce(j) )  &
             / (dmah(j)*dmbe(j)-dmae(j)*dmbh(j)+1.0e-12)

        !---set limits for comparisson
        lower_limit =  MIN( ssnow%tss(j), met%tk(j)) - 5.0
        upper_limit =  MAX( ssnow%tss(j), met%tk(j)) + 5.0

        !--- tvair within these limits
        met%tvair(j) = MAX(met%tvair(j) , lower_limit)
        met%tvair(j) = MIN(met%tvair(j) , upper_limit)

        ! recalculate using canopy within temperature
        met%qvair(j) = met%qv(j) + (dmah(j)*dmce(j)-dmae(j)*dmch(j)) /        &
             ( dmah(j)*dmbe(j)-dmae(j)*dmbh(j)+1.0e-12)
        met%qvair(j) = MAX(0.0,met%qvair(j))

        !---set limits for comparisson

        lower_limit =  MIN( ssnow%qstss(j), met%qv(j))
        upper_limit =  MAX( ssnow%qstss(j), met%qv(j))

        !--- qvair within these limits
        met%qvair(j) =  MAX(met%qvair(j),lower_limit)
        met%qvair(j) =  MIN(met%qvair(j), upper_limit)

        ! Saturated specific humidity in canopy:
        CALL  qsatfjh2( qstvair(j), CRMH2o, Crmair, CTETENA, CTETENB, CTETENC, met%tvair(j)-Ctfrz,met%pmb(j))

        ! Saturated vapour pressure deficit in canopy:
        met%dva(j) = ( qstvair(j) - met%qvair(j) ) *  Crmair/CRMH2o         &
             * met%pmb(j) * 100.
     ENDIF

  ENDDO

END SUBROUTINE within_canopy

END MODULE cable_within_canopy_module