Mercurial > octave-nkf

comparison libcruft/lapack/dgesvd.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 edcaebe1b81b
comparison
equal deleted inserted replaced
3332:7c03933635c6 3333:15cddaacbc2d
1 SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, 1 SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
2 $ WORK, LWORK, INFO ) 2 $ 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 JOBU, JOBVT 10 CHARACTER JOBU, JOBVT
11 INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N 11 INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
12 * .. 12 * ..
116 * LWORK (input) INTEGER 116 * LWORK (input) INTEGER
117 * The dimension of the array WORK. LWORK >= 1. 117 * The dimension of the array WORK. LWORK >= 1.
118 * LWORK >= MAX(3*MIN(M,N)+MAX(M,N),5*MIN(M,N)-4). 118 * LWORK >= MAX(3*MIN(M,N)+MAX(M,N),5*MIN(M,N)-4).
119 * For good performance, LWORK should generally be larger. 119 * For good performance, LWORK should generally be larger.
120 * 120 *
121 * If LWORK = -1, then a workspace query is assumed; the routine
122 * only calculates the optimal size of the WORK array, returns
123 * this value as the first entry of the WORK array, and no error
124 * message related to LWORK is issued by XERBLA.
125 *
121 * INFO (output) INTEGER 126 * INFO (output) INTEGER
122 * = 0: successful exit. 127 * = 0: successful exit.
123 * < 0: if INFO = -i, the i-th argument had an illegal value. 128 * < 0: if INFO = -i, the i-th argument had an illegal value.
124 * > 0: if DBDSQR did not converge, INFO specifies how many 129 * > 0: if DBDSQR did not converge, INFO specifies how many
125 * superdiagonals of an intermediate bidiagonal form B 130 * superdiagonals of an intermediate bidiagonal form B
131 * .. Parameters .. 136 * .. Parameters ..
132 DOUBLE PRECISION ZERO, ONE 137 DOUBLE PRECISION ZERO, ONE
133 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 138 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
134 * .. 139 * ..
135 * .. Local Scalars .. 140 * .. Local Scalars ..
136 LOGICAL WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS, WNTVA, 141 LOGICAL LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
137 $ WNTVAS, WNTVN, WNTVO, WNTVS 142 $ WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
138 INTEGER BDSPAC, BLK, CHUNK, I, IE, IERR, IR, ISCL, 143 INTEGER BDSPAC, BLK, CHUNK, I, IE, IERR, IR, ISCL,
139 $ ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU, 144 $ ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
140 $ MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU, 145 $ MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
141 $ NRVT, WRKBL 146 $ NRVT, WRKBL
142 DOUBLE PRECISION ANRM, BIGNUM, EPS, SMLNUM 147 DOUBLE PRECISION ANRM, BIGNUM, EPS, SMLNUM
174 WNTVS = LSAME( JOBVT, 'S' ) 179 WNTVS = LSAME( JOBVT, 'S' )
175 WNTVAS = WNTVA .OR. WNTVS 180 WNTVAS = WNTVA .OR. WNTVS
176 WNTVO = LSAME( JOBVT, 'O' ) 181 WNTVO = LSAME( JOBVT, 'O' )
177 WNTVN = LSAME( JOBVT, 'N' ) 182 WNTVN = LSAME( JOBVT, 'N' )
178 MINWRK = 1 183 MINWRK = 1
184 LQUERY = ( LWORK.EQ.-1 )
179 * 185 *
180 IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN 186 IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
181 INFO = -1 187 INFO = -1
182 ELSE IF( .NOT.( WNTVA .OR. WNTVS .OR. WNTVO .OR. WNTVN ) .OR. 188 ELSE IF( .NOT.( WNTVA .OR. WNTVS .OR. WNTVO .OR. WNTVN ) .OR.
183 $ ( WNTVO .AND. WNTUO ) ) THEN 189 $ ( WNTVO .AND. WNTUO ) ) THEN
200 * minimal amount of workspace needed at that point in the code, 206 * minimal amount of workspace needed at that point in the code,
201 * as well as the preferred amount for good performance. 207 * as well as the preferred amount for good performance.
202 * NB refers to the optimal block size for the immediately 208 * NB refers to the optimal block size for the immediately
203 * following subroutine, as returned by ILAENV.) 209 * following subroutine, as returned by ILAENV.)
204 * 210 *
205 IF( INFO.EQ.0 .AND. LWORK.GE.1 .AND. M.GT.0 .AND. N.GT.0 ) THEN 211 IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) .AND. M.GT.0 .AND.
212 $ N.GT.0 ) THEN
206 IF( M.GE.N ) THEN 213 IF( M.GE.N ) THEN
207 * 214 *
208 * Compute space needed for DBDSQR 215 * Compute space needed for DBDSQR
209 * 216 *
210 BDSPAC = MAX( 3*N, 5*N-4 ) 217 BDSPAC = MAX( 3*N, 5*N-4 )
551 END IF 558 END IF
552 END IF 559 END IF
553 WORK( 1 ) = MAXWRK 560 WORK( 1 ) = MAXWRK
554 END IF 561 END IF
555 * 562 *
556 IF( LWORK.LT.MINWRK ) THEN 563 IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
557 INFO = -13 564 INFO = -13
558 END IF 565 END IF
559 IF( INFO.NE.0 ) THEN 566 IF( INFO.NE.0 ) THEN
560 CALL XERBLA( 'DGESVD', -INFO ) 567 CALL XERBLA( 'DGESVD', -INFO )
568 RETURN
569 ELSE IF( LQUERY ) THEN
561 RETURN 570 RETURN
562 END IF 571 END IF
563 * 572 *
564 * Quick return if possible 573 * Quick return if possible
565 * 574 *