diff --git a/src/science/canopy/cable_canopy.F90 b/src/science/canopy/cable_canopy.F90 index e0ead8d1f..516c50c44 100644 --- a/src/science/canopy/cable_canopy.F90 +++ b/src/science/canopy/cable_canopy.F90 @@ -6,17 +6,17 @@ MODULE cable_canopy_module PRIVATE CONTAINS - + SUBROUTINE define_canopy(bal,rad,rough,air,met,dels,ssnow,soil,veg, canopy,climate, sunlit_veg_mask, reducedLAIdue2snow ) ! subrs USE cbl_radiation_module, ONLY : radiation -USE cbl_friction_vel_module, ONLY : comp_friction_vel, psim, psis -USE cbl_pot_evap_snow_module, ONLY : Penman_Monteith, Humidity_deficit_method -USE cbl_qsat_module, ONLY : qsatfjh, qsatfjh2 -USE cbl_zetar_module, ONLY : update_zetar -USE cable_latent_heat_module, ONLY : latent_heat_flux -USE cable_wetleaf_module, ONLY : wetleaf -USE cbl_dryLeaf_module, ONLY : dryLeaf +USE cbl_friction_vel_module, ONLY : comp_friction_vel, psim, psis +USE cbl_pot_evap_snow_module, ONLY : Penman_Monteith, Humidity_deficit_method +USE cbl_qsat_module, ONLY : qsatfjh, qsatfjh2 +USE cbl_zetar_module, ONLY : update_zetar +USE cable_latent_heat_module, ONLY : latent_heat_flux +USE cable_wetleaf_module, ONLY : wetleaf +USE cbl_dryLeaf_module, ONLY : dryLeaf USE cable_within_canopy_module, ONLY : within_canopy USE cbl_SurfaceWetness_module, ONLY : Surf_wetness_fact @@ -232,7 +232,7 @@ SUBROUTINE define_canopy(bal,rad,rough,air,met,dels,ssnow,soil,veg, canopy,clima canopy%fhs_cor = 0.0 canopy%fns_cor = 0.0 canopy%ga_cor = 0.0 - canopy%fes_cor = 0.0 + !!canopy%fes_cor = 0.0 !L_REV_CORR - new working variables rttsoil = 0. @@ -409,7 +409,7 @@ SUBROUTINE define_canopy(bal,rad,rough,air,met,dels,ssnow,soil,veg, canopy,clima CALL wetLeaf( dels, cansat, tlfy, gbhu, gbhf, ghwet, mp, CLAI_thresh, & CCAPP, CRmair, reducedLAIdue2snow, sum_rad_rniso, & sum_rad_gradis, canopy%fevw, canopy%fevw_pot, canopy%fhvw, & - canopy%fwet, canopy%cansto, air%rlam, air%dsatdk, & + canopy%fwet, canopy%cansto, air%rlam, air%dsatdk, & met%tvair, met%tk, met%dva, air%psyc ) ! Calculate latent heat from vegetation: @@ -420,7 +420,7 @@ SUBROUTINE define_canopy(bal,rad,rough,air,met,dels,ssnow,soil,veg, canopy,clima canopy%fhv = REAL(ftemp) ftemp= (1.0-canopy%fwet)*REAL(rny)+canopy%fevw+canopy%fhvw canopy%fnv = REAL(ftemp) - + ! canopy rad. temperature calc from long-wave rad. balance DO j=1,mp @@ -883,14 +883,14 @@ SUBROUTINE define_canopy(bal,rad,rough,air,met,dels,ssnow,soil,veg, canopy,clima ! Calculate dewfall: from negative lh wet canopy + neg. lh dry canopy: canopy%dewmm = - (MIN(0.0,canopy%fevw) + MIN(0.0_r_2,canopy%fevc)) * & - dels * 1.0e3 / (CRHOW*air%rlam) + dels / air%rlam ! Add dewfall to canopy water storage: canopy%cansto = canopy%cansto + canopy%dewmm ! Modify canopy water storage for evaporation: canopy%cansto = MAX(canopy%cansto-MAX(0.0,REAL(canopy%fevw))*dels & - *1.0e3/(CRHOW*air%rlam), 0.0) + /air%rlam, 0.0) ! Calculate canopy water storage excess: canopy%spill=MAX(0.0, canopy%cansto-cansat) diff --git a/src/science/canopy/cbl_SurfaceWetness.F90 b/src/science/canopy/cbl_SurfaceWetness.F90 index 83cf4731a..b35530cf6 100644 --- a/src/science/canopy/cbl_SurfaceWetness.F90 +++ b/src/science/canopy/cbl_SurfaceWetness.F90 @@ -11,20 +11,17 @@ SUBROUTINE Surf_wetness_fact( cansat, canopy, ssnow,veg, met, soil, dels ) USE cable_common_module USE cable_def_types_mod -! data -USE cable_surface_types_mod, ONLY: lakes_cable -USE cable_phys_constants_mod, ONLY: CTFRZ => TFRZ +! data +USE cable_phys_constants_mod, ONLY : CTFRZ => TFRZ !H!USE cable_gw_hydro_module, ONLY : calc_srf_wet_fraction +USE cable_init_wetfac_mod, ONLY: initialize_wetfac - -use cable_init_wetfac_mod, ONLY: initialize_wetfac - -TYPE (veg_parameter_type), INTENT(INOUT) :: veg -TYPE (soil_snow_type), INTENT(inout):: ssnow -TYPE (soil_parameter_type), INTENT(inout) :: soil -TYPE (canopy_type), INTENT(INOUT) :: canopy -TYPE (met_type), INTENT(INOUT) :: met +TYPE (veg_parameter_type), INTENT(INOUT) :: veg +TYPE (soil_snow_type), INTENT(INOUT) :: ssnow +TYPE (soil_parameter_type), INTENT(INOUT) :: soil +TYPE (canopy_type), INTENT(INOUT) :: canopy +TYPE (met_type), INTENT(INOUT) :: met REAL, INTENT(IN) :: dels ! integration time setp (s) @@ -71,17 +68,15 @@ SUBROUTINE Surf_wetness_fact( cansat, canopy, ssnow,veg, met, soil, dels ) !originally code in canopy used 1e-6 as MIN CALL initialize_wetfac( mp, ssnow%wetfac, soil%swilt, soil%sfc, & ssnow%wb(:,1), ssnow%wbice(:,1), ssnow%snowd, & - veg%iveg, met%tk, Ctfrz ) + veg%iveg, met%tk, Ctfrz ) ! owetfac introduced to reduce sharp changes in dry regions, ! especially in offline runs in which there may be discrepancies b/n ! timing of precip and temperature change (EAK apr2009) ssnow%wetfac = 0.5*(ssnow%wetfac + ssnow%owetfac) - - - - END SUBROUTINE Surf_wetness_fact +RETURN +END SUBROUTINE Surf_wetness_fact END MODULE cbl_SurfaceWetness_module diff --git a/src/science/canopy/cbl_latent_heat.F90 b/src/science/canopy/cbl_latent_heat.F90 index aed415afa..124dea5c5 100644 --- a/src/science/canopy/cbl_latent_heat.F90 +++ b/src/science/canopy/cbl_latent_heat.F90 @@ -53,6 +53,8 @@ SUBROUTINE Latent_heat_flux( mp, CTFRZ, dels, soil_zse, soil_swilt, & USE cable_def_types_mod, ONLY : r_2 +USE cable_common_module, ONLY : frozen_limit +USE cable_phys_constants_mod, ONLY : density_liq IMPLICIT NONE @@ -171,7 +173,7 @@ SUBROUTINE Latent_heat_flux( mp, CTFRZ, dels, soil_zse, soil_swilt, & ! frescale is a factor used to convert an amount of water (in m3/m3) ! in the surface layer of the soil into a limit on the soil latent heat flux. ! 1000 is the density of water in kg/m3 -frescale = soil_zse * 1000. * air_rlam / dels +frescale = soil_zse * density_liq * air_rlam / dels !| 3. (the main loop) The value for \(c_{ls}\) and additional limits ! on the latent heat flux(es) are applied, according to which of the four cases @@ -208,8 +210,9 @@ SUBROUTINE Latent_heat_flux( mp, CTFRZ, dels, soil_zse, soil_swilt, & ! frozen_limit=0.85. This provides a second upper limit on the evaporation and ! soil latent flux. **WARNING** frozen_limit=0.85 is hard coded - if it is changed ! then the corresponding limit in [[cbl_soilsnow]] must also be changed. -! - fupper_limit(j) = REAL(ssnow_wb(j)-ssnow_wbice(j)/0.85)*frescale(j) + + fupper_limit(j) = REAL(ssnow_wb(j)-ssnow_wbice(j)/frozen_limit)*frescale(j) + fupper_limit(j) = MAX(REAL(fupper_limit(j),r_2),0.) canopy_fess(j) = MIN(canopy_fess(j), REAL(fupper_limit(j),r_2)) diff --git a/src/science/canopy/cbl_within_canopy.F90 b/src/science/canopy/cbl_within_canopy.F90 index 236c535d8..4a2ed7ddf 100644 --- a/src/science/canopy/cbl_within_canopy.F90 +++ b/src/science/canopy/cbl_within_canopy.F90 @@ -29,8 +29,8 @@ SUBROUTINE within_canopy( mp, CRMH2o, Crmair, CTETENA, CTETENB, CTETENC, CLAI_th TYPE(soil_snow_type), INTENT(INOUT) :: ssnow TYPE (veg_parameter_type), INTENT(INOUT) :: veg - REAL, INTENT(INOUT) :: qstvair(mp) ! sat spec humidity at leaf temperature 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