Replaced sorting method which resulted in broken deletion algorithm

This commit is contained in:
Alex Selimov 2020-05-18 10:38:01 -04:00
parent 4f79085956
commit 9ccc5f1caf
3 changed files with 895 additions and 71 deletions

View file

@ -5,6 +5,7 @@ module elements
use parameters
use functions
use subroutines
use sorts
use box
implicit none
@ -395,54 +396,69 @@ module elements
return
end subroutine rhombshape
subroutine delete_atoms(num, index)
subroutine delete_atoms(num, in_index)
!This subroutine deletes atoms from the atom arrays
integer, intent(in) :: num
integer, intent(inout), dimension(num) :: index
integer, intent(in), dimension(num) :: in_index
real(kind=dp), dimension(num) :: for_sort
integer, dimension(num) :: sorted_index
integer :: i
call heapsort(index)
for_sort = in_index
call dpquicksort(for_sort)
do i = 1, num
sorted_index(i) = nint(for_sort(i))
end do
!We go from largest index to smallest index just to make sure that we don't miss
!accidentally overwrite values which need to be deleted
do i = num, 1, -1
if(index(i) == atom_num) then
r_atom(:,index(i)) = 0.0_dp
type_atom(index(i)) = 0
if(sorted_index(i) == atom_num) then
r_atom(:,sorted_index(i)) = 0.0_dp
type_atom(sorted_index(i)) = 0
else
r_atom(:,index(i)) = r_atom(:, atom_num)
type_atom(index(i)) = type_atom(atom_num)
r_atom(:,sorted_index(i)) = r_atom(:, atom_num)
type_atom(sorted_index(i)) = type_atom(atom_num)
end if
atom_num = atom_num - 1
end do
end subroutine
subroutine delete_elements(num, index)
subroutine delete_elements(num, in_index)
!This subroutine deletes elements from the element array
integer, intent(in) :: num
integer, intent(inout), dimension(num) :: index
integer, intent(in), dimension(num) :: in_index
integer :: i
real(kind=dp), dimension(num) :: for_sort
integer, dimension(num) :: sorted_index
call heapsort(index)
for_sort = in_index
call dpquicksort(for_sort)
do i = 1, num
sorted_index(i) = nint(for_sort(i))
end do
!We go from largest index to smallest index just to make sure that we don't miss
!accidentally overwrite values which need to be deleted
do i = num, 1, -1
if(index(i) == ele_num) then
r_node(:,:,:,index(i)) = 0.0_dp
type_ele(index(i)) =''
size_ele(index(i)) = 0
lat_ele(index(i)) = 0
sbox_ele(index(i)) = 0
if(sorted_index(i) == ele_num) then
r_node(:,:,:,sorted_index(i)) = 0.0_dp
type_ele(sorted_index(i)) =''
size_ele(sorted_index(i)) = 0
lat_ele(sorted_index(i)) = 0
sbox_ele(sorted_index(i)) = 0
else
node_num = node_num - ng_node(lat_ele(index(i)))
r_node(:,:,:,index(i)) = r_node(:,:,:,ele_num)
type_ele(index(i)) = type_ele(ele_num)
size_ele(index(i)) = size_ele(ele_num)
lat_ele(index(i)) = lat_ele(ele_num)
sbox_ele(index(i)) = sbox_ele(ele_num)
node_num = node_num - ng_node(lat_ele(sorted_index(i)))
r_node(:,:,:,sorted_index(i)) = r_node(:,:,:,ele_num)
type_ele(sorted_index(i)) = type_ele(ele_num)
size_ele(sorted_index(i)) = size_ele(ele_num)
lat_ele(sorted_index(i)) = lat_ele(ele_num)
sbox_ele(sorted_index(i)) = sbox_ele(ele_num)
end if
ele_num = ele_num - 1
end do
@ -632,4 +648,4 @@ module elements
end select
end subroutine
end module elements
end module elements