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 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 diff --git a/src/offline/cable_define_types.F90 b/src/offline/cable_define_types.F90 index 9a2699ab7..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 @@ -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..a4529f9b7 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 @@ -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 @@ -4876,9 +4862,9 @@ 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, 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 @@ -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..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) @@ -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 @@ -3797,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) @@ -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/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 !============================================================================= diff --git a/src/science/canopy/cbl_dryLeaf.F90 b/src/science/canopy/cbl_dryLeaf.F90 index f71f299fe..c3a389459 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 : transp_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 @@ -145,6 +150,10 @@ 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), DIMENSION(mp) :: local_fevc + REAL :: vpd, g1 ! Ticket #56 REAL, DIMENSION(mp,mf) :: & xleuning ! leuning stomatal coeff @@ -509,27 +518,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) - - 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 ) + 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_vec(i,:), & + veg%froot(i,:), soil%zse_vec(i,:), local_fevc(i), ssnow%wbliq(i,:)) - 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 - + 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) & @@ -656,7 +657,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 ) @@ -665,8 +665,22 @@ 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. 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 + !! `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/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) 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 diff --git a/src/science/gw_hydro/cable_gw_hydro.F90 b/src/science/gw_hydro/cable_gw_hydro.F90 index 8fb9f90ac..dd14fadd7 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!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !---------------------------------------------------------------------- @@ -922,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 @@ -1090,7 +1009,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 50a438ad8..d7ce9f6a7 100644 --- a/src/science/soilsnow/cbl_remove_trans.F90 +++ b/src/science/soilsnow/cbl_remove_trans.F90 @@ -6,58 +6,90 @@ MODULE remove_trans_mod CONTAINS -SUBROUTINE remove_trans(dels, soil, ssnow, canopy, veg) +SUBROUTINE remove_trans(soil, ssnow, canopy) + !! Removes transpiration water from soil. + !! We also attribute the negative canopy transpiration (dew) + !! to the wet canopy flux. - 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) 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) :: diff - REAL(r_2), DIMENSION(mp) :: xx,xxd,evap_cur INTEGER 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 + WHERE (canopy%fevc < 0.0_r_2) + canopy%fevw = canopy%fevw+canopy%fevc + canopy%fevc = 0.0_r_2 + END WHERE - ! 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 - * soil%zse(k)*Cdensity_liq - xxd = xx - diff(:,k) + DO k = 1,ms + 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 - 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 + IF (cable_user%gw_model) THEN + ssnow%wb = ssnow%wbliq + den_rat * ssnow%wbice + ssnow%wmliq = ssnow%wbliq * soil%zse_vec * Cdensity_liq !mass + ssnow%wmtot = ssnow%wmliq + ssnow%wmice !mass - END WHERE - - END DO - - 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%wb(:,k) = ssnow%wb(:,k) - ssnow%evapfbl(:,k)/(soil%zse(k)*Cdensity_liq) - ENDDO + END IF + END SUBROUTINE remove_trans - ENDIF - END SUBROUTINE remove_trans + FUNCTION transp_soil_water(dels, swilt, froot, zse, fevc, wbliq) RESULT(evapfbl) + + !! Calculates the amount of water removed from the soil by transpiration. + ! + REAL, INTENT(IN) :: dels + !! integration time step (s) + 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(r_2), DIMENSION(ms), INTENT(IN) :: zse + !! soil depth (m) + REAL(r_2), DIMENSION(ms), INTENT(IN) :: wbliq + !! liquid soil water (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 + + ! 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) + + 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 transp_soil_water END MODULE remove_trans_mod 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 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 )