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

Merge branch 'ft--option-slip-plane' into development

Browse source
This commit is contained in:
Alex Selimov 2020-10-28 17:53:28 -04:00
commit 0929400d19
6 changed files with 236 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

61
src/elements.f90
View file

@ -201,38 +201,39 @@ module elements
!First check to make sure if it is allocated
if (allocated(size_ele)) then
!Figure out the size of the atom and element arrays
ele_size = size(size_ele)
!Check if we need to grow the ele_size, if so grow all the variables
if ( n+ele_num > size(size_ele)) then
allocate(temp_int(n+ele_num+buffer_size))
temp_int(1:ele_size) = lat_ele
allocate(temp_int(n+ele_size+buffer_size))
temp_int(1:ele_size) = lat_ele(1:ele_size)
temp_int(ele_size+1:) = 0
call move_alloc(temp_int, lat_ele)
allocate(temp_int(n+ele_num+buffer_size))
temp_int(1:ele_size) = tag_ele
allocate(temp_int(n+ele_size+buffer_size))
temp_int(1:ele_size) = tag_ele(1:ele_size)
temp_int(ele_size+1:) = 0
call move_alloc(temp_int, tag_ele)
allocate(temp_int(n+ele_num+buffer_size))
temp_int(1:ele_size) = size_ele
allocate(temp_int(n+ele_size+buffer_size))
temp_int(1:ele_size) = size_ele(1:ele_size)
temp_int(ele_size+1:) = 0
call move_alloc(temp_int, size_ele)
allocate(temp_int(n+ele_num+buffer_size))
temp_int(1:ele_size) = lat_ele
allocate(temp_int(n+ele_size+buffer_size))
temp_int(1:ele_size) = sbox_ele(1:ele_size)
temp_int(ele_size+1:) = 0
call move_alloc(temp_int, sbox_ele)
allocate(char_temp(n+ele_num+buffer_size))
char_temp(1:ele_size) = type_ele
allocate(char_temp(n+ele_size+buffer_size))
char_temp(1:ele_size) = type_ele(1:ele_size)
call move_alloc(char_temp, type_ele)
allocate(temp_ele_real(3, max_basisnum, max_ng_node, n+ele_num+buffer_size))
temp_ele_real(:,:,:,1:ele_size) = r_node
allocate(temp_ele_real(3, max_basisnum, max_ng_node, n+ele_size+buffer_size))
temp_ele_real(:,:,:,1:ele_size) = r_node(:,:,:,1:ele_size)
temp_ele_real(:,:,:,ele_size+1:) = 0.0_dp
call move_alloc(temp_ele_real, r_node)
end if
@ -244,22 +245,22 @@ module elements
if (allocated(type_atom)) then
atom_size = size(type_atom)
if (m+atom_num > atom_size) then
allocate(temp_int(m+atom_num+buffer_size))
allocate(temp_int(m+atom_size+buffer_size))
temp_int(1:atom_size) = type_atom
temp_int(atom_size+1:) = 0
call move_alloc(temp_int, type_atom)
allocate(temp_int(m+atom_num+buffer_size))
allocate(temp_int(m+atom_size+buffer_size))
temp_int(1:atom_size) = tag_atom
temp_int(atom_size+1:) = 0
call move_alloc(temp_int, tag_atom)
allocate(temp_int(m+atom_num+buffer_size))
allocate(temp_int(m+atom_size+buffer_size))
temp_int(1:atom_size) = sbox_atom
temp_int(atom_size+1:) = 0
call move_alloc(temp_int, sbox_atom)
allocate(temp_real(3,m+atom_num+buffer_size))
allocate(temp_real(3,m+atom_size+buffer_size))
temp_real(:,1:atom_size) = r_atom
temp_real(:, atom_size+1:) = 0.0_dp
call move_alloc(temp_real, r_atom)
@ -278,6 +279,7 @@ module elements
integer :: newtag
ele_num = ele_num + 1
node_num = node_num + ng_node(lat)
if (tag==0) then
newtag = ele_num !If we don't assign a tag then pass the tag as the ele_num
@ -292,8 +294,7 @@ module elements
size_ele(ele_num) = size
lat_ele(ele_num) = lat
sbox_ele(ele_num) = sbox
r_node(:,:,:,ele_num) = r(:,:,:)
node_num = node_num + ng_node(lat)
r_node(:,:,:,ele_num) = r(:,:,:)
end subroutine add_element
@ -750,4 +751,28 @@ module elements
end subroutine lattice_map
subroutine get_interp_pos(i,j,k, ie, rout)
!This returns the position of an interpolated basis from an element ie.
!i, j, k should be in natural coordinates
integer, intent(in) :: i, j, k
real(kind=dp), dimension(3,max_basisnum), intent(out) :: rout
integer :: ie, ibasis, inod
real(kind=dp) :: a_shape(8), r, s, t
r = (1.0_dp*(i-1)-(size_ele(ie)-1)/2)/(1.0_dp*(size_ele(ie)-1)/2)
s = (1.0_dp*(j-1)-(size_ele(ie)-1)/2)/(1.0_dp*(size_ele(ie)-1)/2)
t = (1.0_dp*(k-1)-(size_ele(ie)-1)/2)/(1.0_dp*(size_ele(ie)-1)/2)
rout(:,:) = 0
do ibasis = 1, basisnum(lat_ele(ie))
do inod = 1, ng_node(lat_ele(ie))
call rhombshape(r,s,t,a_shape)
rout(:,ibasis) = rout(:,ibasis) + a_shape(inod) * r_node(:,ibasis,inod,ie)
end do
end do
end subroutine
end module elements