parent
08aa5d46df
commit
6f15daf1ec
@ -0,0 +1,117 @@
|
||||
module opt_delete
|
||||
|
||||
use parameters
|
||||
use subroutines
|
||||
use elements
|
||||
|
||||
implicit none
|
||||
|
||||
real(kind=dp) :: rc_off
|
||||
|
||||
public
|
||||
contains
|
||||
|
||||
subroutine run_delete(arg_pos)
|
||||
|
||||
integer, intent(inout) :: arg_pos
|
||||
|
||||
rc_off = -lim_zero
|
||||
!Main calling function for delete option.
|
||||
print *, '-----------------------Option Delete------------------------'
|
||||
|
||||
call parse_delete(arg_pos)
|
||||
|
||||
if (rc_off > 0.0_dp) call delete_overlap
|
||||
end subroutine run_delete
|
||||
|
||||
subroutine parse_delete(arg_pos)
|
||||
!Parse the delete command
|
||||
|
||||
integer, intent(inout) :: arg_pos
|
||||
|
||||
integer :: arg_len
|
||||
character(len=100) :: textholder
|
||||
arg_pos = arg_pos + 1
|
||||
|
||||
call get_command_argument(arg_pos, textholder, arg_len)
|
||||
if(arg_len==0) stop "Missing argument to delete command"
|
||||
|
||||
select case(textholder)
|
||||
case('overlap')
|
||||
arg_pos=arg_pos + 1
|
||||
call get_command_argument(arg_pos, textholder, arg_len)
|
||||
if(arg_len==0) stop "Missing argument to delete overlap command"
|
||||
print *, textholder
|
||||
read(*, textholder) rc_off
|
||||
|
||||
case default
|
||||
print *, "Command ", trim(adjustl(textholder)), " is not accepted for option delete"
|
||||
stop 3
|
||||
end select
|
||||
end subroutine parse_delete
|
||||
|
||||
subroutine delete_overlap
|
||||
!This subroutine deletes all overlapping atoms, which is defined as atoms which are separated by a distance of
|
||||
!less then rc_off
|
||||
|
||||
integer :: i, c(3), ci, cj, ck, num_nei, nei, delete_num
|
||||
integer, dimension(atom_num) :: for_delete
|
||||
integer, dimension(3,atom_num) :: which_cell
|
||||
|
||||
!These are the variables containing the cell list information
|
||||
integer, dimension(3) :: cell_num
|
||||
integer, allocatable :: num_in_cell(:,:,:)
|
||||
integer, allocatable :: cell_list(:,:,:,:)
|
||||
|
||||
!First pass the atom list and atom num to the algorithm which builds the cell list
|
||||
call build_cell_list(atom_num, r_atom, rc_off, cell_num, num_in_cell, cell_list, which_cell)
|
||||
|
||||
!Now loop over every atom and figure out if it has neighbors within the rc_off
|
||||
delete_num = 0
|
||||
atom_loop: do i = 1, atom_num
|
||||
|
||||
!c is the position of the cell that the atom belongs to
|
||||
c = which_cell(:,i)
|
||||
|
||||
!Check to make sure it hasn't already been deleted
|
||||
if(all(c /= 0)) then
|
||||
!Now loop over all neighboring cells
|
||||
do ci = -1, 1, 1
|
||||
do cj = -1, 1, 1
|
||||
do ck = -1, 1, 1
|
||||
do num_nei = 1, num_in_cell(c(1) + ck, c(2) + cj, c(3) + ci)
|
||||
nei = cell_list(num_nei,c(1) + ck, c(2) + cj, c(3) + ci)
|
||||
|
||||
!Check to make sure the atom isn't the same index as the atom we are checking
|
||||
!and that the neighbor hasn't already been deleted
|
||||
if((nei /= i).and.(nei/= 0)) then
|
||||
|
||||
!Now check to see if it is in the cutoff radius, if it is add it to the delete code
|
||||
if (norm2(r_atom(:,nei)-r_atom(:,i)) < rc_off) then
|
||||
|
||||
delete_num = delete_num + 1
|
||||
for_delete(delete_num) = max(i,nei)
|
||||
|
||||
!Now zero out the larger index
|
||||
if(i > nei) then
|
||||
which_cell(:,i) = 0
|
||||
cycle atom_loop
|
||||
else
|
||||
which_cell(:,nei) = 0
|
||||
cell_list(num_nei,c(1) + ck, c(2) + cj, c(3) + ci) = 0
|
||||
end if
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
|
||||
!Now delete all the atoms
|
||||
call delete_atoms(delete_num, for_delete(1:delete_num))
|
||||
|
||||
end do atom_loop
|
||||
|
||||
end subroutine delete_overlap
|
||||
end module opt_delete
|
Loading…
Reference in new issue