|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, 00002 $ LWORK, IWORK, LIWORK, INFO ) 00003 * 00004 * -- LAPACK driver routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER JOBZ, UPLO 00011 INTEGER INFO, ITYPE, LDA, LDB, LIWORK, LWORK, N 00012 * .. 00013 * .. Array Arguments .. 00014 INTEGER IWORK( * ) 00015 REAL A( LDA, * ), B( LDB, * ), W( * ), WORK( * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * SSYGVD computes all the eigenvalues, and optionally, the eigenvectors 00022 * of a real generalized symmetric-definite eigenproblem, of the form 00023 * A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and 00024 * B are assumed to be symmetric and B is also positive definite. 00025 * If eigenvectors are desired, it uses a divide and conquer algorithm. 00026 * 00027 * The divide and conquer algorithm makes very mild assumptions about 00028 * floating point arithmetic. It will work on machines with a guard 00029 * digit in add/subtract, or on those binary machines without guard 00030 * digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or 00031 * Cray-2. It could conceivably fail on hexadecimal or decimal machines 00032 * without guard digits, but we know of none. 00033 * 00034 * Arguments 00035 * ========= 00036 * 00037 * ITYPE (input) INTEGER 00038 * Specifies the problem type to be solved: 00039 * = 1: A*x = (lambda)*B*x 00040 * = 2: A*B*x = (lambda)*x 00041 * = 3: B*A*x = (lambda)*x 00042 * 00043 * JOBZ (input) CHARACTER*1 00044 * = 'N': Compute eigenvalues only; 00045 * = 'V': Compute eigenvalues and eigenvectors. 00046 * 00047 * UPLO (input) CHARACTER*1 00048 * = 'U': Upper triangles of A and B are stored; 00049 * = 'L': Lower triangles of A and B are stored. 00050 * 00051 * N (input) INTEGER 00052 * The order of the matrices A and B. N >= 0. 00053 * 00054 * A (input/output) REAL array, dimension (LDA, N) 00055 * On entry, the symmetric matrix A. If UPLO = 'U', the 00056 * leading N-by-N upper triangular part of A contains the 00057 * upper triangular part of the matrix A. If UPLO = 'L', 00058 * the leading N-by-N lower triangular part of A contains 00059 * the lower triangular part of the matrix A. 00060 * 00061 * On exit, if JOBZ = 'V', then if INFO = 0, A contains the 00062 * matrix Z of eigenvectors. The eigenvectors are normalized 00063 * as follows: 00064 * if ITYPE = 1 or 2, Z**T*B*Z = I; 00065 * if ITYPE = 3, Z**T*inv(B)*Z = I. 00066 * If JOBZ = 'N', then on exit the upper triangle (if UPLO='U') 00067 * or the lower triangle (if UPLO='L') of A, including the 00068 * diagonal, is destroyed. 00069 * 00070 * LDA (input) INTEGER 00071 * The leading dimension of the array A. LDA >= max(1,N). 00072 * 00073 * B (input/output) REAL array, dimension (LDB, N) 00074 * On entry, the symmetric matrix B. If UPLO = 'U', the 00075 * leading N-by-N upper triangular part of B contains the 00076 * upper triangular part of the matrix B. If UPLO = 'L', 00077 * the leading N-by-N lower triangular part of B contains 00078 * the lower triangular part of the matrix B. 00079 * 00080 * On exit, if INFO <= N, the part of B containing the matrix is 00081 * overwritten by the triangular factor U or L from the Cholesky 00082 * factorization B = U**T*U or B = L*L**T. 00083 * 00084 * LDB (input) INTEGER 00085 * The leading dimension of the array B. LDB >= max(1,N). 00086 * 00087 * W (output) REAL array, dimension (N) 00088 * If INFO = 0, the eigenvalues in ascending order. 00089 * 00090 * WORK (workspace/output) REAL array, dimension (MAX(1,LWORK)) 00091 * On exit, if INFO = 0, WORK(1) returns the optimal LWORK. 00092 * 00093 * LWORK (input) INTEGER 00094 * The dimension of the array WORK. 00095 * If N <= 1, LWORK >= 1. 00096 * If JOBZ = 'N' and N > 1, LWORK >= 2*N+1. 00097 * If JOBZ = 'V' and N > 1, LWORK >= 1 + 6*N + 2*N**2. 00098 * 00099 * If LWORK = -1, then a workspace query is assumed; the routine 00100 * only calculates the optimal sizes of the WORK and IWORK 00101 * arrays, returns these values as the first entries of the WORK 00102 * and IWORK arrays, and no error message related to LWORK or 00103 * LIWORK is issued by XERBLA. 00104 * 00105 * IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK)) 00106 * On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK. 00107 * 00108 * LIWORK (input) INTEGER 00109 * The dimension of the array IWORK. 00110 * If N <= 1, LIWORK >= 1. 00111 * If JOBZ = 'N' and N > 1, LIWORK >= 1. 00112 * If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N. 00113 * 00114 * If LIWORK = -1, then a workspace query is assumed; the 00115 * routine only calculates the optimal sizes of the WORK and 00116 * IWORK arrays, returns these values as the first entries of 00117 * the WORK and IWORK arrays, and no error message related to 00118 * LWORK or LIWORK is issued by XERBLA. 00119 * 00120 * INFO (output) INTEGER 00121 * = 0: successful exit 00122 * < 0: if INFO = -i, the i-th argument had an illegal value 00123 * > 0: SPOTRF or SSYEVD returned an error code: 00124 * <= N: if INFO = i and JOBZ = 'N', then the algorithm 00125 * failed to converge; i off-diagonal elements of an 00126 * intermediate tridiagonal form did not converge to 00127 * zero; 00128 * if INFO = i and JOBZ = 'V', then the algorithm 00129 * failed to compute an eigenvalue while working on 00130 * the submatrix lying in rows and columns INFO/(N+1) 00131 * through mod(INFO,N+1); 00132 * > N: if INFO = N + i, for 1 <= i <= N, then the leading 00133 * minor of order i of B is not positive definite. 00134 * The factorization of B could not be completed and 00135 * no eigenvalues or eigenvectors were computed. 00136 * 00137 * Further Details 00138 * =============== 00139 * 00140 * Based on contributions by 00141 * Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA 00142 * 00143 * Modified so that no backsubstitution is performed if SSYEVD fails to 00144 * converge (NEIG in old code could be greater than N causing out of 00145 * bounds reference to A - reported by Ralf Meyer). Also corrected the 00146 * description of INFO and the test on ITYPE. Sven, 16 Feb 05. 00147 * ===================================================================== 00148 * 00149 * .. Parameters .. 00150 REAL ONE 00151 PARAMETER ( ONE = 1.0E+0 ) 00152 * .. 00153 * .. Local Scalars .. 00154 LOGICAL LQUERY, UPPER, WANTZ 00155 CHARACTER TRANS 00156 INTEGER LIOPT, LIWMIN, LOPT, LWMIN 00157 * .. 00158 * .. External Functions .. 00159 LOGICAL LSAME 00160 EXTERNAL LSAME 00161 * .. 00162 * .. External Subroutines .. 00163 EXTERNAL SPOTRF, SSYEVD, SSYGST, STRMM, STRSM, XERBLA 00164 * .. 00165 * .. Intrinsic Functions .. 00166 INTRINSIC MAX, REAL 00167 * .. 00168 * .. Executable Statements .. 00169 * 00170 * Test the input parameters. 00171 * 00172 WANTZ = LSAME( JOBZ, 'V' ) 00173 UPPER = LSAME( UPLO, 'U' ) 00174 LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 ) 00175 * 00176 INFO = 0 00177 IF( N.LE.1 ) THEN 00178 LIWMIN = 1 00179 LWMIN = 1 00180 ELSE IF( WANTZ ) THEN 00181 LIWMIN = 3 + 5*N 00182 LWMIN = 1 + 6*N + 2*N**2 00183 ELSE 00184 LIWMIN = 1 00185 LWMIN = 2*N + 1 00186 END IF 00187 LOPT = LWMIN 00188 LIOPT = LIWMIN 00189 IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN 00190 INFO = -1 00191 ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN 00192 INFO = -2 00193 ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN 00194 INFO = -3 00195 ELSE IF( N.LT.0 ) THEN 00196 INFO = -4 00197 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00198 INFO = -6 00199 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00200 INFO = -8 00201 END IF 00202 * 00203 IF( INFO.EQ.0 ) THEN 00204 WORK( 1 ) = LOPT 00205 IWORK( 1 ) = LIOPT 00206 * 00207 IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN 00208 INFO = -11 00209 ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN 00210 INFO = -13 00211 END IF 00212 END IF 00213 * 00214 IF( INFO.NE.0 ) THEN 00215 CALL XERBLA( 'SSYGVD', -INFO ) 00216 RETURN 00217 ELSE IF( LQUERY ) THEN 00218 RETURN 00219 END IF 00220 * 00221 * Quick return if possible 00222 * 00223 IF( N.EQ.0 ) 00224 $ RETURN 00225 * 00226 * Form a Cholesky factorization of B. 00227 * 00228 CALL SPOTRF( UPLO, N, B, LDB, INFO ) 00229 IF( INFO.NE.0 ) THEN 00230 INFO = N + INFO 00231 RETURN 00232 END IF 00233 * 00234 * Transform problem to standard eigenvalue problem and solve. 00235 * 00236 CALL SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) 00237 CALL SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, 00238 $ INFO ) 00239 LOPT = MAX( REAL( LOPT ), REAL( WORK( 1 ) ) ) 00240 LIOPT = MAX( REAL( LIOPT ), REAL( IWORK( 1 ) ) ) 00241 * 00242 IF( WANTZ .AND. INFO.EQ.0 ) THEN 00243 * 00244 * Backtransform eigenvectors to the original problem. 00245 * 00246 IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN 00247 * 00248 * For A*x=(lambda)*B*x and A*B*x=(lambda)*x; 00249 * backtransform eigenvectors: x = inv(L)'*y or inv(U)*y 00250 * 00251 IF( UPPER ) THEN 00252 TRANS = 'N' 00253 ELSE 00254 TRANS = 'T' 00255 END IF 00256 * 00257 CALL STRSM( 'Left', UPLO, TRANS, 'Non-unit', N, N, ONE, 00258 $ B, LDB, A, LDA ) 00259 * 00260 ELSE IF( ITYPE.EQ.3 ) THEN 00261 * 00262 * For B*A*x=(lambda)*x; 00263 * backtransform eigenvectors: x = L*y or U'*y 00264 * 00265 IF( UPPER ) THEN 00266 TRANS = 'T' 00267 ELSE 00268 TRANS = 'N' 00269 END IF 00270 * 00271 CALL STRMM( 'Left', UPLO, TRANS, 'Non-unit', N, N, ONE, 00272 $ B, LDB, A, LDA ) 00273 END IF 00274 END IF 00275 * 00276 WORK( 1 ) = LOPT 00277 IWORK( 1 ) = LIOPT 00278 * 00279 RETURN 00280 * 00281 * End of SSYGVD 00282 * 00283 END
1.7.3 
