LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cppcon()

subroutine cppcon ( character  UPLO,
integer  N,
complex, dimension( * )  AP,
real  ANORM,
real  RCOND,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer  INFO 
)

CPPCON

Download CPPCON + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 CPPCON estimates the reciprocal of the condition number (in the
 1-norm) of a complex Hermitian positive definite packed matrix using
 the Cholesky factorization A = U**H*U or A = L*L**H computed by
 CPPTRF.

 An estimate is obtained for norm(inv(A)), and the reciprocal of the
 condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
Parameters
[in]UPLO
          UPLO is CHARACTER*1
          = 'U':  Upper triangle of A is stored;
          = 'L':  Lower triangle of A is stored.
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.
[in]AP
          AP is COMPLEX array, dimension (N*(N+1)/2)
          The triangular factor U or L from the Cholesky factorization
          A = U**H*U or A = L*L**H, packed columnwise in a linear
          array.  The j-th column of U or L is stored in the array AP
          as follows:
          if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
[in]ANORM
          ANORM is REAL
          The 1-norm (or infinity-norm) of the Hermitian matrix A.
[out]RCOND
          RCOND is REAL
          The reciprocal of the condition number of the matrix A,
          computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
          estimate of the 1-norm of inv(A) computed in this routine.
[out]WORK
          WORK is COMPLEX array, dimension (2*N)
[out]RWORK
          RWORK is REAL array, dimension (N)
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 117 of file cppcon.f.

118 *
119 * -- LAPACK computational routine --
120 * -- LAPACK is a software package provided by Univ. of Tennessee, --
121 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
122 *
123 * .. Scalar Arguments ..
124  CHARACTER UPLO
125  INTEGER INFO, N
126  REAL ANORM, RCOND
127 * ..
128 * .. Array Arguments ..
129  REAL RWORK( * )
130  COMPLEX AP( * ), WORK( * )
131 * ..
132 *
133 * =====================================================================
134 *
135 * .. Parameters ..
136  REAL ONE, ZERO
137  parameter( one = 1.0e+0, zero = 0.0e+0 )
138 * ..
139 * .. Local Scalars ..
140  LOGICAL UPPER
141  CHARACTER NORMIN
142  INTEGER IX, KASE
143  REAL AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
144  COMPLEX ZDUM
145 * ..
146 * .. Local Arrays ..
147  INTEGER ISAVE( 3 )
148 * ..
149 * .. External Functions ..
150  LOGICAL LSAME
151  INTEGER ICAMAX
152  REAL SLAMCH
153  EXTERNAL lsame, icamax, slamch
154 * ..
155 * .. External Subroutines ..
156  EXTERNAL clacn2, clatps, csrscl, xerbla
157 * ..
158 * .. Intrinsic Functions ..
159  INTRINSIC abs, aimag, real
160 * ..
161 * .. Statement Functions ..
162  REAL CABS1
163 * ..
164 * .. Statement Function definitions ..
165  cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
166 * ..
167 * .. Executable Statements ..
168 *
169 * Test the input parameters.
170 *
171  info = 0
172  upper = lsame( uplo, 'U' )
173  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
174  info = -1
175  ELSE IF( n.LT.0 ) THEN
176  info = -2
177  ELSE IF( anorm.LT.zero ) THEN
178  info = -4
179  END IF
180  IF( info.NE.0 ) THEN
181  CALL xerbla( 'CPPCON', -info )
182  RETURN
183  END IF
184 *
185 * Quick return if possible
186 *
187  rcond = zero
188  IF( n.EQ.0 ) THEN
189  rcond = one
190  RETURN
191  ELSE IF( anorm.EQ.zero ) THEN
192  RETURN
193  END IF
194 *
195  smlnum = slamch( 'Safe minimum' )
196 *
197 * Estimate the 1-norm of the inverse.
198 *
199  kase = 0
200  normin = 'N'
201  10 CONTINUE
202  CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
203  IF( kase.NE.0 ) THEN
204  IF( upper ) THEN
205 *
206 * Multiply by inv(U**H).
207 *
208  CALL clatps( 'Upper', 'Conjugate transpose', 'Non-unit',
209  $ normin, n, ap, work, scalel, rwork, info )
210  normin = 'Y'
211 *
212 * Multiply by inv(U).
213 *
214  CALL clatps( 'Upper', 'No transpose', 'Non-unit', normin, n,
215  $ ap, work, scaleu, rwork, info )
216  ELSE
217 *
218 * Multiply by inv(L).
219 *
220  CALL clatps( 'Lower', 'No transpose', 'Non-unit', normin, n,
221  $ ap, work, scalel, rwork, info )
222  normin = 'Y'
223 *
224 * Multiply by inv(L**H).
225 *
226  CALL clatps( 'Lower', 'Conjugate transpose', 'Non-unit',
227  $ normin, n, ap, work, scaleu, rwork, info )
228  END IF
229 *
230 * Multiply by 1/SCALE if doing so will not cause overflow.
231 *
232  scale = scalel*scaleu
233  IF( scale.NE.one ) THEN
234  ix = icamax( n, work, 1 )
235  IF( scale.LT.cabs1( work( ix ) )*smlnum .OR. scale.EQ.zero )
236  $ GO TO 20
237  CALL csrscl( n, scale, work, 1 )
238  END IF
239  GO TO 10
240  END IF
241 *
242 * Compute the estimate of the reciprocal condition number.
243 *
244  IF( ainvnm.NE.zero )
245  $ rcond = ( one / ainvnm ) / anorm
246 *
247  20 CONTINUE
248  RETURN
249 *
250 * End of CPPCON
251 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
integer function icamax(N, CX, INCX)
ICAMAX
Definition: icamax.f:71
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine csrscl(N, SA, SX, INCX)
CSRSCL multiplies a vector by the reciprocal of a real scalar.
Definition: csrscl.f:84
subroutine clatps(UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, CNORM, INFO)
CLATPS solves a triangular system of equations with the matrix held in packed storage.
Definition: clatps.f:231
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
Definition: clacn2.f:133
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: