Initial commit with file writing and create mode working for atoms
This commit is contained in:
Alex
parent
624886bbe9
commit
8217e8b51c
15 changed files with 2465 additions and 271 deletions
235
src/functions.f90
Normal file
235
src/functions.f90
Normal file
|
|
@ -0,0 +1,235 @@
|
|||
module functions
|
||||
|
||||
use parameters
|
||||
|
||||
implicit none
|
||||
|
||||
public
|
||||
contains
|
||||
|
||||
|
||||
! Functions below this comment are taken from the functions module of atomsk
|
||||
!********************************************************
|
||||
! STRUPCASE
|
||||
! This function reads a string of any length
|
||||
! and capitalizes all letters.
|
||||
!********************************************************
|
||||
FUNCTION StrUpCase (input_string) RESULT (UC_string)
|
||||
!
|
||||
IMPLICIT NONE
|
||||
CHARACTER(*),PARAMETER:: lower_case = 'abcdefghijklmnopqrstuvwxyz'
|
||||
CHARACTER(*),PARAMETER:: upper_case = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
||||
CHARACTER(*),INTENT(IN):: input_string
|
||||
CHARACTER(LEN(Input_String)):: UC_string !Upper-Case string that is produced
|
||||
INTEGER:: i, n
|
||||
!
|
||||
IF(LEN(input_string)==0) RETURN
|
||||
UC_string = input_string
|
||||
! Loop over string elements
|
||||
DO i=1,LEN(UC_string)
|
||||
!Find location of letter in lower case constant string
|
||||
n = INDEX( lower_case, UC_string(i:i) )
|
||||
!If current substring is a lower case letter, make it upper case
|
||||
IF(n>0) THEN
|
||||
UC_string(i:i) = upper_case(n:n)
|
||||
ENDIF
|
||||
END DO
|
||||
!
|
||||
END FUNCTION StrUpCase
|
||||
|
||||
!********************************************************
|
||||
! STRDNCASE
|
||||
! This function reads a string of any length
|
||||
! and transforms all letters to lower case.
|
||||
!********************************************************
|
||||
FUNCTION StrDnCase (input_string) RESULT (lc_string)
|
||||
!
|
||||
IMPLICIT NONE
|
||||
CHARACTER(*),PARAMETER:: lower_case = 'abcdefghijklmnopqrstuvwxyz'
|
||||
CHARACTER(*),PARAMETER:: upper_case = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
||||
CHARACTER(*),INTENT(IN):: input_string
|
||||
CHARACTER(LEN(Input_String)):: lc_string !Lower-Case string that is produced
|
||||
INTEGER:: i, n
|
||||
!
|
||||
IF(LEN(input_string)==0) RETURN
|
||||
lc_string = input_string
|
||||
! Loop over string elements
|
||||
DO i=1,LEN(lc_string)
|
||||
!Find location of letter in upper case constant string
|
||||
n = INDEX( upper_case, lc_string(i:i) )
|
||||
!If current substring is an upper case letter, make it lower case
|
||||
IF(n>0) THEN
|
||||
lc_string(i:i) = lower_case(n:n)
|
||||
ENDIF
|
||||
END DO
|
||||
!
|
||||
END FUNCTION StrDnCase
|
||||
|
||||
pure function matrix_normal(a, n)
|
||||
|
||||
integer :: i
|
||||
integer, intent(in) :: n
|
||||
real(kind = dp), dimension(n) :: v
|
||||
real(kind = dp), dimension(n, n),intent(in) :: a
|
||||
real(kind = dp), dimension(n,n) :: matrix_normal
|
||||
|
||||
matrix_normal(:, :) = a(:, :)
|
||||
|
||||
do i = 1, n
|
||||
|
||||
v(:) = a(i,:)
|
||||
|
||||
matrix_normal(i, :) = v(:) / norm2(v)
|
||||
|
||||
end do
|
||||
|
||||
return
|
||||
end function matrix_normal
|
||||
|
||||
pure function cross_product(a, b)
|
||||
!Function which finds the cross product of two vectors
|
||||
|
||||
real(kind = dp), dimension(3), intent(in) :: a, b
|
||||
real(kind = dp), dimension(3) :: cross_product
|
||||
|
||||
cross_product(1) = a(2) * b(3) - a(3) * b(2)
|
||||
cross_product(2) = a(3) * b(1) - a(1) * b(3)
|
||||
cross_product(3) = a(1) * b(2) - a(2) * b(1)
|
||||
|
||||
return
|
||||
end function cross_product
|
||||
|
||||
pure function identity_mat(n)
|
||||
!Returns the nxn identity matrix
|
||||
|
||||
integer :: i
|
||||
integer, intent(in) :: n
|
||||
real(kind = dp), dimension(n, n) :: identity_mat
|
||||
|
||||
identity_mat(:, :) = 0.0_dp
|
||||
do i = 1, n
|
||||
identity_mat(i, i) = 1.0_dp
|
||||
end do
|
||||
|
||||
return
|
||||
end function identity_mat
|
||||
|
||||
pure function triple_product(a, b, c)
|
||||
!triple product between three 3*1 vectors
|
||||
|
||||
real(kind = dp) :: triple_product
|
||||
real(kind = dp), dimension(3), intent(in) :: a, b, c
|
||||
triple_product = dot_product(a, cross_product(b, c))
|
||||
|
||||
return
|
||||
end function triple_product
|
||||
|
||||
function in_bd_lat(v, box_faces, box_norms)
|
||||
!This function returns whether the point is within the transformed box boundaries. The transformed
|
||||
!box being the transformed simulation cell in the lattice basis
|
||||
|
||||
!Input/output variables
|
||||
real(kind=dp), dimension(3), intent(in) :: v !integer lattice position
|
||||
real(kind=dp), dimension(3,6), intent(in) :: box_faces !Centroid of all the box faces
|
||||
real(kind=dp), dimension(3,6), intent(in) :: box_norms !Box face normals
|
||||
logical :: in_bd_lat
|
||||
|
||||
!Other variables
|
||||
integer :: i
|
||||
real(kind=dp) :: pt_to_face(3)
|
||||
|
||||
in_bd_lat = .true.
|
||||
|
||||
!Check if point is in box bounds, this works by comparing the dot product of the face normal and the
|
||||
!vector from the point to the face. If the dot product is greater than 0 then the point is behind the face
|
||||
!if it is equal to zero then the point is on the face, if is less than 0 the the point is in front of the face.
|
||||
do i = 1, 6
|
||||
pt_to_face(:) = box_faces(:, i) - v
|
||||
if(dot_product(pt_to_face, box_norms(:,i)) <= 0) then
|
||||
in_bd_lat = .false.
|
||||
exit
|
||||
end if
|
||||
end do
|
||||
|
||||
return
|
||||
end function in_bd_lat
|
||||
|
||||
function in_block_bd(v, box_bd)
|
||||
!This function returns whether a point is within a block in 3d
|
||||
|
||||
!Input/output
|
||||
real(kind=dp), dimension(3), intent(in) :: v
|
||||
real(kind=dp), dimension(6), intent(in) :: box_bd
|
||||
logical :: in_block_bd
|
||||
|
||||
!Other variables
|
||||
integer :: i
|
||||
|
||||
in_block_bd = .true.
|
||||
|
||||
do i =1 ,3
|
||||
!Check upper bound
|
||||
if(v(i) > (box_bd(2*i)+10.0_dp**(-10)) ) then
|
||||
in_block_bd =.false.
|
||||
exit
|
||||
!Check lower bound
|
||||
else if (v(i) < (box_bd(2*i-1)-10.0_dp**(-10))) then
|
||||
in_block_bd = .false.
|
||||
exit
|
||||
end if
|
||||
end do
|
||||
end function in_block_bd
|
||||
|
||||
function lcm(a,b)
|
||||
!This function returns the smallest least common multiple of two numbers
|
||||
|
||||
real(kind=dp), intent(in) :: a, b
|
||||
real(kind=dp) :: lcm
|
||||
|
||||
integer :: aint, bint, gcd, remainder, placeholder
|
||||
|
||||
!Cast the vector positions to ints. There will be some error associated with this calculation
|
||||
aint = a*10**2
|
||||
bint = b*10**2
|
||||
|
||||
!Calculate greated common divisor
|
||||
gcd = aint
|
||||
placeholder = bint
|
||||
do while(placeholder /= 0)
|
||||
remainder = modulo(gcd, placeholder)
|
||||
gcd = placeholder
|
||||
placeholder=remainder
|
||||
end do
|
||||
lcm = real((aint*bint),dp)/(real(gcd,dp))* 10.0_dp**(-2.0_dp)
|
||||
end function lcm
|
||||
|
||||
function is_neighbor(rl, rk, r_in, r_out)
|
||||
!This function checks to see if two atoms are within a shell with an inner radius r_in and outer radius
|
||||
!r_out
|
||||
real(kind=dp), intent(in) :: r_in, r_out
|
||||
real(kind=dp), dimension(3), intent(in) :: rl, rk
|
||||
logical :: is_neighbor
|
||||
|
||||
!Internal variable
|
||||
real(kind=dp) :: rlk
|
||||
|
||||
rlk = norm2(rk - rl)
|
||||
is_neighbor=.true.
|
||||
if((rlk>r_out).or.(rlk < r_in)) is_neighbor = .false.
|
||||
|
||||
return
|
||||
end function is_neighbor
|
||||
|
||||
function is_equal(A, B)
|
||||
!This function checks if too numbers are equal within a tolerance
|
||||
real(kind=dp), intent(in) :: A, B
|
||||
logical :: is_equal
|
||||
|
||||
if((A>(B - 10.0_dp**-10)).and.(A < (B+10.0_dp**-10))) then
|
||||
is_equal = .true.
|
||||
else
|
||||
is_equal = .false.
|
||||
end if
|
||||
return
|
||||
end function is_equal
|
||||
end module functions
|
||||
Loading…
Add table
Add a link
Reference in a new issue