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