mirror of https://gitlab.com/QEF/q-e.git
50 lines
1.5 KiB
Fortran
50 lines
1.5 KiB
Fortran
![]() |
!
|
||
![]() |
! Copyright (C) 2004 PWSCF-CP-FPMD group
|
||
![]() |
! This file is distributed under the terms of the
|
||
|
! GNU General Public License. See the file `License'
|
||
|
! in the root directory of the present distribution,
|
||
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
||
|
!
|
||
|
#include "machine.h"
|
||
![]() |
!
|
||
|
subroutine invmat (n, a, a_inv, da)
|
||
|
!-----------------------------------------------------------------------
|
||
![]() |
! computes the inverse "a_inv" of matrix "a", both dimensioned (n,n)
|
||
![]() |
! if the matrix is dimensioned 3x3, it also computes determinant "da"
|
||
![]() |
! matrix "a" is unchanged on output - LAPACK
|
||
|
!
|
||
![]() |
USE kinds
|
||
![]() |
implicit none
|
||
![]() |
integer :: n
|
||
![]() |
real(kind=DP), DIMENSION (n,n) :: a, a_inv
|
||
|
real(kind=DP) :: da
|
||
|
!
|
||
|
integer :: info, lda, lwork, ipiv (n)
|
||
![]() |
! info=0: inversion was successful
|
||
|
! lda : leading dimension (the same as n)
|
||
![]() |
! ipiv : work space for pivoting (assumed of length lwork=n)
|
||
|
real(kind=DP) :: work (n)
|
||
|
! more work space
|
||
|
!
|
||
![]() |
lda = n
|
||
![]() |
lwork=n
|
||
|
!
|
||
|
a_inv(:,:) = a(:,:)
|
||
|
!
|
||
![]() |
call DGETRF (n, n, a_inv, lda, ipiv, info)
|
||
![]() |
call errore ('invmat', 'error in DGETRF', abs (info) )
|
||
![]() |
call DGETRI (n, a_inv, lda, ipiv, work, lwork, info)
|
||
![]() |
call errore ('invmat', 'error in DGETRI', abs (info) )
|
||
![]() |
!
|
||
|
if (n == 3) then
|
||
|
da = a(1,1)*(a(2,2)*a(3,3)-a(2,3)*a(3,2)) + &
|
||
|
a(1,2)*(a(2,3)*a(3,1)-a(2,1)*a(3,3)) + &
|
||
|
a(1,3)*(a(2,1)*a(3,2)-a(3,1)*a(2,2))
|
||
|
IF (ABS(da) < 1.d-10) CALL errore(' invmat ',' singular matrix ', 1)
|
||
|
else
|
||
|
da = 0.d0
|
||
|
end if
|
||
![]() |
|
||
![]() |
return
|
||
![]() |
end subroutine invmat
|