Mercurial > octave-nkf

comparison libcruft/lapack/dgeev.f @ 3333:15cddaacbc2d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1999-11-03 19:53:59 by jwe]
author jwe
date Wed, 03 Nov 1999 19:54:52 +0000
parents 30c606bec7a8
children fa5817b05b0f
comparison
equal deleted inserted replaced
3332:7c03933635c6 3333:15cddaacbc2d
1 SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, 1 SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
2 $ LDVR, WORK, LWORK, INFO ) 2 $ LDVR, WORK, LWORK, INFO )
3 * 3 *
4 * -- LAPACK driver routine (version 2.0) -- 4 * -- LAPACK driver routine (version 3.0) --
5 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 5 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
6 * Courant Institute, Argonne National Lab, and Rice University 6 * Courant Institute, Argonne National Lab, and Rice University
7 * September 30, 1994 7 * June 30, 1999
8 * 8 *
9 * .. Scalar Arguments .. 9 * .. Scalar Arguments ..
10 CHARACTER JOBVL, JOBVR 10 CHARACTER JOBVL, JOBVR
11 INTEGER INFO, LDA, LDVL, LDVR, LWORK, N 11 INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
12 * .. 12 * ..
96 * LWORK (input) INTEGER 96 * LWORK (input) INTEGER
97 * The dimension of the array WORK. LWORK >= max(1,3*N), and 97 * The dimension of the array WORK. LWORK >= max(1,3*N), and
98 * if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good 98 * if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
99 * performance, LWORK must generally be larger. 99 * performance, LWORK must generally be larger.
100 * 100 *
101 * If LWORK = -1, then a workspace query is assumed; the routine
102 * only calculates the optimal size of the WORK array, returns
103 * this value as the first entry of the WORK array, and no error
104 * message related to LWORK is issued by XERBLA.
105 *
101 * INFO (output) INTEGER 106 * INFO (output) INTEGER
102 * = 0: successful exit 107 * = 0: successful exit
103 * < 0: if INFO = -i, the i-th argument had an illegal value. 108 * < 0: if INFO = -i, the i-th argument had an illegal value.
104 * > 0: if INFO = i, the QR algorithm failed to compute all the 109 * > 0: if INFO = i, the QR algorithm failed to compute all the
105 * eigenvalues, and no eigenvectors have been computed; 110 * eigenvalues, and no eigenvectors have been computed;
111 * .. Parameters .. 116 * .. Parameters ..
112 DOUBLE PRECISION ZERO, ONE 117 DOUBLE PRECISION ZERO, ONE
113 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 118 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
114 * .. 119 * ..
115 * .. Local Scalars .. 120 * .. Local Scalars ..
116 LOGICAL SCALEA, WANTVL, WANTVR 121 LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
117 CHARACTER SIDE 122 CHARACTER SIDE
118 INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K, 123 INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K,
119 $ MAXB, MAXWRK, MINWRK, NOUT 124 $ MAXB, MAXWRK, MINWRK, NOUT
120 DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, 125 DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM,
121 $ SN 126 $ SN
123 * .. Local Arrays .. 128 * .. Local Arrays ..
124 LOGICAL SELECT( 1 ) 129 LOGICAL SELECT( 1 )
125 DOUBLE PRECISION DUM( 1 ) 130 DOUBLE PRECISION DUM( 1 )
126 * .. 131 * ..
127 * .. External Subroutines .. 132 * .. External Subroutines ..
128 EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY, 133 EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, DLARTG,
129 $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC, 134 $ DLASCL, DORGHR, DROT, DSCAL, DTREVC, XERBLA
130 $ XERBLA
131 * .. 135 * ..
132 * .. External Functions .. 136 * .. External Functions ..
133 LOGICAL LSAME 137 LOGICAL LSAME
134 INTEGER IDAMAX, ILAENV 138 INTEGER IDAMAX, ILAENV
135 DOUBLE PRECISION DLAMCH, DLANGE, DLAPY2, DNRM2 139 DOUBLE PRECISION DLAMCH, DLANGE, DLAPY2, DNRM2
142 * .. Executable Statements .. 146 * .. Executable Statements ..
143 * 147 *
144 * Test the input arguments 148 * Test the input arguments
145 * 149 *
146 INFO = 0 150 INFO = 0
151 LQUERY = ( LWORK.EQ.-1 )
147 WANTVL = LSAME( JOBVL, 'V' ) 152 WANTVL = LSAME( JOBVL, 'V' )
148 WANTVR = LSAME( JOBVR, 'V' ) 153 WANTVR = LSAME( JOBVR, 'V' )
149 IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN 154 IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
150 INFO = -1 155 INFO = -1
151 ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN 156 ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
191 MAXWRK = MAX( MAXWRK, N+1, N+HSWORK ) 196 MAXWRK = MAX( MAXWRK, N+1, N+HSWORK )
192 MAXWRK = MAX( MAXWRK, 4*N ) 197 MAXWRK = MAX( MAXWRK, 4*N )
193 END IF 198 END IF
194 WORK( 1 ) = MAXWRK 199 WORK( 1 ) = MAXWRK
195 END IF 200 END IF
196 IF( LWORK.LT.MINWRK ) THEN 201 IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
197 INFO = -13 202 INFO = -13
198 END IF 203 END IF
199 IF( INFO.NE.0 ) THEN 204 IF( INFO.NE.0 ) THEN
200 CALL XERBLA( 'DGEEV ', -INFO ) 205 CALL XERBLA( 'DGEEV ', -INFO )
206 RETURN
207 ELSE IF( LQUERY ) THEN
201 RETURN 208 RETURN
202 END IF 209 END IF
203 * 210 *
204 * Quick return if possible 211 * Quick return if possible
205 * 212 *