From 6a04a4448ce5bbe7c3e461d76b090945a200099d Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Tue, 24 Jun 2025 16:55:15 +1000 Subject: [PATCH 01/21] New calculation for accounting of root distribution on the transpiration Fixes #560 --- src/science/canopy/cbl_dryLeaf.F90 | 30 ++++++++++++++++++++--- src/science/soilsnow/cbl_remove_trans.F90 | 2 +- 2 files changed, 27 insertions(+), 5 deletions(-) diff --git a/src/science/canopy/cbl_dryLeaf.F90 b/src/science/canopy/cbl_dryLeaf.F90 index f71f299fe..116348cef 100644 --- a/src/science/canopy/cbl_dryLeaf.F90 +++ b/src/science/canopy/cbl_dryLeaf.F90 @@ -145,6 +145,11 @@ SUBROUTINE dryLeaf( dels, rad, rough, air, met, & REAL, DIMENSION(mp,2) :: gsw_term, lower_limit2 ! local temp var INTEGER :: i, j, k, kk ! iteration count + + ! For the calculation of the amount of transpired water + REAL(r_2) :: xxd, xx + REAL(r_2), DIMENSION(0:ms) :: diff + REAL :: vpd, g1 ! Ticket #56 REAL, DIMENSION(mp,mf) :: & xleuning ! leuning stomatal coeff @@ -513,12 +518,29 @@ SUBROUTINE dryLeaf( dels, rad, rough, air, met, & evapfb(i) = ( 1.0 - canopy%fwet(i)) * REAL( ecx(i) ) *dels & / air%rlam(i) + xx = 0.; xxd = 0.; diff(:) = 0. DO kk = 1,ms - ssnow%evapfbl(i,kk) = MIN( evapfb(i) * veg%froot(i,kk), & - MAX( 0.0, REAL( ssnow%wb(i,kk) ) - & - 1.1 * soil%swilt(i) ) * & - soil%zse(kk) * density_liq ) + ! Root water extraction demand + xx = evapfb(i) * veg%froot(i,kk) + diff(kk-1) + ! Maximum water available at this soil layer + diff(kk) = MAX( 0.0_r_2, ssnow%wb(i,kk) - 1.1 * soil%swilt(i)) & ! m3/m3 + * soil%zse(kk)*density_liq + xxd = xx - diff(kk) + + ! ssnow%evapfbl is the water extracted from this layer + ! diff is the excess water demand that is transferred to the next layer + IF (xxd > 0.0) THEN + ssnow%evapfbl(i,kk) = diff(kk) + diff(kk) = xxd + ELSE + ssnow%evapfbl(i,kk) = xx + diff(kk) = 0.0 + END IF + ! ssnow%evapfbl(i,kk) = MIN( evapfb(i) * veg%froot(i,kk), & + ! MAX( 0.0, REAL( ssnow%wb(i,kk) ) - & + ! 1.1 * soil%swilt(i) ) * & + ! soil%zse(kk) * density_liq ) ENDDO IF (cable_user%soil_struc=='default') THEN diff --git a/src/science/soilsnow/cbl_remove_trans.F90 b/src/science/soilsnow/cbl_remove_trans.F90 index 50a438ad8..f4a49dc98 100644 --- a/src/science/soilsnow/cbl_remove_trans.F90 +++ b/src/science/soilsnow/cbl_remove_trans.F90 @@ -30,7 +30,7 @@ SUBROUTINE remove_trans(dels, soil, ssnow, canopy, veg) ! Calculate the amount (perhaps moisture/ice limited) ! which can be removed: xx = canopy%fevc * dels / CHL * veg%froot(:,k) + diff(:,k-1) ! kg/m2 - diff(:,k) = MAX( 0.0_r_2, ssnow%wb(:,k) - soil%swilt) & ! m3/m3 + diff(:,k) = MAX( 0.0_r_2, ssnow%wb(:,k) - 1.1 * soil%swilt) & ! m3/m3 * soil%zse(k)*Cdensity_liq xxd = xx - diff(:,k) From 3334097813876353eab85cec7f7e5761fcbb01aa Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Mon, 23 Jun 2025 16:41:32 +1000 Subject: [PATCH 02/21] (#560) - Remove unused, duplicate canopy%evapfbl. ssnow%evapfbl is the same variable. --- src/offline/cable_define_types.F90 | 3 --- src/offline/cable_mpicommon.F90 | 6 +++--- src/offline/cable_mpimaster.F90 | 21 --------------------- src/offline/cable_mpiworker.F90 | 22 ---------------------- src/science/canopy/cbl_dryLeaf.F90 | 1 - 5 files changed, 3 insertions(+), 50 deletions(-) diff --git a/src/offline/cable_define_types.F90 b/src/offline/cable_define_types.F90 index 9a2699ab7..f6a92a935 100644 --- a/src/offline/cable_define_types.F90 +++ b/src/offline/cable_define_types.F90 @@ -493,7 +493,6 @@ MODULE cable_def_types_mod ga_cor ! correction to ground heat flux (W/m2) REAL, DIMENSION(:,:), POINTER :: & - evapfbl, & gswx, & ! stom cond for water zetar, & ! stability parameter (ref height) ! vh_js ! @@ -1149,7 +1148,6 @@ SUBROUTINE alloc_canopy_type(var, mp) ALLOCATE( var% fwet(mp) ) ALLOCATE( var% fns_cor(mp) ) !REV_CORR variable ALLOCATE( var% ga_cor(mp) ) !REV_CORR variable - ALLOCATE ( var % evapfbl(mp,ms) ) ALLOCATE( var% epot(mp) ) ALLOCATE( var% fnpp(mp) ) ALLOCATE( var% fevw_pot(mp) ) @@ -1783,7 +1781,6 @@ SUBROUTINE dealloc_canopy_type(var) DEALLOCATE( var% fwet ) DEALLOCATE( var% fns_cor ) !REV_CORR variable DEALLOCATE( var% ga_cor ) !REV_CORR variable - DEALLOCATE ( var % evapfbl ) DEALLOCATE( var% epot ) DEALLOCATE( var% fnpp ) DEALLOCATE( var% fevw_pot ) diff --git a/src/offline/cable_mpicommon.F90 b/src/offline/cable_mpicommon.F90 index 15e1c70d2..5070ca57d 100644 --- a/src/offline/cable_mpicommon.F90 +++ b/src/offline/cable_mpicommon.F90 @@ -29,7 +29,7 @@ MODULE cable_mpicommon ! base number of input fields: must correspond to CALLS to ! MPI_address (field ) in *_mpimaster/ *_mpiworker - INTEGER, PARAMETER :: nparam = 341 + INTEGER, PARAMETER :: nparam = 340 ! MPI: extra params sent only if nsoilparmnew is true INTEGER, PARAMETER :: nsoilnew = 1 @@ -77,7 +77,7 @@ MODULE cable_mpicommon !INTEGER, PARAMETER :: nmat = 29 ! MPI: CABLE_r491, after following up with Bernard on the new variables ! vh sli nmat + 4 36 -> 40 - INTEGER, PARAMETER :: nmat = 40 + INTEGER, PARAMETER :: nmat = 39 ! MPI: number of contig vector parts / worker (results) !INTEGER, PARAMETER :: nvec = 149 @@ -103,7 +103,7 @@ MODULE cable_mpicommon ! MPI: number of fields included in restart_t type for data ! that is returned only for creating a restart file at the end of the run ! MPI: gol124: canopy%rwater removed when Bernard ported to CABLE_r491 - INTEGER, PARAMETER :: nrestart = 17 + INTEGER, PARAMETER :: nrestart = 16 INTEGER, PARAMETER :: nsumcasaflux = 62 INTEGER, PARAMETER :: nsumcasapool = 40 INTEGER, PARAMETER :: nclimate = 30 diff --git a/src/offline/cable_mpimaster.F90 b/src/offline/cable_mpimaster.F90 index 591caba01..74aefa282 100644 --- a/src/offline/cable_mpimaster.F90 +++ b/src/offline/cable_mpimaster.F90 @@ -2508,14 +2508,6 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& ! blen(bidx) = 1 ! !blen(bidx) = ms * r1len - bidx = bidx + 1 - CALL MPI_Get_address (canopy%evapfbl(off,1), displs(bidx), ierr) - ! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491 - CALL MPI_Type_create_hvector (ms, r1len, r1stride, MPI_BYTE, & - & types(bidx), ierr) - blen(bidx) = 1 - !blen(bidx) = ms * r2len - bidx = bidx + 1 CALL MPI_Get_address (canopy%epot(off), displs(bidx), ierr) blen(bidx) = r1len @@ -4788,12 +4780,6 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg) ! REAL(r_2) ! MPI: gol124: backport to r1134 changes r_2 to r_1 ! MPI: gol124: in newest CABLE-cnp it's r_2 again - midx = midx + 1 - CALL MPI_Get_address (canopy%evapfbl(off,1), maddr(midx), ierr) ! 2 - ! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491 - CALL MPI_Type_create_hvector (ms, r1len, r1stride, MPI_BYTE, & - & mat_t(midx, rank), ierr) - CALL MPI_Type_commit (mat_t(midx, rank), ierr) midx = midx + 1 CALL MPI_Get_address (canopy%gswx(off,1), maddr(midx), ierr) ! 2 @@ -7222,13 +7208,6 @@ SUBROUTINE master_restart_types (comm, canopy, air, bgc) ! & types(bidx), ierr) ! blocks(bidx) = 1 - bidx = bidx + 1 - CALL MPI_Get_address (canopy%evapfbl(off,1), displs(bidx), ierr) ! 2 - ! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491 - CALL MPI_Type_create_hvector (ms, r1len, r1stride, MPI_BYTE, & - & types(bidx), ierr) - blocks(bidx) = 1 - bidx = bidx + 1 CALL MPI_Get_address (bgc%cplant(off,1), displs(bidx), ierr) CALL MPI_Type_create_hvector (ncp, r1len, r1stride, MPI_BYTE, & diff --git a/src/offline/cable_mpiworker.F90 b/src/offline/cable_mpiworker.F90 index 030f62af1..f2066beb1 100644 --- a/src/offline/cable_mpiworker.F90 +++ b/src/offline/cable_mpiworker.F90 @@ -1742,11 +1742,6 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& ! CALL MPI_Get_address (canopy%rwater, displs(bidx), ierr) ! blen(bidx) = ms * r1len - bidx = bidx + 1 - CALL MPI_Get_address (canopy%evapfbl, displs(bidx), ierr) - ! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491 - blen(bidx) = ms * r1len - bidx = bidx + 1 CALL MPI_Get_address (canopy%epot, displs(bidx), ierr) blen(bidx) = r1len @@ -3679,18 +3674,6 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg) ! CALL MPI_Get_address (canopy%rwater(off,1), displs(bidx), ierr) ! blocks(bidx) = r1len * ms - ! midx = midx + 1 - ! REAL(r_2) - ! CALL MPI_Get_address (canopy%evapfbl(off,1), maddr(midx), ierr) ! 2 - !CALL MPI_Type_create_hvector (ms, r2len, r2stride, MPI_BYTE, & - ! & mat_t(midx, rank), ierr) - - ! TODO: skip, used for restart but not output - bidx = bidx + 1 - CALL MPI_Get_address (canopy%evapfbl(off,1), displs(bidx), ierr) - ! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491 - blocks(bidx) = r1len * ms - bidx = bidx + 1 CALL MPI_Get_address (canopy%gswx(off,1), displs(bidx), ierr) blocks(bidx) = r1len * mf @@ -6404,11 +6387,6 @@ SUBROUTINE worker_restart_type (comm, canopy, air, bgc) ! CALL MPI_Get_address (canopy%rwater(off,1), displs(bidx), ierr) ! blocks(bidx) = r1len * ms - bidx = bidx + 1 - CALL MPI_Get_address (canopy%evapfbl(off,1), displs(bidx), ierr) - ! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491 - blocks(bidx) = r1len * ms - bidx = bidx + 1 CALL MPI_Get_address (bgc%cplant(off,1), displs(bidx), ierr) blocks(bidx) = r1len * ncp diff --git a/src/science/canopy/cbl_dryLeaf.F90 b/src/science/canopy/cbl_dryLeaf.F90 index 116348cef..75cb50a02 100644 --- a/src/science/canopy/cbl_dryLeaf.F90 +++ b/src/science/canopy/cbl_dryLeaf.F90 @@ -678,7 +678,6 @@ SUBROUTINE dryLeaf( dels, rad, rough, air, met, & canopy%frday = 12.0 * SUM(rdy, 2) ! vh ! inserted min to avoid -ve values of GPP canopy%fpn = MIN(-12.0 * SUM(an_y, 2), canopy%frday) - canopy%evapfbl = ssnow%evapfbl DEALLOCATE( gswmin ) From 4eacb1cf5c46c15588f38bab21f41720f29443a1 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Tue, 24 Jun 2025 14:54:33 +1000 Subject: [PATCH 03/21] (#560) - change ssnow%evapfbl to double precision --- src/offline/cable_define_types.F90 | 2 +- src/science/canopy/cbl_latent_heat.F90 | 50 +++++++++++++++----------- 2 files changed, 31 insertions(+), 21 deletions(-) diff --git a/src/offline/cable_define_types.F90 b/src/offline/cable_define_types.F90 index f6a92a935..5358b6fbe 100644 --- a/src/offline/cable_define_types.F90 +++ b/src/offline/cable_define_types.F90 @@ -278,7 +278,6 @@ MODULE cable_def_types_mod tggsn, & ! snow temperature in K dtmlt, & ! water flux to the soil albsoilsn, & ! soil + snow reflectance - evapfbl, & ! tilefrac ! factor for latent heat @@ -286,6 +285,7 @@ MODULE cable_def_types_mod wbtot ! total soil water (mm) REAL(r_2), DIMENSION(:,:), POINTER :: & + evapfbl, & ! gammzz, & ! heat capacity for each soil layer wb, & ! volumetric soil moisture (solid+liq) wbice, & ! soil ice diff --git a/src/science/canopy/cbl_latent_heat.F90 b/src/science/canopy/cbl_latent_heat.F90 index 124dea5c5..7329c2edc 100644 --- a/src/science/canopy/cbl_latent_heat.F90 +++ b/src/science/canopy/cbl_latent_heat.F90 @@ -60,41 +60,51 @@ SUBROUTINE Latent_heat_flux( mp, CTFRZ, dels, soil_zse, soil_swilt, & INTEGER :: mp REAL(KIND=r_2), INTENT(OUT) :: canopy_fes(mp) -!! latent heat flux from the ground (Wm\(^{-2}\)) + !! latent heat flux from the ground (Wm\(^{-2}\)) REAL(KIND=r_2), INTENT(OUT) :: canopy_fess(mp) -!! latent heat flux from the soil (Wm\(^{-2}\)) + !! latent heat flux from the soil (Wm\(^{-2}\)) REAL(KIND=r_2), INTENT(OUT) :: canopy_fesp(mp) -!! latent heat flux from any puddles (Wm\(^{-2}\)) + !! latent heat flux from any puddles (Wm\(^{-2}\)) REAL, INTENT(OUT) :: ssnow_cls(mp) -!! factor denoting phase of water flux (=1 if liquid, =1.1335 if ice) + !! factor denoting phase of water flux (=1 if liquid, =1.1335 if ice) REAL, INTENT(IN OUT) :: pwet(mp) -!! factor to reduce soil evaporation due to presence of a puddle (-) + !! factor to reduce soil evaporation due to presence of a puddle (-) REAL, INTENT(IN OUT) :: ssnow_wetfac(mp) -!! wetness factor for soil (between 0 and 1) + !! wetness factor for soil (between 0 and 1) -REAL, INTENT(IN) :: CTFRZ !! temperature at freezing point (K) -REAL, INTENT(IN) :: dels !! time step of CABLE (s) -REAL, INTENT(IN) :: soil_zse !! thickness of topmost soil layer (m) +REAL, INTENT(IN) :: CTFRZ + !! temperature at freezing point (K) +REAL, INTENT(IN) :: dels + !! time step of CABLE (s) +REAL, INTENT(IN) :: soil_zse + !! thickness of topmost soil layer (m) REAL, INTENT(IN) :: soil_swilt(mp) -!! soil moisture content at wilting point (m\(^3\) water m\(^{-3}\) volume of soil) + !! soil moisture content at wilting point + !! (m\(^3\) water m\(^{-3}\) volume of soil) LOGICAL , INTENT(IN) :: cable_user_l_new_reduce_soilevp -!! NAMELIST switch to use alternate soil evaporation scheme + !! NAMELIST switch to use alternate soil evaporation scheme -REAL, INTENT(IN) :: air_rlam(mp) !! density of air (kgm\(^{-3}\)) +REAL, INTENT(IN) :: air_rlam(mp) + !! density of air (kgm\(^{-3}\)) REAL, INTENT(IN) :: ssnow_snowd(mp) -!! depth of snow in liquid water equivalent (mm m\(^{-2}\)) -REAL, INTENT(IN) :: ssnow_pudsto(mp) !! amount of water in puddles (kgm\(^{-2}\)) + !! depth of snow in liquid water equivalent (mm m\(^{-2}\)) +REAL, INTENT(IN) :: ssnow_pudsto(mp) + !! amount of water in puddles (kgm\(^{-2}\)) REAL, INTENT(IN) :: ssnow_pudsmx(mp) -!! maximum amount of water possible in puddles (kgm\(^{-2}\)) + !! maximum amount of water possible in puddles (kgm\(^{-2}\)) REAL, INTENT(IN) :: ssnow_potev(mp) -!! latent heat flux associated potential evaporation (Wm\(^{-2}\)) -REAL, INTENT(IN) :: ssnow_evapfbl(mp) !! flux of water from soil surface (kg m\(^{-2}\)) + !! latent heat flux associated potential evaporation (Wm\(^{-2}\)) +REAL(KIND=r_2), INTENT(IN) :: ssnow_evapfbl(mp) + !! flux of water from soil surface (kg m\(^{-2}\)) REAL(KIND=r_2), INTENT(IN) :: ssnow_wb(mp) -!! water content in surface soil layer (m\(^{3}\) liquid water m\(^{-3}\) volume of soil) + !! water content in surface soil layer + !! (m\(^{3}\) liquid water m\(^{-3}\) volume of soil) REAL(KIND=r_2), INTENT(IN) :: ssnow_wbice(mp) -!! ice content in surface soil layer (m\(^{3}\) frozen water m\(^{-3}\) volume of soil) -REAL, INTENT(IN) :: ssnow_tss(mp) !! temperature of surface soil/snow layer (K) + !! ice content in surface soil layer + !! (m\(^{3}\) frozen water m\(^{-3}\) volume of soil) +REAL, INTENT(IN) :: ssnow_tss(mp) + !! temperature of surface soil/snow layer (K) REAL, DIMENSION(mp) :: & frescale, flower_limit, fupper_limit From fcce19cac697c9ddbb046b799671da501d5cc5c0 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Tue, 24 Jun 2025 16:01:41 +1000 Subject: [PATCH 04/21] (#560) - Function for the calculation of evapfbl --- src/science/canopy/cbl_dryLeaf.F90 | 109 +++++++++------------- src/science/soilsnow/cbl_remove_trans.F90 | 83 ++++++++++------ 2 files changed, 101 insertions(+), 91 deletions(-) diff --git a/src/science/canopy/cbl_dryLeaf.F90 b/src/science/canopy/cbl_dryLeaf.F90 index 75cb50a02..9a0e36891 100644 --- a/src/science/canopy/cbl_dryLeaf.F90 +++ b/src/science/canopy/cbl_dryLeaf.F90 @@ -15,33 +15,38 @@ SUBROUTINE dryLeaf( dels, rad, rough, air, met, & USE cable_def_types_mod USE cable_common_module -USE cbl_photosynthesis_module, ONLY : photosynthesis -USE cbl_fwsoil_module, ONLY : fwsoil_calc_std, fwsoil_calc_non_linear, & - fwsoil_calc_Lai_Ktaul, fwsoil_calc_sli -!data -USE cable_surface_types_mod, ONLY: evergreen_broadleaf, deciduous_broadleaf -USE cable_surface_types_mod, ONLY: evergreen_needleleaf, deciduous_needleleaf -USE cable_surface_types_mod, ONLY: c3_grassland, tundra, c3_cropland - -! maths & other constants -USE cable_other_constants_mod, ONLY : CLAI_THRESH => LAI_THRESH -! physical constants -USE cable_phys_constants_mod, ONLY : CTFRZ => TFRZ -USE cable_phys_constants_mod, ONLY : CDHEAT => DHEAT -USE cable_phys_constants_mod, ONLY : CRGAS => RGAS -USE cable_phys_constants_mod, ONLY : CCAPP => CAPP -USE cable_phys_constants_mod, ONLY : CRMAIR => RMAIR -USE cable_phys_constants_mod, ONLY : density_liq -! photosynthetic constants -USE cable_photo_constants_mod, ONLY : CMAXITER => MAXITER ! only integer here -USE cable_photo_constants_mod, ONLY : CTREFK => TREFK -USE cable_photo_constants_mod, ONLY : CGAM0 => GAM0 -USE cable_photo_constants_mod, ONLY : CGAM1 => GAM1 -USE cable_photo_constants_mod, ONLY : CGAM2 => GAM2 -USE cable_photo_constants_mod, ONLY : CRGSWC => RGSWC -USE cable_photo_constants_mod, ONLY : CRGBWC => RGBWC - -IMPLICIT NONE + USE cbl_photosynthesis_module, ONLY : photosynthesis + USE cbl_fwsoil_module, ONLY : fwsoil_calc_std, & + fwsoil_calc_non_linear, & + fwsoil_calc_Lai_Ktaul, & + fwsoil_calc_sli + + USE remove_trans_mod, ONLY : trans_soil_water + + !data + USE cable_surface_types_mod, ONLY: evergreen_broadleaf, deciduous_broadleaf + USE cable_surface_types_mod, ONLY: evergreen_needleleaf, deciduous_needleleaf + USE cable_surface_types_mod, ONLY: c3_grassland, tundra, c3_cropland + + ! maths & other constants + USE cable_other_constants_mod, ONLY : CLAI_THRESH => LAI_THRESH + ! physical constants + USE cable_phys_constants_mod, ONLY : CTFRZ => TFRZ + USE cable_phys_constants_mod, ONLY : CDHEAT => DHEAT + USE cable_phys_constants_mod, ONLY : CRGAS => RGAS + USE cable_phys_constants_mod, ONLY : CCAPP => CAPP + USE cable_phys_constants_mod, ONLY : CRMAIR => RMAIR + USE cable_phys_constants_mod, ONLY : density_liq + ! photosynthetic constants + USE cable_photo_constants_mod, ONLY : CMAXITER => MAXITER ! only integer here + USE cable_photo_constants_mod, ONLY : CTREFK => TREFK + USE cable_photo_constants_mod, ONLY : CGAM0 => GAM0 + USE cable_photo_constants_mod, ONLY : CGAM1 => GAM1 + USE cable_photo_constants_mod, ONLY : CGAM2 => GAM2 + USE cable_photo_constants_mod, ONLY : CRGSWC => RGSWC + USE cable_photo_constants_mod, ONLY : CRGBWC => RGBWC + + IMPLICIT NONE TYPE (radiation_type), INTENT(INOUT) :: rad TYPE (roughness_type), INTENT(INOUT) :: rough @@ -149,6 +154,7 @@ SUBROUTINE dryLeaf( dels, rad, rough, air, met, & ! For the calculation of the amount of transpired water REAL(r_2) :: xxd, xx REAL(r_2), DIMENSION(0:ms) :: diff + REAL(r_2), DIMENSION(mp) :: local_fevc REAL :: vpd, g1 ! Ticket #56 REAL, DIMENSION(mp,mf) :: & @@ -514,44 +520,19 @@ SUBROUTINE dryLeaf( dels, rad, rough, air, met, & ELSE - IF (ecx(i) > 0.0 .AND. canopy%fwet(i) < 1.0) THEN - evapfb(i) = ( 1.0 - canopy%fwet(i)) * REAL( ecx(i) ) *dels & - / air%rlam(i) - - xx = 0.; xxd = 0.; diff(:) = 0. - DO kk = 1,ms - - ! Root water extraction demand - xx = evapfb(i) * veg%froot(i,kk) + diff(kk-1) - ! Maximum water available at this soil layer - diff(kk) = MAX( 0.0_r_2, ssnow%wb(i,kk) - 1.1 * soil%swilt(i)) & ! m3/m3 - * soil%zse(kk)*density_liq - xxd = xx - diff(kk) - - ! ssnow%evapfbl is the water extracted from this layer - ! diff is the excess water demand that is transferred to the next layer - IF (xxd > 0.0) THEN - ssnow%evapfbl(i,kk) = diff(kk) - diff(kk) = xxd - ELSE - ssnow%evapfbl(i,kk) = xx - diff(kk) = 0.0 - END IF - ! ssnow%evapfbl(i,kk) = MIN( evapfb(i) * veg%froot(i,kk), & - ! MAX( 0.0, REAL( ssnow%wb(i,kk) ) - & - ! 1.1 * soil%swilt(i) ) * & - ! soil%zse(kk) * density_liq ) - - ENDDO - IF (cable_user%soil_struc=='default') THEN - canopy%fevc(i) = SUM(ssnow%evapfbl(i,:))*air%rlam(i)/dels - ecx(i) = canopy%fevc(i) / (1.0-canopy%fwet(i)) - ELSEIF (cable_user%soil_struc=='sli') THEN - canopy%fevc(i) = ecx(i)*(1.0-canopy%fwet(i)) - ENDIF - - ENDIF + local_fevc(i) = ( 1.0 - canopy%fwet(i)) * REAL( ecx(i) ) + IF (local_fevc(i) > 0.0_r_2) THEN + + ssnow%evapfbl(i,:) = trans_soil_water(dels, soil%swilt(i), & + veg%froot(i,:), soil%zse, local_fevc(i), ssnow%wb(i,:)) + IF (cable_user%soil_struc=='default') THEN + canopy%fevc(i) = SUM(ssnow%evapfbl(i,:))*air%rlam(i)/dels + ecx(i) = canopy%fevc(i) / (1.0-canopy%fwet(i)) + ELSE IF (cable_user%soil_struc=='sli') THEN + canopy%fevc(i) = ecx(i)*(1.0-canopy%fwet(i)) + END IF + END IF ENDIF ! Update canopy sensible heat flux: hcx(i) = (sum_rad_rniso(i)-ecx(i) & diff --git a/src/science/soilsnow/cbl_remove_trans.F90 b/src/science/soilsnow/cbl_remove_trans.F90 index f4a49dc98..3418a6da2 100644 --- a/src/science/soilsnow/cbl_remove_trans.F90 +++ b/src/science/soilsnow/cbl_remove_trans.F90 @@ -8,7 +8,7 @@ MODULE remove_trans_mod SUBROUTINE remove_trans(dels, soil, ssnow, canopy, veg) - USE cable_common_module, ONLY : redistrb, cable_user + USE cable_common_module, ONLY : cable_user ! Removes transpiration water from soil. REAL, INTENT(IN) :: dels ! integration time step (s) @@ -16,35 +16,17 @@ SUBROUTINE remove_trans(dels, soil, ssnow, canopy, veg) TYPE(soil_snow_type), INTENT(INOUT) :: ssnow TYPE(soil_parameter_type), INTENT(INOUT) :: soil TYPE(veg_parameter_type), INTENT(INOUT) :: veg - REAL(r_2), DIMENSION(mp,0:ms) :: diff - REAL(r_2), DIMENSION(mp) :: xx,xxd,evap_cur - INTEGER k + INTEGER i, k IF (cable_user%FWSOIL_switch.NE.'Haverd2013') THEN - xx = 0.; xxd = 0.; diff(:,:) = 0. - DO k = 1,ms - - ! Removing transpiration from soil: - WHERE (canopy%fevc > 0.0 ) ! convert to mm/dels - - ! Calculate the amount (perhaps moisture/ice limited) - ! which can be removed: - xx = canopy%fevc * dels / CHL * veg%froot(:,k) + diff(:,k-1) ! kg/m2 - diff(:,k) = MAX( 0.0_r_2, ssnow%wb(:,k) - 1.1 * soil%swilt) & ! m3/m3 - * soil%zse(k)*Cdensity_liq - xxd = xx - diff(:,k) - WHERE ( xxd .GT. 0.0 ) - ssnow%wb(:,k) = ssnow%wb(:,k) - diff(:,k) / (soil%zse(k)*Cdensity_liq) - diff(:,k) = xxd - ELSEWHERE - ssnow%wb(:,k) = ssnow%wb(:,k) - xx / (soil%zse(k)*Cdensity_liq) - diff(:,k) = 0.0 - ENDWHERE - - END WHERE - - END DO + ssnow%evapfbl = 0.0_r_2 + + DO i = 1, mp + ssnow%evapfbl(i,:) = trans_soil_water(dels, soil%swilt(i), & + veg%froot(i,:), soil%zse, canopy%fevc(i), ssnow%wb(i,:)) + ssnow%wb(i,:) = ssnow%wb(i,:) - ssnow%evapfbl(i,:) / (soil%zse(:)*Cdensity_liq) + END DO ELSE WHERE (canopy%fevc .LT. 0.0_r_2) @@ -60,4 +42,51 @@ SUBROUTINE remove_trans(dels, soil, ssnow, canopy, veg) END SUBROUTINE remove_trans + FUNCTION trans_soil_water(dels, swilt, froot, zse, fevc, wb) RESULT(evapfbl) + + !! Calculates the amount of water removed from the soil by transpiration. + ! + REAL, INTENT(IN) :: dels + !! integration time step (s) + REAL, INTENT(IN) :: swilt + !! wilting point (m3/m3) + REAL(r_2), INTENT(IN) :: fevc + !! transpiration (kg/m2/s) + REAL, DIMENSION(ms), INTENT(IN) :: froot + !! root fraction (-) + REAL, DIMENSION(ms), INTENT(IN) :: zse + !! soil depth (m) + REAL(r_2), DIMENSION(ms), INTENT(IN) :: wb + !! water balance (m3/m3) + + ! Local variables + REAL(r_2), DIMENSION(ms) :: evapfbl + REAL(r_2), DIMENSION(0:ms) :: diff + REAL(r_2) :: xx,xxd + INTEGER k + + xx = 0.; xxd = 0.; diff(:) = 0. + IF (fevc > 0.0) THEN + DO k = 1,ms + ! Removing transpiration from soil: + + ! Calculate the amount (perhaps moisture/ice limited) + ! that can be removed: + xx = fevc * dels / CHL * froot(k) + diff(k-1) ! kg/m2 + diff(k) = MAX( 0.0_r_2, wb(k) - 1.1 * swilt) * zse(k)*Cdensity_liq + xxd = xx - diff(k) + + IF ( xxd > 0.0 ) THEN + evapfbl(k) = diff(k) + diff(k) = xxd + ELSE + evapfbl(k) = xx + diff(k) = 0.0 + END IF + + END DO + END IF + + END FUNCTION trans_soil_water + END MODULE remove_trans_mod From 332b27284b73e4b048f26bfeedfdb2231005b8c1 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Wed, 25 Jun 2025 12:23:44 +1000 Subject: [PATCH 05/21] (#560) - Update fevc from soilsnow --- src/science/soilsnow/cbl_remove_trans.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/science/soilsnow/cbl_remove_trans.F90 b/src/science/soilsnow/cbl_remove_trans.F90 index 3418a6da2..28f75a5c0 100644 --- a/src/science/soilsnow/cbl_remove_trans.F90 +++ b/src/science/soilsnow/cbl_remove_trans.F90 @@ -23,9 +23,12 @@ SUBROUTINE remove_trans(dels, soil, ssnow, canopy, veg) ssnow%evapfbl = 0.0_r_2 DO i = 1, mp - ssnow%evapfbl(i,:) = trans_soil_water(dels, soil%swilt(i), & - veg%froot(i,:), soil%zse, canopy%fevc(i), ssnow%wb(i,:)) - ssnow%wb(i,:) = ssnow%wb(i,:) - ssnow%evapfbl(i,:) / (soil%zse(:)*Cdensity_liq) + ssnow%evapfbl(i,:) = trans_soil_water(dels, soil%swilt(i), & + veg%froot(i,:), soil%zse, canopy%fevc(i), ssnow%wb(i,:)) + ssnow%wb(i,:) = ssnow%wb(i,:) - ssnow%evapfbl(i,:) / (soil%zse(:)*Cdensity_liq) + IF ( canopy%fevc(i) > 0.0_r_2 ) THEN + canopy%fevc(i) = SUM(ssnow%evapfbl(i,:)) * CHL / dels + END IF END DO ELSE From defcb20b6083b3a82fc56e72e47e60e6cd858ed1 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Fri, 27 Jun 2025 10:09:40 +1000 Subject: [PATCH 06/21] (#560) Clean up and a bit more doc --- src/science/canopy/cbl_dryLeaf.F90 | 17 ++++++++++-- src/science/soilsnow/cbl_remove_trans.F90 | 34 ++++++++--------------- 2 files changed, 26 insertions(+), 25 deletions(-) diff --git a/src/science/canopy/cbl_dryLeaf.F90 b/src/science/canopy/cbl_dryLeaf.F90 index 9a0e36891..54b0efaf5 100644 --- a/src/science/canopy/cbl_dryLeaf.F90 +++ b/src/science/canopy/cbl_dryLeaf.F90 @@ -21,7 +21,7 @@ SUBROUTINE dryLeaf( dels, rad, rough, air, met, & fwsoil_calc_Lai_Ktaul, & fwsoil_calc_sli - USE remove_trans_mod, ONLY : trans_soil_water + USE remove_trans_mod, ONLY : transp_soil_water !data USE cable_surface_types_mod, ONLY: evergreen_broadleaf, deciduous_broadleaf @@ -523,7 +523,7 @@ SUBROUTINE dryLeaf( dels, rad, rough, air, met, & local_fevc(i) = ( 1.0 - canopy%fwet(i)) * REAL( ecx(i) ) IF (local_fevc(i) > 0.0_r_2) THEN - ssnow%evapfbl(i,:) = trans_soil_water(dels, soil%swilt(i), & + ssnow%evapfbl(i,:) = transp_soil_water(dels, soil%swilt(i), & veg%froot(i,:), soil%zse, local_fevc(i), ssnow%wb(i,:)) IF (cable_user%soil_struc=='default') THEN @@ -667,8 +667,19 @@ END SUBROUTINE dryLeaf SUBROUTINE getrex_1d(theta, rex, fws, Fs, thetaS, thetaw, Etrans, gamma, dx, dt, zr) + !! Root extraction : Haverd et al. 2013 + !! **Warning**: This subroutine has diverged from the other `getrex_1d` subroutine + !! in cable_sli_roots.F90. Considering this subroutine predates the other one, + !! it is likely this is an older version and should be updated. Although no, + !! tests has been done to quantify the differences. + !! Changes identified as of 27/06/2025: + !! - `theta` and `thetas` arguments instead ot `thetaS` and `S=theta/thetaS` + !! - `rex` is INTENT(OUT) in sli_roots module. Correct for this version as well. + !! - Condition `WHERE (Fs(:) > zero .AND. layer_depth < zr ) ` changed to + !! `WHERE (Fs(:) > zero` (zr unused in sli_roots) + !! - `IF (ANY(((rex*dt) > MAX((theta(:)-thetaw(:)),zero)*dx(:)) .AND. (Etrans > zero))) THEN` + !! changed to `IF (ANY(((rex*dt) > (theta(:)-thetaw(:))*dx(:)) .AND. ((rex*dt) > zero))) THEN` - ! root extraction : Haverd et al. 2013 USE cable_def_types_mod, ONLY: r_2 IMPLICIT NONE diff --git a/src/science/soilsnow/cbl_remove_trans.F90 b/src/science/soilsnow/cbl_remove_trans.F90 index 28f75a5c0..f3f603d95 100644 --- a/src/science/soilsnow/cbl_remove_trans.F90 +++ b/src/science/soilsnow/cbl_remove_trans.F90 @@ -7,10 +7,12 @@ MODULE remove_trans_mod CONTAINS SUBROUTINE remove_trans(dels, soil, ssnow, canopy, veg) + !! Removes transpiration water from soil. + !! For Haverd2013, it also deals with negative canopy + !! transpiration. USE cable_common_module, ONLY : cable_user - ! Removes transpiration water from soil. REAL, INTENT(IN) :: dels ! integration time step (s) TYPE(canopy_type), INTENT(INOUT) :: canopy TYPE(soil_snow_type), INTENT(INOUT) :: ssnow @@ -18,34 +20,22 @@ SUBROUTINE remove_trans(dels, soil, ssnow, canopy, veg) TYPE(veg_parameter_type), INTENT(INOUT) :: veg INTEGER i, k - IF (cable_user%FWSOIL_switch.NE.'Haverd2013') THEN + IF (cable_user%FWSOIL_switch == 'Haverd2013') THEN - ssnow%evapfbl = 0.0_r_2 - - DO i = 1, mp - ssnow%evapfbl(i,:) = trans_soil_water(dels, soil%swilt(i), & - veg%froot(i,:), soil%zse, canopy%fevc(i), ssnow%wb(i,:)) - ssnow%wb(i,:) = ssnow%wb(i,:) - ssnow%evapfbl(i,:) / (soil%zse(:)*Cdensity_liq) - IF ( canopy%fevc(i) > 0.0_r_2 ) THEN - canopy%fevc(i) = SUM(ssnow%evapfbl(i,:)) * CHL / dels - END IF - END DO - - ELSE - WHERE (canopy%fevc .LT. 0.0_r_2) + WHERE (canopy%fevc < 0.0_r_2) canopy%fevw = canopy%fevw+canopy%fevc canopy%fevc = 0.0_r_2 END WHERE - DO k = 1,ms - ssnow%wb(:,k) = ssnow%wb(:,k) - ssnow%evapfbl(:,k)/(soil%zse(k)*Cdensity_liq) - ENDDO - + END IF - ENDIF + DO k = 1,ms + ssnow%wb(:,k) = ssnow%wb(:,k) - ssnow%evapfbl(:,k)/(soil%zse(k)*Cdensity_liq) + END DO END SUBROUTINE remove_trans - FUNCTION trans_soil_water(dels, swilt, froot, zse, fevc, wb) RESULT(evapfbl) + + FUNCTION transp_soil_water(dels, swilt, froot, zse, fevc, wb) RESULT(evapfbl) !! Calculates the amount of water removed from the soil by transpiration. ! @@ -90,6 +80,6 @@ FUNCTION trans_soil_water(dels, swilt, froot, zse, fevc, wb) RESULT(evapfbl) END DO END IF - END FUNCTION trans_soil_water + END FUNCTION transp_soil_water END MODULE remove_trans_mod From f60d767a5f127b888f18539947c39bfec5bb0541 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Fri, 27 Jun 2025 10:14:38 +1000 Subject: [PATCH 07/21] (#560) - Use liquid soil water only for transpiration --- src/science/canopy/cbl_dryLeaf.F90 | 2 +- src/science/soilsnow/cbl_remove_trans.F90 | 11 ++++++----- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/science/canopy/cbl_dryLeaf.F90 b/src/science/canopy/cbl_dryLeaf.F90 index 54b0efaf5..90f9d6b5a 100644 --- a/src/science/canopy/cbl_dryLeaf.F90 +++ b/src/science/canopy/cbl_dryLeaf.F90 @@ -524,7 +524,7 @@ SUBROUTINE dryLeaf( dels, rad, rough, air, met, & IF (local_fevc(i) > 0.0_r_2) THEN ssnow%evapfbl(i,:) = transp_soil_water(dels, soil%swilt(i), & - veg%froot(i,:), soil%zse, local_fevc(i), ssnow%wb(i,:)) + veg%froot(i,:), soil%zse, local_fevc(i), ssnow%wbliq(i,:)) IF (cable_user%soil_struc=='default') THEN canopy%fevc(i) = SUM(ssnow%evapfbl(i,:))*air%rlam(i)/dels diff --git a/src/science/soilsnow/cbl_remove_trans.F90 b/src/science/soilsnow/cbl_remove_trans.F90 index f3f603d95..5568676e2 100644 --- a/src/science/soilsnow/cbl_remove_trans.F90 +++ b/src/science/soilsnow/cbl_remove_trans.F90 @@ -29,13 +29,14 @@ SUBROUTINE remove_trans(dels, soil, ssnow, canopy, veg) END IF DO k = 1,ms - ssnow%wb(:,k) = ssnow%wb(:,k) - ssnow%evapfbl(:,k)/(soil%zse(k)*Cdensity_liq) + ssnow%wbliq(:,k) = ssnow%wbliq(:,k) - ssnow%evapfbl(:,k)/(soil%zse(k)*Cdensity_liq) + ssnow%wb(:,k) = ssnow%wbliq(:,k) + ssnow%wbice(:,k) END DO END SUBROUTINE remove_trans - FUNCTION transp_soil_water(dels, swilt, froot, zse, fevc, wb) RESULT(evapfbl) + FUNCTION transp_soil_water(dels, swilt, froot, zse, fevc, wbliq) RESULT(evapfbl) !! Calculates the amount of water removed from the soil by transpiration. ! @@ -49,8 +50,8 @@ FUNCTION transp_soil_water(dels, swilt, froot, zse, fevc, wb) RESULT(evapfbl) !! root fraction (-) REAL, DIMENSION(ms), INTENT(IN) :: zse !! soil depth (m) - REAL(r_2), DIMENSION(ms), INTENT(IN) :: wb - !! water balance (m3/m3) + REAL(r_2), DIMENSION(ms), INTENT(IN) :: wbliq + !! liquid soil water (m3/m3) ! Local variables REAL(r_2), DIMENSION(ms) :: evapfbl @@ -66,7 +67,7 @@ FUNCTION transp_soil_water(dels, swilt, froot, zse, fevc, wb) RESULT(evapfbl) ! Calculate the amount (perhaps moisture/ice limited) ! that can be removed: xx = fevc * dels / CHL * froot(k) + diff(k-1) ! kg/m2 - diff(k) = MAX( 0.0_r_2, wb(k) - 1.1 * swilt) * zse(k)*Cdensity_liq + diff(k) = MAX( 0.0_r_2, wbliq(k) - 1.1 * swilt) * zse(k)*Cdensity_liq xxd = xx - diff(k) IF ( xxd > 0.0 ) THEN From 7bd21f4f2225bac715097d9c57b159f8a1bc9f5d Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Fri, 27 Jun 2025 16:32:09 +1000 Subject: [PATCH 08/21] (#560) - Use swilt_vec and zse_vec for all applications --- src/science/canopy/cbl_dryLeaf.F90 | 4 ++-- src/science/soilsnow/cbl_remove_trans.F90 | 16 ++++++++++++---- src/science/soilsnow/cbl_soilsnow_data.F90 | 2 ++ 3 files changed, 16 insertions(+), 6 deletions(-) diff --git a/src/science/canopy/cbl_dryLeaf.F90 b/src/science/canopy/cbl_dryLeaf.F90 index 90f9d6b5a..8185b72d3 100644 --- a/src/science/canopy/cbl_dryLeaf.F90 +++ b/src/science/canopy/cbl_dryLeaf.F90 @@ -523,8 +523,8 @@ SUBROUTINE dryLeaf( dels, rad, rough, air, met, & local_fevc(i) = ( 1.0 - canopy%fwet(i)) * REAL( ecx(i) ) IF (local_fevc(i) > 0.0_r_2) THEN - ssnow%evapfbl(i,:) = transp_soil_water(dels, soil%swilt(i), & - veg%froot(i,:), soil%zse, local_fevc(i), ssnow%wbliq(i,:)) + ssnow%evapfbl(i,:) = transp_soil_water(dels, soil%swilt_vec(i,:), & + veg%froot(i,:), soil%zse_vec(i,:), local_fevc(i), ssnow%wbliq(i,:)) IF (cable_user%soil_struc=='default') THEN canopy%fevc(i) = SUM(ssnow%evapfbl(i,:))*air%rlam(i)/dels diff --git a/src/science/soilsnow/cbl_remove_trans.F90 b/src/science/soilsnow/cbl_remove_trans.F90 index 5568676e2..c521c8317 100644 --- a/src/science/soilsnow/cbl_remove_trans.F90 +++ b/src/science/soilsnow/cbl_remove_trans.F90 @@ -29,10 +29,18 @@ SUBROUTINE remove_trans(dels, soil, ssnow, canopy, veg) END IF DO k = 1,ms - ssnow%wbliq(:,k) = ssnow%wbliq(:,k) - ssnow%evapfbl(:,k)/(soil%zse(k)*Cdensity_liq) + ssnow%wbliq(:,k) = ssnow%wbliq(:,k) - ssnow%evapfbl(:,k)/ & + (soil%zse_vec(:,k)*Cdensity_liq) ssnow%wb(:,k) = ssnow%wbliq(:,k) + ssnow%wbice(:,k) END DO + IF (cable_user%gw_model) THEN + ssnow%wb = ssnow%wbliq + den_rat * ssnow%wbice + ssnow%wmliq = ssnow%wbliq * zse_vec * Cdensity_liq !mass + ssnow%wmtot = ssnow%wmliq + ssnow%wmice !mass + + END IF + END SUBROUTINE remove_trans @@ -42,13 +50,13 @@ FUNCTION transp_soil_water(dels, swilt, froot, zse, fevc, wbliq) RESULT(evapfbl) ! REAL, INTENT(IN) :: dels !! integration time step (s) - REAL, INTENT(IN) :: swilt + REAL(r_2), DIMENSION(ms), INTENT(IN) :: swilt !! wilting point (m3/m3) REAL(r_2), INTENT(IN) :: fevc !! transpiration (kg/m2/s) REAL, DIMENSION(ms), INTENT(IN) :: froot !! root fraction (-) - REAL, DIMENSION(ms), INTENT(IN) :: zse + REAL(r_2), DIMENSION(ms), INTENT(IN) :: zse !! soil depth (m) REAL(r_2), DIMENSION(ms), INTENT(IN) :: wbliq !! liquid soil water (m3/m3) @@ -67,7 +75,7 @@ FUNCTION transp_soil_water(dels, swilt, froot, zse, fevc, wbliq) RESULT(evapfbl) ! Calculate the amount (perhaps moisture/ice limited) ! that can be removed: xx = fevc * dels / CHL * froot(k) + diff(k-1) ! kg/m2 - diff(k) = MAX( 0.0_r_2, wbliq(k) - 1.1 * swilt) * zse(k)*Cdensity_liq + diff(k) = MAX( 0.0_r_2, wbliq(k) - 1.1 * swilt(k)) * zse(k)*Cdensity_liq xxd = xx - diff(k) IF ( xxd > 0.0 ) THEN diff --git a/src/science/soilsnow/cbl_soilsnow_data.F90 b/src/science/soilsnow/cbl_soilsnow_data.F90 index 88ac8adc5..738432c4b 100644 --- a/src/science/soilsnow/cbl_soilsnow_data.F90 +++ b/src/science/soilsnow/cbl_soilsnow_data.F90 @@ -21,4 +21,6 @@ MODULE cbl_ssnow_data_mod IMPLICIT NONE +REAL, PARAMETER :: den_rat = Cdensity_ice / Cdensity_liq + END MODULE cbl_ssnow_data_mod From 43c8ffe294a37f33a4de5401555fda658d0e5134 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Fri, 27 Jun 2025 16:32:25 +1000 Subject: [PATCH 09/21] (#560) - Correct initialisation of zse_vec --- src/offline/cable_parameters.F90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/offline/cable_parameters.F90 b/src/offline/cable_parameters.F90 index 0c553c89b..44ebc6b9d 100644 --- a/src/offline/cable_parameters.F90 +++ b/src/offline/cable_parameters.F90 @@ -1405,9 +1405,6 @@ SUBROUTINE write_default_params(met, air, ssnow, veg, bgc, & soil%watr(landpt(e)%cstart:landpt(e)%cend,klev) = & REAL(inWatr(landpt(e)%ilon, landpt(e)%ilat),r_2) - soil%zse_vec(landpt(e)%cstart:landpt(e)%cend,klev) = & - REAL(soil%zse(landpt(e)%cstart:landpt(e)%cend), r_2) - soil%css_vec(landpt(e)%cstart:landpt(e)%cend, klev) = & REAL(incss(landpt(e)%ilon, landpt(e)%ilat), r_2) @@ -1684,12 +1681,13 @@ SUBROUTINE write_default_params(met, air, ssnow, veg, bgc, & soil%GWdz = MAX(1.0,MIN(20.0,soil%GWdz - SUM(soil%zse,dim=1))) !set vectorized versions as same as defaut for now - soil%swilt_vec(:,:) = REAL(SPREAD(soil%swilt(:),2,ms),r_2) - soil%sfc_vec(:,:) = REAL(SPREAD(soil%sfc(:),2,ms),r_2) + soil%swilt_vec(:,:) = REAL(SPREAD(soil%swilt(:),2,ms),r_2) + soil%sfc_vec(:,:) = REAL(SPREAD(soil%sfc(:),2,ms),r_2) soil%sucs_vec(:,:) = REAL(SPREAD(soil%sucs(:),2,ms),r_2) - soil%bch_vec(:,:) = REAL(SPREAD(soil%bch(:),2,ms),r_2) + soil%bch_vec(:,:) = REAL(SPREAD(soil%bch(:),2,ms),r_2) soil%ssat_vec(:,:) = REAL(SPREAD(soil%ssat(:),2,ms),r_2) soil%hyds_vec(:,:) = REAL(SPREAD(soil%hyds(:),2,ms),r_2) + soil%zse_vec(:,:) = REAL(SPREAD(soil%zse(:),1,mp),r_2) END SUBROUTINE write_default_params !============================================================================= From 4d0093fc694847c6d199e19e88632f16066ca129 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Mon, 30 Jun 2025 15:37:03 +1000 Subject: [PATCH 10/21] (#560) - Doc formatting --- src/science/canopy/cbl_dryLeaf.F90 | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/src/science/canopy/cbl_dryLeaf.F90 b/src/science/canopy/cbl_dryLeaf.F90 index 8185b72d3..8a07acd8f 100644 --- a/src/science/canopy/cbl_dryLeaf.F90 +++ b/src/science/canopy/cbl_dryLeaf.F90 @@ -668,16 +668,19 @@ END SUBROUTINE dryLeaf SUBROUTINE getrex_1d(theta, rex, fws, Fs, thetaS, thetaw, Etrans, gamma, dx, dt, zr) !! Root extraction : Haverd et al. 2013 + !! !! **Warning**: This subroutine has diverged from the other `getrex_1d` subroutine !! in cable_sli_roots.F90. Considering this subroutine predates the other one, - !! it is likely this is an older version and should be updated. Although no, - !! tests has been done to quantify the differences. + !! it is likely this is an older version and should be updated. No + !! tests have been done to quantify the differences. + !! !! Changes identified as of 27/06/2025: - !! - `theta` and `thetas` arguments instead ot `thetaS` and `S=theta/thetaS` - !! - `rex` is INTENT(OUT) in sli_roots module. Correct for this version as well. - !! - Condition `WHERE (Fs(:) > zero .AND. layer_depth < zr ) ` changed to + !! + !! - `theta` and `thetas` arguments instead ot `thetaS` and `S=theta/thetaS` + !! - `rex` is INTENT(OUT) in sli_roots module. Correct for this version as well. + !! - Condition `WHERE (Fs(:) > zero .AND. layer_depth < zr ) ` changed to !! `WHERE (Fs(:) > zero` (zr unused in sli_roots) - !! - `IF (ANY(((rex*dt) > MAX((theta(:)-thetaw(:)),zero)*dx(:)) .AND. (Etrans > zero))) THEN` + !! - `IF (ANY(((rex*dt) > MAX((theta(:)-thetaw(:)),zero)*dx(:)) .AND. (Etrans > zero))) THEN` !! changed to `IF (ANY(((rex*dt) > (theta(:)-thetaw(:))*dx(:)) .AND. ((rex*dt) > zero))) THEN` USE cable_def_types_mod, ONLY: r_2 From 4c1c9244b31cd0b220878694a81f66725471634b Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Mon, 30 Jun 2025 16:01:19 +1000 Subject: [PATCH 11/21] (#560) - Removed unused variables and arguments --- src/science/canopy/cbl_dryLeaf.F90 | 2 -- src/science/soilsnow/cbl_remove_trans.F90 | 4 +--- src/science/soilsnow/cbl_soilsnow_main.F90 | 2 +- 3 files changed, 2 insertions(+), 6 deletions(-) diff --git a/src/science/canopy/cbl_dryLeaf.F90 b/src/science/canopy/cbl_dryLeaf.F90 index 8a07acd8f..c3a389459 100644 --- a/src/science/canopy/cbl_dryLeaf.F90 +++ b/src/science/canopy/cbl_dryLeaf.F90 @@ -152,8 +152,6 @@ SUBROUTINE dryLeaf( dels, rad, rough, air, met, & INTEGER :: i, j, k, kk ! iteration count ! For the calculation of the amount of transpired water - REAL(r_2) :: xxd, xx - REAL(r_2), DIMENSION(0:ms) :: diff REAL(r_2), DIMENSION(mp) :: local_fevc REAL :: vpd, g1 ! Ticket #56 diff --git a/src/science/soilsnow/cbl_remove_trans.F90 b/src/science/soilsnow/cbl_remove_trans.F90 index c521c8317..d0fe90aab 100644 --- a/src/science/soilsnow/cbl_remove_trans.F90 +++ b/src/science/soilsnow/cbl_remove_trans.F90 @@ -6,18 +6,16 @@ MODULE remove_trans_mod CONTAINS -SUBROUTINE remove_trans(dels, soil, ssnow, canopy, veg) +SUBROUTINE remove_trans(soil, ssnow, canopy) !! Removes transpiration water from soil. !! For Haverd2013, it also deals with negative canopy !! transpiration. USE cable_common_module, ONLY : cable_user - REAL, INTENT(IN) :: dels ! integration time step (s) TYPE(canopy_type), INTENT(INOUT) :: canopy TYPE(soil_snow_type), INTENT(INOUT) :: ssnow TYPE(soil_parameter_type), INTENT(INOUT) :: soil - TYPE(veg_parameter_type), INTENT(INOUT) :: veg INTEGER i, k IF (cable_user%FWSOIL_switch == 'Haverd2013') THEN diff --git a/src/science/soilsnow/cbl_soilsnow_main.F90 b/src/science/soilsnow/cbl_soilsnow_main.F90 index c7fd4d7db..1751a5982 100644 --- a/src/science/soilsnow/cbl_soilsnow_main.F90 +++ b/src/science/soilsnow/cbl_soilsnow_main.F90 @@ -131,7 +131,7 @@ SUBROUTINE soil_snow(dels, soil, ssnow, canopy, met, bal, veg) ! Add new snow melt to global snow melt variable: ssnow%smelt = ssnow%smelt + snowmlt - CALL remove_trans(dels, soil, ssnow, canopy, veg) + CALL remove_trans(soil, ssnow, canopy) CALL soilfreeze(dels, soil, ssnow, soil%heat_cap_lower_limit ) From 55200244af845538c9481c336dffb87e83da323b Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Tue, 1 Jul 2025 11:00:58 +1000 Subject: [PATCH 12/21] (#560) - Use remove_trans for GW soil --- src/science/gw_hydro/cable_gw_hydro.F90 | 2 +- src/science/soilsnow/cbl_remove_trans.F90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/science/gw_hydro/cable_gw_hydro.F90 b/src/science/gw_hydro/cable_gw_hydro.F90 index 8fb9f90ac..429db06b1 100644 --- a/src/science/gw_hydro/cable_gw_hydro.F90 +++ b/src/science/gw_hydro/cable_gw_hydro.F90 @@ -1090,7 +1090,7 @@ SUBROUTINE soil_snow_gw(dels, soil, ssnow, canopy, met, bal, veg) CALL snow_processes_soil_thermal(dels,ssnow,soil,veg,canopy,met,bal) !> 11. transpiration loss per soil layer ! leave here for now, could move into soilsnow as well - CALL remove_transGW(dels, soil, ssnow, canopy, veg) + CALL remove_trans(soil, ssnow, canopy) !> 12. Snow freezes and melts. CALL GWsoilfreeze(dels, soil, ssnow) diff --git a/src/science/soilsnow/cbl_remove_trans.F90 b/src/science/soilsnow/cbl_remove_trans.F90 index d0fe90aab..d7ed0cf3c 100644 --- a/src/science/soilsnow/cbl_remove_trans.F90 +++ b/src/science/soilsnow/cbl_remove_trans.F90 @@ -16,7 +16,7 @@ SUBROUTINE remove_trans(soil, ssnow, canopy) TYPE(canopy_type), INTENT(INOUT) :: canopy TYPE(soil_snow_type), INTENT(INOUT) :: ssnow TYPE(soil_parameter_type), INTENT(INOUT) :: soil - INTEGER i, k + INTEGER k IF (cable_user%FWSOIL_switch == 'Haverd2013') THEN @@ -34,7 +34,7 @@ SUBROUTINE remove_trans(soil, ssnow, canopy) IF (cable_user%gw_model) THEN ssnow%wb = ssnow%wbliq + den_rat * ssnow%wbice - ssnow%wmliq = ssnow%wbliq * zse_vec * Cdensity_liq !mass + ssnow%wmliq = ssnow%wbliq * soil%zse_vec * Cdensity_liq !mass ssnow%wmtot = ssnow%wmliq + ssnow%wmice !mass END IF From f097c1e66b58f153911ad8915889761fc878b4b0 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Tue, 1 Jul 2025 13:03:52 +1000 Subject: [PATCH 13/21] (#560) - Fix MPI for evapfbl --- src/offline/cable_mpimaster.F90 | 4 ++-- src/offline/cable_mpiworker.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/offline/cable_mpimaster.F90 b/src/offline/cable_mpimaster.F90 index 74aefa282..15b9ff4bc 100644 --- a/src/offline/cable_mpimaster.F90 +++ b/src/offline/cable_mpimaster.F90 @@ -1930,7 +1930,7 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& bidx = bidx + 1 CALL MPI_Get_address (ssnow%evapfbl(off,1), displs(bidx), ierr) - CALL MPI_Type_create_hvector (ms, r1len, r1stride, MPI_BYTE, & + CALL MPI_Type_create_hvector (ms, r2len, r2stride, MPI_BYTE, & & types(bidx), ierr) blen(bidx) = 1 @@ -4864,7 +4864,7 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg) midx = midx + 1 ! REAL(r_1) CALL MPI_Get_address (ssnow%evapfbl(off,1), maddr(midx), ierr) ! 12 - CALL MPI_Type_create_hvector (ms, r1len, r1stride, MPI_BYTE, & + CALL MPI_Type_create_hvector (ms, r2len, r2stride, MPI_BYTE, & & mat_t(midx, rank), ierr) CALL MPI_Type_commit (mat_t(midx, rank), ierr) midx = midx + 1 diff --git a/src/offline/cable_mpiworker.F90 b/src/offline/cable_mpiworker.F90 index f2066beb1..8358b21f8 100644 --- a/src/offline/cable_mpiworker.F90 +++ b/src/offline/cable_mpiworker.F90 @@ -1198,7 +1198,7 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& bidx = bidx + 1 CALL MPI_Get_address (ssnow%evapfbl, displs(bidx), ierr) - blen(bidx) = ms * r1len + blen(bidx) = ms * r2len bidx = bidx + 1 CALL MPI_Get_address (ssnow%qstss, displs(bidx), ierr) @@ -3780,7 +3780,7 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg) bidx = bidx + 1 CALL MPI_Get_address (ssnow%evapfbl(off,1), displs(bidx), ierr) - blocks(bidx) = r1len * ms + blocks(bidx) = r2len * ms !midx = midx + 1 ! REAL(r_1) From e752a90a6c339f084cdd7c2e670987532c40e582 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Tue, 1 Jul 2025 16:30:29 +1000 Subject: [PATCH 14/21] (#560) - Change fwsoil calculations to use wbliq and *_vec soil properties --- src/science/canopy/cbl_fwsoil.F90 | 36 ++++++++++++------------------- 1 file changed, 14 insertions(+), 22 deletions(-) diff --git a/src/science/canopy/cbl_fwsoil.F90 b/src/science/canopy/cbl_fwsoil.F90 index 4e25e0854..f83608bf3 100644 --- a/src/science/canopy/cbl_fwsoil.F90 +++ b/src/science/canopy/cbl_fwsoil.F90 @@ -19,22 +19,13 @@ SUBROUTINE fwsoil_calc_std(fwsoil, soil, ssnow, veg) REAL, INTENT(OUT), DIMENSION(:):: fwsoil ! soil water modifier of stom. cond REAL, DIMENSION(mp) :: rwater ! soil water availability - !note even though swilt_vec is defined in default model it is r_2 - !and even using real(_vec) gives results different from trunk (rounding - !errors) + ! Moving to use *_vec variables even outside of the groundwater + ! option for simplicity. It introduces small rounding differences. - IF (.NOT.cable_user%gw_model) THEN + rwater = MAX(1.0e-9, & + SUM(veg%froot * MAX(1.0e-9,MIN(1.0, REAL((ssnow%wbliq - & + soil%swilt_vec)/(soil%sfc_vec-soil%swilt_vec)) )),2) ) - rwater = MAX(1.0e-9, & - SUM(veg%froot * MAX(1.0e-9,MIN(1.0, REAL(ssnow%wb) - & - SPREAD(soil%swilt, 2, ms))),2) /(soil%sfc-soil%swilt)) - - ELSE - rwater = MAX(1.0e-9, & - SUM(veg%froot * MAX(1.0e-9,MIN(1.0, REAL((ssnow%wbliq - & - soil%swilt_vec)/(soil%sfc_vec-soil%swilt_vec)) )),2) ) - - ENDIF ! Remove vbeta #56 IF(cable_user%GS_SWITCH == 'medlyn') THEN @@ -59,8 +50,8 @@ SUBROUTINE fwsoil_calc_non_linear(fwsoil, soil, ssnow, veg) INTEGER :: j rwater = MAX(1.0e-9, & - SUM(veg%froot * MAX(0.0,MIN(1.0, REAL(ssnow%wb) - & - SPREAD(soil%swilt, 2, ms))),2) /(soil%sfc-soil%swilt)) + SUM(veg%froot * MAX(0.0,MIN(1.0, REAL((ssnow%wbliq) - & + SPREAD(soil%swilt, 2, ms)))),2) /(soil%sfc-soil%swilt)) fwsoil = 1. @@ -112,14 +103,15 @@ SUBROUTINE fwsoil_calc_Lai_Ktaul(fwsoil, soil, ssnow, veg) DO ns=1,ms - dummy(:) = rootgamma/MAX(1.0e-3_r_2,ssnow%wb(:,ns)-soil%swilt(:)) + dummy(:) = rootgamma/MAX(1.0e-3_r_2,ssnow%wbliq(:,ns)-soil%swilt_vec(:,ns)) - frwater(:,ns) = MAX(1.0e-4_r_2,((ssnow%wb(:,ns)-soil%swilt(:))/soil%ssat(:)) & - ** dummy) + frwater(:,ns) = MAX(1.0e-4_r_2,((ssnow%wbliq(:,ns)-soil%swilt_vec(:,ns))/ & + soil%ssat_vec(:,ns))** dummy) fwsoil(:) = MIN(1.0,MAX(fwsoil(:),frwater(:,ns))) - normFac(:) = normFac(:) + frwater(:,ns) * veg%froot(:,ns) + ! normFac unused. + !normFac(:) = normFac(:) + frwater(:,ns) * veg%froot(:,ns) ENDDO @@ -134,8 +126,8 @@ SUBROUTINE fwsoil_calc_sli(fwsoil, soil, ssnow, veg) REAL, INTENT(OUT), DIMENSION(:):: fwsoil ! soil water modifier of stom. cond REAL, DIMENSION(mp,ms):: tmp2d1, tmp2d2, delta_root, alpha2a_root, alpha2_root ! Lai and Katul formulation for root efficiency function vh 17/07/09 - alpha2a_root = MAX(ssnow%wb-soil%swilt_vec, 0.001_r_2)/(soil%ssat_vec) - tmp2d1 = ssnow%wb -soil%swilt_vec + alpha2a_root = MAX(ssnow%wbliq-soil%swilt_vec, 0.001_r_2)/(soil%ssat_vec) + tmp2d1 = ssnow%wbliq -soil%swilt_vec tmp2d2 = SPREAD(veg%gamma,2,ms)/tmp2d1*LOG(alpha2a_root) WHERE ((tmp2d1>0.001) .AND. (tmp2d2 > -10.0)) alpha2_root = EXP(tmp2d2) From 71447e5d340f9bada81901401f8331ebcad1f2fc Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Wed, 2 Jul 2025 12:14:22 +1000 Subject: [PATCH 15/21] (#560) - Attribute negative fevc to fevw in all cases --- src/science/soilsnow/cbl_remove_trans.F90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/src/science/soilsnow/cbl_remove_trans.F90 b/src/science/soilsnow/cbl_remove_trans.F90 index d7ed0cf3c..8096a6446 100644 --- a/src/science/soilsnow/cbl_remove_trans.F90 +++ b/src/science/soilsnow/cbl_remove_trans.F90 @@ -8,8 +8,8 @@ MODULE remove_trans_mod SUBROUTINE remove_trans(soil, ssnow, canopy) !! Removes transpiration water from soil. - !! For Haverd2013, it also deals with negative canopy - !! transpiration. + !! We also attribute the negative canopy transpiration (dew) + !! to the wet canopy flux. USE cable_common_module, ONLY : cable_user @@ -18,13 +18,11 @@ SUBROUTINE remove_trans(soil, ssnow, canopy) TYPE(soil_parameter_type), INTENT(INOUT) :: soil INTEGER k - IF (cable_user%FWSOIL_switch == 'Haverd2013') THEN - WHERE (canopy%fevc < 0.0_r_2) - canopy%fevw = canopy%fevw+canopy%fevc - canopy%fevc = 0.0_r_2 - END WHERE - END IF + WHERE (canopy%fevc < 0.0_r_2) + canopy%fevw = canopy%fevw+canopy%fevc + canopy%fevc = 0.0_r_2 + END WHERE DO k = 1,ms ssnow%wbliq(:,k) = ssnow%wbliq(:,k) - ssnow%evapfbl(:,k)/ & From f6b58b33db9ccc1b5ead9dd1435b37767ea19893 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Wed, 2 Jul 2025 12:25:09 +1000 Subject: [PATCH 16/21] (#560) - improve comments --- src/science/soilsnow/cbl_remove_trans.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/science/soilsnow/cbl_remove_trans.F90 b/src/science/soilsnow/cbl_remove_trans.F90 index 8096a6446..d7ce9f6a7 100644 --- a/src/science/soilsnow/cbl_remove_trans.F90 +++ b/src/science/soilsnow/cbl_remove_trans.F90 @@ -66,10 +66,15 @@ FUNCTION transp_soil_water(dels, swilt, froot, zse, fevc, wbliq) RESULT(evapfbl) xx = 0.; xxd = 0.; diff(:) = 0. IF (fevc > 0.0) THEN DO k = 1,ms - ! Removing transpiration from soil: ! Calculate the amount (perhaps moisture/ice limited) ! that can be removed: + ! xx: water demand from the transpiration and above soil layers + ! diff(k-1): excess demand from higher soil layers + ! diff(k): maximum water amount available for this layer (supply) + ! xxd: demand minus supply. If the demand is larger (xxd>0), + ! evapfbl is limited by the supply and the excess demand is shifted + ! to the next layer. xx = fevc * dels / CHL * froot(k) + diff(k-1) ! kg/m2 diff(k) = MAX( 0.0_r_2, wbliq(k) - 1.1 * swilt(k)) * zse(k)*Cdensity_liq xxd = xx - diff(k) From 24ef0425ad27ded453ebe7463be8ed1708559d2a Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Wed, 2 Jul 2025 14:20:37 +1000 Subject: [PATCH 17/21] (#560) - fix broken link in doc. New domain for ACCESS-Hive docs --- .../docs/developer_guide/documentation_guidelines/index.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/documentation/docs/developer_guide/documentation_guidelines/index.md b/documentation/docs/developer_guide/documentation_guidelines/index.md index f960508e3..296a95c0a 100644 --- a/documentation/docs/developer_guide/documentation_guidelines/index.md +++ b/documentation/docs/developer_guide/documentation_guidelines/index.md @@ -29,5 +29,5 @@ To help you find the file corresponding to a page, on the rendered [documentatio [cheat-sheets]: ../other_resources/cheat_sheets.md [api-guidelines]: science_doc.md [doc-pages]: https://cable.readthedocs.io/en/latest -[Hive-contribute]: https://access-hive.org.au/about/contribute/ +[Hive-contribute]: https://docs.access-hive.org.au/about/contribute/ [cable-lsm-join]: https://github.com/CABLE-LSM/CABLE/issues/110 From 7e83ba75035e0f64d819a3040a15260dd5c39488 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Mon, 7 Jul 2025 09:27:48 +1000 Subject: [PATCH 18/21] (#560) - Remove remove_transGW, unused now. --- src/science/gw_hydro/cable_gw_hydro.F90 | 82 ------------------------- 1 file changed, 82 deletions(-) diff --git a/src/science/gw_hydro/cable_gw_hydro.F90 b/src/science/gw_hydro/cable_gw_hydro.F90 index 429db06b1..7bc56a0d8 100644 --- a/src/science/gw_hydro/cable_gw_hydro.F90 +++ b/src/science/gw_hydro/cable_gw_hydro.F90 @@ -244,88 +244,6 @@ END SUBROUTINE GWsoilfreeze ! !! ----------------------------------------------------------------------------- ! - SUBROUTINE remove_transGW(dels, soil, ssnow, canopy, veg) - - !*## Purpose - ! - - !NOTE: this is only included because gw_model uses parameters XXX_vec - !these are r_2. this breaks bitwise compatibility with trunk - !if acceptable this routine does the same thing but with r_2 soil params - - ! Removes transpiration water from soil. - REAL, INTENT(IN) :: dels ! integration time step (s) - TYPE(canopy_type), INTENT(INOUT) :: canopy - TYPE(soil_snow_type), INTENT(INOUT) :: ssnow - TYPE(soil_parameter_type), INTENT(INOUT) :: soil - TYPE(veg_parameter_type), INTENT(INOUT) :: veg - REAL(r_2), DIMENSION(mp,0:ms+1) :: diff - REAL(r_2), DIMENSION(mp) :: xx,xxd - REAL(r_2), DIMENSION(mp,ms) :: zse_mp_mm - INTEGER :: k,i - - DO k=1,ms - DO i=1,mp - zse_mp_mm(i,k) = REAL(soil%zse_vec(i,k)*Cdensity_liq,r_2) - END DO - END DO - - IF (cable_user%FWSOIL_switch.NE.'Haverd2013') THEN - - xx(:) = 0._r_2 - xxd(:) = 0._r_2 - diff(:,:) = 0._r_2 - - DO k = 1,ms - - DO i=1,mp - - IF (canopy%fevc(i) .GT. 0._r_2) THEN - - xx(i) = canopy%fevc(i) * dels / CHL * veg%froot(i,k) + diff(i,k-1) - diff(i,k) = MAX(0._r_2,ssnow%wbliq(i,k)-soil%swilt_vec(i,k)) & - * zse_mp_mm(i,k) - xxd(i) = xx(i) - diff(i,k) - - IF (xxd(i) .GT. 0._r_2) THEN - ssnow%wbliq(i,k) = ssnow%wbliq(i,k) - diff(i,k)/zse_mp_mm(i,k) - diff(i,k) = xxd(i) - ELSE - ssnow%wbliq(i,k) = ssnow%wbliq(i,k) - xx(i)/zse_mp_mm(i,k) - diff(i,k) = 0._r_2 - END IF - - - END IF !fvec > 0 - - END DO !mp - END DO !ms - - ELSE - - WHERE (canopy%fevc .LT. 0.0_r_2) - canopy%fevw = canopy%fevw+canopy%fevc - canopy%fevc = 0.0_r_2 - END WHERE - DO k = 1,ms - ssnow%wbliq(:,k) = ssnow%wbliq(:,k) - ssnow%evapfbl(:,k)/(soil%zse_vec(:,k)*m2mm) - ENDDO - - ENDIF - - DO k=1,ms - DO i=1,mp - ssnow%wmliq(i,k) = ssnow%wbliq(i,k)*zse_mp_mm(i,k)!mass - ssnow%wmtot(i,k) = ssnow%wmliq(i,k) + ssnow%wmice(i,k) !mass - ssnow%wb(i,k) = ssnow%wbliq(i,k) + den_rat * ssnow%wbice(i,k) !volume ! MMY - END DO - END DO - - - END SUBROUTINE remove_transGW - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!MD GW code from here on!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !---------------------------------------------------------------------- From 84ed8197220632c87febbdf6b44e6ce844898f38 Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Wed, 9 Jul 2025 11:36:00 +1000 Subject: [PATCH 19/21] (#560) - Add use statement for remove_trans in gw_hydro. --- src/science/gw_hydro/cable_gw_hydro.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/science/gw_hydro/cable_gw_hydro.F90 b/src/science/gw_hydro/cable_gw_hydro.F90 index 7bc56a0d8..dd14fadd7 100644 --- a/src/science/gw_hydro/cable_gw_hydro.F90 +++ b/src/science/gw_hydro/cable_gw_hydro.F90 @@ -840,6 +840,7 @@ SUBROUTINE soil_snow_gw(dels, soil, ssnow, canopy, met, bal, veg) USE cable_common_module USE snow_processes_soil_thermal_mod, ONLY : snow_processes_soil_thermal ! inserted by rk4417 - phase2 + USE remove_trans_mod, ONLY : remove_trans REAL , INTENT(IN) :: dels ! integration time step (s) TYPE(soil_parameter_type), INTENT(INOUT) :: soil From aa9c084692adeb9169f7960cf3b6549ce97451ca Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Wed, 9 Jul 2025 15:41:11 +1000 Subject: [PATCH 20/21] Update comment for evapfbl to reflect change to r_2. Co-authored-by: Sean Bryan <39685865+SeanBryan51@users.noreply.github.com> --- src/offline/cable_mpimaster.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/offline/cable_mpimaster.F90 b/src/offline/cable_mpimaster.F90 index 15b9ff4bc..a4529f9b7 100644 --- a/src/offline/cable_mpimaster.F90 +++ b/src/offline/cable_mpimaster.F90 @@ -4862,7 +4862,7 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg) & mat_t(midx, rank), ierr) CALL MPI_Type_commit (mat_t(midx, rank), ierr) midx = midx + 1 - ! REAL(r_1) + ! REAL(r_2) CALL MPI_Get_address (ssnow%evapfbl(off,1), maddr(midx), ierr) ! 12 CALL MPI_Type_create_hvector (ms, r2len, r2stride, MPI_BYTE, & & mat_t(midx, rank), ierr) From d6acbe3ac510ff95898b42a118304d8ece85403b Mon Sep 17 00:00:00 2001 From: Claire Carouge Date: Thu, 10 Jul 2025 16:15:46 +1000 Subject: [PATCH 21/21] (#560) - Add variable definition changes in coupled --- src/coupled/AM3/control/cable/CM3/cbl_canopy_type.F90 | 7 ------- src/coupled/AM3/control/cable/CM3/ssnow_type.F90 | 4 ++-- src/coupled/shared/cable_canopy_type_mod.F90 | 2 -- src/coupled/shared/cable_soilsnow_type_mod.F90 | 2 +- 4 files changed, 3 insertions(+), 12 deletions(-) diff --git a/src/coupled/AM3/control/cable/CM3/cbl_canopy_type.F90 b/src/coupled/AM3/control/cable/CM3/cbl_canopy_type.F90 index 615642fa7..9a310d437 100644 --- a/src/coupled/AM3/control/cable/CM3/cbl_canopy_type.F90 +++ b/src/coupled/AM3/control/cable/CM3/cbl_canopy_type.F90 @@ -63,7 +63,6 @@ MODULE cable_canopy_type_mod REAL, ALLOCATABLE, PUBLIC :: fwet(:) ! fraction of canopy wet REAL, ALLOCATABLE, PUBLIC :: fns_cor(:) ! correction to net rad avail to soil (W/m2) REAL, ALLOCATABLE, PUBLIC :: ga_cor(:) ! correction to ground heat flux (W/m2) - REAL, ALLOCATABLE, PUBLIC :: evapfbl(:,:) ! REAL, ALLOCATABLE, PUBLIC :: gswx(:,:) ! stom cond for water REAL, ALLOCATABLE, PUBLIC :: zetar(:,:) ! stability parameter (ref height) REAL, ALLOCATABLE, PUBLIC :: zetash(:,:) ! stability parameter (shear height) @@ -144,7 +143,6 @@ MODULE cable_canopy_type_mod REAL, POINTER, PUBLIC :: fwet(:) ! fraction of canopy wet REAL, POINTER, PUBLIC :: fns_cor(:) ! correction to net rad avail to soil (W/m2) REAL, POINTER, PUBLIC :: ga_cor(:) ! correction to ground heat flux (W/m2) - REAL, POINTER, PUBLIC :: evapfbl(:,:) ! REAL, POINTER, PUBLIC :: gswx(:,:) ! stom cond for water REAL, POINTER, PUBLIC :: zetar(:,:) ! stability parameter (ref height) REAL, POINTER, PUBLIC :: zetash(:,:) ! stability parameter (shear height) @@ -230,7 +228,6 @@ SUBROUTINE alloc_canopy_type(var, mp) ALLOCATE( var% fwet(mp) ) ALLOCATE( var% fns_cor(mp) ) !REV_CORR variable ALLOCATE( var% ga_cor(mp) ) !REV_CORR variable -ALLOCATE( var % evapfbl(mp,nsl) ) ALLOCATE( var% epot(mp) ) ALLOCATE( var% fnpp(mp) ) ALLOCATE( var% fevw_pot(mp) ) @@ -308,7 +305,6 @@ SUBROUTINE alloc_canopy_type(var, mp) var % fwet(:) = 0.0 var % fns_cor(:) = 0.0 var % ga_cor(:) = 0.0 -var % evapfbl(:,:) = 0.0 var % gswx(:,:) = 0.0 var % zetar(:,:) = 0.0 var % zetash(:,:) = 0.0 @@ -382,7 +378,6 @@ SUBROUTINE dealloc_canopy_type(var) DEALLOCATE( var% fwet ) DEALLOCATE( var% fns_cor ) !REV_CORR variable DEALLOCATE( var% ga_cor ) !REV_CORR variable - DEALLOCATE ( var % evapfbl ) DEALLOCATE( var% epot ) DEALLOCATE( var% fnpp ) DEALLOCATE( var% fevw_pot ) @@ -473,7 +468,6 @@ SUBROUTINE assoc_canopy_type(canopy, canopy_data ) canopy% fwet => canopy_data% fwet canopy% fns_cor => canopy_data% fns_cor canopy% ga_cor => canopy_data% ga_cor -canopy% evapfbl => canopy_data% evapfbl canopy% gswx => canopy_data% gswx canopy% zetar => canopy_data% zetar canopy% zetash => canopy_data% zetash @@ -557,7 +551,6 @@ SUBROUTINE nullify_canopy_cbl( var ) NULLIFY( var% fwet ) NULLIFY( var% fns_cor ) !REV_CORR variable NULLIFY( var% ga_cor ) !REV_CORR variable - NULLIFY( var % evapfbl ) NULLIFY( var% epot ) NULLIFY( var% fnpp ) NULLIFY( var% fevw_pot ) diff --git a/src/coupled/AM3/control/cable/CM3/ssnow_type.F90 b/src/coupled/AM3/control/cable/CM3/ssnow_type.F90 index c107987a6..de57ec639 100644 --- a/src/coupled/AM3/control/cable/CM3/ssnow_type.F90 +++ b/src/coupled/AM3/control/cable/CM3/ssnow_type.F90 @@ -74,11 +74,11 @@ MODULE cable_soil_snow_type_mod REAL, ALLOCATABLE :: tggsn (:,:) ! snow temperature in K REAL, ALLOCATABLE :: dtmlt (:,:) ! water flux to the soil REAL, ALLOCATABLE :: albsoilsn (:,:) ! soil + snow reflectance - REAL, ALLOCATABLE :: evapfbl (:,:) ! REAL, ALLOCATABLE :: tilefrac (:,:) ! factor for latent heat REAL(r_2), ALLOCATABLE :: wbtot (:) ! total soil water (mm) + REAL(r_2), ALLOCATABLE :: evapfbl (:,:) ! REAL(r_2), ALLOCATABLE :: gammzz (:,:) ! heat capacity for each soil layer REAL(r_2), ALLOCATABLE :: wb (:,:) ! volumetric soil moisture (solid+liq) REAL(r_2), ALLOCATABLE :: wbice (:,:) ! soil ice @@ -209,11 +209,11 @@ MODULE cable_soil_snow_type_mod REAL, POINTER :: tggsn (:,:) ! snow temperature in K REAL, POINTER :: dtmlt (:,:) ! water flux to the soil REAL, POINTER :: albsoilsn (:,:) ! soil + snow reflectance - REAL, POINTER :: evapfbl (:,:) ! REAL, POINTER :: tilefrac (:,:) ! factor for latent heat REAL(r_2), POINTER :: wbtot (:) ! total soil water (mm) + REAL(r_2), POINTER :: evapfbl (:,:) ! REAL(r_2), POINTER :: gammzz (:,:) ! heat capacity for each soil layer REAL(r_2), POINTER :: wb (:,:) ! volumetric soil moisture (solid+liq) REAL(r_2), POINTER :: wbice (:,:) ! soil ice diff --git a/src/coupled/shared/cable_canopy_type_mod.F90 b/src/coupled/shared/cable_canopy_type_mod.F90 index 2cf050de5..6e519f5b4 100644 --- a/src/coupled/shared/cable_canopy_type_mod.F90 +++ b/src/coupled/shared/cable_canopy_type_mod.F90 @@ -62,7 +62,6 @@ MODULE cable_canopy_type_mod ga_cor ! correction to ground heat flux (W/m2) REAL, DIMENSION(:,:), POINTER :: & - evapfbl, & gswx, & ! stom cond for water zetar, & ! stability parameter (ref height) ! vh_js ! @@ -158,7 +157,6 @@ SUBROUTINE alloc_canopy_type(var, mp) ALLOCATE( var% fwet(mp) ) ALLOCATE( var% fns_cor(mp) ) !REV_CORR variable ALLOCATE( var% ga_cor(mp) ) !REV_CORR variable -ALLOCATE ( var % evapfbl(mp,ms) ) ALLOCATE( var% epot(mp) ) ALLOCATE( var% fnpp(mp) ) ALLOCATE( var% fevw_pot(mp) ) diff --git a/src/coupled/shared/cable_soilsnow_type_mod.F90 b/src/coupled/shared/cable_soilsnow_type_mod.F90 index 789c6a085..85dc668ef 100644 --- a/src/coupled/shared/cable_soilsnow_type_mod.F90 +++ b/src/coupled/shared/cable_soilsnow_type_mod.F90 @@ -72,7 +72,6 @@ MODULE cable_soil_snow_type_mod tggsn, & ! snow temperature in K dtmlt, & ! water flux to the soil albsoilsn, & ! soil + snow reflectance - evapfbl, & ! tilefrac ! factor for latent heat @@ -80,6 +79,7 @@ MODULE cable_soil_snow_type_mod wbtot ! total soil water (mm) REAL(r_2), DIMENSION(:,:), POINTER :: & + evapfbl, & ! gammzz, & ! heat capacity for each soil layer wb, & ! volumetric soil moisture (solid+liq) wbice, & ! soil ice