LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE SSTEV( JOBZ, N, D, E, Z, LDZ, WORK, INFO ) 00002 * 00003 * -- LAPACK driver 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 * .. Scalar Arguments .. 00009 CHARACTER JOBZ 00010 INTEGER INFO, LDZ, N 00011 * .. 00012 * .. Array Arguments .. 00013 REAL D( * ), E( * ), WORK( * ), Z( LDZ, * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * SSTEV computes all eigenvalues and, optionally, eigenvectors of a 00020 * real symmetric tridiagonal matrix A. 00021 * 00022 * Arguments 00023 * ========= 00024 * 00025 * JOBZ (input) CHARACTER*1 00026 * = 'N': Compute eigenvalues only; 00027 * = 'V': Compute eigenvalues and eigenvectors. 00028 * 00029 * N (input) INTEGER 00030 * The order of the matrix. N >= 0. 00031 * 00032 * D (input/output) REAL array, dimension (N) 00033 * On entry, the n diagonal elements of the tridiagonal matrix 00034 * A. 00035 * On exit, if INFO = 0, the eigenvalues in ascending order. 00036 * 00037 * E (input/output) REAL array, dimension (N-1) 00038 * On entry, the (n-1) subdiagonal elements of the tridiagonal 00039 * matrix A, stored in elements 1 to N-1 of E. 00040 * On exit, the contents of E are destroyed. 00041 * 00042 * Z (output) REAL array, dimension (LDZ, N) 00043 * If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal 00044 * eigenvectors of the matrix A, with the i-th column of Z 00045 * holding the eigenvector associated with D(i). 00046 * If JOBZ = 'N', then Z is not referenced. 00047 * 00048 * LDZ (input) INTEGER 00049 * The leading dimension of the array Z. LDZ >= 1, and if 00050 * JOBZ = 'V', LDZ >= max(1,N). 00051 * 00052 * WORK (workspace) REAL array, dimension (max(1,2*N-2)) 00053 * If JOBZ = 'N', WORK is not referenced. 00054 * 00055 * INFO (output) INTEGER 00056 * = 0: successful exit 00057 * < 0: if INFO = -i, the i-th argument had an illegal value 00058 * > 0: if INFO = i, the algorithm failed to converge; i 00059 * off-diagonal elements of E did not converge to zero. 00060 * 00061 * ===================================================================== 00062 * 00063 * .. Parameters .. 00064 REAL ZERO, ONE 00065 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) 00066 * .. 00067 * .. Local Scalars .. 00068 LOGICAL WANTZ 00069 INTEGER IMAX, ISCALE 00070 REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM, 00071 $ TNRM 00072 * .. 00073 * .. External Functions .. 00074 LOGICAL LSAME 00075 REAL SLAMCH, SLANST 00076 EXTERNAL LSAME, SLAMCH, SLANST 00077 * .. 00078 * .. External Subroutines .. 00079 EXTERNAL SSCAL, SSTEQR, SSTERF, XERBLA 00080 * .. 00081 * .. Intrinsic Functions .. 00082 INTRINSIC SQRT 00083 * .. 00084 * .. Executable Statements .. 00085 * 00086 * Test the input parameters. 00087 * 00088 WANTZ = LSAME( JOBZ, 'V' ) 00089 * 00090 INFO = 0 00091 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN 00092 INFO = -1 00093 ELSE IF( N.LT.0 ) THEN 00094 INFO = -2 00095 ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN 00096 INFO = -6 00097 END IF 00098 * 00099 IF( INFO.NE.0 ) THEN 00100 CALL XERBLA( 'SSTEV ', -INFO ) 00101 RETURN 00102 END IF 00103 * 00104 * Quick return if possible 00105 * 00106 IF( N.EQ.0 ) 00107 $ RETURN 00108 * 00109 IF( N.EQ.1 ) THEN 00110 IF( WANTZ ) 00111 $ Z( 1, 1 ) = ONE 00112 RETURN 00113 END IF 00114 * 00115 * Get machine constants. 00116 * 00117 SAFMIN = SLAMCH( 'Safe minimum' ) 00118 EPS = SLAMCH( 'Precision' ) 00119 SMLNUM = SAFMIN / EPS 00120 BIGNUM = ONE / SMLNUM 00121 RMIN = SQRT( SMLNUM ) 00122 RMAX = SQRT( BIGNUM ) 00123 * 00124 * Scale matrix to allowable range, if necessary. 00125 * 00126 ISCALE = 0 00127 TNRM = SLANST( 'M', N, D, E ) 00128 IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN 00129 ISCALE = 1 00130 SIGMA = RMIN / TNRM 00131 ELSE IF( TNRM.GT.RMAX ) THEN 00132 ISCALE = 1 00133 SIGMA = RMAX / TNRM 00134 END IF 00135 IF( ISCALE.EQ.1 ) THEN 00136 CALL SSCAL( N, SIGMA, D, 1 ) 00137 CALL SSCAL( N-1, SIGMA, E( 1 ), 1 ) 00138 END IF 00139 * 00140 * For eigenvalues only, call SSTERF. For eigenvalues and 00141 * eigenvectors, call SSTEQR. 00142 * 00143 IF( .NOT.WANTZ ) THEN 00144 CALL SSTERF( N, D, E, INFO ) 00145 ELSE 00146 CALL SSTEQR( 'I', N, D, E, Z, LDZ, WORK, INFO ) 00147 END IF 00148 * 00149 * If matrix was scaled, then rescale eigenvalues appropriately. 00150 * 00151 IF( ISCALE.EQ.1 ) THEN 00152 IF( INFO.EQ.0 ) THEN 00153 IMAX = N 00154 ELSE 00155 IMAX = INFO - 1 00156 END IF 00157 CALL SSCAL( IMAX, ONE / SIGMA, D, 1 ) 00158 END IF 00159 * 00160 RETURN 00161 * 00162 * End of SSTEV 00163 * 00164 END