mirror of https://gitlab.com/QEF/q-e.git
115 lines
3.0 KiB
Fortran
115 lines
3.0 KiB
Fortran
c
|
|
subroutine zgefa(a,lda,n,ipvt,info)
|
|
integer lda,n,ipvt(n),info
|
|
complex*16 a(lda,n)
|
|
c
|
|
c zgefa factors a complex*16 matrix by gaussian elimination.
|
|
c
|
|
c zgefa is usually called by zgeco, but it can be called
|
|
c directly with a saving in time if rcond is not needed.
|
|
c (time for zgeco) = (1 + 9/n)*(time for zgefa) .
|
|
c
|
|
c on entry
|
|
c
|
|
c a complex*16(lda, n)
|
|
c the matrix to be factored.
|
|
c
|
|
c lda integer
|
|
c the leading dimension of the array a .
|
|
c
|
|
c n integer
|
|
c the order of the matrix a .
|
|
c
|
|
c on return
|
|
c
|
|
c a an upper triangular matrix and the multipliers
|
|
c which were used to obtain it.
|
|
c the factorization can be written a = l*u where
|
|
c l is a product of permutation and unit lower
|
|
c triangular matrices and u is upper triangular.
|
|
c
|
|
c ipvt integer(n)
|
|
c an integer vector of pivot indices.
|
|
c
|
|
c info integer
|
|
c = 0 normal value.
|
|
c = k if u(k,k) .eq. 0.0 . this is not an error
|
|
c condition for this subroutine, but it does
|
|
c indicate that zgesl or zgedi will divide by zero
|
|
c if called. use rcond in zgeco for a reliable
|
|
c indication of singularity.
|
|
c
|
|
c linpack. this version dated 08/14/78 .
|
|
c cleve moler, university of new mexico, argonne national lab.
|
|
c
|
|
c subroutines and functions
|
|
c
|
|
c blas zaxpy,zscal,izamax
|
|
c fortran dabs
|
|
c
|
|
c internal variables
|
|
c
|
|
complex*16 t
|
|
integer izamax,j,k,kp1,l,nm1
|
|
c
|
|
complex*16 zdum
|
|
double precision cabs1
|
|
double precision dreal,dimag
|
|
complex*16 zdumr,zdumi
|
|
dreal(zdumr) = zdumr
|
|
dimag(zdumi) = (0.0d0,-1.0d0)*zdumi
|
|
cabs1(zdum) = dabs(dreal(zdum)) + dabs(dimag(zdum))
|
|
c
|
|
c gaussian elimination with partial pivoting
|
|
c
|
|
info = 0
|
|
nm1 = n - 1
|
|
if (nm1 .lt. 1) go to 70
|
|
do 60 k = 1, nm1
|
|
kp1 = k + 1
|
|
c
|
|
c find l = pivot index
|
|
c
|
|
l = izamax(n-k+1,a(k,k),1) + k - 1
|
|
ipvt(k) = l
|
|
c
|
|
c zero pivot implies this column already triangularized
|
|
c
|
|
if (cabs1(a(l,k)) .eq. 0.0d0) go to 40
|
|
c
|
|
c interchange if necessary
|
|
c
|
|
if (l .eq. k) go to 10
|
|
t = a(l,k)
|
|
a(l,k) = a(k,k)
|
|
a(k,k) = t
|
|
10 continue
|
|
c
|
|
c compute multipliers
|
|
c
|
|
t = -(1.0d0,0.0d0)/a(k,k)
|
|
call zscal(n-k,t,a(k+1,k),1)
|
|
c
|
|
c row elimination with column indexing
|
|
c
|
|
do 30 j = kp1, n
|
|
t = a(l,j)
|
|
if (l .eq. k) go to 20
|
|
a(l,j) = a(k,j)
|
|
a(k,j) = t
|
|
20 continue
|
|
call zaxpy(n-k,t,a(k+1,k),1,a(k+1,j),1)
|
|
30 continue
|
|
go to 50
|
|
40 continue
|
|
info = k
|
|
50 continue
|
|
60 continue
|
|
70 continue
|
|
ipvt(n) = n
|
|
if (cabs1(a(n,n)) .eq. 0.0d0) info = n
|
|
return
|
|
end
|
|
|
|
|