aselimov
5 years ago
committed by
GitHub
commit
5a1676cd66
|
After Width: | Height: | Size: 164 KiB |
@ -0,0 +1,125 @@
|
|||||||
|
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"
|
||||||
|
read(textholder, *) rc_off
|
||||||
|
case default
|
||||||
|
print *, "Command ", trim(adjustl(textholder)), " is not accepted for option delete"
|
||||||
|
stop 3
|
||||||
|
end select
|
||||||
|
|
||||||
|
arg_pos = arg_pos + 1
|
||||||
|
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
|
||||||
|
|
||||||
|
!These are the variables containing the cell list information
|
||||||
|
integer, dimension(3) :: cell_num
|
||||||
|
integer, allocatable :: num_in_cell(:,:,:), which_cell(:,:)
|
||||||
|
integer, allocatable :: cell_list(:,:,:,:)
|
||||||
|
|
||||||
|
allocate(which_cell(3,atom_num))
|
||||||
|
|
||||||
|
!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
|
||||||
|
|
||||||
|
if (any((c + (/ ck, cj, ci /)) == 0)) cycle
|
||||||
|
|
||||||
|
if( (c(1) + ck > cell_num(1)).or.(c(2) + cj > cell_num(2)).or. &
|
||||||
|
(c(3) + ci > cell_num(3))) cycle
|
||||||
|
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
end do atom_loop
|
||||||
|
|
||||||
|
print *, "Overlap command deletes ", delete_num, " atoms"
|
||||||
|
!Now delete all the atoms
|
||||||
|
call delete_atoms(delete_num, for_delete(1:delete_num))
|
||||||
|
end subroutine delete_overlap
|
||||||
|
end module opt_delete
|
||||||
@ -0,0 +1,132 @@
|
|||||||
|
module opt_orient
|
||||||
|
!This module contains the orient option which allows for the reorientation
|
||||||
|
!of simulation cells. This can be used to create arbitrarily oriented dislocation or loops.
|
||||||
|
use parameters
|
||||||
|
use subroutines
|
||||||
|
use elements
|
||||||
|
use box
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
|
||||||
|
real(kind=dp), save :: new_orient(3,3)
|
||||||
|
real(kind=dp), dimension(6) :: orig_box_bd
|
||||||
|
real(kind=dp), allocatable :: orig_sub_box_ori(:,:,:)
|
||||||
|
|
||||||
|
public
|
||||||
|
contains
|
||||||
|
|
||||||
|
subroutine orient(arg_pos)
|
||||||
|
|
||||||
|
integer, intent(inout) :: arg_pos
|
||||||
|
|
||||||
|
integer :: i, ibasis, inod
|
||||||
|
logical :: isortho, isrighthanded
|
||||||
|
real(kind=dp) :: inv_sub_box_ori(3,3,sub_box_num)
|
||||||
|
|
||||||
|
!First parse the orient command
|
||||||
|
call parse_orient(arg_pos)
|
||||||
|
|
||||||
|
!Now rotate the basis. To do this we transform the basis to [100] [010] [001] and then
|
||||||
|
!transform to user specified basis.
|
||||||
|
|
||||||
|
!Find all inverse orientation matrices for all sub_boxes
|
||||||
|
do i = 1, sub_box_num
|
||||||
|
call matrix_inverse(sub_box_ori, 3, inv_sub_box_ori)
|
||||||
|
end do
|
||||||
|
|
||||||
|
!Now transform all atoms
|
||||||
|
do i = 1, atom_num
|
||||||
|
r_atom(:,i) = matmul(new_orient,matmul(inv_sub_box_ori(:,:,sbox_atom(i)),r_atom(:,i)))
|
||||||
|
end do
|
||||||
|
|
||||||
|
!Now transform all elements
|
||||||
|
do i = 1, ele_num
|
||||||
|
do inod =1, ng_node(lat_ele(i))
|
||||||
|
do ibasis = 1, basisnum(lat_ele(i))
|
||||||
|
r_node(:,ibasis,inod,i) = matmul(new_orient,matmul(inv_sub_box_ori(:,:,sbox_ele(i)),r_node(:,ibasis,inod,i)))
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
|
||||||
|
!Now save the original sub_box_ori and overwrite them
|
||||||
|
if(allocated(orig_sub_box_ori)) deallocate(orig_sub_box_ori)
|
||||||
|
|
||||||
|
allocate(orig_sub_box_ori(3,3,sub_box_num))
|
||||||
|
orig_sub_box_ori = sub_box_ori
|
||||||
|
|
||||||
|
!Now overwrite the orientations
|
||||||
|
do i = 1, sub_box_num
|
||||||
|
sub_box_ori(:,:,i) = new_orient
|
||||||
|
end do
|
||||||
|
|
||||||
|
!Save original box boundaries
|
||||||
|
orig_box_bd = box_bd
|
||||||
|
|
||||||
|
!Now find new box boundaries
|
||||||
|
call def_new_box
|
||||||
|
end subroutine orient
|
||||||
|
|
||||||
|
subroutine parse_orient(arg_pos)
|
||||||
|
!This parses the orient option
|
||||||
|
integer, intent(inout) :: arg_pos
|
||||||
|
|
||||||
|
integer :: i, arg_len
|
||||||
|
logical :: isortho, isrighthanded
|
||||||
|
character(len=8) :: ori_string
|
||||||
|
|
||||||
|
!Pull out the new user orientation
|
||||||
|
do i = 1, 3
|
||||||
|
arg_pos = arg_pos + 1
|
||||||
|
call get_command_argument(arg_pos, ori_string, arg_len)
|
||||||
|
if (arg_len == 0) print *, "Missing orientation vector in -orient option"
|
||||||
|
call parse_ori_vec(ori_string, new_orient(i,:))
|
||||||
|
end do
|
||||||
|
|
||||||
|
!Normalize the orientation matrix
|
||||||
|
new_orient = matrix_normal(new_orient,3)
|
||||||
|
|
||||||
|
!Check right hand rule and orthogonality
|
||||||
|
call check_right_ortho(new_orient, isortho, isrighthanded)
|
||||||
|
if (.not.isortho) then
|
||||||
|
stop "Directions in orient are not orthogonal"
|
||||||
|
else if (.not.isrighthanded) then
|
||||||
|
stop "Directions in orient are not righthanded"
|
||||||
|
end if
|
||||||
|
|
||||||
|
arg_pos = arg_pos + 1
|
||||||
|
|
||||||
|
end subroutine parse_orient
|
||||||
|
|
||||||
|
subroutine unorient
|
||||||
|
|
||||||
|
integer :: i, ibasis, inod
|
||||||
|
real(kind=dp) :: inv_ori(3,3)
|
||||||
|
|
||||||
|
!Now rotate the basis. To do this we transform the basis to [100] [010] [001] and then
|
||||||
|
!transform to the original sbox_ele
|
||||||
|
|
||||||
|
!Find the inverse for the new orientation matrix
|
||||||
|
call matrix_inverse(new_orient, 3, inv_ori)
|
||||||
|
|
||||||
|
!Recover original sub_box_ori
|
||||||
|
sub_box_ori = orig_sub_box_ori
|
||||||
|
|
||||||
|
!Now transform all atoms
|
||||||
|
do i = 1, atom_num
|
||||||
|
r_atom(:,i) = matmul(sub_box_ori(:,:,sbox_atom(i)),matmul(inv_ori(:,:),r_atom(:,i)))
|
||||||
|
end do
|
||||||
|
|
||||||
|
!Now transform all elements
|
||||||
|
do i = 1, ele_num
|
||||||
|
do inod =1, ng_node(lat_ele(i))
|
||||||
|
do ibasis = 1, basisnum(lat_ele(i))
|
||||||
|
r_node(:,ibasis,inod,i) = matmul(sub_box_ori(:,:,sbox_ele(i)),matmul(inv_ori,r_node(:,ibasis,inod,i)))
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
|
||||||
|
!Restore original box boundaries
|
||||||
|
box_bd = orig_box_bd
|
||||||
|
end subroutine unorient
|
||||||
|
|
||||||
|
end module opt_orient
|
||||||
Loading…
Reference in new issue