parent
d2aeb5a7f6
commit
b684e0754b
@ -0,0 +1,171 @@
|
||||
module mode_da
|
||||
!This mode is used to calculate the dislocation analysis algorithm for both CG and atomistic regions
|
||||
|
||||
use parameters
|
||||
use io
|
||||
use elements
|
||||
use neighbors
|
||||
|
||||
implicit none
|
||||
|
||||
integer, allocatable :: is_slipped(:,:,:)
|
||||
|
||||
private :: write_xyz
|
||||
public
|
||||
contains
|
||||
|
||||
subroutine da(arg_pos)
|
||||
!This is the main calling subroutine for the dislocation analysis code
|
||||
integer, intent(out) :: arg_pos
|
||||
real(kind=dp), dimension(6) :: temp_box_bd
|
||||
|
||||
integer :: ppos
|
||||
character(len=100) :: outfile
|
||||
|
||||
!Now call the dislocation analysis code for the coarse-grained elements
|
||||
call parse_command(arg_pos)
|
||||
|
||||
call read_in(1, (/0.0_dp,0.0_dp,0.0_dp/), temp_box_bd)
|
||||
|
||||
!Now allocate the necessary variables
|
||||
if(allocated(is_slipped)) deallocate(is_slipped)
|
||||
allocate(is_slipped(max_basisnum, max_ng_node, ele_num))
|
||||
|
||||
call cga_da
|
||||
|
||||
!Now create the output file num and write out to xyz format
|
||||
ppos = scan(trim(infiles(1)),".", BACK= .true.)
|
||||
if ( ppos > 0 ) then
|
||||
outfile = 'da_'//infiles(1)(1:ppos)//'xyz'
|
||||
else
|
||||
outfile = 'da_'//infiles(1)//'.xyz'
|
||||
end if
|
||||
|
||||
call write_da_xyz(outfile)
|
||||
|
||||
return
|
||||
end subroutine da
|
||||
|
||||
|
||||
subroutine parse_command(arg_pos)
|
||||
!This subroutine parses the arguments for mode command
|
||||
integer, intent(out) :: arg_pos
|
||||
integer :: i, arglen
|
||||
character(len = 100) :: textholder
|
||||
logical :: file_exists
|
||||
|
||||
!Read the input file
|
||||
call get_command_argument(2,textholder, arglen)
|
||||
if (arglen == 0) stop "Missing file for dislocation analysis"
|
||||
call get_in_file(textholder)
|
||||
|
||||
arg_pos = 3
|
||||
return
|
||||
end subroutine parse_command
|
||||
|
||||
subroutine cga_da
|
||||
|
||||
integer :: i, j, k, l, ibasis, nei
|
||||
|
||||
integer :: face_types(ele_num*6), face_ele(6*ele_num)
|
||||
real(kind = dp) :: face_centroids(3, ele_num*6), r(3), rc, vnode(3, max_basisnum, 4), vnorm(max_basisnum, 4)
|
||||
|
||||
!Initialize variables
|
||||
l = 0
|
||||
|
||||
!First calculate all of the face centroids
|
||||
do i = 1, ele_num
|
||||
do j = 1, 6
|
||||
r(:) = 0.0_dp
|
||||
do k = 1, 4
|
||||
do ibasis = 1, basisnum(lat_ele(i))
|
||||
r = r + r_node(:, ibasis, cubic_faces(k,j), i)
|
||||
end do
|
||||
end do
|
||||
|
||||
r = r/(basisnum(lat_ele(i))*4)
|
||||
|
||||
!add the face centroids, the type, and map the elements faces to the face arrays
|
||||
l = l + 1
|
||||
face_centroids(:, l) = r
|
||||
face_types(l) = j
|
||||
face_ele(l) = i
|
||||
end do
|
||||
end do
|
||||
|
||||
!Now calculate the nearest faces
|
||||
rc = max_esize*maxval(lapa)
|
||||
call calc_NN(l, face_centroids(:,1:l), rc)
|
||||
|
||||
!Now loop overall the faces and make sure the nearest neighbor is the opposite type. If it isn't than we dscard it
|
||||
is_slipped = 0
|
||||
do i = 1, l
|
||||
nei = nn(i)
|
||||
|
||||
!Skip if it's 0
|
||||
if (nei == 0) cycle
|
||||
|
||||
!Check the face types, the way that the faces are laid out in the cubic_faces array face 1's opposite is 6 and
|
||||
! face 2's opposite is 5 and etc
|
||||
vnode = 0
|
||||
if(face_types(i) == (7-face_types(nei))) then
|
||||
vnorm = 0
|
||||
do j = 1, 4
|
||||
do ibasis = 1, basisnum(lat_ele(face_ele(i)))
|
||||
!Compute the vectors between all nodes at the face.
|
||||
vnode(:,ibasis,j) = r_node(:,ibasis, cubic_faces(j,face_types(i)), face_ele(i)) - &
|
||||
r_node(:,ibasis, cubic_faces(j,face_types(nei)), face_ele(nei))
|
||||
end do
|
||||
end do
|
||||
|
||||
do j = 1, 3
|
||||
vnode(j,1:basisnum(lat_ele(face_ele(i))),:) = vnode(j,1:basisnum(lat_ele(face_ele(i))),:) - &
|
||||
minval(vnode(j,1:basisnum(lat_ele(face_ele(i))),:))
|
||||
end do
|
||||
do j = 1, 4
|
||||
do ibasis = 1, basisnum(lat_ele(face_ele(i)))
|
||||
vnorm = norm2(vnode(:, ibasis, j))
|
||||
end do
|
||||
end do
|
||||
!Now calculate the difference between the largest norm and the smallest norm, if it's larger than 0.5 then mark it
|
||||
!as slipped. This value probably can be converted to a variable value that depends on the current lattice parameter
|
||||
!I think 0.5 works ok though.
|
||||
if (any(vnorm > 0.5_dp)) then
|
||||
do j = 1, 4
|
||||
is_slipped(:, cubic_faces(j,face_types(i)), face_ele(i)) = 1
|
||||
end do
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
|
||||
end subroutine cga_da
|
||||
|
||||
subroutine write_da_xyz(outfile)
|
||||
!This subroutine write the element positions to a .xyz file and marks whether they are slipped or not
|
||||
character(len=*), intent(in) :: outfile
|
||||
integer :: i, ibasis, inod, outn
|
||||
|
||||
open(unit=11, file=outfile, action='write', status='replace', position='rewind')
|
||||
|
||||
!Write number of node_atoms
|
||||
write(11, '(i16)') node_atoms
|
||||
!Write comment
|
||||
write(11, '(a)') "is_slipped x y z"
|
||||
!Write nodal positions
|
||||
outn = 0
|
||||
do i = 1, ele_num
|
||||
do inod = 1, ng_node(lat_ele(i))
|
||||
do ibasis = 1, basisnum(lat_ele(i))
|
||||
write(11, '(1i16, 3f23.15)') is_slipped(ibasis,inod,i), r_node(:,ibasis,inod,i)
|
||||
outn = outn + 1
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
if(outn /= node_atoms) then
|
||||
print *, "outn", outn, " doesn't equal node_atoms ", node_atoms
|
||||
end if
|
||||
|
||||
close(11)
|
||||
end subroutine write_da_xyz
|
||||
end module
|
Loading…
Reference in new issue