diff --git a/components/elm/src/main/surfrdUtilsMod.F90 b/components/elm/src/main/surfrdUtilsMod.F90 index c581f968aaf6..2c1e42559dac 100644 --- a/components/elm/src/main/surfrdUtilsMod.F90 +++ b/components/elm/src/main/surfrdUtilsMod.F90 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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: @@ -323,16 +320,15 @@ 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 @@ -340,7 +336,7 @@ subroutine collapse_crop_types(wt_cft, fert_cft, fert_p_cft, begg, endg, verbose 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__)) @@ -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, @@ -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 ! ------------------------------------------------------------------------ @@ -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