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

Added orient and unorient options

Browse source
This commit is contained in:
Alex Selimov 2020-02-03 17:30:41 -05:00
parent 58ad74ca9a
commit 44efb4be4a
6 changed files with 77 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

48
src/elements.f90
View file

@ -5,6 +5,7 @@ module elements
use parameters
use functions
use subroutines
use box
implicit none
!Data structures used to represent the CAC elements. Each index represents an element
@ -17,6 +18,7 @@ module elements
!Data structure used to represent atoms
integer, allocatable :: type_atom(:)!atom type
integer, allocatable :: sbox_atom(:)
real(kind =dp),allocatable :: r_atom(:,:) !atom position
integer :: atom_num=0 !Number of atoms
@ -153,7 +155,7 @@ module elements
if(m > 0) then
!Allocate atom arrays
allocate(type_atom(m), r_atom(3,m), stat=allostat)
allocate(type_atom(m), sbox_atom(m), r_atom(3,m), stat=allostat)
if(allostat > 0) then
print *, "Error allocating atom arrays in elements.f90 because of: ", allostat
stop
@ -211,6 +213,11 @@ module elements
temp_int(atom_size+1:) = 0
call move_alloc(temp_int, type_atom)
allocate(temp_int(m+atom_num+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))
temp_real(:,1:atom_size) = r_atom
temp_real(:, atom_size+1:) = 0.0_dp
@ -237,9 +244,9 @@ module elements
end subroutine add_element
subroutine add_atom(type, r)
subroutine add_atom(type, sbox, r)
!Subroutine which adds an atom to the atom arrays
integer, intent(in) :: type
integer, intent(in) :: type, sbox
real(kind=dp), intent(in), dimension(3) :: r
atom_num = atom_num+1
@ -247,6 +254,7 @@ module elements
call grow_ele_arrays(0,1)
type_atom(atom_num) = type
r_atom(:,atom_num) = r(:)
sbox_atom(atom_num) = sbox
end subroutine add_atom
@ -449,4 +457,38 @@ module elements
end do
end subroutine wrap_atoms
subroutine def_new_box
!This subroutine calculates new box boundaries based on minimum and maximum nodal/atomic positions
integer :: i, j, inod, ibasis
real(kind=dp) :: max_bd(3), min_bd(3)
max_bd(:) = -huge(1.0_dp)
min_bd(:) = huge(1.0_dp)
do i = 1, atom_num
do j = 1, 3
if (r_atom(j,i) > max_bd(j)) max_bd(j) = r_atom(j,i) + lim_zero
if (r_atom(j,i) < min_bd(j)) min_bd(j) = r_atom(j,i) - lim_zero
end do
end do
do i = 1, ele_num
do inod = 1, ng_node(lat_ele(i))
do ibasis = 1, basisnum(lat_ele(i))
do j = 1, 3
if (r_node(j,ibasis,inod,i) > max_bd(j)) max_bd(j) = r_node(j,ibasis,inod,i) + lim_zero
if (r_node(j,ibasis,inod,i) < min_bd(j)) min_bd(j) = r_node(j,ibasis,inod,i) -lim_zero
end do
end do
end do
end do
do j = 1, 3
box_bd(2*j) = max_bd(j)
box_bd(2*j-1) = min_bd(j)
end do
end subroutine
end module elements