LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ 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 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
complex *16 function zdotu(N, ZX, INCX, ZY, INCY)
ZDOTU
Definition: zdotu.f:83
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
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
Definition: zgemv.f:158
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
Here is the call graph for this function:
Here is the caller graph for this function: