cbl_pot_evap_snow.F90 Source File


This file depends on

sourcefile~~cbl_pot_evap_snow.f90~~EfferentGraph sourcefile~cbl_pot_evap_snow.f90 cbl_pot_evap_snow.F90 sourcefile~cbl_qsat.f90 cbl_qsat.F90 sourcefile~cbl_pot_evap_snow.f90->sourcefile~cbl_qsat.f90

Files dependent on this one

sourcefile~~cbl_pot_evap_snow.f90~~AfferentGraph sourcefile~cbl_pot_evap_snow.f90 cbl_pot_evap_snow.F90 sourcefile~cable_canopy.f90 cable_canopy.F90 sourcefile~cable_canopy.f90->sourcefile~cbl_pot_evap_snow.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 cbl_pot_evap_snow_module

IMPLICIT NONE

PUBLIC Penman_Monteith
PUBLIC Humidity_deficit_method
PRIVATE

CONTAINS

FUNCTION Penman_Monteith( mp, Ctfrz, CRMH2o, Crmair, CTETENA, CTETENB,         &
                          CTETENC, veg_clitt, cable_user_litter,               &
                          air_dsatdk, air_psyc, air_rho, air_rlam,             & 
                          met_tvair, met_pmb, met_qvair,                       &
                          ground_H_flux, canopy_fns, canopy_DvLitt,            & 
                          ssnow_rtsoil, ssnow_isflag )        RESULT(ssnowpotev)
USE cbl_qsat_module, ONLY : qsatfjh 
IMPLICIT NONE

INTEGER, INTENT(IN) :: mp
!REAL, INTENT(OUT)   :: ssnowpotev(mp)     ! returned result of function
REAL   :: ssnowpotev(mp)     ! returned result of function

REAL, INTENT(IN) :: Ctfrz 
REAl :: CRMH2o
REAl :: Crmair
REAl :: CTETENA, CTETENB, CTETENC
REAL, INTENT(IN) :: veg_clitt(mp)
LOGICAL, INTENT(IN) :: cable_user_litter
REAL, INTENT(IN) :: air_dsatdk(mp)
REAL, INTENT(IN) :: air_psyc(mp)
REAL, INTENT(IN) :: air_rho(mp)
REAL, INTENT(IN) :: air_rlam(mp)
REAL, INTENT(IN) :: met_tvair(mp) 
REAL, INTENT(IN) :: met_qvair(mp) 
REAL, INTENT(IN) :: met_pmb(mp)
REAL, INTENT(IN) :: ground_H_flux(mp)
REAL, INTENT(IN) :: canopy_fns(mp)
REAL, INTENT(IN) :: canopy_DVLitt(mp)
REAL, INTENT(IN) :: ssnow_rtsoil(mp)
INTEGER, INTENT(IN) :: ssnow_isflag(mp)

!local vars
REAL :: sss(mp)          ! var for Penman-Monteith soil evap  
REAL :: cc1(mp)          ! var for Penman-Monteith soil evap                                                    &
REAL :: cc2(mp)          ! var for Penman-Monteith soil evap
REAL :: qsatfvar(mp)
INTEGER :: j

! Penman-Monteith formula
sss=air_dsatdk
cc1=sss/(sss+air_psyc )
cc2=air_psyc /(sss+air_psyc )

CALL qsatfjh( mp, qsatfvar, CRMH2o, Crmair, CTETENA, CTETENB, CTETENC,         &
              met_tvair-CTfrz,met_pmb)

!INH 10-1-2017 - this P-M implementation is incorrect over snow.
!variable ssnowpotev is actually the latent heat flux associated with
!potential evaporation.
!Needs to be addressed/simplified at a later date - involves changes
!to HDM method and latent_heat_flux() and elsewhere

IF (cable_user_litter) THEN
  ! vh_js !
  ssnowpotev = cc1 * (canopy_fns - ground_H_flux) + &
               cc2 * air_rho * air_rlam*(qsatfvar - met_qvair)/ &
               (ssnow_rtsoil+ REAL((1-ssnow_isflag))*veg_clitt*0.003/canopy_DvLitt)
ELSE
  ssnowpotev = cc1 * (canopy_fns - ground_H_flux) + &
               cc2 * air_rho * air_rlam*(qsatfvar  - met_qvair)/ssnow_rtsoil
ENDIF

RETURN
END FUNCTION Penman_Monteith



FUNCTION Humidity_deficit_method( mp, Ctfrz, veg_clitt,cable_user_or_evap,     &
                                 cable_user_gw_model, cable_user_litter,       &
                                 air_rho,air_rlam,           & 
                                 dq,dqu,qstss,   & 
                                 canopy_DvLitt,      &
                                 ssnow_isflag, ssnow_satfrac, ssnow_rtsoil,    &
                                 ssnow_rtevap_sat, ssnow_rtevap_unsat,      & 
                                 ssnow_snowd, ssnow_tgg &
                                 ) RESULT(ssnowpotev)
IMPLICIT NONE

INTEGER :: mp
REAL ::  ssnowpotev(mp)

REAL:: Ctfrz 
REAL, INTENT(IN) :: veg_clitt(mp)
LOGICAL :: cable_user_or_evap, cable_user_gw_model, cable_user_litter
REAL :: air_rho(mp)    !
REAL :: air_rlam(mp)    !
REAL :: dq(mp)       ! sat spec hum diff.
REAL :: dqu(mp)      ! sat spec hum diff.
REAL :: qstss(mp)    !dummy var for compilation
REAL :: canopy_DvLitt(mp)    ! 
INTEGER, INTENT(IN) :: ssnow_isflag(mp)
REAL :: ssnow_snowd(mp)    ! 
REAL :: ssnow_tgg(mp)    ! 
REAL :: ssnow_satfrac(mp)    !
REAL :: ssnow_rtsoil(mp)    !
REAL :: ssnow_rtevap_sat(mp)    !
REAL :: ssnow_rtevap_unsat(mp)    !

!local vars
INTEGER :: j
REAL, DIMENSION(mp) :: q_air

q_air = qstss - dq

DO j=1,mp

  IF( ssnow_snowd(j)>1.0 .OR. ssnow_tgg(j) .EQ. Ctfrz ) THEN
    dq(j) = MAX( -0.1e-3, dq(j))
    dqu(j) = MAX( -0.1e-3, dqu(j))
  END IF

  IF (dq(j) .LE. 0.0 .AND. dqu(j) .LT. dq(j)) THEN
    dqu(j) = dq(j)
  END IF

  IF (dq(j) .GE. 0.0 .AND. dqu(j) .LT. 0.0) THEN
    dqu(j) = 0.0
  ENDIF
ENDDO

IF (cable_user_or_evap .or. cable_user_gw_model) then
  write(6,*) "GW or ORevepis not an option right now"
  !H!        IF (cable_user_or_evap) THEN
  !H!          do j=1,mp
  !H!       
  !H!             if (veg_iveg(j) .lt. 16 .and. ssnow_snowd(j) .lt. 1e-7) THEN
  !H!       
  !H!                if (dq(j) .le. 0.0) THEN
  !H!                   ssnow_rtevap_sat(j) = min(rtevap_max,canopy_sublayer_dz(j)/rt_Dff)
  !H!                end if
  !H!       
  !H!                if (dqu(j) .le. 0.0) THEN
  !H!                   ssnow_rtevap_unsat(j) = min(rtevap_max,canopy_sublayer_dz(j)/rt_Dff)
  !H!                end if
  !H!       
  !H!             end if
  !H!
  !H!          end do
  !H!
  !H!        END IF

  ssnowpotev = air_rho * air_rlam * ( &
               REAL(ssnow_satfrac) * dq /(ssnow_rtsoil + REAL(ssnow_rtevap_sat)) + &
               (1.0 - REAL(ssnow_satfrac))* dqu/( &
               ssnow_rtsoil + REAL(ssnow_rtevap_unsat)) )

 ELSEIF (cable_user_litter) THEN
         ! vh_js !
  ssnowpotev = air_rho * air_rlam * dq /( ssnow_rtsoil +                       &
                          REAL((1-ssnow_isflag))* veg_clitt*0.003/canopy_DvLitt)
 ELSE
  ssnowpotev = air_rho * air_rlam * dq / ssnow_rtsoil
 ENDIF

RETURN
END FUNCTION Humidity_deficit_method

END MODULE cbl_pot_evap_snow_module