Skip to content

Commit

Permalink
this is basically sub-suming branch 436 , PR#446 now
Browse files Browse the repository at this point in the history
  • Loading branch information
JhanSrbinovsky committed Nov 13, 2024
1 parent 3416445 commit 2b0b6dc
Show file tree
Hide file tree
Showing 3 changed files with 34 additions and 20 deletions.
26 changes: 20 additions & 6 deletions src/offline/cable_parameters.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1171,6 +1171,7 @@ SUBROUTINE write_default_params(met, air, ssnow, veg, bgc, &
INTEGER :: e,f,h,i,klev ! do loop counter
INTEGER :: is ! YP oct07
INTEGER :: ir ! BP sep2010
REAL :: totdepth ! YP oct07
REAL :: tmp ! BP sep2010

! The following is for the alternate method to calculate froot by Zeng 2001
Expand Down Expand Up @@ -1260,6 +1261,18 @@ SUBROUTINE write_default_params(met, air, ssnow, veg, bgc, &

veg%meth = 1 ! canopy turbulence parameterisation method: 0 or 1

! I brought this in with manual merge of #199 BUT Am i bringing this back in ?
! calculate vegin%froot from using rootbeta and soil depth
! (Jackson et al. 1996, Oceologica, 108:389-411)
!totdepth = 0.0
!DO is = 1, ms
! totdepth = totdepth + soil%zse(is) * 100.0 ! unit in centimetres
! vegin%froot(is, :) = MIN(1.0, 1.0-vegin%rootbeta(:)**totdepth)
!END DO
!DO is = ms, 2, -1
! vegin%froot(is, :) = vegin%froot(is, :)-vegin%froot(is-1, :)
!END DO

ALLOCATE(defaultLAI(mp, 12))

DO e = 1, mland ! over all land grid points
Expand Down Expand Up @@ -2461,8 +2474,9 @@ SUBROUTINE consistency_ice_veg_soil(soil, veg)
! Ensure that when an active patch has a veg type of ice then its soil type is also ice and vice versa
! Any change effected to enforce this consistency includes correcting the appropriate paramter values

USE grid_constants_mod_cbl, ONLY : ICE_SoilType, ICE_VegType => ice_cable
USE cable_phys_constants_mod, ONLY : csice, density_ice
USE grid_constants_mod_cbl, ONLY: ICE_SoilType
USE cable_surface_types_mod, ONLY: ICE_VegType => ice_cable
USE cable_phys_constants_mod, ONLY: csice, density_ice

TYPE (soil_parameter_type), INTENT(INOUT) :: soil ! soil parameter data
TYPE (veg_parameter_type), INTENT(INOUT) :: veg ! vegetation parameter
Expand Down Expand Up @@ -3326,12 +3340,12 @@ SUBROUTINE init_veg_from_vegin(ifmp,fmp, veg, soil_zse )
! (Jackson et al. 1996, Oceologica, 108:389-411)
totdepth = 0.0
DO is = 1, ms-1
totdepth = totdepth + soil_zse(is) * 100.0 ! unit in centimetres
veg%froot(ifmp:fmp, is) = MIN( 1.0, 1.0-veg%rootbeta(ifmp:fmp)**totdepth )
totdepth = totdepth + soil_zse(is) * 100.0 ! unit in centimetres
veg%froot(:, is) = MIN( 1.0, 1.0-veg%rootbeta(:)**totdepth )
END DO
veg%froot(ifmp:fmp, ms) = 1.0 - veg%froot(ifmp:fmp, ms-1)
veg%froot(:, ms) = 1.0 - veg%froot(:, ms-1)
DO is = ms-1, 2, -1
veg%froot(ifmp:fmp, is) = veg%froot(ifmp:fmp, is)-veg%froot(ifmp:fmp,is-1)
veg%froot(:, is) = veg%froot(:, is)-veg%froot(:,is-1)
END DO

END SUBROUTINE init_veg_from_vegin
Expand Down
19 changes: 10 additions & 9 deletions src/offline/cbl_model_driver_offline.F90
Original file line number Diff line number Diff line change
Expand Up @@ -62,15 +62,16 @@ SUBROUTINE cbm( ktau,dels, air, bgc, canopy, met,
USE sli_main_mod, ONLY : sli_main
USE snow_aging_mod, ONLY: snow_aging

!data !jhan:pass these
USE cable_other_constants_mod, ONLY : CLAI_THRESH => lai_thresh
USE cable_other_constants_mod, ONLY : Crad_thresh => rad_thresh
USE cable_other_constants_mod, ONLY : Ccoszen_tols => coszen_tols
USE cable_other_constants_mod, ONLY : CGAUSS_W => gauss_w
USE cable_math_constants_mod, ONLY : CPI => pi
USE cable_math_constants_mod, ONLY : CPI180 => pi180
use cbl_masks_mod, ONLY : fveg_mask, fsunlit_mask, fsunlit_veg_mask
USE grid_constants_mod_cbl, ONLY : ICE_SoilType, lakes_cable
!data
USE cable_other_constants_mod, ONLY: CLAI_THRESH => lai_thresh
USE cable_other_constants_mod, ONLY: Crad_thresh => rad_thresh
USE cable_other_constants_mod, ONLY: Ccoszen_tols => coszen_tols
USE cable_other_constants_mod, ONLY: CGAUSS_W => gauss_w
USE cable_math_constants_mod, ONLY: CPI => pi
USE cable_math_constants_mod, ONLY: CPI180 => pi180
USE cbl_masks_mod, ONLY: fveg_mask, fsunlit_mask, fsunlit_veg_mask
USE cable_surface_types_mod, ONLY: lakes_cable
USE grid_constants_mod_cbl, ONLY: ICE_SoilType

! CABLE model variables
TYPE (air_type), INTENT(INOUT) :: air
Expand Down
9 changes: 4 additions & 5 deletions src/science/gw_hydro/cable_gw_hydro.F90
Original file line number Diff line number Diff line change
Expand Up @@ -336,9 +336,8 @@ END SUBROUTINE remove_transGW
SUBROUTINE ovrlndflx (dels, ssnow, soil,veg, canopy,sli_call )
!* Calculate surface runoff

USE cable_common_module, ONLY : gw_params,cable_user

USE grid_surface_types_mod_cbl, ONLY : lakes_cable
USE cable_common_module, ONLY: gw_params,cable_user
USE cable_surface_types_mod, ONLY: lakes_cable

IMPLICIT NONE
REAL, INTENT(IN) :: dels ! integration time step (s)
Expand Down Expand Up @@ -1388,7 +1387,7 @@ SUBROUTINE calc_srf_wet_fraction(ssnow,soil,met,veg)
! following [Decker, 2015](http://doi.wiley.com/10.1002/2015MS000507)


USE grid_constants_mod_cbl, ONLY : lakes_cable
USE cable_surface_types_mod, ONLY: lakes_cable

IMPLICIT NONE
TYPE(soil_snow_type), INTENT(INOUT) :: ssnow ! soil+snow variables
Expand Down Expand Up @@ -1756,7 +1755,7 @@ SUBROUTINE subsurface_drainage(ssnow,soil,veg)
! [Decker, 2015](http://doi.wiley.com/10.1002/2015MS000507)

USE cable_common_module
USE grid_constants_mod_cbl, ONLY : lakes_cable
USE cable_surface_types_mod, ONLY: lakes_cable

IMPLICIT NONE

Expand Down

0 comments on commit 2b0b6dc

Please sign in to comment.