Skip to content

Commit

Permalink
Bug fix to remove topi, topf and use max_topounits, plus cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
@thorntonpe
thorntonpe committed May 19, 2024
1 parent 5b5ad91 commit 6ced7eb
Showing 1 changed file with 12 additions and 21 deletions.
33 changes: 12 additions & 21 deletions components/elm/src/main/surfrdUtilsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ subroutine check_sums_equal_1_3d(arr, lb, name, caller)
! Confirm that sum(arr(n,:)) == 1 for all n. If this isn't true for any n, abort with a message.
!
! Uses
use topounit_varcon, only : max_topounits, has_topounit
use topounit_varcon, only : max_topounits

! !ARGUMENTS:
integer , intent(in) :: lb ! lower bound of the first dimension of arr
Expand Down Expand Up @@ -123,7 +123,7 @@ subroutine convert_cft_to_pft( begg, endg, cftsize, wt_cft )
! a crop landunit, and put them on the vegetated landunit.
! !USES:
use elm_varsur , only : wt_lunit, wt_nat_patch
use elm_varpar , only : cft_size, surfpft_size
use elm_varpar , only : cft_size
use elm_varpar , only : natpft_size
use landunit_varcon , only : istsoil, istcrop
use topounit_varcon , only : max_topounits
Expand Down Expand Up @@ -170,7 +170,6 @@ subroutine convert_pft_to_cft( begg, endg )
! the new crop landunit
! !USES:
use elm_varsur , only : wt_lunit, wt_nat_patch, wt_cft
use elm_varpar , only : cft_size, surfpft_size
use elm_varpar , only : cft_size, cft_lb, cft_ub, surfpft_lb, surfpft_ub
use landunit_varcon , only : istsoil, istcrop
use topounit_varcon , only : max_topounits
Expand Down Expand Up @@ -261,7 +260,6 @@ subroutine collapse_crop_var(crop_var, begg, endg)
use elm_varpar, only: cft_lb, cft_ub, cft_size
use pftvarcon , only: is_pft_known_to_model
use topounit_varcon , only : max_topounits ! TKT
use GridcellType, only : grc_pp
!
! !ARGUMENTS:
! Use begg and endg rather than 'bounds', because bounds may not be
Expand Down Expand Up @@ -311,8 +309,7 @@ subroutine collapse_crop_types(wt_cft, fert_cft, fert_p_cft, begg, endg, verbose
use elm_varpar , only : cft_lb, cft_ub, cft_size
use pftvarcon , only: is_pft_known_to_model
use pftvarcon , only : npcropmax, mergetoelmpft
use topounit_varcon , only : max_topounits ! TKT
use GridcellType , only : grc_pp ! TKT
use topounit_varcon , only : max_topounits
!
! !ARGUMENTS:

Expand All @@ -323,24 +320,23 @@ subroutine collapse_crop_types(wt_cft, fert_cft, fert_p_cft, begg, endg, verbose

! Weight and fertilizer of each CFT in each grid cell; dimensioned [g, cft_lb:cft_ub]
! This array is modified in-place
real(r8), intent(inout) :: wt_cft(begg:,1:, cft_lb:) !TKT
real(r8), intent(inout) :: fert_cft(begg:,1:, cft_lb:) !TKT
real(r8), intent(inout) :: wt_cft(begg:,1:, cft_lb:)
real(r8), intent(inout) :: fert_cft(begg:,1:, cft_lb:)
real(r8), intent(inout) :: fert_p_cft(begg:, 1:, cft_lb:)

logical, intent(in) :: verbose ! If true, print some extra information
!
! !LOCAL VARIABLES:
integer :: g, t,t2 ! TKT
integer :: g, t,t2
integer :: m
!integer, allocatable :: ntpu(:) ! To store number of topounits per grid TKT
real(r8) :: wt_cft_to
real(r8) :: wt_cft_from
real(r8) :: wt_cft_merge

character(len=*), parameter :: subname = 'collapse_crop_types'
!-----------------------------------------------------------------------

SHR_ASSERT_ALL((ubound(wt_cft) == (/endg,max_topounits, cft_ub/)), errMsg(__FILE__, __LINE__)) ! TKT
SHR_ASSERT_ALL((ubound(wt_cft) == (/endg,max_topounits, cft_ub/)), errMsg(__FILE__, __LINE__))
SHR_ASSERT_ALL((ubound(fert_cft) == (/endg,max_topounits, cft_ub/)), errMsg(__FILE__, __LINE__))
SHR_ASSERT_ALL((ubound(fert_p_cft) == (/endg,max_topounits, cft_ub/)), errMsg(__FILE__, __LINE__))

Expand All @@ -353,14 +349,12 @@ subroutine collapse_crop_types(wt_cft, fert_cft, fert_p_cft, begg, endg, verbose
! ------------------------------------------------------------------------
! If not using irrigation, merge irrigated CFTs into rainfed CFTs
! ------------------------------------------------------------------------
!allocate(ntpu(begg:endg))
if (.not. irrigate) then
if (verbose .and. masterproc) then
write(iulog,*) trim(subname)//' crop=.T. and irrigate=.F., so merging irrigated pfts with rainfed'
end if

do g = begg, endg
!ntpu(g) = grc_pp%ntopounits(g)
! Left Hand Side: merged rainfed+irrigated crop pfts from nc3crop to
! npcropmax-1, stride 2
! Right Hand Side: rainfed crop pfts from nc3crop to npcropmax-1,
Expand All @@ -369,16 +363,14 @@ subroutine collapse_crop_types(wt_cft, fert_cft, fert_p_cft, begg, endg, verbose
! stride 2
! where stride 2 means "every other"

do t = grc_pp%topi(g), grc_pp%topf(g) ! TKT
t2 = t - grc_pp%topi(g) + 1

do t2 = 1, max_topounits
wt_cft(g,t2, cft_lb:cft_ub-1:2) = &
wt_cft(g,t2, cft_lb:cft_ub-1:2) + wt_cft(g,t2, cft_lb+1:cft_ub:2) ! TKT
wt_cft(g,t2, cft_lb:cft_ub-1:2) + wt_cft(g,t2, cft_lb+1:cft_ub:2)
wt_cft(g,t2, cft_lb+1:cft_ub:2) = 0._r8
end do ! TKT
end do
end do

call check_sums_equal_1_3d(wt_cft, begg, 'wt_cft', subname//': irrigation') ! TKT
call check_sums_equal_1_3d(wt_cft, begg, 'wt_cft', subname//': irrigation')
end if

! ------------------------------------------------------------------------
Expand Down Expand Up @@ -412,8 +404,7 @@ subroutine collapse_crop_types(wt_cft, fert_cft, fert_p_cft, begg, endg, verbose
end do
end do

call check_sums_equal_1_3d(wt_cft, begg, 'wt_cft', subname//': mergetoelmpft') ! TKT
!deallocate(ntpu)
call check_sums_equal_1_3d(wt_cft, begg, 'wt_cft', subname//': mergetoelmpft')
end subroutine collapse_crop_types

end module surfrdUtilsMod

0 comments on commit 6ced7eb

Please sign in to comment.