Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix initialization of doubles in VerticalProfileMod #6649

Merged
merged 4 commits into from
Oct 14, 2024
Merged

Fix initialization of doubles in VerticalProfileMod #6649

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
dd108ac
Fix initialization of doubles
peterdschwartz Sep 26, 2024
e482b69
adjusted 1. to 1._r8 in VerticalProfileMod
peterdschwartz Oct 1, 2024
aba6966
Added debugging info
peterdschwartz Oct 3, 2024
2cdecfd
Added more output and changed > 0._r8 checks to > tiny
peterdschwartz Oct 10, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion components/elm/src/biogeochem/CH4Mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -223,7 +223,7 @@ subroutine InitAllocate(this, bounds)
! Allocate module variables and data structures
!
! !USES:
use shr_infnan_mod, only: spval => shr_infnan_nan, assignment(=)
use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=)
use elm_varpar , only: nlevgrnd
!
! !ARGUMENTS:
Expand Down
59 changes: 36 additions & 23 deletions components/elm/src/biogeochem/VerticalProfileMod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,9 +25,9 @@ module VerticalProfileMod
logical , public :: exponential_rooting_profile = .true.
logical , public :: pftspecific_rootingprofile = .true.
! how steep profile is for root C inputs (1/ e-folding depth) (1/m)
real(r8), public :: rootprof_exp = 3.
real(r8), public :: rootprof_exp = 3._r8
! how steep profile is for surface components (1/ e_folding depth) (1/m)
real(r8), public :: surfprof_exp = 10.
real(r8), public :: surfprof_exp = 10._r8
!-----------------------------------------------------------------------

contains
Expand Down Expand Up @@ -83,7 +83,8 @@ subroutine decomp_vertprofiles(bounds, &
real(r8) :: ndep_prof_sum
real(r8) :: nfixation_prof_sum
real(r8) :: pdep_prof_sum
real(r8) :: delta = 1.e-10
real(r8) :: delta = 1.e-10_r8
real(r8), parameter :: smallparameter = tiny(1._r8)
character(len=32) :: subname = 'decomp_vertprofiles'
!-----------------------------------------------------------------------

Expand Down Expand Up @@ -191,7 +192,7 @@ subroutine decomp_vertprofiles(bounds, &
surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j)
end if
end do
if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > 0._r8) .and. (surface_prof_tot > 0._r8) ) then
if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > smallparameter) .and. (surface_prof_tot > smallparameter) ) then
! where there is not permafrost extending to the surface, integrate the profiles over the active layer
! this is equivalnet to integrating over all soil layers outside of permafrost regions
do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp)
Expand All @@ -212,10 +213,10 @@ subroutine decomp_vertprofiles(bounds, &
end do
else
! if fully frozen, or no roots, put everything in the top layer
froot_prof(p,1) = 1./dzsoi_decomp(1)
croot_prof(p,1) = 1./dzsoi_decomp(1)
leaf_prof(p,1) = 1./dzsoi_decomp(1)
stem_prof(p,1) = 1./dzsoi_decomp(1)
froot_prof(p,1) = 1._r8/dzsoi_decomp(1)
croot_prof(p,1) = 1._r8/dzsoi_decomp(1)
leaf_prof(p,1) = 1._r8/dzsoi_decomp(1)
stem_prof(p,1) = 1._r8/dzsoi_decomp(1)
endif

end do
Expand Down Expand Up @@ -250,19 +251,19 @@ subroutine decomp_vertprofiles(bounds, &
surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j)
end do
if(col_pp%is_fates(c))then
if ( (altmax_lastyear_indx(c) > 0) .and. (surface_prof_tot > 0._r8) ) then
if ( (altmax_lastyear_indx(c) > 0) .and. (surface_prof_tot > smallparameter) ) then
do j = 1,min(alt_ind, nlevbed)
nfixation_prof(c,j) = surface_prof(j)/ surface_prof_tot
ndep_prof(c,j) = surface_prof(j)/ surface_prof_tot
pdep_prof(c,j) = surface_prof(j)/ surface_prof_tot
end do
else
nfixation_prof(c,1) = 1./dzsoi_decomp(1)
ndep_prof(c,1) = 1./dzsoi_decomp(1)
pdep_prof(c,1) = 1./dzsoi_decomp(1)
nfixation_prof(c,1) = 1._r8/dzsoi_decomp(1)
ndep_prof(c,1) = 1._r8/dzsoi_decomp(1)
pdep_prof(c,1) = 1._r8/dzsoi_decomp(1)
endif
else
if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > 0._r8) .and. (surface_prof_tot > 0._r8) ) then
if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > smallparameter) .and. (surface_prof_tot > smallparameter) ) then
do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp)
nfixation_prof(c,j) = col_cinput_rootfr(c,j) / rootfr_tot
if (j <= nlevbed) then
Expand All @@ -271,9 +272,9 @@ subroutine decomp_vertprofiles(bounds, &
end if
end do
else
nfixation_prof(c,1) = 1./dzsoi_decomp(1)
ndep_prof(c,1) = 1./dzsoi_decomp(1)
pdep_prof(c,1) = 1./dzsoi_decomp(1)
nfixation_prof(c,1) = 1._r8/dzsoi_decomp(1)
ndep_prof(c,1) = 1._r8/dzsoi_decomp(1)
pdep_prof(c,1) = 1._r8/dzsoi_decomp(1)
endif
end if
end do
Expand All @@ -294,9 +295,9 @@ subroutine decomp_vertprofiles(bounds, &
! check to make sure integral of all profiles = 1.
do fc = 1,num_soilc
c = filter_soilc(fc)
ndep_prof_sum = 0.
nfixation_prof_sum = 0.
pdep_prof_sum = 0.
ndep_prof_sum = 0._r8
nfixation_prof_sum = 0._r8
pdep_prof_sum = 0._r8
do j = 1, nlevdecomp
ndep_prof_sum = ndep_prof_sum + ndep_prof(c,j) * dzsoi_decomp(j)
nfixation_prof_sum = nfixation_prof_sum + nfixation_prof(c,j) * dzsoi_decomp(j)
Expand Down Expand Up @@ -324,10 +325,10 @@ subroutine decomp_vertprofiles(bounds, &

do fp = 1,num_soilp
p = filter_soilp(fp)
froot_prof_sum = 0.
croot_prof_sum = 0.
leaf_prof_sum = 0.
stem_prof_sum = 0.
froot_prof_sum = 0._r8
croot_prof_sum = 0._r8
leaf_prof_sum = 0._r8
stem_prof_sum = 0._r8
do j = 1, nlevdecomp
froot_prof_sum = froot_prof_sum + froot_prof(p,j) * dzsoi_decomp(j)
croot_prof_sum = croot_prof_sum + croot_prof(p,j) * dzsoi_decomp(j)
Expand All @@ -336,7 +337,19 @@ subroutine decomp_vertprofiles(bounds, &
end do
if ( ( abs(froot_prof_sum - 1._r8) > delta ) .or. ( abs(croot_prof_sum - 1._r8) > delta ) .or. &
( abs(stem_prof_sum - 1._r8) > delta ) .or. ( abs(leaf_prof_sum - 1._r8) > delta ) ) then
c = veg_pp%column(p)
write(iulog, *) 'profile sums: ', froot_prof_sum, croot_prof_sum, leaf_prof_sum, stem_prof_sum
write(iulog, *) 'c: ',c
write(iulog, *) 'altmax_lastyear_indx: ', altmax_lastyear_indx(c)
write(iulog, *) 'cinput_rootfr: ', col_cinput_rootfr(c,:)
write(iulog, *) 'dzsoi_decomp: ', dzsoi_decomp(:)
write(iulog, *) 'surface_prof: ', surface_prof(:)
write(iulog, *) 'p, itype(p), wtcol(p): ', p, veg_pp%itype(p), veg_pp%wtcol(p)
write(iulog, *) 'cinput_rootfr(p,:): ', cinput_rootfr(p,:)
write(iulog,*) 'croot_prof(p,:): ',croot_prof(p,:)
write(iulog,*) 'froot_prof(p,:): ',froot_prof(p,:)
write(iulog,*) 'leaf_prof(p,:): ',leaf_prof(p,:)
write(iulog,*) 'stem_prof(p,:): ',stem_prof(p,:)
call endrun(msg=' ERROR: sum-1 > delta'//errMsg(__FILE__, __LINE__))
endif
end do
Expand Down