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.
132 lines
4.5 KiB
132 lines
4.5 KiB
module opt_redef_box
|
|
|
|
use box
|
|
use elements
|
|
use subroutines
|
|
implicit none
|
|
|
|
character(len=3) :: redef_dim, new_bc
|
|
real(kind=dp) :: new_bd(6)
|
|
public
|
|
contains
|
|
|
|
subroutine redef_box(arg_pos)
|
|
!This is the main calling function for opt_redef_box
|
|
integer, intent(inout) :: arg_pos
|
|
integer :: i, inod, ibasis, iatom, delete_list(atom_num), delete_num, type_interp(max_basisnum*max_esize**3)
|
|
real(kind=dp):: r_interp(3, max_basisnum*max_esize**3)
|
|
logical :: node_out(8)
|
|
|
|
!First parse the argument
|
|
call parse_redef_box(arg_pos)
|
|
|
|
print *, '------------------------------------------------------------'
|
|
print *, 'Option redef_box'
|
|
print *, '------------------------------------------------------------'
|
|
|
|
!Now first filter atoms that don't fit in the new box bounds and delete them
|
|
delete_num = 0
|
|
do i = 1, atom_num
|
|
if(.not.in_block_bd(r_atom(:,i),new_bd)) then
|
|
delete_num = delete_num + 1
|
|
delete_list(delete_num) = i
|
|
end if
|
|
end do
|
|
call delete_atoms(delete_num, delete_list(1:delete_num))
|
|
|
|
!Now loop over all elements
|
|
delete_num = 0
|
|
delete_list(:) = 0
|
|
do i = 1, ele_num
|
|
!Determine if all nodes are within the new boundaries
|
|
node_out(:) = .false.
|
|
do inod = 1, ng_node(lat_ele(i))
|
|
do ibasis = 1, basisnum(lat_ele(i))
|
|
if(.not.in_block_bd(r_node(:,ibasis,inod,i), new_bd)) then
|
|
node_out(inod) = .true.
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
!If all nodes are out just add the element to the delete list
|
|
if(all(node_out)) then
|
|
delete_num = delete_num +1
|
|
delete_list(delete_num) = i
|
|
|
|
!If any nodes are out we add the element to the delete list, but then loop over the interpoalted atoms to figure out
|
|
!which ones fit inside the boundary to keep the box rectangular
|
|
else if (any(node_out)) then
|
|
delete_num = delete_num +1
|
|
delete_list(delete_num) = i
|
|
|
|
call interpolate_atoms(type_ele(i), size_ele(i), lat_ele(i), r_node(:,:,:,i), type_interp, r_interp)
|
|
|
|
!loop over all interpolated atoms and add them to the system
|
|
do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3
|
|
if(in_block_bd(r_interp(:,iatom), new_bd)) then
|
|
call add_atom(0,type_interp(iatom), sbox_ele(i), r_interp(:,iatom))
|
|
end if
|
|
end do
|
|
end if
|
|
end do
|
|
|
|
call delete_elements(delete_num, delete_list(1:delete_num))
|
|
|
|
print *, "Old box_bd: ", box_bd, " is redefined to new box boundaries: ", new_bd
|
|
box_bd=new_bd
|
|
box_bc = new_bc
|
|
|
|
end subroutine redef_box
|
|
|
|
subroutine parse_redef_box(arg_pos)
|
|
!Parse the command
|
|
integer, intent(inout) :: arg_pos
|
|
|
|
integer :: i, j, arglen
|
|
character(len=100) textholder
|
|
|
|
|
|
!First read in the dimensions that we are redefining
|
|
redef_dim = ''
|
|
arg_pos=arg_pos+1
|
|
call get_command_argument(arg_pos, redef_dim, arglen)
|
|
select case(trim(adjustl(redef_dim)))
|
|
case('x','y','z','xy','yx','xz','zx','yz','zy','xyz','yxz','xzy','zyx','zxy','yzx')
|
|
continue
|
|
case default
|
|
print *, "Incorrect redef_dim ", redef_dim, "please select any permuation of x, y, z, xy, yz, xz, xyz"
|
|
stop 3
|
|
end select
|
|
|
|
!Now read in the new dimensions
|
|
new_bd = box_bd
|
|
new_bc = box_bc
|
|
do i = 1, 3
|
|
select case(trim(adjustl(redef_dim(i:i))))
|
|
case('x')
|
|
j = 1
|
|
case('y')
|
|
j = 2
|
|
case('z')
|
|
j = 3
|
|
case default
|
|
exit
|
|
end select
|
|
|
|
arg_pos=arg_pos +1
|
|
call get_command_argument(arg_pos, textholder, arglen)
|
|
if(arglen == 0) stop "Missing a box dimension in opt_redef_box"
|
|
call parse_pos(j, textholder,new_bd(2*j-1))
|
|
|
|
arg_pos=arg_pos +1
|
|
call get_command_argument(arg_pos, textholder, arglen)
|
|
if(arglen == 0) stop "Missing a box dimension in opt_redef_box"
|
|
call parse_pos(j, textholder,new_bd(2*j))
|
|
new_bc(j:j) = 's'
|
|
end do
|
|
|
|
arg_pos = arg_pos + 1
|
|
end subroutine parse_redef_box
|
|
|
|
end module opt_redef_box
|