@ -8,9 +8,9 @@ module opt_group
use box
use box
implicit none
implicit none
integer :: group_ele_num , group_atom_num , remesh_size , remesh_type
integer :: group_ele_num , group_atom_num , remesh_size , normal , remesh_type , dim1 , dim2
character ( len = 15 ) :: type , shape ! Type indicates what element type is selected and shape is the group shape
character ( len = 15 ) :: type , shape ! Type indicates what element type is selected and shape is the group shape
real ( kind = dp ) :: block_bd ( 6 ) , disp_vec( 3 ) , remesh_lat_pam
real ( kind = dp ) :: block_bd ( 6 ) , centroid( 3 ) , vertices ( 3 , 3 ) , disp_vec( 3 ) , remesh_lat_pam
logical :: displace , delete , max_remesh , refine
logical :: displace , delete , max_remesh , refine
integer , allocatable :: element_index ( : ) , atom_index ( : )
integer , allocatable :: element_index ( : ) , atom_index ( : )
@ -56,6 +56,7 @@ module opt_group
integer :: i , arglen
integer :: i , arglen
character ( len = 100 ) :: textholder
character ( len = 100 ) :: textholder
real ( kind = dp ) bwidth , wheight
! Parse type and shape command
! Parse type and shape command
arg_pos = arg_pos + 1
arg_pos = arg_pos + 1
@ -79,10 +80,56 @@ module opt_group
do i = 1 , 6
do i = 1 , 6
arg_pos = arg_pos + 1
arg_pos = arg_pos + 1
call get_command_argument ( arg_pos , textholder , arglen )
call get_command_argument ( arg_pos , textholder , arglen )
if ( arglen == 0 ) STOP "Missing block boundary in dislgen command"
if ( arglen == 0 ) STOP "Missing block boundary in group command"
call parse_pos ( int ( ( i + 1 ) / 2 ) , textholder , block_bd ( i ) )
call parse_pos ( int ( ( i + 1 ) / 2 ) , textholder , block_bd ( i ) )
end do
end do
case ( 'wedge' )
arg_pos = arg_pos + 1
call get_command_argument ( arg_pos , textholder , arglen )
if ( arglen == 0 ) STOP "Missing normal dim in group wedge command"
read ( textholder , * ) dim1
arg_pos = arg_pos + 1
call get_command_argument ( arg_pos , textholder , arglen )
if ( arglen == 0 ) STOP "Missing normal dim in group wedge command"
read ( textholder , * ) dim2
do i = 1 , 3
arg_pos = arg_pos + 1
call get_command_argument ( arg_pos , textholder , arglen )
if ( arglen == 0 ) STOP "Missing centroid in group wedge command"
call parse_pos ( i , textholder , centroid ( i ) )
end do
arg_pos = arg_pos + 1
call get_command_argument ( arg_pos , textholder , arglen )
if ( arglen == 0 ) STOP "Missing base width in group wedge command"
read ( textholder , * ) bwidth
! Calculate the vertex positions
vertices ( : , 1 ) = centroid
vertices ( dim2 , 1 ) = 0.0_dp
do i = 1 , 3
if ( i == dim1 ) then
if ( bwidth > 0 ) then
vertices ( i , 2 ) = box_bd ( 2 * i )
vertices ( i , 3 ) = box_bd ( 2 * i )
else if ( bwidth < 0 ) then
vertices ( i , 2 ) = box_bd ( 2 * i - 1 )
vertices ( i , 3 ) = box_bd ( 2 * i - 1 )
else
print * , "bwidth cannot be 0 in wedge shaped group"
stop 3
end if
else if ( i == dim2 ) then
vertices ( i , 2 ) = 0.0_dp
vertices ( i , 3 ) = 0.0_dp
else
vertices ( i , 2 ) = centroid ( i ) + bwidth
vertices ( i , 3 ) = centroid ( i ) - bwidth
end if
end do
case default
case default
print * , "Group shape " , trim ( adjustl ( shape ) ) , " is not currently accepted. Please check documentation " , &
print * , "Group shape " , trim ( adjustl ( shape ) ) , " is not currently accepted. Please check documentation " , &
"for accepted group shapes."
"for accepted group shapes."
@ -141,54 +188,55 @@ module opt_group
select case ( trim ( adjustl ( shape ) ) )
select case ( trim ( adjustl ( shape ) ) )
case ( 'block' )
case ( 'block' )
print * , "Group has block shape with boundaries: " , block_bd
print * , "Group has block shape with boundaries: " , block_bd
case ( 'crack' )
print * , "Group has crack shape with dim1" , dim1 , "and dim2" , dim2 , "and vertices " , vertices
end select
! Allocate variables to arbitrary size
! Allocate variables to arbitrary size
allocate ( element_index ( 1024 ) , atom_index ( 1024 ) )
allocate ( element_index ( 1024 ) , atom_index ( 1024 ) )
! Check the type to see whether we need to find the elements within the group
! Check the type to see whether we need to find the elements within the group
select case ( trim ( adjustl ( type ) ) )
select case ( trim ( adjustl ( type ) ) )
case ( 'elements' , 'both' )
case ( 'elements' , 'both' )
do i = 1 , ele_num
do i = 1 , ele_num
r_center ( : ) = 0.0_dp
r_center ( : ) = 0.0_dp
do inod = 1 , ng_node ( lat_ele ( i ) )
do inod = 1 , ng_node ( lat_ele ( i ) )
do ibasis = 1 , basisnum ( lat_ele ( i ) )
do ibasis = 1 , basisnum ( lat_ele ( i ) )
r_center = r_center + r_node ( : , ibasis , inod , i ) / ( basisnum ( lat_ele ( i ) ) * ng_node ( lat_ele ( i ) ) )
r_center = r_center + r_node ( : , ibasis , inod , i ) / ( basisnum ( lat_ele ( i ) ) * ng_node ( lat_ele ( i ) ) )
end do
end do
end do
end do
if ( in_block_bd ( r_center , block_bd ) ) then
if ( in_group ( r_center ) ) then
group_ele_num = group_ele_num + 1
group_ele_num = group_ele_num + 1
if ( group_ele_num > size ( element_index ) ) then
if ( group_ele_num > size ( element_index ) ) then
allocate ( resize_array ( size ( element_index ) + 1024 ) )
allocate ( resize_array ( size ( element_index ) + 1024 ) )
resize_array ( 1 : group_ele_num - 1 ) = element_index
resize_array ( 1 : group_ele_num - 1 ) = element_index
resize_array ( group_ele_num : ) = 0
resize_array ( group_ele_num : ) = 0
call move_alloc ( resize_array , element_index )
call move_alloc ( resize_array , element_index )
end if
end if
element_index ( group_ele_num ) = i
end if
end do
end select
! Check the type to see if we need to find the atoms within the group
element_index ( group_ele_num ) = i
select case ( trim ( adjustl ( type ) ) )
end if
case ( 'atoms' , 'both' )
end do
do i = 1 , atom_num
end select
if ( in_block_bd ( r_atom ( : , i ) , block_bd ) ) then
group_atom_num = group_atom_num + 1
if ( group_atom_num > size ( atom_index ) ) then
allocate ( resize_array ( size ( atom_index ) + 1024 ) )
resize_array ( 1 : group_atom_num - 1 ) = atom_index
resize_array ( group_atom_num : ) = 0
call move_alloc ( resize_array , atom_index )
end if
atom_index ( group_atom_num ) = i
! Check the type to see if we need to find the atoms within the group
select case ( trim ( adjustl ( type ) ) )
case ( 'atoms' , 'both' )
do i = 1 , atom_num
if ( in_group ( r_atom ( : , i ) ) ) then
group_atom_num = group_atom_num + 1
if ( group_atom_num > size ( atom_index ) ) then
allocate ( resize_array ( size ( atom_index ) + 1024 ) )
resize_array ( 1 : group_atom_num - 1 ) = atom_index
resize_array ( group_atom_num : ) = 0
call move_alloc ( resize_array , atom_index )
end if
end if
end do
end select
atom_index ( group_atom_num ) = i
end select
end if
end do
end select
print * , 'Group contains ' , group_ele_num , " elements and " , group_atom_num , " atoms."
print * , 'Group contains ' , group_ele_num , " elements and " , group_atom_num , " atoms."
end subroutine get_group
end subroutine get_group
@ -440,4 +488,16 @@ module opt_group
call delete_elements ( group_ele_num , element_index )
call delete_elements ( group_ele_num , element_index )
end subroutine delete_group
end subroutine delete_group
end module opt_group
function in_group ( r )
! This subroutine determines if a point is within the group boundaries
real ( kind = dp ) , intent ( in ) :: r ( 3 )
logical :: in_group
select case ( trim ( adjustl ( shape ) ) )
case ( 'block' )
in_group = in_block_bd ( r , block_bd )
case ( 'wedge' )
in_group = in_wedge_bd ( r , vertices )
end select
end function in_group
end module opt_group