aselimov/cacmb
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Working code which picks random position slightly outside element bounds

Browse source
This commit is contained in:
Alex Selimov 2020-03-02 12:24:22 -05:00
parent b847cca4ab
commit 27faeee5ea
5 changed files with 154 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

136
src/elements.f90
View file

@ -64,11 +64,11 @@ module elements
shape(fcc_cell))
!Now we create a list containing the list of vertices needed to describe the 6 cube faces
cubic_faces(:,1) = (/ 1, 4, 8, 5 /)
cubic_faces(:,2) = (/ 2, 3, 7, 6 /)
cubic_faces(:,3) = (/ 1, 2, 6, 5 /)
cubic_faces(:,1) = (/ 1, 2, 3, 4 /)
cubic_faces(:,2) = (/ 1, 2, 6, 5 /)
cubic_faces(:,3) = (/ 2, 3, 7, 6 /)
cubic_faces(:,4) = (/ 3, 4, 8, 7 /)
cubic_faces(:,5) = (/ 1, 2, 3, 4 /)
cubic_faces(:,5) = (/ 1, 4, 8, 5 /)
cubic_faces(:,6) = (/ 5, 6, 7, 8 /)
!!Now initialize the fcc primitive cell
@ -491,4 +491,132 @@ module elements
end do
end subroutine
recursive subroutine parse_pos(i, pos_string, pos)
!This subroutine parses the pos command allowing for command which include inf
integer, intent(in) :: i !The dimension of the position
character(len=100), intent(in) :: pos_string !The position string
real(kind=dp), intent(out) :: pos !The output parsed position value
integer :: iospara, face, ele
real(kind=dp) :: rand, rone, rtwo, rand_ele_pos(3)
character(len=100) :: cone, ctwo
iospara = 0
if(trim(adjustl(pos_string)) == 'inf') then
pos=box_bd(2*i)
else if(trim(adjustl(pos_string)) == '-inf') then
pos=box_bd(2*i-1)
else if (trim(adjustl(pos_string)) == 'rand') then
call random_number(rand)
pos = (box_bd(2*i)-box_bd(2*i-1))*rand + box_bd(2*i-1)
else if (index(pos_string,'rande')>0) then
!First select a random element
call random_number(rand)
ele= 1 + floor(ele_num*rand)
!Now read the rest of the command which specifies the face we need and check
!to make sure it's an accepted face number
cone = pos_string(index(pos_string, '[')+1:index(pos_string, '[')+1)
read(cone, *) face
if ((face < 1).or.(face > 6)) stop "Current face number must be 1,2,3,4,5,6. Please check documentation"
!Now get the position
call offset_pos(ele, face, rand_ele_pos)
pos = rand_ele_pos(i)
else if (index(pos_string,'rand')>0) then
call random_number(rand)
cone = pos_string(index(pos_string, '[')+1:index(pos_string,':')-1)
call parse_pos(i, cone, rone)
ctwo = pos_string(index(pos_string, ':')+1:index(pos_string,']')-1)
call parse_pos(i, ctwo, rtwo)
pos = (rtwo - rone)*rand + rone
else if ((index(pos_string,'-') > 0).and.(index(pos_string,'inf')>0)) then
!Now extract the number we are reducing from infinity
if(index(pos_string,'inf') < index(pos_string,'-')) then
read(pos_string(index(pos_string,'-')+1:), *, iostat=iospara) pos
else
read(pos_string(1:index(pos_string,'-')-1), *, iostat=iospara) pos
end if
pos = box_bd(2*i) - pos
else if ((index(pos_string,'+') > 0).and.(index(pos_string,'inf')>0)) then
!Now extract the number we are reducing from infinity
if(index(pos_string,'inf') < index(pos_string,'+')) then
read(pos_string(index(pos_string,'+')+1:), *, iostat=iospara) pos
else
read(pos_string(1:index(pos_string,'+')-1), *, iostat=iospara) pos
end if
pos = box_bd(2*i-1) + pos
else if ((index(pos_string,'*') > 0).and.(index(pos_string,'inf')>0)) then
!Now extract the number we are reducing from infinity
if(index(pos_string,'inf') < index(pos_string,'*')) then
read(pos_string(index(pos_string,'*')+1:), *, iostat=iospara) pos
else
read(pos_string(1:index(pos_string,'*')-1), *, iostat=iospara) pos
end if
pos = (box_bd(2*i)-box_bd(2*i-1))*pos + box_bd(2*i-1)
else
read(pos_string, *, iostat=iospara) pos
end if
if (iospara > 0) then
print *, "Error reading position argument ", trim(adjustl(pos_string)), ". Please reformat and try again."
end if
end subroutine parse_pos
subroutine offset_pos(ie, iface, pos)
!This returns a position slightly offset from the center of an element face
!This is used to return a random position within an element discontinuity
integer, intent(in) :: ie !Element index
integer, intent(in) :: iface !Face number between 1 and 6
real(kind=dp), dimension(3), intent(out) :: pos !Position vector
!Other variables we need
integer :: esize
real(kind=dp) :: orient(3,3), ori_inv(3,3), lp, r_cubic_node(3,8)
!First find the offset vector for the face in the untransformed cubic cell
esize = size_ele(ie)
select case(iface)
case(1)
pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, -10.0_dp**-2.0_dp /)
case(2)
pos = (/ real(esize-1,dp)/2.0_dp, -10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp /)
case(3)
pos = (/ (esize-1)+10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /)
case(4)
pos = (/ real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp /)
case(5)
pos = (/ -10.0_dp**-2.0_dp, real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp /)
case(6)
pos = (/ real(esize-1,dp)/2.0_dp, real(esize-1,dp)/2.0_dp, (esize-1)+10.0_dp**-2.0_dp /)
end select
!Now transform it to real space and adjust it to the position of the element in the first node.
select case (trim(adjustl(type_ele(ie))))
case('fcc')
!First we have to extract the element lattice parameter
call matrix_inverse(sub_box_ori(:,:,sbox_ele(ie)),3,ori_inv)
r_cubic_node = r_node(:,1,:,ie)
r_cubic_node = matmul(fcc_inv,matmul(ori_inv,r_cubic_node))
lp = (maxval(r_cubic_node(1,:))-minval(r_cubic_node(1,:)))/(esize-1)
pos = matmul(sub_box_ori(:,:,sbox_ele(ie)),matmul(fcc_mat,pos))*lp
pos = pos + r_node(:,1, 1, ie)
case default
print *, trim(adjustl(type_ele(ie))), " is not a currently accepted element type for random element positions"
stop 3
end select
end subroutine
end module elements