aselimov
4 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