Merge branch 'pure-LAPACK' into 'development'

improved function attributes

See merge request damask/DAMASK!491
This commit is contained in:
Sharan Roongta 2022-01-03 14:07:54 +00:00
commit b8203e94d8
5 changed files with 27 additions and 25 deletions

View File

@ -6,7 +6,7 @@
module LAPACK_interface module LAPACK_interface
interface interface
subroutine dgeev(jobvl,jobvr,n,a,lda,wr,wi,vl,ldvl,vr,ldvr,work,lwork,info) pure subroutine dgeev(jobvl,jobvr,n,a,lda,wr,wi,vl,ldvl,vr,ldvr,work,lwork,info)
use prec use prec
character, intent(in) :: jobvl,jobvr character, intent(in) :: jobvl,jobvr
integer, intent(in) :: n,lda,ldvl,ldvr,lwork integer, intent(in) :: n,lda,ldvl,ldvr,lwork
@ -18,16 +18,16 @@ module LAPACK_interface
integer, intent(out) :: info integer, intent(out) :: info
end subroutine dgeev end subroutine dgeev
subroutine dgesv(n,nrhs,a,lda,ipiv,b,ldb,info) pure subroutine dgesv(n,nrhs,a,lda,ipiv,b,ldb,info)
use prec use prec
integer, intent(in) :: n,nrhs,lda,ldb integer, intent(in) :: n,nrhs,lda,ldb
real(pReal), intent(inout), dimension(lda,n) :: a real(pReal), intent(inout), dimension(lda,n) :: a
integer, intent(out), dimension(n) :: ipiv integer, intent(out), dimension(n) :: ipiv
real(pReal), intent(out), dimension(ldb,nrhs) :: b real(pReal), intent(inout), dimension(ldb,nrhs) :: b
integer, intent(out) :: info integer, intent(out) :: info
end subroutine dgesv end subroutine dgesv
subroutine dgetrf(m,n,a,lda,ipiv,info) pure subroutine dgetrf(m,n,a,lda,ipiv,info)
use prec use prec
integer, intent(in) :: m,n,lda integer, intent(in) :: m,n,lda
real(pReal), intent(inout), dimension(lda,n) :: a real(pReal), intent(inout), dimension(lda,n) :: a
@ -35,16 +35,16 @@ module LAPACK_interface
integer, intent(out) :: info integer, intent(out) :: info
end subroutine dgetrf end subroutine dgetrf
subroutine dgetri(n,a,lda,ipiv,work,lwork,info) pure subroutine dgetri(n,a,lda,ipiv,work,lwork,info)
use prec use prec
integer, intent(in) :: n,lda,lwork integer, intent(in) :: n,lda,lwork
real(pReal), intent(inout), dimension(lda,n) :: a real(pReal), intent(inout), dimension(lda,n) :: a
integer, intent(out), dimension(n) :: ipiv integer, intent(in), dimension(n) :: ipiv
real(pReal), intent(out), dimension(max(1,lwork)) :: work real(pReal), intent(out), dimension(max(1,lwork)) :: work
integer, intent(out) :: info integer, intent(out) :: info
end subroutine dgetri end subroutine dgetri
subroutine dsyev(jobz,uplo,n,a,lda,w,work,lwork,info) pure subroutine dsyev(jobz,uplo,n,a,lda,w,work,lwork,info)
use prec use prec
character, intent(in) :: jobz,uplo character, intent(in) :: jobz,uplo
integer, intent(in) :: n,lda,lwork integer, intent(in) :: n,lda,lwork

View File

@ -2070,7 +2070,7 @@ end function getlabels
!> @brief Equivalent Poisson's ratio (ν) !> @brief Equivalent Poisson's ratio (ν)
!> @details https://doi.org/10.1143/JPSJ.20.635 !> @details https://doi.org/10.1143/JPSJ.20.635
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function lattice_equivalent_nu(C,assumption) result(nu) pure function lattice_equivalent_nu(C,assumption) result(nu)
real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation) real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
character(len=5), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress) character(len=5), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress)
@ -2103,7 +2103,7 @@ end function lattice_equivalent_nu
!> @brief Equivalent shear modulus (μ) !> @brief Equivalent shear modulus (μ)
!> @details https://doi.org/10.1143/JPSJ.20.635 !> @details https://doi.org/10.1143/JPSJ.20.635
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function lattice_equivalent_mu(C,assumption) result(mu) pure function lattice_equivalent_mu(C,assumption) result(mu)
real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation) real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
character(len=5), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress) character(len=5), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress)

View File

@ -512,7 +512,7 @@ end subroutine math_invert33
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Inversion of symmetriced 3x3x3x3 matrix !> @brief Inversion of symmetriced 3x3x3x3 matrix
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function math_invSym3333(A) pure function math_invSym3333(A)
real(pReal),dimension(3,3,3,3) :: math_invSym3333 real(pReal),dimension(3,3,3,3) :: math_invSym3333
@ -538,7 +538,7 @@ end function math_invSym3333
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief invert quadratic matrix of arbitrary dimension !> @brief invert quadratic matrix of arbitrary dimension
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine math_invert(InvA, error, A) pure subroutine math_invert(InvA, error, A)
real(pReal), dimension(:,:), intent(in) :: A real(pReal), dimension(:,:), intent(in) :: A
real(pReal), dimension(size(A,1),size(A,1)), intent(out) :: invA real(pReal), dimension(size(A,1),size(A,1)), intent(out) :: invA
@ -996,7 +996,7 @@ end subroutine math_normal
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief eigenvalues and eigenvectors of symmetric matrix !> @brief eigenvalues and eigenvectors of symmetric matrix
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine math_eigh(w,v,error,m) pure subroutine math_eigh(w,v,error,m)
real(pReal), dimension(:,:), intent(in) :: m !< quadratic matrix to compute eigenvectors and values of real(pReal), dimension(:,:), intent(in) :: m !< quadratic matrix to compute eigenvectors and values of
real(pReal), dimension(size(m,1)), intent(out) :: w !< eigenvalues real(pReal), dimension(size(m,1)), intent(out) :: w !< eigenvalues
@ -1021,7 +1021,7 @@ end subroutine math_eigh
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @details See http://arxiv.org/abs/physics/0610206 (DSYEVH3) !> @details See http://arxiv.org/abs/physics/0610206 (DSYEVH3)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine math_eigh33(w,v,m) pure subroutine math_eigh33(w,v,m)
real(pReal), dimension(3,3),intent(in) :: m !< 3x3 matrix to compute eigenvectors and values of real(pReal), dimension(3,3),intent(in) :: m !< 3x3 matrix to compute eigenvectors and values of
real(pReal), dimension(3), intent(out) :: w !< eigenvalues real(pReal), dimension(3), intent(out) :: w !< eigenvalues
@ -1114,7 +1114,7 @@ end function math_rotationalPart
!> @brief Eigenvalues of symmetric matrix !> @brief Eigenvalues of symmetric matrix
! will return NaN on error ! will return NaN on error
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function math_eigvalsh(m) pure function math_eigvalsh(m)
real(pReal), dimension(:,:), intent(in) :: m !< symmetric matrix to compute eigenvalues of real(pReal), dimension(:,:), intent(in) :: m !< symmetric matrix to compute eigenvalues of
real(pReal), dimension(size(m,1)) :: math_eigvalsh real(pReal), dimension(size(m,1)) :: math_eigvalsh
@ -1137,7 +1137,7 @@ end function math_eigvalsh
!> but apparently more stable solution and has general LAPACK powered version for arbritrary sized !> but apparently more stable solution and has general LAPACK powered version for arbritrary sized
!> matrices as fallback !> matrices as fallback
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function math_eigvalsh33(m) pure function math_eigvalsh33(m)
real(pReal), intent(in), dimension(3,3) :: m !< 3x3 symmetric matrix to compute eigenvalues of real(pReal), intent(in), dimension(3,3) :: m !< 3x3 symmetric matrix to compute eigenvalues of
real(pReal), dimension(3) :: math_eigvalsh33,I real(pReal), dimension(3) :: math_eigvalsh33,I
@ -1432,9 +1432,11 @@ subroutine selfTest
error stop 'math_LeviCivita' error stop 'math_LeviCivita'
normal_distribution: block normal_distribution: block
real(pReal), dimension(500000) :: r integer, parameter :: N = 1000000
real(pReal), dimension(:), allocatable :: r
real(pReal) :: mu, sigma real(pReal) :: mu, sigma
allocate(r(N))
call random_number(mu) call random_number(mu)
call random_number(sigma) call random_number(sigma)
@ -1443,11 +1445,11 @@ subroutine selfTest
call math_normal(r,mu,sigma) call math_normal(r,mu,sigma)
if (abs(mu -sum(r)/real(size(r),pReal))>5.0e-2_pReal) & if (abs(mu -sum(r)/real(N,pReal))>5.0e-2_pReal) &
error stop 'math_normal(mu)' error stop 'math_normal(mu)'
mu = sum(r)/real(size(r),pReal) mu = sum(r)/real(N,pReal)
if (abs(sigma**2 -1.0_pReal/real(size(r)-1,pReal) * sum((r-mu)**2))/sigma > 5.0e-2_pReal) & if (abs(sigma**2 -1.0_pReal/real(N-1,pReal) * sum((r-mu)**2))/sigma > 5.0e-2_pReal) &
error stop 'math_normal(sigma)' error stop 'math_normal(sigma)'
end block normal_distribution end block normal_distribution

View File

@ -168,17 +168,17 @@ submodule(phase) mechanical
integer, intent(in) :: ph,en integer, intent(in) :: ph,en
end function plastic_dislotwin_homogenizedC end function plastic_dislotwin_homogenizedC
module function elastic_C66(ph,en) result(C66) pure module function elastic_C66(ph,en) result(C66)
real(pReal), dimension(6,6) :: C66 real(pReal), dimension(6,6) :: C66
integer, intent(in) :: ph, en integer, intent(in) :: ph, en
end function elastic_C66 end function elastic_C66
module function elastic_mu(ph,en) result(mu) pure module function elastic_mu(ph,en) result(mu)
real(pReal) :: mu real(pReal) :: mu
integer, intent(in) :: ph, en integer, intent(in) :: ph, en
end function elastic_mu end function elastic_mu
module function elastic_nu(ph,en) result(nu) pure module function elastic_nu(ph,en) result(nu)
real(pReal) :: nu real(pReal) :: nu
integer, intent(in) :: ph, en integer, intent(in) :: ph, en
end function elastic_nu end function elastic_nu

View File

@ -86,7 +86,7 @@ end subroutine elastic_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief return 6x6 elasticity tensor !> @brief return 6x6 elasticity tensor
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module function elastic_C66(ph,en) result(C66) pure module function elastic_C66(ph,en) result(C66)
integer, intent(in) :: & integer, intent(in) :: &
ph, & ph, &
@ -140,7 +140,7 @@ end function elastic_C66
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief return shear modulus !> @brief return shear modulus
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module function elastic_mu(ph,en) result(mu) pure module function elastic_mu(ph,en) result(mu)
integer, intent(in) :: & integer, intent(in) :: &
ph, & ph, &
@ -157,7 +157,7 @@ end function elastic_mu
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief return Poisson ratio !> @brief return Poisson ratio
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module function elastic_nu(ph,en) result(nu) pure module function elastic_nu(ph,en) result(nu)
integer, intent(in) :: & integer, intent(in) :: &
ph, & ph, &