144c6b23bd
Added lapack routines for calculation of condition number and to fill out the QR factorization capability.
181 lines
5.1 KiB
Fortran
181 lines
5.1 KiB
Fortran
SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
|
|
$ INFO )
|
|
*
|
|
* -- LAPACK routine (version 3.0) --
|
|
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
|
|
* Courant Institute, Argonne National Lab, and Rice University
|
|
* February 29, 1992
|
|
*
|
|
* .. Scalar Arguments ..
|
|
CHARACTER NORM
|
|
INTEGER INFO, LDA, N
|
|
DOUBLE PRECISION ANORM, RCOND
|
|
* ..
|
|
* .. Array Arguments ..
|
|
INTEGER IWORK( * )
|
|
DOUBLE PRECISION A( LDA, * ), WORK( * )
|
|
* ..
|
|
*
|
|
* Purpose
|
|
* =======
|
|
*
|
|
* DGECON estimates the reciprocal of the condition number of a general
|
|
* real matrix A, in either the 1-norm or the infinity-norm, using
|
|
* the LU factorization computed by DGETRF.
|
|
*
|
|
* An estimate is obtained for norm(inv(A)), and the reciprocal of the
|
|
* condition number is computed as
|
|
* RCOND = 1 / ( norm(A) * norm(inv(A)) ).
|
|
*
|
|
* Arguments
|
|
* =========
|
|
*
|
|
* NORM (input) CHARACTER*1
|
|
* Specifies whether the 1-norm condition number or the
|
|
* infinity-norm condition number is required:
|
|
* = '1' or 'O': 1-norm;
|
|
* = 'I': Infinity-norm.
|
|
*
|
|
* N (input) INTEGER
|
|
* The order of the matrix A. N >= 0.
|
|
*
|
|
* A (input) DOUBLE PRECISION array, dimension (LDA,N)
|
|
* The factors L and U from the factorization A = P*L*U
|
|
* as computed by DGETRF.
|
|
*
|
|
* LDA (input) INTEGER
|
|
* The leading dimension of the array A. LDA >= max(1,N).
|
|
*
|
|
* ANORM (input) DOUBLE PRECISION
|
|
* If NORM = '1' or 'O', the 1-norm of the original matrix A.
|
|
* If NORM = 'I', the infinity-norm of the original matrix A.
|
|
*
|
|
* RCOND (output) DOUBLE PRECISION
|
|
* The reciprocal of the condition number of the matrix A,
|
|
* computed as RCOND = 1/(norm(A) * norm(inv(A))).
|
|
*
|
|
* WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
|
|
*
|
|
* IWORK (workspace) INTEGER array, dimension (N)
|
|
*
|
|
* INFO (output) INTEGER
|
|
* = 0: successful exit
|
|
* < 0: if INFO = -i, the i-th argument had an illegal value
|
|
*
|
|
* =====================================================================
|
|
*
|
|
* .. Parameters ..
|
|
DOUBLE PRECISION ONE, ZERO
|
|
PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
|
|
* ..
|
|
* .. Local Scalars ..
|
|
LOGICAL ONENRM
|
|
CHARACTER NORMIN
|
|
INTEGER IX, KASE, KASE1
|
|
DOUBLE PRECISION AINVNM, SCALE, SL, SMLNUM, SU
|
|
* ..
|
|
* .. External Functions ..
|
|
LOGICAL LSAME
|
|
INTEGER IDAMAX
|
|
DOUBLE PRECISION DLAMCH
|
|
EXTERNAL LSAME, IDAMAX, DLAMCH
|
|
* ..
|
|
* .. External Subroutines ..
|
|
EXTERNAL DLACON, DLATRS, DRSCL, XERBLA
|
|
* ..
|
|
* .. Intrinsic Functions ..
|
|
INTRINSIC ABS, MAX
|
|
* ..
|
|
* .. Executable Statements ..
|
|
*
|
|
* Test the input parameters.
|
|
*
|
|
INFO = 0
|
|
ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
|
|
IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
|
|
INFO = -1
|
|
ELSE IF( N.LT.0 ) THEN
|
|
INFO = -2
|
|
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
|
|
INFO = -4
|
|
ELSE IF( ANORM.LT.ZERO ) THEN
|
|
INFO = -5
|
|
END IF
|
|
IF( INFO.NE.0 ) THEN
|
|
CALL XERBLA( 'DGECON', -INFO )
|
|
RETURN
|
|
END IF
|
|
*
|
|
* Quick return if possible
|
|
*
|
|
RCOND = ZERO
|
|
IF( N.EQ.0 ) THEN
|
|
RCOND = ONE
|
|
RETURN
|
|
ELSE IF( ANORM.EQ.ZERO ) THEN
|
|
RETURN
|
|
END IF
|
|
*
|
|
SMLNUM = DLAMCH( 'Safe minimum' )
|
|
*
|
|
* Estimate the norm of inv(A).
|
|
*
|
|
AINVNM = ZERO
|
|
NORMIN = 'N'
|
|
IF( ONENRM ) THEN
|
|
KASE1 = 1
|
|
ELSE
|
|
KASE1 = 2
|
|
END IF
|
|
KASE = 0
|
|
10 CONTINUE
|
|
CALL DLACON( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE )
|
|
IF( KASE.NE.0 ) THEN
|
|
IF( KASE.EQ.KASE1 ) THEN
|
|
*
|
|
* Multiply by inv(L).
|
|
*
|
|
CALL DLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A,
|
|
$ LDA, WORK, SL, WORK( 2*N+1 ), INFO )
|
|
*
|
|
* Multiply by inv(U).
|
|
*
|
|
CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
|
|
$ A, LDA, WORK, SU, WORK( 3*N+1 ), INFO )
|
|
ELSE
|
|
*
|
|
* Multiply by inv(U').
|
|
*
|
|
CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A,
|
|
$ LDA, WORK, SU, WORK( 3*N+1 ), INFO )
|
|
*
|
|
* Multiply by inv(L').
|
|
*
|
|
CALL DLATRS( 'Lower', 'Transpose', 'Unit', NORMIN, N, A,
|
|
$ LDA, WORK, SL, WORK( 2*N+1 ), INFO )
|
|
END IF
|
|
*
|
|
* Divide X by 1/(SL*SU) if doing so will not cause overflow.
|
|
*
|
|
SCALE = SL*SU
|
|
NORMIN = 'Y'
|
|
IF( SCALE.NE.ONE ) THEN
|
|
IX = IDAMAX( N, WORK, 1 )
|
|
IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
|
|
$ GO TO 20
|
|
CALL DRSCL( N, SCALE, WORK, 1 )
|
|
END IF
|
|
GO TO 10
|
|
END IF
|
|
*
|
|
* Compute the estimate of the reciprocal condition number.
|
|
*
|
|
IF( AINVNM.NE.ZERO )
|
|
$ RCOND = ( ONE / AINVNM ) / ANORM
|
|
*
|
|
20 CONTINUE
|
|
RETURN
|
|
*
|
|
* End of DGECON
|
|
*
|
|
END
|