octave-nkf: libcruft/lapack/dgeesx.f comparison

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

[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

-:f0142f2afdc6
+:68db500cb558
 SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM,
 $                   WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK,
 $                   IWORK, LIWORK, BWORK, INFO )
 *
-*  -- LAPACK driver routine (version 3.0) --
+*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     Courant Institute, Argonne National Lab, and Rice University
+*     November 2006
-*     June 30, 1999
 *
 *     .. Scalar Arguments ..
 CHARACTER          JOBVS, SENSE, SORT
 INTEGER            INFO, LDA, LDVS, LIWORK, LWORK, N, SDIM
 DOUBLE PRECISION   RCONDE, RCONDV
 *          Specifies whether or not to order the eigenvalues on the
 *          diagonal of the Schur form.
 *          = 'N': Eigenvalues are not ordered;
 *          = 'S': Eigenvalues are ordered (see SELECT).
 *
-*  SELECT  (input) LOGICAL FUNCTION of two DOUBLE PRECISION arguments
+*  SELECT  (external procedure) LOGICAL FUNCTION of two DOUBLE PRECISION arguments
 *          SELECT must be declared EXTERNAL in the calling subroutine.
 *          If SORT = 'S', SELECT is used to select eigenvalues to sort
 *          to the top left of the Schur form.
 *          If SORT = 'N', SELECT is not referenced.
 *          An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
 *  RCONDV  (output) DOUBLE PRECISION
 *          If SENSE = 'V' or 'B', RCONDV contains the reciprocal
 *          condition number for the selected right invariant subspace.
 *          Not referenced if SENSE = 'N' or 'E'.
 *
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
 *          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
 *
 *  LWORK   (input) INTEGER
 *          The dimension of the array WORK.  LWORK >= max(1,3*N).
 *          Also, if SENSE = 'E' or 'V' or 'B',
 *          LWORK >= N+2*SDIM*(N-SDIM), where SDIM is the number of
 *          selected eigenvalues computed by this routine.  Note that
-*          N+2*SDIM*(N-SDIM) <= N+N*N/2.
+*          N+2*SDIM*(N-SDIM) <= N+N*N/2. Note also that an error is only
+*          returned if LWORK < max(1,3*N), but if SENSE = 'E' or 'V' or
+*          'B' this may not be large enough.
 *          For good performance, LWORK must generally be larger.
 *
-*  IWORK   (workspace/output) INTEGER array, dimension (LIWORK)
+*          If LWORK = -1, then a workspace query is assumed; the routine
-*          Not referenced if SENSE = 'N' or 'E'.
+*          only calculates upper bounds on the optimal sizes of the
+*          arrays WORK and IWORK, returns these values as the first
+*          entries of the WORK and IWORK arrays, and no error messages
+*          related to LWORK or LIWORK are issued by XERBLA.
+*
+*  IWORK   (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
 *          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
 *
 *  LIWORK  (input) INTEGER
 *          The dimension of the array IWORK.
 *          LIWORK >= 1; if SENSE = 'V' or 'B', LIWORK >= SDIM*(N-SDIM).
+*          Note that SDIM*(N-SDIM) <= N*N/4. Note also that an error is
+*          only returned if LIWORK < 1, but if SENSE = 'V' or 'B' this
+*          may not be large enough.
+*
+*          If LIWORK = -1, then a workspace query is assumed; the
+*          routine only calculates upper bounds on the optimal sizes of
+*          the arrays WORK and IWORK, returns these values as the first
+*          entries of the WORK and IWORK arrays, and no error messages
+*          related to LWORK or LIWORK are issued by XERBLA.
 *
 *  BWORK   (workspace) LOGICAL array, dimension (N)
 *          Not referenced if SORT = 'N'.
 *
 *  INFO    (output) INTEGER
 *     .. Parameters ..
 DOUBLE PRECISION   ZERO, ONE
 PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
 *     ..
 *     .. Local Scalars ..
-LOGICAL            CURSL, LASTSL, LST2SL, SCALEA, WANTSB, WANTSE,
+LOGICAL            CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTSB,
-$                   WANTSN, WANTST, WANTSV, WANTVS
+$                   WANTSE, WANTSN, WANTST, WANTSV, WANTVS
 INTEGER            HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
-$                   IHI, ILO, INXT, IP, ITAU, IWRK, K, MAXB,
+$                   IHI, ILO, INXT, IP, ITAU, IWRK, LIWRK, LWRK,
 $                   MAXWRK, MINWRK
 DOUBLE PRECISION   ANRM, BIGNUM, CSCALE, EPS, SMLNUM
 *     ..
 *     .. Local Arrays ..
 DOUBLE PRECISION   DUM( 1 )
 *     ..
 *     .. External Functions ..
 LOGICAL            LSAME
 INTEGER            ILAENV
 DOUBLE PRECISION   DLAMCH, DLANGE
-EXTERNAL           LSAME, ILAENV, DLAMCH, DLANGE
+EXTERNAL           LSAME, ILAENV, DLABAD, DLAMCH, DLANGE
 *     ..
 *     .. Intrinsic Functions ..
-INTRINSIC          MAX, MIN, SQRT
+INTRINSIC          MAX, SQRT
 *     ..
 *     .. Executable Statements ..
 *
 *     Test the input arguments
 *
 WANTST = LSAME( SORT, 'S' )
 WANTSN = LSAME( SENSE, 'N' )
 WANTSE = LSAME( SENSE, 'E' )
 WANTSV = LSAME( SENSE, 'V' )
 WANTSB = LSAME( SENSE, 'B' )
+LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
 IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
 INFO = -1
 ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
 INFO = -2
 ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR.
 *       the worst case.
 *       If SENSE = 'E', 'V' or 'B', then the amount of workspace needed
 *       depends on SDIM, which is computed by the routine DTRSEN later
 *       in the code.)
 *
-MINWRK = 1
+IF( INFO.EQ.0 ) THEN
-IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+LIWRK = 1
-MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
+IF( N.EQ.0 ) THEN
-MINWRK = MAX( 1, 3*N )
+MINWRK = 1
-IF( .NOT.WANTVS ) THEN
+LWRK = 1
-MAXB = MAX( ILAENV( 8, 'DHSEQR', 'SN', N, 1, N, -1 ), 2 )
-K = MIN( MAXB, N, MAX( 2, ILAENV( 4, 'DHSEQR', 'SN', N, 1,
-$          N, -1 ) ) )
-HSWORK = MAX( K*( K+2 ), 2*N )
-MAXWRK = MAX( MAXWRK, N+HSWORK, 1 )
 ELSE
-MAXWRK = MAX( MAXWRK, 2*N+( N-1 )*
+MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
-$               ILAENV( 1, 'DORGHR', ' ', N, 1, N, -1 ) )
+MINWRK = 3*N
-MAXB = MAX( ILAENV( 8, 'DHSEQR', 'SV', N, 1, N, -1 ), 2 )
+*
-K = MIN( MAXB, N, MAX( 2, ILAENV( 4, 'DHSEQR', 'SV', N, 1,
+CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS,
-$          N, -1 ) ) )
+$             WORK, -1, IEVAL )
-HSWORK = MAX( K*( K+2 ), 2*N )
+HSWORK = WORK( 1 )
-MAXWRK = MAX( MAXWRK, N+HSWORK, 1 )
+*
+IF( .NOT.WANTVS ) THEN
+MAXWRK = MAX( MAXWRK, N + HSWORK )
+ELSE
+MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
+$                       'DORGHR', ' ', N, 1, N, -1 ) )
+MAXWRK = MAX( MAXWRK, N + HSWORK )
+END IF
+LWRK = MAXWRK
+IF( .NOT.WANTSN )
+$         LWRK = MAX( LWRK, N + ( N*N )/2 )
+IF( WANTSV .OR. WANTSB )
+$         LIWRK = ( N*N )/4
 END IF
-WORK( 1 ) = MAXWRK
+IWORK( 1 ) = LIWRK
-END IF
+WORK( 1 ) = LWRK
-IF( LWORK.LT.MINWRK ) THEN
+*
-INFO = -16
+IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
-END IF
+INFO = -16
-IF( LIWORK.LT.1 ) THEN
+ELSE IF( LIWORK.LT.1 .AND. .NOT.LQUERY ) THEN
 INFO = -18
 END IF
+END IF
+*
 IF( INFO.NE.0 ) THEN
 CALL XERBLA( 'DGEESX', -INFO )
 RETURN
 END IF
 *
 30    CONTINUE
 END IF
 *
 WORK( 1 ) = MAXWRK
 IF( WANTSV .OR. WANTSB ) THEN
-IWORK( 1 ) = SDIM*( N-SDIM )
+IWORK( 1 ) = MAX( 1, SDIM*( N-SDIM ) )
 ELSE
 IWORK( 1 ) = 1
 END IF
 *
 RETURN

Mercurial > octave-nkf

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