LAPACK 3.3.1 Linear Algebra PACKage

# sspcon.f

Go to the documentation of this file.
```00001       SUBROUTINE SSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK,
00002      \$                   INFO )
00003 *
00004 *  -- LAPACK routine (version 3.3.1) --
00005 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00006 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00007 *  -- April 2011                                                      --
00008 *
00009 *     Modified to call SLACN2 in place of SLACON, 5 Feb 03, SJH.
00010 *
00011 *     .. Scalar Arguments ..
00012       CHARACTER          UPLO
00013       INTEGER            INFO, N
00014       REAL               ANORM, RCOND
00015 *     ..
00016 *     .. Array Arguments ..
00017       INTEGER            IPIV( * ), IWORK( * )
00018       REAL               AP( * ), WORK( * )
00019 *     ..
00020 *
00021 *  Purpose
00022 *  =======
00023 *
00024 *  SSPCON estimates the reciprocal of the condition number (in the
00025 *  1-norm) of a real symmetric packed matrix A using the factorization
00026 *  A = U*D*U**T or A = L*D*L**T computed by SSPTRF.
00027 *
00028 *  An estimate is obtained for norm(inv(A)), and the reciprocal of the
00029 *  condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
00030 *
00031 *  Arguments
00032 *  =========
00033 *
00034 *  UPLO    (input) CHARACTER*1
00035 *          Specifies whether the details of the factorization are stored
00036 *          as an upper or lower triangular matrix.
00037 *          = 'U':  Upper triangular, form is A = U*D*U**T;
00038 *          = 'L':  Lower triangular, form is A = L*D*L**T.
00039 *
00040 *  N       (input) INTEGER
00041 *          The order of the matrix A.  N >= 0.
00042 *
00043 *  AP      (input) REAL array, dimension (N*(N+1)/2)
00044 *          The block diagonal matrix D and the multipliers used to
00045 *          obtain the factor U or L as computed by SSPTRF, stored as a
00046 *          packed triangular matrix.
00047 *
00048 *  IPIV    (input) INTEGER array, dimension (N)
00049 *          Details of the interchanges and the block structure of D
00050 *          as determined by SSPTRF.
00051 *
00052 *  ANORM   (input) REAL
00053 *          The 1-norm of the original matrix A.
00054 *
00055 *  RCOND   (output) REAL
00056 *          The reciprocal of the condition number of the matrix A,
00057 *          computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
00058 *          estimate of the 1-norm of inv(A) computed in this routine.
00059 *
00060 *  WORK    (workspace) REAL array, dimension (2*N)
00061 *
00062 *  IWORK    (workspace) INTEGER array, dimension (N)
00063 *
00064 *  INFO    (output) INTEGER
00065 *          = 0:  successful exit
00066 *          < 0:  if INFO = -i, the i-th argument had an illegal value
00067 *
00068 *  =====================================================================
00069 *
00070 *     .. Parameters ..
00071       REAL               ONE, ZERO
00072       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00073 *     ..
00074 *     .. Local Scalars ..
00075       LOGICAL            UPPER
00076       INTEGER            I, IP, KASE
00077       REAL               AINVNM
00078 *     ..
00079 *     .. Local Arrays ..
00080       INTEGER            ISAVE( 3 )
00081 *     ..
00082 *     .. External Functions ..
00083       LOGICAL            LSAME
00084       EXTERNAL           LSAME
00085 *     ..
00086 *     .. External Subroutines ..
00087       EXTERNAL           SLACN2, SSPTRS, XERBLA
00088 *     ..
00089 *     .. Executable Statements ..
00090 *
00091 *     Test the input parameters.
00092 *
00093       INFO = 0
00094       UPPER = LSAME( UPLO, 'U' )
00095       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00096          INFO = -1
00097       ELSE IF( N.LT.0 ) THEN
00098          INFO = -2
00099       ELSE IF( ANORM.LT.ZERO ) THEN
00100          INFO = -5
00101       END IF
00102       IF( INFO.NE.0 ) THEN
00103          CALL XERBLA( 'SSPCON', -INFO )
00104          RETURN
00105       END IF
00106 *
00107 *     Quick return if possible
00108 *
00109       RCOND = ZERO
00110       IF( N.EQ.0 ) THEN
00111          RCOND = ONE
00112          RETURN
00113       ELSE IF( ANORM.LE.ZERO ) THEN
00114          RETURN
00115       END IF
00116 *
00117 *     Check that the diagonal matrix D is nonsingular.
00118 *
00119       IF( UPPER ) THEN
00120 *
00121 *        Upper triangular storage: examine D from bottom to top
00122 *
00123          IP = N*( N+1 ) / 2
00124          DO 10 I = N, 1, -1
00125             IF( IPIV( I ).GT.0 .AND. AP( IP ).EQ.ZERO )
00126      \$         RETURN
00127             IP = IP - I
00128    10    CONTINUE
00129       ELSE
00130 *
00131 *        Lower triangular storage: examine D from top to bottom.
00132 *
00133          IP = 1
00134          DO 20 I = 1, N
00135             IF( IPIV( I ).GT.0 .AND. AP( IP ).EQ.ZERO )
00136      \$         RETURN
00137             IP = IP + N - I + 1
00138    20    CONTINUE
00139       END IF
00140 *
00141 *     Estimate the 1-norm of the inverse.
00142 *
00143       KASE = 0
00144    30 CONTINUE
00145       CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
00146       IF( KASE.NE.0 ) THEN
00147 *
00148 *        Multiply by inv(L*D*L**T) or inv(U*D*U**T).
00149 *
00150          CALL SSPTRS( UPLO, N, 1, AP, IPIV, WORK, N, INFO )
00151          GO TO 30
00152       END IF
00153 *
00154 *     Compute the estimate of the reciprocal condition number.
00155 *
00156       IF( AINVNM.NE.ZERO )
00157      \$   RCOND = ( ONE / AINVNM ) / ANORM
00158 *
00159       RETURN
00160 *
00161 *     End of SSPCON
00162 *
00163       END
```