You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
350 lines
13 KiB
350 lines
13 KiB
module mode_merge
|
|
!This module contains the code needed for merging several .mb files together
|
|
|
|
use parameters
|
|
use atoms
|
|
use io
|
|
use subroutines
|
|
use elements
|
|
use neighbors
|
|
|
|
implicit none
|
|
|
|
character(len=4) :: dim
|
|
integer :: in_num, new_starts(2)
|
|
real(kind=dp) :: shift_vec(3), replace_vec(3)
|
|
character(len=100) :: replace_str(3)
|
|
logical :: shift_flag, replace_flag
|
|
real(kind=dp), private, save :: rc_off
|
|
|
|
public
|
|
contains
|
|
subroutine merge(arg_pos)
|
|
|
|
integer, intent(out) :: arg_pos
|
|
integer :: i, j
|
|
real(kind=dp) :: displace(3), temp_box_bd(6)
|
|
|
|
print *, '-----------------------Mode Merge---------------------------'
|
|
|
|
shift_flag = .false.
|
|
|
|
shift_vec(:) = 0.0_dp
|
|
temp_box_bd(:) = 0.0_dp
|
|
!First we parse the merge command
|
|
call parse_command(arg_pos)
|
|
|
|
!Now loop over all files and stack them
|
|
do i = 1, in_num
|
|
displace(:) = 0.0_dp
|
|
|
|
!The new starts variable dictate where in the atom and element array each new
|
|
!file starts. This is used for additional options that can be applied to solely
|
|
!these new atoms/elements that are read in.
|
|
|
|
new_starts(1) = atom_num + 1
|
|
new_starts(2) = ele_num + 1
|
|
|
|
if ((i==1).or.(trim(adjustl(dim)) == 'none')) then
|
|
call read_in(i, displace, temp_box_bd)
|
|
else
|
|
select case(trim(adjustl(dim)))
|
|
case('x')
|
|
displace(1) = box_bd(2)
|
|
case('y')
|
|
displace(2) = box_bd(4)
|
|
case('z')
|
|
displace(3) = box_bd(6)
|
|
end select
|
|
|
|
call read_in(i, displace, temp_box_bd)
|
|
end if
|
|
|
|
|
|
if(shift_flag) call shift(new_starts, i)
|
|
|
|
if(replace_flag.and.(i>1)) then
|
|
!Parse the replace vector
|
|
do j = 1, 3
|
|
call parse_pos(j, replace_str(j), replace_vec(j))
|
|
end do
|
|
call replace(new_starts, temp_box_bd)
|
|
end if
|
|
|
|
end do
|
|
|
|
|
|
!Now reset tags
|
|
do i = 1, atom_num
|
|
tag_atom(i) = i
|
|
end do
|
|
|
|
do i = 1, ele_num
|
|
tag_ele(i) = i
|
|
end do
|
|
|
|
return
|
|
end subroutine merge
|
|
|
|
subroutine parse_command(arg_pos)
|
|
|
|
integer, intent(out) :: arg_pos
|
|
|
|
character(len=100) :: textholder
|
|
integer :: i, stat, arglen
|
|
|
|
!Get dimension to concatenate along
|
|
call get_command_argument(2, dim, arglen)
|
|
if (arglen == 0) STOP "Missing dim in mode_merge command"
|
|
select case(trim(adjustl(dim)))
|
|
case('x','y','z','none')
|
|
continue
|
|
case default
|
|
print *, dim, " not accepted as a dimension in mode_merge"
|
|
stop 3
|
|
end select
|
|
!Get number of files to read in
|
|
call get_command_argument(3, textholder, arglen)
|
|
if (arglen == 0) STOP "Number of files to read missing in mode_merge command"
|
|
read(textholder, *, iostat = stat) in_num
|
|
if (stat > 0) STOP "Error reading number of files in, must be integer"
|
|
|
|
!Now loop and pull out all files
|
|
do i = 1, in_num
|
|
call get_command_argument(3+i, textholder, arglen)
|
|
if (arglen == 0) STOP "Fewer files to read in then specified"
|
|
!Make sure this file is readable
|
|
call get_in_file(textholder)
|
|
end do
|
|
|
|
!Set argpos accordingly
|
|
arg_pos = 3+in_num
|
|
!Now options loop
|
|
!Check for optional keywords
|
|
do while(.true.)
|
|
if(arg_pos > command_argument_count()) exit
|
|
!Pull out the next argument which should either be a keyword or an option
|
|
arg_pos=arg_pos+1
|
|
call get_command_argument(arg_pos, textholder)
|
|
textholder=adjustl(textholder)
|
|
|
|
!Choose what to based on what the option string is
|
|
select case(trim(textholder))
|
|
case('shift')
|
|
shift_flag = .true.
|
|
do i = 1,3
|
|
arg_pos = arg_pos + 1
|
|
call get_command_argument(arg_pos, textholder, arglen)
|
|
if (arglen==0) stop "Missing vector component for shift command"
|
|
read(textholder, *) shift_vec(i)
|
|
end do
|
|
case('replace')
|
|
replace_flag = .true.
|
|
do i = 1,3
|
|
arg_pos = arg_pos + 1
|
|
call get_command_argument(arg_pos, replace_str(i), arglen)
|
|
if (arglen==0) stop "Missing vector component for shift command"
|
|
end do
|
|
arg_pos = arg_pos+1
|
|
call get_command_argument(arg_pos, textholder, arglen)
|
|
read(textholder,*) rc_off
|
|
|
|
case default
|
|
!If it isn't an available option to mode merge then we just exit
|
|
exit
|
|
end select
|
|
end do
|
|
|
|
end subroutine parse_command
|
|
|
|
subroutine shift(array_start, filenum)
|
|
!This subroutine applies a shift to newly added atoms and elements.
|
|
|
|
integer, dimension(2), intent(in) :: array_start
|
|
integer, intent(in) :: filenum
|
|
|
|
integer :: i, ibasis, inod
|
|
real(kind=dp), dimension(3) :: current_shift
|
|
character(len=3) :: alldims
|
|
|
|
alldims = 'xyz'
|
|
!Calculate the current shift which is the filenum-1 multiplied by the user specified shift
|
|
current_shift = (filenum-1)*shift_vec
|
|
|
|
print *, "Atoms/elements from file ", trim(adjustl(infiles(filenum))), " are shifted by ", current_shift
|
|
|
|
!First shift all the atoms
|
|
do i = array_start(1), atom_num
|
|
r_atom(:,i) = r_atom(:,i) + current_shift
|
|
end do
|
|
|
|
!Now shift all the elements
|
|
do i = array_start(2), ele_num
|
|
do inod = 1, ng_node(lat_ele(i))
|
|
do ibasis = 1, basisnum(lat_ele(i))
|
|
r_node(:,ibasis, inod, i) = r_node(:,ibasis, inod, i) + current_shift
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
!If we don't include the wrap command then we have to increase the size of the box
|
|
if(.not.(wrap_flag)) then
|
|
do i = 1,3
|
|
if (alldims(i:i) /= trim(adjustl(dim))) then
|
|
if (current_shift(i) < -lim_zero) then
|
|
box_bd(2*i-1) = box_bd(2*i-1) - current_shift(i)
|
|
else if (current_shift(i) > lim_zero) then
|
|
box_bd(2*i) = box_bd(2*i) + current_shift(i)
|
|
end if
|
|
else if (alldims(i:i) == trim(adjustl(dim))) then
|
|
box_bd(2*i) = box_bd(2*i) + current_shift(i)
|
|
end if
|
|
end do
|
|
end if
|
|
|
|
end subroutine shift
|
|
|
|
subroutine replace(array_start, rbox_bd)
|
|
integer, intent(in) :: array_start(2)
|
|
real(kind = dp), intent(in) :: rbox_bd(6)
|
|
|
|
integer :: ibasis, inod, del_num, del_index(atom_num), nump_ele, interp_start
|
|
integer :: j, ie, type_interp(max_basisnum*max_esize**3), add_atom_num, orig_atom_num, m, n, o, esize, &
|
|
ele(3,8), new_ele_num, vlat(3), added_points
|
|
real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), rfill(3,max_basisnum,max_ng_node), ravg(3), ratom(3,max_basisnum)
|
|
logical :: in_bd, lat_points(max_esize, max_esize, max_esize)
|
|
real(kind=dp) :: del_bd(6)
|
|
integer :: i, c(3), ci, cj, ck, num_nei, nei, delete_num
|
|
|
|
!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(:,:,:,:)
|
|
|
|
!First apply the replace vec to all new nodes and elements
|
|
do i = array_start(1), atom_num
|
|
r_atom(:,i) = r_atom(:, i) + replace_vec
|
|
end do
|
|
|
|
do i = array_start(2), ele_num
|
|
do inod = 1, ng_node(lat_ele(i))
|
|
do ibasis=1, basisnum(lat_ele(i))
|
|
r_node(:, ibasis,inod, i) = r_node(:, ibasis,inod, i) + replace_vec
|
|
end do
|
|
end do
|
|
|
|
end do
|
|
|
|
!Calculate new boundary
|
|
do i = 1, 6
|
|
del_bd(i) = rbox_bd(i) + replace_vec((i-1)/2 + 1)
|
|
end do
|
|
|
|
del_num = 0
|
|
del_index=0
|
|
interp_start = atom_num +1
|
|
!Now loop over all old elements,
|
|
do ie = 1, array_start(2)-1
|
|
!If any element points are within the boundary then we run the refine code
|
|
if(ele_in_bounds(del_bd, type_ele(ie), size_ele(ie), lat_ele(ie), r_node(:,:,:,ie))) then
|
|
added_points=0
|
|
del_num = del_num + 1
|
|
del_index(del_num) = ie
|
|
|
|
!Find all possible elements that we can make while making sure they aren't in the group
|
|
lat_points(1:size_ele(ie),1:size_ele(ie),1:size_ele(ie)) = .true.
|
|
|
|
!Now add the leftover lattice points as atoms, only if they aren't within the new boundaries
|
|
do o = 1, size_ele(ie)
|
|
do n = 1, size_ele(ie)
|
|
do m = 1, size_ele(ie)
|
|
if(lat_points(m,n,o)) then
|
|
call get_interp_pos(m,n,o, ie, ratom(:,:))
|
|
do ibasis = 1, basisnum(lat_ele(ie))
|
|
call apply_periodic(ratom(:,ibasis))
|
|
added_points=added_points + 1
|
|
call add_atom(0, basis_type(ibasis,lat_ele(ie)), sbox_ele(ie), ratom(:,ibasis))
|
|
end do
|
|
end if
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
if (added_points /= (size_ele(ie)**3)) then
|
|
print *, "Element ", ie, " is refined incorrectly in refinefill"
|
|
end if
|
|
end if
|
|
end do
|
|
|
|
!Once all atoms are added we delete all of the elements
|
|
call delete_elements(del_num, del_index)
|
|
|
|
!Now delete overlapping atoms
|
|
allocate(which_cell(3,atom_num))
|
|
|
|
!First pass the atom list and atom num to the algorithm which builds the cell list
|
|
print *, rc_off
|
|
call build_cell_list(atom_num, r_atom, 4*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
|
|
del_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
|
|
|
|
del_num = del_num + 1
|
|
|
|
!Make sure to delete the older value
|
|
if( (i < array_start(1)).or.(i > interp_start)) then
|
|
del_index(del_num) = i
|
|
which_cell(:,i) = 0
|
|
cycle atom_loop
|
|
else
|
|
del_index(del_num) = nei
|
|
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 *, "Replace command deletes ", del_num, " atoms"
|
|
!Now delete all the atoms
|
|
call delete_atoms(del_num, del_index(1:del_num))
|
|
|
|
|
|
return
|
|
end subroutine replace
|
|
|
|
end module mode_merge
|