LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine dspev ( character  JOBZ,
character  UPLO,
integer  N,
double precision, dimension( * )  AP,
double precision, dimension( * )  W,
double precision, dimension( ldz, * )  Z,
integer  LDZ,
double precision, dimension( * )  WORK,
integer  INFO 
)

DSPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices

Download DSPEV + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DSPEV computes all the eigenvalues and, optionally, eigenvectors of a
 real symmetric matrix A in packed storage.
Parameters
[in]JOBZ
          JOBZ is CHARACTER*1
          = 'N':  Compute eigenvalues only;
          = 'V':  Compute eigenvalues and eigenvectors.
[in]UPLO
          UPLO is CHARACTER*1
          = 'U':  Upper triangle of A is stored;
          = 'L':  Lower triangle of A is stored.
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.
[in,out]AP
          AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
          On entry, the upper or lower triangle of the symmetric matrix
          A, packed columnwise in a linear array.  The j-th column of A
          is stored in the array AP as follows:
          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
          if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.

          On exit, AP is overwritten by values generated during the
          reduction to tridiagonal form.  If UPLO = 'U', the diagonal
          and first superdiagonal of the tridiagonal matrix T overwrite
          the corresponding elements of A, and if UPLO = 'L', the
          diagonal and first subdiagonal of T overwrite the
          corresponding elements of A.
[out]W
          W is DOUBLE PRECISION array, dimension (N)
          If INFO = 0, the eigenvalues in ascending order.
[out]Z
          Z is DOUBLE PRECISION array, dimension (LDZ, N)
          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
          eigenvectors of the matrix A, with the i-th column of Z
          holding the eigenvector associated with W(i).
          If JOBZ = 'N', then Z is not referenced.
[in]LDZ
          LDZ is INTEGER
          The leading dimension of the array Z.  LDZ >= 1, and if
          JOBZ = 'V', LDZ >= max(1,N).
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (3*N)
[out]INFO
          INFO is INTEGER
          = 0:  successful exit.
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          > 0:  if INFO = i, the algorithm failed to converge; i
                off-diagonal elements of an intermediate tridiagonal
                form did not converge to zero.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 132 of file dspev.f.

132 *
133 * -- LAPACK driver routine (version 3.4.0) --
134 * -- LAPACK is a software package provided by Univ. of Tennessee, --
135 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
136 * November 2011
137 *
138 * .. Scalar Arguments ..
139  CHARACTER jobz, uplo
140  INTEGER info, ldz, n
141 * ..
142 * .. Array Arguments ..
143  DOUBLE PRECISION ap( * ), w( * ), work( * ), z( ldz, * )
144 * ..
145 *
146 * =====================================================================
147 *
148 * .. Parameters ..
149  DOUBLE PRECISION zero, one
150  parameter ( zero = 0.0d0, one = 1.0d0 )
151 * ..
152 * .. Local Scalars ..
153  LOGICAL wantz
154  INTEGER iinfo, imax, inde, indtau, indwrk, iscale
155  DOUBLE PRECISION anrm, bignum, eps, rmax, rmin, safmin, sigma,
156  $ smlnum
157 * ..
158 * .. External Functions ..
159  LOGICAL lsame
160  DOUBLE PRECISION dlamch, dlansp
161  EXTERNAL lsame, dlamch, dlansp
162 * ..
163 * .. External Subroutines ..
164  EXTERNAL dopgtr, dscal, dsptrd, dsteqr, dsterf, xerbla
165 * ..
166 * .. Intrinsic Functions ..
167  INTRINSIC sqrt
168 * ..
169 * .. Executable Statements ..
170 *
171 * Test the input parameters.
172 *
173  wantz = lsame( jobz, 'V' )
174 *
175  info = 0
176  IF( .NOT.( wantz .OR. lsame( jobz, 'N' ) ) ) THEN
177  info = -1
178  ELSE IF( .NOT.( lsame( uplo, 'U' ) .OR. lsame( uplo, 'L' ) ) )
179  $ THEN
180  info = -2
181  ELSE IF( n.LT.0 ) THEN
182  info = -3
183  ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) ) THEN
184  info = -7
185  END IF
186 *
187  IF( info.NE.0 ) THEN
188  CALL xerbla( 'DSPEV ', -info )
189  RETURN
190  END IF
191 *
192 * Quick return if possible
193 *
194  IF( n.EQ.0 )
195  $ RETURN
196 *
197  IF( n.EQ.1 ) THEN
198  w( 1 ) = ap( 1 )
199  IF( wantz )
200  $ z( 1, 1 ) = one
201  RETURN
202  END IF
203 *
204 * Get machine constants.
205 *
206  safmin = dlamch( 'Safe minimum' )
207  eps = dlamch( 'Precision' )
208  smlnum = safmin / eps
209  bignum = one / smlnum
210  rmin = sqrt( smlnum )
211  rmax = sqrt( bignum )
212 *
213 * Scale matrix to allowable range, if necessary.
214 *
215  anrm = dlansp( 'M', uplo, n, ap, work )
216  iscale = 0
217  IF( anrm.GT.zero .AND. anrm.LT.rmin ) THEN
218  iscale = 1
219  sigma = rmin / anrm
220  ELSE IF( anrm.GT.rmax ) THEN
221  iscale = 1
222  sigma = rmax / anrm
223  END IF
224  IF( iscale.EQ.1 ) THEN
225  CALL dscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
226  END IF
227 *
228 * Call DSPTRD to reduce symmetric packed matrix to tridiagonal form.
229 *
230  inde = 1
231  indtau = inde + n
232  CALL dsptrd( uplo, n, ap, w, work( inde ), work( indtau ), iinfo )
233 *
234 * For eigenvalues only, call DSTERF. For eigenvectors, first call
235 * DOPGTR to generate the orthogonal matrix, then call DSTEQR.
236 *
237  IF( .NOT.wantz ) THEN
238  CALL dsterf( n, w, work( inde ), info )
239  ELSE
240  indwrk = indtau + n
241  CALL dopgtr( uplo, n, ap, work( indtau ), z, ldz,
242  $ work( indwrk ), iinfo )
243  CALL dsteqr( jobz, n, w, work( inde ), z, ldz, work( indtau ),
244  $ info )
245  END IF
246 *
247 * If matrix was scaled, then rescale eigenvalues appropriately.
248 *
249  IF( iscale.EQ.1 ) THEN
250  IF( info.EQ.0 ) THEN
251  imax = n
252  ELSE
253  imax = info - 1
254  END IF
255  CALL dscal( imax, one / sigma, w, 1 )
256  END IF
257 *
258  RETURN
259 *
260 * End of DSPEV
261 *
subroutine dsterf(N, D, E, INFO)
DSTERF
Definition: dsterf.f:88
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEQR
Definition: dsteqr.f:133
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dscal(N, DA, DX, INCX)
DSCAL
Definition: dscal.f:55
subroutine dsptrd(UPLO, N, AP, D, E, TAU, INFO)
DSPTRD
Definition: dsptrd.f:152
subroutine dopgtr(UPLO, N, AP, TAU, Q, LDQ, WORK, INFO)
DOPGTR
Definition: dopgtr.f:116
double precision function dlansp(NORM, UPLO, N, AP, WORK)
DLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
Definition: dlansp.f:116
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: