CACmb/src/functions.f90

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