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