Mercurial > octave-nkf

comparison libcruft/lapack/dsyev.f @ 7034:68db500cb558

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2007-10-16 18:54:19 by jwe]
author jwe
date Tue, 16 Oct 2007 18:54:23 +0000
parents 15cddaacbc2d
children
comparison
equal deleted inserted replaced
7033:f0142f2afdc6 7034:68db500cb558
1 SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) 1 SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
2 * 2 *
3 * -- LAPACK driver routine (version 3.0) -- 3 * -- LAPACK driver routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * Courant Institute, Argonne National Lab, and Rice University 5 * November 2006
6 * June 30, 1999
7 * 6 *
8 * .. Scalar Arguments .. 7 * .. Scalar Arguments ..
9 CHARACTER JOBZ, UPLO 8 CHARACTER JOBZ, UPLO
10 INTEGER INFO, LDA, LWORK, N 9 INTEGER INFO, LDA, LWORK, N
11 * .. 10 * ..
49 * The leading dimension of the array A. LDA >= max(1,N). 48 * The leading dimension of the array A. LDA >= max(1,N).
50 * 49 *
51 * W (output) DOUBLE PRECISION array, dimension (N) 50 * W (output) DOUBLE PRECISION array, dimension (N)
52 * If INFO = 0, the eigenvalues in ascending order. 51 * If INFO = 0, the eigenvalues in ascending order.
53 * 52 *
54 * WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) 53 * WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
55 * On exit, if INFO = 0, WORK(1) returns the optimal LWORK. 54 * On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
56 * 55 *
57 * LWORK (input) INTEGER 56 * LWORK (input) INTEGER
58 * The length of the array WORK. LWORK >= max(1,3*N-1). 57 * The length of the array WORK. LWORK >= max(1,3*N-1).
59 * For optimal efficiency, LWORK >= (NB+2)*N, 58 * For optimal efficiency, LWORK >= (NB+2)*N,
78 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 77 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
79 * .. 78 * ..
80 * .. Local Scalars .. 79 * .. Local Scalars ..
81 LOGICAL LOWER, LQUERY, WANTZ 80 LOGICAL LOWER, LQUERY, WANTZ
82 INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE, 81 INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
83 $ LLWORK, LOPT, LWKOPT, NB 82 $ LLWORK, LWKOPT, NB
84 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, 83 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
85 $ SMLNUM 84 $ SMLNUM
86 * .. 85 * ..
87 * .. External Functions .. 86 * .. External Functions ..
88 LOGICAL LSAME 87 LOGICAL LSAME
112 INFO = -2 111 INFO = -2
113 ELSE IF( N.LT.0 ) THEN 112 ELSE IF( N.LT.0 ) THEN
114 INFO = -3 113 INFO = -3
115 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 114 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
116 INFO = -5 115 INFO = -5
117 ELSE IF( LWORK.LT.MAX( 1, 3*N-1 ) .AND. .NOT.LQUERY ) THEN
118 INFO = -8
119 END IF 116 END IF
120 * 117 *
121 IF( INFO.EQ.0 ) THEN 118 IF( INFO.EQ.0 ) THEN
122 NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) 119 NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
123 LWKOPT = MAX( 1, ( NB+2 )*N ) 120 LWKOPT = MAX( 1, ( NB+2 )*N )
124 WORK( 1 ) = LWKOPT 121 WORK( 1 ) = LWKOPT
122 *
123 IF( LWORK.LT.MAX( 1, 3*N-1 ) .AND. .NOT.LQUERY )
124 $ INFO = -8
125 END IF 125 END IF
126 * 126 *
127 IF( INFO.NE.0 ) THEN 127 IF( INFO.NE.0 ) THEN
128 CALL XERBLA( 'DSYEV ', -INFO ) 128 CALL XERBLA( 'DSYEV ', -INFO )
129 RETURN 129 RETURN
132 END IF 132 END IF
133 * 133 *
134 * Quick return if possible 134 * Quick return if possible
135 * 135 *
136 IF( N.EQ.0 ) THEN 136 IF( N.EQ.0 ) THEN
137 WORK( 1 ) = 1
138 RETURN 137 RETURN
139 END IF 138 END IF
140 * 139 *
141 IF( N.EQ.1 ) THEN 140 IF( N.EQ.1 ) THEN
142 W( 1 ) = A( 1, 1 ) 141 W( 1 ) = A( 1, 1 )
143 WORK( 1 ) = 3 142 WORK( 1 ) = 2
144 IF( WANTZ ) 143 IF( WANTZ )
145 $ A( 1, 1 ) = ONE 144 $ A( 1, 1 ) = ONE
146 RETURN 145 RETURN
147 END IF 146 END IF
148 * 147 *
175 INDTAU = INDE + N 174 INDTAU = INDE + N
176 INDWRK = INDTAU + N 175 INDWRK = INDTAU + N
177 LLWORK = LWORK - INDWRK + 1 176 LLWORK = LWORK - INDWRK + 1
178 CALL DSYTRD( UPLO, N, A, LDA, W, WORK( INDE ), WORK( INDTAU ), 177 CALL DSYTRD( UPLO, N, A, LDA, W, WORK( INDE ), WORK( INDTAU ),
179 $ WORK( INDWRK ), LLWORK, IINFO ) 178 $ WORK( INDWRK ), LLWORK, IINFO )
180 LOPT = 2*N + WORK( INDWRK )
181 * 179 *
182 * For eigenvalues only, call DSTERF. For eigenvectors, first call 180 * For eigenvalues only, call DSTERF. For eigenvectors, first call
183 * DORGTR to generate the orthogonal matrix, then call DSTEQR. 181 * DORGTR to generate the orthogonal matrix, then call DSTEQR.
184 * 182 *
185 IF( .NOT.WANTZ ) THEN 183 IF( .NOT.WANTZ ) THEN