LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ cget01()

subroutine cget01 ( integer  M,
integer  N,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( ldafac, * )  AFAC,
integer  LDAFAC,
integer, dimension( * )  IPIV,
real, dimension( * )  RWORK,
real  RESID 
)

CGET01

Purpose:
 CGET01 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 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 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 CGETRF.
          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 CGETRF.
[out]RWORK
          RWORK is REAL array, dimension (M)
[out]RESID
          RESID is REAL
          norm(L*U - A) / ( N * norm(A) * EPS )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 110 of file cget01.f.

110 *
111 * -- LAPACK test routine (version 3.7.0) --
112 * -- LAPACK is a software package provided by Univ. of Tennessee, --
113 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
114 * December 2016
115 *
116 * .. Scalar Arguments ..
117  INTEGER lda, ldafac, m, n
118  REAL resid
119 * ..
120 * .. Array Arguments ..
121  INTEGER ipiv( * )
122  REAL rwork( * )
123  COMPLEX a( lda, * ), afac( ldafac, * )
124 * ..
125 *
126 * =====================================================================
127 *
128 * .. Parameters ..
129  REAL one, zero
130  parameter( zero = 0.0e+0, one = 1.0e+0 )
131  COMPLEX cone
132  parameter( cone = ( 1.0e+0, 0.0e+0 ) )
133 * ..
134 * .. Local Scalars ..
135  INTEGER i, j, k
136  REAL anorm, eps
137  COMPLEX t
138 * ..
139 * .. External Functions ..
140  REAL clange, slamch
141  COMPLEX cdotu
142  EXTERNAL clange, slamch, cdotu
143 * ..
144 * .. External Subroutines ..
145  EXTERNAL cgemv, claswp, cscal, ctrmv
146 * ..
147 * .. Intrinsic Functions ..
148  INTRINSIC min, real
149 * ..
150 * .. Executable Statements ..
151 *
152 * Quick exit if M = 0 or N = 0.
153 *
154  IF( m.LE.0 .OR. n.LE.0 ) THEN
155  resid = zero
156  RETURN
157  END IF
158 *
159 * Determine EPS and the norm of A.
160 *
161  eps = slamch( 'Epsilon' )
162  anorm = clange( '1', m, n, a, lda, rwork )
163 *
164 * Compute the product L*U and overwrite AFAC with the result.
165 * A column at a time of the product is obtained, starting with
166 * column N.
167 *
168  DO 10 k = n, 1, -1
169  IF( k.GT.m ) THEN
170  CALL ctrmv( 'Lower', 'No transpose', 'Unit', m, afac,
171  $ ldafac, afac( 1, k ), 1 )
172  ELSE
173 *
174 * Compute elements (K+1:M,K)
175 *
176  t = afac( k, k )
177  IF( k+1.LE.m ) THEN
178  CALL cscal( m-k, t, afac( k+1, k ), 1 )
179  CALL cgemv( 'No transpose', m-k, k-1, cone,
180  $ afac( k+1, 1 ), ldafac, afac( 1, k ), 1,
181  $ cone, afac( k+1, k ), 1 )
182  END IF
183 *
184 * Compute the (K,K) element
185 *
186  afac( k, k ) = t + cdotu( k-1, afac( k, 1 ), ldafac,
187  $ afac( 1, k ), 1 )
188 *
189 * Compute elements (1:K-1,K)
190 *
191  CALL ctrmv( 'Lower', 'No transpose', 'Unit', k-1, afac,
192  $ ldafac, afac( 1, k ), 1 )
193  END IF
194  10 CONTINUE
195  CALL claswp( n, afac, ldafac, 1, min( m, n ), ipiv, -1 )
196 *
197 * Compute the difference L*U - A and store in AFAC.
198 *
199  DO 30 j = 1, n
200  DO 20 i = 1, m
201  afac( i, j ) = afac( i, j ) - a( i, j )
202  20 CONTINUE
203  30 CONTINUE
204 *
205 * Compute norm( L*U - A ) / ( N * norm(A) * EPS )
206 *
207  resid = clange( '1', m, n, afac, ldafac, rwork )
208 *
209  IF( anorm.LE.zero ) THEN
210  IF( resid.NE.zero )
211  $ resid = one / eps
212  ELSE
213  resid = ( ( resid/REAL( N ) )/anorm ) / eps
214  END IF
215 *
216  RETURN
217 *
218 * End of CGET01
219 *
subroutine claswp(N, A, LDA, K1, K2, IPIV, INCX)
CLASWP performs a series of row interchanges on a general rectangular matrix.
Definition: claswp.f:117
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: clange.f:117
subroutine cscal(N, CA, CX, INCX)
CSCAL
Definition: cscal.f:80
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:160
complex function cdotu(N, CX, INCX, CY, INCY)
CDOTU
Definition: cdotu.f:85
subroutine ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRMV
Definition: ctrmv.f:149
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
Here is the call graph for this function:
Here is the caller graph for this function: