diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index af73a7733..738386da8 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -368,9 +368,8 @@ subroutine encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, lvdotr, integer(I2B), dimension(npl) :: vshift_min, vshift_max type(walltimer) :: timer - if (npl <= 1) return - ! call timer%reset() - ! call timer%start() + if (npl == 0) return + ! If this is the first time through, build the index lists n = 2 * npl if (npl_last /= npl) then @@ -378,7 +377,6 @@ subroutine encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, lvdotr, npl_last = npl end if - !$omp parallel do default(private) schedule(static) & !$omp shared(x, v, renc, boundingbox) & !$omp firstprivate(dt, npl, n) @@ -395,33 +393,18 @@ subroutine encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, lvdotr, end do !$omp end parallel do - - ! call timer%reset() - ! call timer%start() call boundingbox%sweep(npl, nenc, index1, index2) - ! call timer%stop() - ! call timer%report(nsubsteps=1, message="Sweep plpl:") if (nenc > 0) then ! Now that we have identified potential pairs, use the narrow-phase process to get the final values allocate(lencounter(nenc)) allocate(lvdotr(nenc)) - ! call timer%reset() - ! call timer%start() call encounter_check_all(nenc, index1, index2, x, v, x, v, renc, renc, dt, lencounter, lvdotr) - ! call timer%stop() - ! call timer%report(nsubsteps=1, message="Narrow plpl:") - ! call timer%reset() - ! call timer%start() call encounter_check_reduce_broadphase(npl, nenc, index1, index2, lencounter, lvdotr) - ! call timer%stop() - ! call timer%report(nsubsteps=1, message="Reduce plpl:") end if - ! call timer%stop() - ! call timer%report(nsubsteps=1, message="Sort & Sweep plpl:") return end subroutine encounter_check_all_sort_and_sweep_plpl @@ -459,8 +442,6 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt ! If this is the first time through, build the index lists if ((nplm == 0) .or. (nplt == 0)) return - ! call timer%reset() - ! call timer%start() ntot = nplm + nplt n = 2 * ntot @@ -471,7 +452,6 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt ntot_last = ntot end if - !$omp parallel do default(private) schedule(static) & !$omp shared(xplm, xplt, vplm, vplt, rencm, renct, boundingbox) & !$omp firstprivate(dt, nplm, nplt, ntot) @@ -498,14 +478,8 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt xplt(dim,1:nplt) + renct(1:nplt) + vpltshift_max(1:nplt) * vplt(dim,1:nplt) * dt]) end do !$omp end parallel do - ! call timer%stop() - ! call timer%report(nsubsteps=1, message="Sort plplm:") - - ! call timer%reset() - ! call timer%start() + call boundingbox%sweep(nplm, nplt, nenc, index1, index2) - ! call timer%stop() - ! call timer%report(nsubsteps=1, message="Sweep plplm:") if (nenc > 0) then ! Shift tiny body indices back into the range of the input position and velocity arrays @@ -515,25 +489,13 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt allocate(lencounter(nenc)) allocate(lvdotr(nenc)) - ! call timer%reset() - ! call timer%start() call encounter_check_all(nenc, index1, index2, xplm, vplm, xplt, vplt, rencm, renct, dt, lencounter, lvdotr) - ! call timer%stop() - ! call timer%report(nsubsteps=1, message="Narrow plplm:") - - ! call timer%reset() - ! call timer%start() ! Shift the tiny body indices back to their natural range index2(:) = index2(:) + nplm call encounter_check_reduce_broadphase(ntot, nenc, index1, index2, lencounter, lvdotr) - ! call timer%stop() - ! call timer%report(nsubsteps=1, message="Reduce plplm:") - end if - ! call timer%stop() - ! call timer%report(nsubsteps=1, message="Sort & Sweep plplm:") return end subroutine encounter_check_all_sort_and_sweep_plplm @@ -626,7 +588,7 @@ subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, end subroutine encounter_check_all_sort_and_sweep_pltp - subroutine encounter_check_all_triangular_one(i, n, xi, yi, zi, vxi, vyi, vzi, x, y, z, vx, vy, vz, renci, renc, dt, ind_arr, lenci) + pure subroutine encounter_check_all_triangular_one(i, n, xi, yi, zi, vxi, vyi, vzi, x, y, z, vx, vy, vz, renci, renc, dt, ind_arr, lenci) implicit none ! Arguments integer(I4B), intent(in) :: i @@ -691,9 +653,6 @@ subroutine encounter_check_all_triangular_plpl(npl, x, v, renc, dt, lvdotr, inde type(encounter_list), dimension(npl) :: lenc type(walltimer) :: timer - ! call timer%reset() - ! call timer%start() - call util_index_array(ind_arr, npl) !$omp parallel do default(private) schedule(static)& @@ -710,9 +669,6 @@ subroutine encounter_check_all_triangular_plpl(npl, x, v, renc, dt, lvdotr, inde call encounter_check_collapse_ragged_list(lenc, npl, nenc, index1, index2, lvdotr) - ! call timer%stop() - ! call timer%report(nsubsteps=1, message="Triangular plpl:") - return end subroutine encounter_check_all_triangular_plpl @@ -745,9 +701,6 @@ subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vp type(encounter_list), dimension(nplm) :: lenc type(walltimer) :: timer - ! call timer%reset() - ! call timer%start() - call util_index_array(ind_arr, nplt) !$omp parallel do default(private) schedule(static)& @@ -764,9 +717,6 @@ subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vp call encounter_check_collapse_ragged_list(lenc, nplm, nenc, index1, index2, lvdotr) - ! call timer%stop() - ! call timer%report(nsubsteps=1, message="Triangular plplm:") - return end subroutine encounter_check_all_triangular_plplm @@ -881,6 +831,7 @@ module subroutine encounter_check_collapse_ragged_list(ragged_list, n1, nenc, in logical, dimension(:), allocatable, intent(out), optional :: lvdotr !! Array indicating which bodies are approaching ! Internals integer(I4B) :: i, j0, j1, nenci + integer(I4B), dimension(n1) :: ibeg associate(nenc_arr => ragged_list(:)%nenc) nenc = sum(nenc_arr(:)) @@ -890,23 +841,51 @@ module subroutine encounter_check_collapse_ragged_list(ragged_list, n1, nenc, in allocate(index1(nenc)) allocate(index2(nenc)) if (present(lvdotr)) allocate(lvdotr(nenc)) + j0 = 1 do i = 1, n1 nenci = ragged_list(i)%nenc - if (nenci > 0) then - j1 = j0 + nenci - 1 - index1(j0:j1) = i - index2(j0:j1) = ragged_list(i)%index2(:) - if (present(lvdotr)) lvdotr(j0:j1) = ragged_list(i)%lvdotr(:) - j0 = j1 + 1 - end if + if (nenci == 0) cycle + ibeg(i) = j0 + j0 = j0 + nenci + end do + + !$omp parallel do default(private) & + !$omp shared(ragged_list, index1, index2, ibeg, lvdotr) & + !$omp firstprivate(n1) + do i = 1,n1 + if (ragged_list(i)%nenc == 0) cycle + nenci = ragged_list(i)%nenc + j0 = ibeg(i) + j1 = j0 + nenci - 1 + index1(j0:j1) = i + index2(j0:j1) = ragged_list(i)%index2(:) + if (present(lvdotr)) lvdotr(j0:j1) = ragged_list(i)%lvdotr(:) end do + !$omp end parallel do return end subroutine encounter_check_collapse_ragged_list + + pure subroutine encounter_check_make_ragged_list(lencounteri, ind_arr, lenci) + implicit none + ! Arguments + logical, dimension(:), intent(in) :: lencounteri + integer(I4B), dimension(:), intent(in) :: ind_arr + type(encounter_list), intent(out) :: lenci + + lenci%nenc = count(lencounteri(:)) + if (lenci%nenc > 0) then + allocate(lenci%index2(lenci%nenc)) + lenci%index2(:) = pack(ind_arr(:), lencounteri(:)) + end if + + return + end subroutine encounter_check_make_ragged_list + - module subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) + module pure subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) !! author: David A. Minton !! !! Sorts the bounding box extents along a single dimension prior to the sweep phase. @@ -958,14 +937,8 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, nenc, ind ! Sweep the intervals for each of the massive bodies along one dimension ! This will build a ragged pair of index lists inside of the lenc data structure - !$omp parallel do default(private) schedule(static)& - !$omp shared(self, lenc, ind_arr) & - !$omp firstprivate(ntot, n1, n2) - do i = 1, ntot - call encounter_check_sweep_aabb_one_double_list(i, n1, n2, self%aabb(1)%ind(:), self%aabb(1)%ibeg(:), self%aabb(1)%iend(:), self%aabb(2)%ibeg(:), self%aabb(2)%iend(:), ind_arr(:), lenc(i)) - end do - !$omp end parallel do - + call encounter_check_sweep_aabb_all_double_list(n1, n2, self%aabb(1)%ind(:), self%aabb(1)%ibeg(:), self%aabb(1)%iend(:), self%aabb(2)%ibeg(:), self%aabb(2)%iend(:), ind_arr(:), lenc(:)) + call encounter_check_collapse_ragged_list(lenc, ntot, nenc, index1, index2) ! Reorder the pairs and sort the first index in order to remove any duplicates @@ -995,18 +968,13 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, nenc, index1, Integer(I4B) :: i, k type(encounter_list), dimension(n) :: lenc !! Array of encounter lists (one encounter list per body) integer(I4B), dimension(:), allocatable, save :: ind_arr + type(walltimer) :: timer call util_index_array(ind_arr, n) ! Sweep the intervals for each of the massive bodies along one dimension ! This will build a ragged pair of index lists inside of the lenc data structure - !$omp parallel do default(private) schedule(static)& - !$omp shared(self, lenc, ind_arr) & - !$omp firstprivate(n) - do i = 1, n - call encounter_check_sweep_aabb_one_single_list(i, n, self%aabb(1)%ind(:), self%aabb(1)%ibeg(:), self%aabb(1)%iend(:), self%aabb(2)%ibeg(:), self%aabb(2)%iend(:), ind_arr(:), lenc(i)) - end do - !$omp end parallel do + call encounter_check_sweep_aabb_all_single_list(n, self%aabb(1)%ind(:), self%aabb(1)%ibeg(:), self%aabb(1)%iend(:), self%aabb(2)%ibeg(:), self%aabb(2)%iend(:), ind_arr(:), lenc(:)) call encounter_check_collapse_ragged_list(lenc, n, nenc, index1, index2) @@ -1021,7 +989,85 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, nenc, index1, end subroutine encounter_check_sweep_aabb_single_list - subroutine encounter_check_sweep_aabb_one_double_list(i, n1, n2, ext_ind, ibegx, iendx, ibegy, iendy, ind_arr, lenc) + subroutine encounter_check_sweep_aabb_all_double_list(n1, n2, ext_ind, ibegx, iendx, ibegy, iendy, ind_arr, lenc) + !! author: David A. Minton + !! + !! Performs the loop part of the sweep operation. Double list version (e.g. pl-tp or plm-plt) + implicit none + ! Arguments + integer(I4B), intent(in) :: n1, n2 !! Number of bodies + integer(I4B), dimension(:), intent(in) :: ext_ind !! Sorted index array of extents + integer(I4B), dimension(:), intent(in) :: ibegx, iendx !! Beginning and ending index lists in the x-dimension + integer(I4B), dimension(:), intent(in) :: ibegy, iendy !! Beginning and ending index lists in the y-dimension + integer(I4B), dimension(:), intent(in) :: ind_arr !! index array for mapping body 2 indexes + type(encounter_list), dimension(:), intent(inout) :: lenc !! Encounter list for the ith body + ! Internals + integer(I4B) :: i, ntot + logical, dimension(n1+n2) :: lencounteri + integer(I4B) :: ibegxi, iendxi, ibegyi, iendyi + + ntot = n1 + n2 + !$omp parallel do default(private) schedule(guided)& + !$omp shared(ext_ind, ibegx, iendx, ibegy, iendy, ind_arr, lenc) & + !$omp firstprivate(ntot, n1, n2) + do i = 1, ntot + ibegxi = ibegx(i) + 1 + iendxi = iendx(i) - 1 + if (iendxi >= ibegxi) then + ibegyi = ibegy(i) + iendyi = iendy(i) + call encounter_check_sweep_aabb_one_double_list(i, n1, n2, ntot, ext_ind(:), ibegxi, iendxi, ibegyi, iendyi, ibegx(:), iendx(:), ibegy(:), iendy(:), lencounteri(:)) + call encounter_check_make_ragged_list(lencounteri(:), ind_arr(:), lenc(i)) + else + lenc(i)%nenc = 0 + end if + end do + !$omp end parallel do + + return + end subroutine encounter_check_sweep_aabb_all_double_list + + + subroutine encounter_check_sweep_aabb_all_single_list(n, ext_ind, ibegx, iendx, ibegy, iendy, ind_arr, lenc) + !! author: David A. Minton + !! + !! Performs the loop part of the sweep operation. Single list version (e.g. pl-pl) + implicit none + ! Arguments + integer(I4B), intent(in) :: n !! Number of bodies + integer(I4B), dimension(:), intent(in) :: ext_ind !! Sorted index array of extents + integer(I4B), dimension(:), intent(in) :: ibegx, iendx !! Beginning and ending index lists in the x-dimension + integer(I4B), dimension(:), intent(in) :: ibegy, iendy !! Beginning and ending index lists in the y-dimension + integer(I4B), dimension(:), intent(in) :: ind_arr !! index array for mapping body 2 indexes + type(encounter_list), dimension(:), intent(inout) :: lenc !! Encounter list for the ith body + ! Internals + integer(I4B) :: i + logical, dimension(n) :: lencounteri + integer(I4B) :: ibegxi, iendxi, ibegyi, iendyi + + !$omp parallel do default(private) schedule(guided)& + !$omp shared(ext_ind, ibegx, iendx, ibegy, iendy, ind_arr, lenc) & + !$omp firstprivate(n) + do i = 1, n + ibegxi = ibegx(i) + 1 + iendxi = iendx(i) - 1 + if (iendxi >= ibegxi) then + ibegyi = ibegy(i) + iendyi = iendy(i) + call encounter_check_sweep_aabb_one_single_list(n, ext_ind(:), ibegxi, iendxi, ibegyi, iendyi, ibegx(:), iendx(:), ibegy(:), iendy(:), lencounteri(:)) + call encounter_check_make_ragged_list(lencounteri(:), ind_arr(:), lenc(i)) + else + lenc(i)%nenc = 0 + end if + end do + !$omp end parallel do + + return + end subroutine encounter_check_sweep_aabb_all_single_list + + + pure subroutine encounter_check_sweep_aabb_one_double_list(i, n1, n2, ntot, ext_ind, ibegxi, iendxi, ibegyi, iendyi, ibegx, iendx, ibegy, iendy, lencounteri) + !$omp declare simd(encounter_check_sweep_aabb_one_double_list) !! author: David A. Minton !! !! Performs a sweep operation on a single body. Encounters from the same lists not allowed (e.g. pl-tp encounters only) @@ -1030,74 +1076,54 @@ subroutine encounter_check_sweep_aabb_one_double_list(i, n1, n2, ext_ind, ibegx, integer(I4B), intent(in) :: i !! The current index of the ith body integer(I4B), intent(in) :: n1 !! Number of bodies 1 integer(I4B), intent(in) :: n2 !! Number of bodies 2 + integer(I4B), intent(in) :: ntot !! n1 + n2 integer(I4B), dimension(:), intent(in) :: ext_ind !! Sorted index array of extents - integer(I4B), dimension(:), intent(in) :: ibegx, iendx !! Beginning and ending index lists in the x-dimension - integer(I4B), dimension(:), intent(in) :: ibegy, iendy !! Beginning and ending index lists in the y-dimension - integer(I4B), dimension(:), intent(in) :: ind_arr !! index array for mapping body 2 indexes - type(encounter_list), intent(inout) :: lenc !! Encounter list for the ith body + integer(I4B), intent(in) :: ibegxi, iendxi !! The beginning and ending indices of the ith bounding box in the x-dimension + integer(I4B), intent(in) :: ibegyi, iendyi !! The beginning and ending indices of the ith bounding box in the y-dimension + integer(I4B), dimension(:), intent(in) :: ibegx, iendx !! Beginning and ending index lists in the x-dimension + integer(I4B), dimension(:), intent(in) :: ibegy, iendy !! Beginning and ending index lists in the y-dimensio + logical, dimension(:), intent(out) :: lencounteri !! Encounter list for the ith body ! Internals - integer(I4B) :: ibox, jbox, nbox, j, ybegi, yendi, ntot - logical, dimension(n1+n2) :: lencounteri + integer(I4B) :: j, jbox - ntot = n1 + n2 - ibox = ibegx(i) + 1 - nbox = iendx(i) - 1 - ybegi = ibegy(i) - yendi = iendy(i) lencounteri(:) = .false. - do concurrent(jbox = ibox:nbox) ! Sweep forward until the end of the interval + do concurrent(jbox = ibegxi:iendxi) ! Sweep forward until the end of the interval j = ext_ind(jbox) if (j > ntot) j = j - ntot ! If this is an endpoint index, shift it to the correct range if (((i <= n1) .and. (j <= n1)) .or. ((i > n1) .and. (j > n1))) cycle ! only pairs from the two different lists allowed ! Check the y-dimension - lencounteri(j) = (iendy(j) > ybegi) .and. (ibegy(j) < yendi) + lencounteri(j) = (iendy(j) > ibegyi) .and. (ibegy(j) < iendyi) end do - lenc%nenc = count(lencounteri(:)) - if (lenc%nenc > 0) then - allocate(lenc%index2(lenc%nenc)) - lenc%index2(:) = pack(ind_arr(:), lencounteri(:)) - end if - return end subroutine encounter_check_sweep_aabb_one_double_list - subroutine encounter_check_sweep_aabb_one_single_list(i, n, ext_ind, ibegx, iendx, ibegy, iendy, ind_arr, lenc) + pure subroutine encounter_check_sweep_aabb_one_single_list(n, ext_ind, ibegxi, iendxi, ibegyi, iendyi, ibegx, iendx, ibegy, iendy, lencounteri) + !$omp declare simd(encounter_check_sweep_aabb_one_single_list) !! author: David A. Minton !! !! Performs a sweep operation on a single body. Mutual encounters allowed (e.g. pl-pl) implicit none ! Arguments - integer(I4B), intent(in) :: i !! The current index of the ith body - integer(I4B), intent(in) :: n !! Number of bodies - integer(I4B), dimension(:), intent(in) :: ext_ind !! Sorted index array of extents - integer(I4B), dimension(:), intent(in) :: ibegx, iendx !! Beginning and ending index lists in the x-dimension - integer(I4B), dimension(:), intent(in) :: ibegy, iendy !! Beginning and ending index lists in the y-dimension - integer(I4B), dimension(:), intent(in) :: ind_arr !! index array for mapping body 2 indexes - type(encounter_list), intent(inout) :: lenc !! Encounter list for the ith body + integer(I4B), intent(in) :: n !! Number of bodies + integer(I4B), dimension(:), intent(in) :: ext_ind !! Sorted index array of extents + integer(I4B), intent(in) :: ibegxi, iendxi !! The beginning and ending indices of the ith bounding box in the x-dimension + integer(I4B), intent(in) :: ibegyi, iendyi !! The beginning and ending indices of the ith bounding box in the y-dimension + integer(I4B), dimension(:), intent(in) :: ibegx, iendx !! Beginning and ending index lists in the x-dimension + integer(I4B), dimension(:), intent(in) :: ibegy, iendy !! Beginning and ending index lists in the y-dimension + logical, dimension(:), intent(out) :: lencounteri !! Encounter list for the ith body ! Internals - integer(I4B) :: ibox, jbox, nbox, j, ybegi, yendi - logical, dimension(n) :: lencounteri + integer(I4B) :: j, jbox - ibox = ibegx(i) + 1 - nbox = iendx(i) - 1 - ybegi = ibegy(i) - yendi = iendy(i) lencounteri(:) = .false. - do concurrent(jbox = ibox:nbox) ! Sweep forward until the end of the interval + do concurrent(jbox = ibegxi:iendxi) ! Sweep forward until the end of the interval j = ext_ind(jbox) if (j > n) j = j - n ! If this is an endpoint index, shift it to the correct range ! Check the y-dimension - lencounteri(j) = (iendy(j) > ybegi) .and. (ibegy(j) < yendi) + lencounteri(j) = (iendy(j) > ibegyi) .and. (ibegy(j) < iendyi) end do - lenc%nenc = count(lencounteri(:)) - if (lenc%nenc > 0) then - allocate(lenc%index2(lenc%nenc)) - lenc%index2(:) = pack(ind_arr(:), lencounteri(:)) - end if - return end subroutine encounter_check_sweep_aabb_one_single_list diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index af10af236..f8d0d398d 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -550,7 +550,7 @@ function radial_objective_function(v_r_mag_input) result(fval) associate(nfrag => frag%nbody) allocate(v_shift, mold=frag%vb) v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, frag%v_r_unit, frag%v_t_mag, frag%v_t_unit, frag%mass, frag%vbcom) - !$omp do simd + !$omp do simd firstprivate(nfrag) lastprivate(rotmag2, vmag2) do i = 1,nfrag rotmag2 = frag%rot(1,i)**2 + frag%rot(2,i)**2 + frag%rot(3,i)**2 vmag2 = v_shift(1,i)**2 + v_shift(2,i)**2 + v_shift(3,i)**2 diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 96dbb1e83..a34b0fd3f 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -137,7 +137,7 @@ module subroutine encounter_check_collapse_ragged_list(ragged_list, n1, nenc, in logical, dimension(:), allocatable, intent(out), optional :: lvdotr !! Array indicating which bodies are approaching end subroutine encounter_check_collapse_ragged_list - module subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) + module pure subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) implicit none class(encounter_bounding_box_1D), intent(inout) :: self !! Bounding box structure along a single dimension integer(I4B), intent(in) :: n !! Number of bodies with extents diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 4d2b4f38f..dfa6b4dea 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -1612,34 +1612,34 @@ end function util_solve_rkf45 end interface interface util_sort - module subroutine util_sort_i4b(arr) + module pure subroutine util_sort_i4b(arr) implicit none integer(I4B), dimension(:), intent(inout) :: arr end subroutine util_sort_i4b - module subroutine util_sort_index_i4b(arr,ind) + module pure subroutine util_sort_index_i4b(arr,ind) implicit none integer(I4B), dimension(:), intent(in) :: arr integer(I4B), dimension(:), allocatable, intent(inout) :: ind end subroutine util_sort_index_i4b - module subroutine util_sort_sp(arr) + module pure subroutine util_sort_sp(arr) implicit none real(SP), dimension(:), intent(inout) :: arr end subroutine util_sort_sp - module subroutine util_sort_index_sp(arr,ind) + module pure subroutine util_sort_index_sp(arr,ind) implicit none real(SP), dimension(:), intent(in) :: arr integer(I4B), dimension(:), allocatable, intent(inout) :: ind end subroutine util_sort_index_sp - module subroutine util_sort_dp(arr) + module pure subroutine util_sort_dp(arr) implicit none real(DP), dimension(:), intent(inout) :: arr end subroutine util_sort_dp - module subroutine util_sort_index_dp(arr,ind) + module pure subroutine util_sort_index_dp(arr,ind) implicit none real(DP), dimension(:), intent(in) :: arr integer(I4B), dimension(:), allocatable, intent(inout) :: ind @@ -1647,28 +1647,28 @@ end subroutine util_sort_index_dp end interface util_sort interface util_sort_rearrange - module subroutine util_sort_rearrange_arr_char_string(arr, ind, n) + module pure subroutine util_sort_rearrange_arr_char_string(arr, ind, n) implicit none character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange end subroutine util_sort_rearrange_arr_char_string - module subroutine util_sort_rearrange_arr_DP(arr, ind, n) + module pure subroutine util_sort_rearrange_arr_DP(arr, ind, n) implicit none real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange end subroutine util_sort_rearrange_arr_DP - module subroutine util_sort_rearrange_arr_DPvec(arr, ind, n) + module pure subroutine util_sort_rearrange_arr_DPvec(arr, ind, n) implicit none real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange end subroutine util_sort_rearrange_arr_DPvec - module subroutine util_sort_rearrange_arr_I4B(arr, ind, n) + module pure subroutine util_sort_rearrange_arr_I4B(arr, ind, n) implicit none integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against @@ -1682,7 +1682,7 @@ module subroutine util_sort_rearrange_arr_info(arr, ind, n) integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange end subroutine util_sort_rearrange_arr_info - module subroutine util_sort_rearrange_arr_logical(arr, ind, n) + module pure subroutine util_sort_rearrange_arr_logical(arr, ind, n) implicit none logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against diff --git a/src/util/util_sort.f90 b/src/util/util_sort.f90 index 824a1c994..c24f81341 100644 --- a/src/util/util_sort.f90 +++ b/src/util/util_sort.f90 @@ -57,7 +57,7 @@ module subroutine util_sort_body(self, sortby, ascending) end subroutine util_sort_body - module subroutine util_sort_dp(arr) + module pure subroutine util_sort_dp(arr) !! author: David A. Minton !! !! Sort input double precision array in place into ascending numerical order using insertion sort. @@ -86,7 +86,7 @@ module subroutine util_sort_dp(arr) end subroutine util_sort_dp - module subroutine util_sort_index_dp(arr, ind) + module pure subroutine util_sort_index_dp(arr, ind) !! author: David A. Minton !! !! Sort input double precision array by index in ascending numerical order using insertion sort. @@ -121,7 +121,7 @@ module subroutine util_sort_index_dp(arr, ind) end subroutine util_sort_index_dp - module subroutine util_sort_i4b(arr) + module pure subroutine util_sort_i4b(arr) !! author: David A. Minton !! !! Sort input integer array in place into ascending numerical order using insertion sort. @@ -150,7 +150,7 @@ module subroutine util_sort_i4b(arr) end subroutine util_sort_i4b - module subroutine util_sort_index_i4b(arr, ind) + module pure subroutine util_sort_index_i4b(arr, ind) !! author: David A. Minton !! !! Sort input integer array by index in ascending numerical order using insertion sort. @@ -185,7 +185,7 @@ module subroutine util_sort_index_i4b(arr, ind) end subroutine util_sort_index_i4b - module subroutine util_sort_sp(arr) + module pure subroutine util_sort_sp(arr) !! author: David A. Minton !! !! Sort input single precision array in place into ascending numerical order using insertion sort. @@ -214,7 +214,7 @@ module subroutine util_sort_sp(arr) end subroutine util_sort_sp - module subroutine util_sort_index_sp(arr, ind) + module pure subroutine util_sort_index_sp(arr, ind) !! author: David A. Minton !! !! Sort input single precision array by index in ascending numerical order using insertion sort. @@ -385,7 +385,7 @@ module subroutine util_sort_rearrange_body(self, ind) end subroutine util_sort_rearrange_body - module subroutine util_sort_rearrange_arr_char_string(arr, ind, n) + module pure subroutine util_sort_rearrange_arr_char_string(arr, ind, n) !! author: David A. Minton !! !! Rearrange a single array of character string in-place from an index list. @@ -406,7 +406,7 @@ module subroutine util_sort_rearrange_arr_char_string(arr, ind, n) end subroutine util_sort_rearrange_arr_char_string - module subroutine util_sort_rearrange_arr_DP(arr, ind, n) + module pure subroutine util_sort_rearrange_arr_DP(arr, ind, n) !! author: David A. Minton !! !! Rearrange a single array of DP type in-place from an index list. @@ -427,7 +427,7 @@ module subroutine util_sort_rearrange_arr_DP(arr, ind, n) end subroutine util_sort_rearrange_arr_DP - module subroutine util_sort_rearrange_arr_DPvec(arr, ind, n) + module pure subroutine util_sort_rearrange_arr_DPvec(arr, ind, n) !! author: David A. Minton !! !! Rearrange a single array of (NDIM,n) DP-type vectors in-place from an index list. @@ -448,7 +448,7 @@ module subroutine util_sort_rearrange_arr_DPvec(arr, ind, n) end subroutine util_sort_rearrange_arr_DPvec - module subroutine util_sort_rearrange_arr_I4B(arr, ind, n) + module pure subroutine util_sort_rearrange_arr_I4B(arr, ind, n) !! author: David A. Minton !! !! Rearrange a single array of integers in-place from an index list. @@ -469,7 +469,7 @@ module subroutine util_sort_rearrange_arr_I4B(arr, ind, n) end subroutine util_sort_rearrange_arr_I4B - module subroutine util_sort_rearrange_arr_logical(arr, ind, n) + module pure subroutine util_sort_rearrange_arr_logical(arr, ind, n) !! author: David A. Minton !! !! Rearrange a single array of logicals in-place from an index list.