LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zget01()

subroutine zget01 ( integer  m,
integer  n,
complex*16, dimension( lda, * )  a,
integer  lda,
complex*16, dimension( ldafac, * )  afac,
integer  ldafac,
integer, dimension( * )  ipiv,
double precision, dimension( * )  rwork,
double precision  resid 
)

ZGET01

Purpose:
 ZGET01 reconstructs a matrix A from its L*U factorization and
 computes the residual
    norm(L*U - A) / ( N * norm(A) * EPS ),
 where EPS is the machine epsilon.
Parameters
[in]M
          M is INTEGER
          The number of rows of the matrix A.  M >= 0.
[in]N
          N is INTEGER
          The number of columns of the matrix A.  N >= 0.
[in]A
          A is COMPLEX*16 array, dimension (LDA,N)
          The original M x N matrix A.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,M).
[in,out]AFAC
          AFAC is COMPLEX*16 array, dimension (LDAFAC,N)
          The factored form of the matrix A.  AFAC contains the factors
          L and U from the L*U factorization as computed by ZGETRF.
          Overwritten with the reconstructed matrix, and then with the
          difference L*U - A.
[in]LDAFAC
          LDAFAC is INTEGER
          The leading dimension of the array AFAC.  LDAFAC >= max(1,M).
[in]IPIV
          IPIV is INTEGER array, dimension (N)
          The pivot indices from ZGETRF.
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension (M)
[out]RESID
          RESID is DOUBLE PRECISION
          norm(L*U - A) / ( N * norm(A) * EPS )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 106 of file zget01.f.

108*
109* -- LAPACK test routine --
110* -- LAPACK is a software package provided by Univ. of Tennessee, --
111* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
112*
113* .. Scalar Arguments ..
114 INTEGER LDA, LDAFAC, M, N
115 DOUBLE PRECISION RESID
116* ..
117* .. Array Arguments ..
118 INTEGER IPIV( * )
119 DOUBLE PRECISION RWORK( * )
120 COMPLEX*16 A( LDA, * ), AFAC( LDAFAC, * )
121* ..
122*
123* =====================================================================
124*
125* .. Parameters ..
126 DOUBLE PRECISION ZERO, ONE
127 parameter( zero = 0.0d+0, one = 1.0d+0 )
128 COMPLEX*16 CONE
129 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
130* ..
131* .. Local Scalars ..
132 INTEGER I, J, K
133 DOUBLE PRECISION ANORM, EPS
134 COMPLEX*16 T
135* ..
136* .. External Functions ..
137 DOUBLE PRECISION DLAMCH, ZLANGE
138 COMPLEX*16 ZDOTU
139 EXTERNAL dlamch, zlange, zdotu
140* ..
141* .. External Subroutines ..
142 EXTERNAL zgemv, zlaswp, zscal, ztrmv
143* ..
144* .. Intrinsic Functions ..
145 INTRINSIC dble, min
146* ..
147* .. Executable Statements ..
148*
149* Quick exit if M = 0 or N = 0.
150*
151 IF( m.LE.0 .OR. n.LE.0 ) THEN
152 resid = zero
153 RETURN
154 END IF
155*
156* Determine EPS and the norm of A.
157*
158 eps = dlamch( 'Epsilon' )
159 anorm = zlange( '1', m, n, a, lda, rwork )
160*
161* Compute the product L*U and overwrite AFAC with the result.
162* A column at a time of the product is obtained, starting with
163* column N.
164*
165 DO 10 k = n, 1, -1
166 IF( k.GT.m ) THEN
167 CALL ztrmv( 'Lower', 'No transpose', 'Unit', m, afac,
168 $ ldafac, afac( 1, k ), 1 )
169 ELSE
170*
171* Compute elements (K+1:M,K)
172*
173 t = afac( k, k )
174 IF( k+1.LE.m ) THEN
175 CALL zscal( m-k, t, afac( k+1, k ), 1 )
176 CALL zgemv( 'No transpose', m-k, k-1, cone,
177 $ afac( k+1, 1 ), ldafac, afac( 1, k ), 1,
178 $ cone, afac( k+1, k ), 1 )
179 END IF
180*
181* Compute the (K,K) element
182*
183 afac( k, k ) = t + zdotu( k-1, afac( k, 1 ), ldafac,
184 $ afac( 1, k ), 1 )
185*
186* Compute elements (1:K-1,K)
187*
188 CALL ztrmv( 'Lower', 'No transpose', 'Unit', k-1, afac,
189 $ ldafac, afac( 1, k ), 1 )
190 END IF
191 10 CONTINUE
192 CALL zlaswp( n, afac, ldafac, 1, min( m, n ), ipiv, -1 )
193*
194* Compute the difference L*U - A and store in AFAC.
195*
196 DO 30 j = 1, n
197 DO 20 i = 1, m
198 afac( i, j ) = afac( i, j ) - a( i, j )
199 20 CONTINUE
200 30 CONTINUE
201*
202* Compute norm( L*U - A ) / ( N * norm(A) * EPS )
203*
204 resid = zlange( '1', m, n, afac, ldafac, rwork )
205*
206 IF( anorm.LE.zero ) THEN
207 IF( resid.NE.zero )
208 $ resid = one / eps
209 ELSE
210 resid = ( ( resid / dble( n ) ) / anorm ) / eps
211 END IF
212*
213 RETURN
214*
215* End of ZGET01
216*
complex *16 function zdotu(n, zx, incx, zy, incy)
ZDOTU
Definition zdotu.f:83
subroutine zgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
ZGEMV
Definition zgemv.f:160
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
double precision function zlange(norm, m, n, a, lda, work)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition zlange.f:115
subroutine zlaswp(n, a, lda, k1, k2, ipiv, incx)
ZLASWP performs a series of row interchanges on a general rectangular matrix.
Definition zlaswp.f:115
subroutine zscal(n, za, zx, incx)
ZSCAL
Definition zscal.f:78
subroutine ztrmv(uplo, trans, diag, n, a, lda, x, incx)
ZTRMV
Definition ztrmv.f:147
Here is the call graph for this function:
Here is the caller graph for this function: