Handle corner cases of LWORK (Reference-LAPACK PR 942)

This commit is contained in:
Martin Kroeker 2023-12-23 19:44:11 +01:00 committed by GitHub
parent 0814491d96
commit 29d6024ec5
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
48 changed files with 751 additions and 510 deletions

View File

@ -122,7 +122,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of the array WORK. LWORK >= max(1,M,N). *> The length of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(M,N), otherwise.
*> For optimum performance LWORK >= (M+N)*NB, where NB *> For optimum performance LWORK >= (M+N)*NB, where NB
*> is the optimal blocksize. *> is the optimal blocksize.
*> *>
@ -147,7 +148,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEcomputational *> \ingroup gebrd
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -223,8 +224,8 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB, INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT,
$ NBMIN, NX, WS $ MINMN, NB, NBMIN, NX, WS
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DGEBD2, DGEMM, DLABRD, XERBLA EXTERNAL DGEBD2, DGEMM, DLABRD, XERBLA
@ -241,9 +242,17 @@
* Test the input parameters * Test the input parameters
* *
INFO = 0 INFO = 0
NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) ) MINMN = MIN( M, N )
LWKOPT = ( M+N )*NB IF( MINMN.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = MAX( M, N )
NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) )
LWKOPT = ( M+N )*NB
ENDIF
WORK( 1 ) = DBLE( LWKOPT ) WORK( 1 ) = DBLE( LWKOPT )
*
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
@ -251,7 +260,7 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4 INFO = -4
ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10 INFO = -10
END IF END IF
IF( INFO.LT.0 ) THEN IF( INFO.LT.0 ) THEN
@ -263,7 +272,6 @@
* *
* Quick return if possible * Quick return if possible
* *
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN IF( MINMN.EQ.0 ) THEN
WORK( 1 ) = 1 WORK( 1 ) = 1
RETURN RETURN
@ -282,7 +290,7 @@
* Determine when to switch from blocked to unblocked code. * Determine when to switch from blocked to unblocked code.
* *
IF( NX.LT.MINMN ) THEN IF( NX.LT.MINMN ) THEN
WS = ( M+N )*NB WS = LWKOPT
IF( LWORK.LT.WS ) THEN IF( LWORK.LT.WS ) THEN
* *
* Not enough work space for the optimal NB, consider using * Not enough work space for the optimal NB, consider using

View File

@ -89,7 +89,7 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, dimension (LWORK) *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
@ -120,7 +120,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEcomputational *> \ingroup gehrd
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -173,7 +173,7 @@
INTEGER IHI, ILO, INFO, LDA, LWORK, N INTEGER IHI, ILO, INFO, LDA, LWORK, N
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
* .. * ..
* *
* ===================================================================== * =====================================================================
@ -182,7 +182,7 @@
INTEGER NBMAX, LDT, TSIZE INTEGER NBMAX, LDT, TSIZE
PARAMETER ( NBMAX = 64, LDT = NBMAX+1, PARAMETER ( NBMAX = 64, LDT = NBMAX+1,
$ TSIZE = LDT*NBMAX ) $ TSIZE = LDT*NBMAX )
DOUBLE PRECISION ZERO, ONE DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D+0, PARAMETER ( ZERO = 0.0D+0,
$ ONE = 1.0D+0 ) $ ONE = 1.0D+0 )
* .. * ..
@ -190,7 +190,7 @@
LOGICAL LQUERY LOGICAL LQUERY
INTEGER I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB, INTEGER I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB,
$ NBMIN, NH, NX $ NBMIN, NH, NX
DOUBLE PRECISION EI DOUBLE PRECISION EI
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DAXPY, DGEHD2, DGEMM, DLAHR2, DLARFB, DTRMM, EXTERNAL DAXPY, DGEHD2, DGEMM, DLAHR2, DLARFB, DTRMM,
@ -221,12 +221,18 @@
INFO = -8 INFO = -8
END IF END IF
* *
NH = IHI - ILO + 1
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
* *
* Compute the workspace requirements * Compute the workspace requirements
* *
NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, -1 ) ) IF( NH.LE.1 ) THEN
LWKOPT = N*NB + TSIZE LWKOPT = 1
ELSE
NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI,
$ -1 ) )
LWKOPT = N*NB + TSIZE
ENDIF
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
END IF END IF
* *
@ -248,7 +254,6 @@
* *
* Quick return if possible * Quick return if possible
* *
NH = IHI - ILO + 1
IF( NH.LE.1 ) THEN IF( NH.LE.1 ) THEN
WORK( 1 ) = 1 WORK( 1 ) = 1
RETURN RETURN
@ -268,7 +273,7 @@
* *
* Determine if workspace is large enough for blocked code * Determine if workspace is large enough for blocked code
* *
IF( LWORK.LT.N*NB+TSIZE ) THEN IF( LWORK.LT.LWKOPT ) THEN
* *
* Not enough workspace to use optimal NB: determine the * Not enough workspace to use optimal NB: determine the
* minimum value of NB, and reduce NB or force use of * minimum value of NB, and reduce NB or force use of
@ -344,6 +349,7 @@
* Use unblocked code to reduce the rest of the matrix * Use unblocked code to reduce the rest of the matrix
* *
CALL DGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO ) CALL DGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
*
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
* *
RETURN RETURN

View File

@ -98,7 +98,7 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1 or -2, then a workspace query is assumed. The routine *> If LWORK = -1 or -2, then a workspace query is assumed. The routine
*> only calculates the sizes of the T and WORK arrays, returns these *> only calculates the sizes of the T and WORK arrays, returns these
*> values as the first entries of the T and WORK arrays, and no error *> values as the first entries of the T and WORK arrays, and no error
@ -166,6 +166,8 @@
*> the LQ factorization. *> the LQ factorization.
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup gelq
*>
* ===================================================================== * =====================================================================
SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
$ INFO ) $ INFO )

View File

@ -93,7 +93,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,M). *> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M, otherwise.
*> For optimum performance LWORK >= M*NB, where NB is the *> For optimum performance LWORK >= M*NB, where NB is the
*> optimal blocksize. *> optimal blocksize.
*> *>
@ -118,7 +119,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEcomputational *> \ingroup gelqf
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -174,9 +175,8 @@
* Test the input arguments * Test the input arguments
* *
INFO = 0 INFO = 0
K = MIN( M, N )
NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 ) NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
LWKOPT = M*NB
WORK( 1 ) = LWKOPT
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
@ -184,19 +184,25 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4 INFO = -4
ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN ELSE IF( .NOT.LQUERY ) THEN
INFO = -7 IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) )
$ INFO = -7
END IF END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGELQF', -INFO ) CALL XERBLA( 'DGELQF', -INFO )
RETURN RETURN
ELSE IF( LQUERY ) THEN ELSE IF( LQUERY ) THEN
IF( K.EQ.0 ) THEN
LWKOPT = 1
ELSE
LWKOPT = M*NB
END IF
WORK( 1 ) = LWKOPT
RETURN RETURN
END IF END IF
* *
* Quick return if possible * Quick return if possible
* *
K = MIN( M, N )
IF( K.EQ.0 ) THEN IF( K.EQ.0 ) THEN
WORK( 1 ) = 1 WORK( 1 ) = 1
RETURN RETURN

View File

@ -188,7 +188,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEsolve *> \ingroup gelsd
* *
*> \par Contributors: *> \par Contributors:
* ================== * ==================
@ -228,7 +228,7 @@
DOUBLE PRECISION ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM DOUBLE PRECISION ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DGEBRD, DGELQF, DGEQRF, DLABAD, DLACPY, DLALSD, EXTERNAL DGEBRD, DGELQF, DGEQRF, DLACPY, DLALSD,
$ DLASCL, DLASET, DORMBR, DORMLQ, DORMQR, XERBLA $ DLASCL, DLASET, DORMBR, DORMLQ, DORMQR, XERBLA
* .. * ..
* .. External Functions .. * .. External Functions ..
@ -276,7 +276,7 @@
$ LOG( TWO ) ) + 1, 0 ) $ LOG( TWO ) ) + 1, 0 )
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
MAXWRK = 0 MAXWRK = 1
LIWORK = 3*MINMN*NLVL + 11*MINMN LIWORK = 3*MINMN*NLVL + 11*MINMN
MM = M MM = M
IF( M.GE.N .AND. M.GE.MNTHR ) THEN IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@ -372,7 +372,6 @@
SFMIN = DLAMCH( 'S' ) SFMIN = DLAMCH( 'S' )
SMLNUM = SFMIN / EPS SMLNUM = SFMIN / EPS
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
* *
* Scale A if max entry outside range [SMLNUM,BIGNUM]. * Scale A if max entry outside range [SMLNUM,BIGNUM].
* *

View File

@ -111,16 +111,17 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1, then a workspace query is assumed. The routine *> If LWORK = -1, then a workspace query is assumed. The routine
*> only calculates the size of the WORK array, returns this *> only calculates the size of the WORK array, returns this
*> value as WORK(1), and no error message related to WORK *> value as WORK(1), and no error message related to WORK
*> is issued by XERBLA. *> is issued by XERBLA.
*> \endverbatim *> \endverbatim
*> *>
@ -144,7 +145,7 @@
*> *>
*> \verbatim *> \verbatim
*> *>
*> These details are particular for this LAPACK implementation. Users should not *> These details are particular for this LAPACK implementation. Users should not
*> take them for granted. These details may change in the future, and are not likely *> take them for granted. These details may change in the future, and are not likely
*> true for another LAPACK implementation. These details are relevant if one wants *> true for another LAPACK implementation. These details are relevant if one wants
*> to try to understand the code. They are not part of the interface. *> to try to understand the code. They are not part of the interface.
@ -160,11 +161,13 @@
*> block sizes MB and NB returned by ILAENV, DGELQ will use either *> block sizes MB and NB returned by ILAENV, DGELQ will use either
*> DLASWLQ (if the matrix is wide-and-short) or DGELQT to compute *> DLASWLQ (if the matrix is wide-and-short) or DGELQT to compute
*> the LQ factorization. *> the LQ factorization.
*> This version of DGEMLQ will use either DLAMSWLQ or DGEMLQT to *> This version of DGEMLQ will use either DLAMSWLQ or DGEMLQT to
*> multiply matrix Q by another matrix. *> multiply matrix Q by another matrix.
*> Further Details in DLAMSWLQ or DGEMLQT. *> Further Details in DLAMSWLQ or DGEMLQT.
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup gemlq
*>
* ===================================================================== * =====================================================================
SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
$ C, LDC, WORK, LWORK, INFO ) $ C, LDC, WORK, LWORK, INFO )
@ -186,7 +189,7 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER MB, NB, LW, NBLCKS, MN INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -202,7 +205,7 @@
* *
* Test the input arguments * Test the input arguments
* *
LQUERY = LWORK.EQ.-1 LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' ) NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' ) TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' ) LEFT = LSAME( SIDE, 'L' )
@ -217,6 +220,13 @@
LW = M * MB LW = M * MB
MN = N MN = N
END IF END IF
*
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
* *
IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
@ -245,12 +255,12 @@
INFO = -9 INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -11 INFO = -11
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
INFO = -13 INFO = -13
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LW WORK( 1 ) = LWMIN
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -262,7 +272,7 @@
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN( M, N, K ).EQ.0 ) THEN IF( MINMNK.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
@ -275,7 +285,7 @@
$ MB, C, LDC, WORK, LWORK, INFO ) $ MB, C, LDC, WORK, LWORK, INFO )
END IF END IF
* *
WORK( 1 ) = LW WORK( 1 ) = LWMIN
* *
RETURN RETURN
* *

View File

@ -111,16 +111,17 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1, then a workspace query is assumed. The routine *> If LWORK = -1, then a workspace query is assumed. The routine
*> only calculates the size of the WORK array, returns this *> only calculates the size of the WORK array, returns this
*> value as WORK(1), and no error message related to WORK *> value as WORK(1), and no error message related to WORK
*> is issued by XERBLA. *> is issued by XERBLA.
*> \endverbatim *> \endverbatim
*> *>
@ -144,7 +145,7 @@
*> *>
*> \verbatim *> \verbatim
*> *>
*> These details are particular for this LAPACK implementation. Users should not *> These details are particular for this LAPACK implementation. Users should not
*> take them for granted. These details may change in the future, and are not likely *> take them for granted. These details may change in the future, and are not likely
*> true for another LAPACK implementation. These details are relevant if one wants *> true for another LAPACK implementation. These details are relevant if one wants
*> to try to understand the code. They are not part of the interface. *> to try to understand the code. They are not part of the interface.
@ -160,12 +161,14 @@
*> block sizes MB and NB returned by ILAENV, DGEQR will use either *> block sizes MB and NB returned by ILAENV, DGEQR will use either
*> DLATSQR (if the matrix is tall-and-skinny) or DGEQRT to compute *> DLATSQR (if the matrix is tall-and-skinny) or DGEQRT to compute
*> the QR factorization. *> the QR factorization.
*> This version of DGEMQR will use either DLAMTSQR or DGEMQRT to *> This version of DGEMQR will use either DLAMTSQR or DGEMQRT to
*> multiply matrix Q by another matrix. *> multiply matrix Q by another matrix.
*> Further Details in DLATMSQR or DGEMQRT. *> Further Details in DLATMSQR or DGEMQRT.
*> *>
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup gemqr
*>
* ===================================================================== * =====================================================================
SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
$ C, LDC, WORK, LWORK, INFO ) $ C, LDC, WORK, LWORK, INFO )
@ -187,7 +190,7 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER MB, NB, LW, NBLCKS, MN INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -203,7 +206,7 @@
* *
* Test the input arguments * Test the input arguments
* *
LQUERY = LWORK.EQ.-1 LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' ) NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' ) TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' ) LEFT = LSAME( SIDE, 'L' )
@ -218,6 +221,13 @@
LW = MB * NB LW = MB * NB
MN = N MN = N
END IF END IF
*
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
* *
IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN
IF( MOD( MN - K, MB - K ).EQ.0 ) THEN IF( MOD( MN - K, MB - K ).EQ.0 ) THEN
@ -246,12 +256,12 @@
INFO = -9 INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -11 INFO = -11
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
INFO = -13 INFO = -13
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LW WORK( 1 ) = LWMIN
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -263,7 +273,7 @@
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN( M, N, K ).EQ.0 ) THEN IF( MINMNK.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
@ -276,7 +286,7 @@
$ NB, C, LDC, WORK, LWORK, INFO ) $ NB, C, LDC, WORK, LWORK, INFO )
END IF END IF
* *
WORK( 1 ) = LW WORK( 1 ) = LWMIN
* *
RETURN RETURN
* *

View File

@ -88,7 +88,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,N). *> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise.
*> For optimum performance LWORK >= N*NB, where NB is the *> For optimum performance LWORK >= N*NB, where NB is the
*> optimal blocksize. *> optimal blocksize.
*> *>
@ -113,7 +114,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEcomputational *> \ingroup geqlf
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -188,8 +189,9 @@
END IF END IF
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
* *
IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN IF( .NOT.LQUERY ) THEN
INFO = -7 IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) )
$ INFO = -7
END IF END IF
END IF END IF
* *

View File

@ -427,7 +427,8 @@
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK.
*. LWORK >= (3*N + NRHS - 1) *> LWORK >= 1, if MIN(M,N) = 0, and
*> LWORK >= (3*N+NRHS-1), otherwise.
*> For optimal performance LWORK >= (2*N + NB*( N+NRHS+1 )), *> For optimal performance LWORK >= (2*N + NB*( N+NRHS+1 )),
*> where NB is the optimal block size for DGEQP3RK returned *> where NB is the optimal block size for DGEQP3RK returned
*> by ILAENV. Minimal block size MINNB=2. *> by ILAENV. Minimal block size MINNB=2.

View File

@ -99,7 +99,7 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1 or -2, then a workspace query is assumed. The routine *> If LWORK = -1 or -2, then a workspace query is assumed. The routine
*> only calculates the sizes of the T and WORK arrays, returns these *> only calculates the sizes of the T and WORK arrays, returns these
*> values as the first entries of the T and WORK arrays, and no error *> values as the first entries of the T and WORK arrays, and no error
@ -168,6 +168,8 @@
*> *>
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup geqr
*>
* ===================================================================== * =====================================================================
SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
$ INFO ) $ INFO )
@ -188,7 +190,7 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY, LMINWS, MINT, MINW LOGICAL LQUERY, LMINWS, MINT, MINW
INTEGER MB, NB, MINTSZ, NBLCKS INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWREQ
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -244,8 +246,10 @@
* *
* Determine if the workspace size satisfies minimal size * Determine if the workspace size satisfies minimal size
* *
LWMIN = MAX( 1, N )
LWREQ = MAX( 1, N*NB )
LMINWS = .FALSE. LMINWS = .FALSE.
IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.NB*N ) IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.LWREQ )
$ .AND. ( LWORK.GE.N ) .AND. ( TSIZE.GE.MINTSZ ) $ .AND. ( LWORK.GE.N ) .AND. ( TSIZE.GE.MINTSZ )
$ .AND. ( .NOT.LQUERY ) ) THEN $ .AND. ( .NOT.LQUERY ) ) THEN
IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN
@ -253,7 +257,7 @@
NB = 1 NB = 1
MB = M MB = M
END IF END IF
IF( LWORK.LT.NB*N ) THEN IF( LWORK.LT.LWREQ ) THEN
LMINWS = .TRUE. LMINWS = .TRUE.
NB = 1 NB = 1
END IF END IF
@ -268,7 +272,7 @@
ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 )
$ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
INFO = -6 INFO = -6
ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY ) ELSE IF( ( LWORK.LT.LWREQ ) .AND. ( .NOT.LQUERY )
$ .AND. ( .NOT.LMINWS ) ) THEN $ .AND. ( .NOT.LMINWS ) ) THEN
INFO = -8 INFO = -8
END IF END IF
@ -282,9 +286,9 @@
T( 2 ) = MB T( 2 ) = MB
T( 3 ) = NB T( 3 ) = NB
IF( MINW ) THEN IF( MINW ) THEN
WORK( 1 ) = MAX( 1, N ) WORK( 1 ) = LWMIN
ELSE ELSE
WORK( 1 ) = MAX( 1, NB*N ) WORK( 1 ) = LWREQ
END IF END IF
END IF END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -309,7 +313,7 @@
$ LWORK, INFO ) $ LWORK, INFO )
END IF END IF
* *
WORK( 1 ) = MAX( 1, NB*N ) WORK( 1 ) = LWREQ
* *
RETURN RETURN
* *

View File

@ -97,7 +97,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,N). *> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise.
*> For optimum performance LWORK >= N*NB, where NB is *> For optimum performance LWORK >= N*NB, where NB is
*> the optimal blocksize. *> the optimal blocksize.
*> *>
@ -122,7 +123,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEcomputational *> \ingroup geqrfp
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -162,8 +163,8 @@
* *
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB, INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKMIN, LWKOPT,
$ NBMIN, NX $ NB, NBMIN, NX
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DGEQR2P, DLARFB, DLARFT, XERBLA EXTERNAL DGEQR2P, DLARFB, DLARFT, XERBLA
@ -181,8 +182,16 @@
* *
INFO = 0 INFO = 0
NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
LWKOPT = N*NB K = MIN( M, N )
IF( K.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = N
LWKOPT = N*NB
END IF
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
*
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
@ -190,7 +199,7 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4 INFO = -4
ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -7 INFO = -7
END IF END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -202,7 +211,6 @@
* *
* Quick return if possible * Quick return if possible
* *
K = MIN( M, N )
IF( K.EQ.0 ) THEN IF( K.EQ.0 ) THEN
WORK( 1 ) = 1 WORK( 1 ) = 1
RETURN RETURN
@ -210,7 +218,7 @@
* *
NBMIN = 2 NBMIN = 2
NX = 0 NX = 0
IWS = N IWS = LWKMIN
IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( NB.GT.1 .AND. NB.LT.K ) THEN
* *
* Determine when to cross over from blocked to unblocked code. * Determine when to cross over from blocked to unblocked code.

View File

@ -114,7 +114,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEcomputational *> \ingroup gerqf
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -189,7 +189,7 @@
END IF END IF
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
* *
IF ( .NOT.LQUERY ) THEN IF( .NOT.LQUERY ) THEN
IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) ) IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) )
$ INFO = -7 $ INFO = -7
END IF END IF

View File

@ -208,7 +208,7 @@
*> *>
*> \param[in,out] WORK *> \param[in,out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, dimension (LWORK) *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On entry : *> On entry :
*> If JOBU = 'C' : *> If JOBU = 'C' :
*> WORK(1) = CTOL, where CTOL defines the threshold for convergence. *> WORK(1) = CTOL, where CTOL defines the threshold for convergence.
@ -239,7 +239,12 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> length of WORK, WORK >= MAX(6,M+N) *> The length of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(6,M+N), otherwise.
*>
*> If on entry LWORK = -1, then a workspace query is assumed and
*> no computation is done; WORK(1) is set to the minial (and optimal)
*> length of WORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[out] INFO *> \param[out] INFO
@ -260,7 +265,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEcomputational *> \ingroup gesvj
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -365,9 +370,9 @@
INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1, INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
$ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34, $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34,
$ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP,
$ SWBAND $ SWBAND, MINMN, LWMIN
LOGICAL APPLV, GOSCALE, LOWER, LSVEC, NOSCALE, ROTOK, LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE,
$ RSVEC, UCTOL, UPPER $ ROTOK, RSVEC, UCTOL, UPPER
* .. * ..
* .. Local Arrays .. * .. Local Arrays ..
DOUBLE PRECISION FASTR( 5 ) DOUBLE PRECISION FASTR( 5 )
@ -408,6 +413,14 @@
UPPER = LSAME( JOBA, 'U' ) UPPER = LSAME( JOBA, 'U' )
LOWER = LSAME( JOBA, 'L' ) LOWER = LSAME( JOBA, 'L' )
* *
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 6, M+N )
END IF
*
LQUERY = ( LWORK.EQ.-1 )
IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN
INFO = -1 INFO = -1
ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN
@ -427,7 +440,7 @@
INFO = -11 INFO = -11
ELSE IF( UCTOL .AND. ( WORK( 1 ).LE.ONE ) ) THEN ELSE IF( UCTOL .AND. ( WORK( 1 ).LE.ONE ) ) THEN
INFO = -12 INFO = -12
ELSE IF( LWORK.LT.MAX( M+N, 6 ) ) THEN ELSE IF( LWORK.LT.LWMIN .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13 INFO = -13
ELSE ELSE
INFO = 0 INFO = 0
@ -437,11 +450,14 @@
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGESVJ', -INFO ) CALL XERBLA( 'DGESVJ', -INFO )
RETURN RETURN
ELSE IF( LQUERY ) THEN
WORK( 1 ) = LWMIN
RETURN
END IF END IF
* *
* #:) Quick return for void matrix * #:) Quick return for void matrix
* *
IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN IF( MINMN.EQ.0 ) RETURN
* *
* Set numerical parameters * Set numerical parameters
* The stopping criterion for Jacobi rotations is * The stopping criterion for Jacobi rotations is

View File

@ -107,7 +107,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEcomputational *> \ingroup getri
* *
* ===================================================================== * =====================================================================
SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
@ -151,8 +151,9 @@
* *
INFO = 0 INFO = 0
NB = ILAENV( 1, 'DGETRI', ' ', N, -1, -1, -1 ) NB = ILAENV( 1, 'DGETRI', ' ', N, -1, -1, -1 )
LWKOPT = N*NB LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
*
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LT.0 ) THEN IF( N.LT.0 ) THEN
INFO = -1 INFO = -1

View File

@ -127,7 +127,7 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1 or -2, then a workspace query is assumed. *> If LWORK = -1 or -2, then a workspace query is assumed.
*> If LWORK = -1, the routine calculates optimal size of WORK for the *> If LWORK = -1, the routine calculates optimal size of WORK for the
*> optimal performance and returns this value in WORK(1). *> optimal performance and returns this value in WORK(1).
@ -154,7 +154,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEsolve *> \ingroup getsls
* *
* ===================================================================== * =====================================================================
SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
@ -189,7 +189,7 @@
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
DOUBLE PRECISION DLAMCH, DLANGE DOUBLE PRECISION DLAMCH, DLANGE
EXTERNAL LSAME, DLABAD, DLAMCH, DLANGE EXTERNAL LSAME, DLAMCH, DLANGE
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DGEQR, DGEMQR, DLASCL, DLASET, EXTERNAL DGEQR, DGEMQR, DLASCL, DLASET,
@ -226,7 +226,10 @@
* *
* Determine the optimum and minimum LWORK * Determine the optimum and minimum LWORK
* *
IF( M.GE.N ) THEN IF( MIN( M, N, NRHS ).EQ.0 ) THEN
WSIZEM = 1
WSIZEO = 1
ELSE IF( M.GE.N ) THEN
CALL DGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 ) CALL DGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) ) TSZO = INT( TQ( 1 ) )
LWO = INT( WORKQ( 1 ) ) LWO = INT( WORKQ( 1 ) )
@ -294,7 +297,6 @@
* *
SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
* *
* Scale A, B if max element outside range [SMLNUM,BIGNUM] * Scale A, B if max element outside range [SMLNUM,BIGNUM]
* *

View File

@ -130,14 +130,17 @@
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK.
*> LWORK >= MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), *> If MIN(M,N) = 0, LWORK >= 1, else
*> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ),
*> where *> where
*> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)), *> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)),
*> NB1LOCAL = MIN(NB1,N). *> NB1LOCAL = MIN(NB1,N).
*> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL, *> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL,
*> LW1 = NB1LOCAL * N, *> LW1 = NB1LOCAL * N,
*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ), *> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ).
*>
*> If LWORK = -1, then a workspace query is assumed. *> If LWORK = -1, then a workspace query is assumed.
*> The routine only calculates the optimal size of the WORK *> The routine only calculates the optimal size of the WORK
*> array, returns this value as the first entry of the WORK *> array, returns this value as the first entry of the WORK
@ -160,7 +163,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleOTHERcomputational *> \ingroup getsqrhrt
* *
*> \par Contributors: *> \par Contributors:
* ================== * ==================
@ -212,7 +215,7 @@
* Test the input arguments * Test the input arguments
* *
INFO = 0 INFO = 0
LQUERY = LWORK.EQ.-1 LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 .OR. M.LT.N ) THEN ELSE IF( N.LT.0 .OR. M.LT.N ) THEN
@ -225,7 +228,7 @@
INFO = -5 INFO = -5
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -7 INFO = -7
ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN
INFO = -9 INFO = -9
ELSE ELSE
* *
@ -263,8 +266,9 @@
LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ) LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) )
* *
LWORKOPT = MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ) LWORKOPT = MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) )
LWORKOPT = MAX( 1, LWORKOPT )
* *
IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN IF( LWORK.LT.LWORKOPT .AND. .NOT.LQUERY ) THEN
INFO = -11 INFO = -11
END IF END IF
* *
@ -346,4 +350,4 @@
* *
* End of DGETSQRHRT * End of DGETSQRHRT
* *
END END

View File

@ -234,8 +234,8 @@
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK.
*> If N = 0, LWORK >= 1, else LWORK >= 8*N+16. *> If N = 0, LWORK >= 1, else LWORK >= MAX(8*N,6*N+16).
*> For good performance , LWORK must generally be larger. *> For good performance, LWORK must generally be larger.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
@ -275,7 +275,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEeigen *> \ingroup gges
* *
* ===================================================================== * =====================================================================
SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB,
@ -321,9 +321,8 @@
DOUBLE PRECISION DIF( 2 ) DOUBLE PRECISION DIF( 2 )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD, EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY,
$ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, $ DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, XERBLA
$ XERBLA
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -431,7 +430,6 @@
EPS = DLAMCH( 'P' ) EPS = DLAMCH( 'P' )
SAFMIN = DLAMCH( 'S' ) SAFMIN = DLAMCH( 'S' )
SAFMAX = ONE / SAFMIN SAFMAX = ONE / SAFMIN
CALL DLABAD( SAFMIN, SAFMAX )
SMLNUM = SQRT( SAFMIN ) / EPS SMLNUM = SQRT( SAFMIN ) / EPS
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
* *

View File

@ -234,6 +234,8 @@
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK.
*> If N = 0, LWORK >= 1, else LWORK >= 6*N+16.
*> For good performance, LWORK must generally be larger.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
@ -273,7 +275,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEeigen *> \ingroup gges3
* *
* ===================================================================== * =====================================================================
SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B,
@ -309,7 +311,8 @@
LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL, LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
$ LQUERY, LST2SL, WANTST $ LQUERY, LST2SL, WANTST
INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
$ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, LWKOPT $ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, LWKOPT,
$ LWKMIN
DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL, DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL,
$ PVSR, SAFMAX, SAFMIN, SMLNUM $ PVSR, SAFMAX, SAFMIN, SMLNUM
* .. * ..
@ -318,9 +321,8 @@
DOUBLE PRECISION DIF( 2 ) DOUBLE PRECISION DIF( 2 )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLABAD, EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLACPY,
$ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, $ DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, XERBLA
$ XERBLA
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -362,6 +364,12 @@
* *
INFO = 0 INFO = 0
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.EQ.0 ) THEN
LWKMIN = 1
ELSE
LWKMIN = 6*N+16
END IF
*
IF( IJOBVL.LE.0 ) THEN IF( IJOBVL.LE.0 ) THEN
INFO = -1 INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN ELSE IF( IJOBVR.LE.0 ) THEN
@ -378,7 +386,7 @@
INFO = -15 INFO = -15
ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
INFO = -17 INFO = -17
ELSE IF( LWORK.LT.6*N+16 .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -19 INFO = -19
END IF END IF
* *
@ -386,29 +394,33 @@
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL DGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) CALL DGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
LWKOPT = MAX( 6*N+16, 3*N+INT( WORK ( 1 ) ) ) LWKOPT = MAX( LWKMIN, 3*N+INT( WORK( 1 ) ) )
CALL DORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, CALL DORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK,
$ -1, IERR ) $ -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
IF( ILVSL ) THEN IF( ILVSL ) THEN
CALL DORGQR( N, N, N, VSL, LDVSL, WORK, WORK, -1, IERR ) CALL DORGQR( N, N, N, VSL, LDVSL, WORK, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
END IF END IF
CALL DGGHD3( JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, VSL, CALL DGGHD3( JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, VSL,
$ LDVSL, VSR, LDVSR, WORK, -1, IERR ) $ LDVSL, VSR, LDVSR, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
CALL DLAQZ0( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, CALL DLAQZ0( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB,
$ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
$ WORK, -1, 0, IERR ) $ WORK, -1, 0, IERR )
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK ( 1 ) ) ) LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
IF( WANTST ) THEN IF( WANTST ) THEN
CALL DTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, CALL DTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB,
$ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
$ SDIM, PVSL, PVSR, DIF, WORK, -1, IDUM, 1, $ SDIM, PVSL, PVSR, DIF, WORK, -1, IDUM, 1,
$ IERR ) $ IERR )
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK ( 1 ) ) ) LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
END IF
IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = LWKOPT
END IF END IF
WORK( 1 ) = LWKOPT
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -430,7 +442,6 @@
EPS = DLAMCH( 'P' ) EPS = DLAMCH( 'P' )
SAFMIN = DLAMCH( 'S' ) SAFMIN = DLAMCH( 'S' )
SAFMAX = ONE / SAFMIN SAFMAX = ONE / SAFMIN
CALL DLABAD( SAFMIN, SAFMAX )
SMLNUM = SQRT( SAFMIN ) / EPS SMLNUM = SQRT( SAFMIN ) / EPS
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
* *

View File

@ -188,7 +188,9 @@
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER.
*> The dimension of the array WORK. LWORK >= MAX(1,8*N).
*> For good performance, LWORK should generally be larger.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
@ -217,7 +219,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEeigen *> \ingroup ggev3
* *
* ===================================================================== * =====================================================================
SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR,
@ -248,7 +250,8 @@
LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
CHARACTER CHTEMP CHARACTER CHTEMP
INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO, INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
$ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, LWKOPT $ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, LWKOPT,
$ LWKMIN
DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
$ SMLNUM, TEMP $ SMLNUM, TEMP
* .. * ..
@ -256,9 +259,8 @@
LOGICAL LDUMMA( 1 ) LOGICAL LDUMMA( 1 )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLABAD, EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLACPY,
$ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, $ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, XERBLA
$ XERBLA
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -299,6 +301,7 @@
* *
INFO = 0 INFO = 0
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 8*N )
IF( IJOBVL.LE.0 ) THEN IF( IJOBVL.LE.0 ) THEN
INFO = -1 INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN ELSE IF( IJOBVR.LE.0 ) THEN
@ -313,7 +316,7 @@
INFO = -12 INFO = -12
ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
INFO = -14 INFO = -14
ELSE IF( LWORK.LT.MAX( 1, 8*N ) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -16 INFO = -16
END IF END IF
* *
@ -321,13 +324,13 @@
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL DGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) CALL DGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
LWKOPT = MAX(1, 8*N, 3*N+INT( WORK( 1 ) ) ) LWKOPT = MAX( LWKMIN, 3*N+INT( WORK( 1 ) ) )
CALL DORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, -1, CALL DORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, -1,
$ IERR ) $ IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
IF( ILVL ) THEN IF( ILVL ) THEN
CALL DORGQR( N, N, N, VL, LDVL, WORK, WORK, -1, IERR ) CALL DORGQR( N, N, N, VL, LDVL, WORK, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
END IF END IF
IF( ILV ) THEN IF( ILV ) THEN
CALL DGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL, CALL DGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL,
@ -336,18 +339,21 @@
CALL DLAQZ0( 'S', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, CALL DLAQZ0( 'S', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
$ WORK, -1, 0, IERR ) $ WORK, -1, 0, IERR )
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK ( 1 ) ) ) LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
ELSE ELSE
CALL DGGHD3( 'N', 'N', N, 1, N, A, LDA, B, LDB, VL, LDVL, CALL DGGHD3( 'N', 'N', N, 1, N, A, LDA, B, LDB, VL, LDVL,
$ VR, LDVR, WORK, -1, IERR ) $ VR, LDVR, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
CALL DLAQZ0( 'E', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, CALL DLAQZ0( 'E', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
$ WORK, -1, 0, IERR ) $ WORK, -1, 0, IERR )
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK ( 1 ) ) ) LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
END IF
IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = LWKOPT
END IF END IF
WORK( 1 ) = LWKOPT
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -367,7 +373,6 @@
EPS = DLAMCH( 'P' ) EPS = DLAMCH( 'P' )
SMLNUM = DLAMCH( 'S' ) SMLNUM = DLAMCH( 'S' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
SMLNUM = SQRT( SMLNUM ) / EPS SMLNUM = SQRT( SMLNUM ) / EPS
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
* *

View File

@ -179,14 +179,14 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, dimension (LWORK) *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of the array WORK. LWORK >= 1. *> The length of the array WORK. LWORK >= 1.
*> For optimum performance LWORK >= 6*N*NB, where NB is the *> For optimum performance LWORK >= 6*N*NB, where NB is the
*> optimal blocksize. *> optimal blocksize.
*> *>
@ -211,7 +211,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleOTHERcomputational *> \ingroup gghd3
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -275,7 +275,12 @@
* *
INFO = 0 INFO = 0
NB = ILAENV( 1, 'DGGHD3', ' ', N, ILO, IHI, -1 ) NB = ILAENV( 1, 'DGGHD3', ' ', N, ILO, IHI, -1 )
LWKOPT = MAX( 6*N*NB, 1 ) NH = IHI - ILO + 1
IF( NH.LE.1 ) THEN
LWKOPT = 1
ELSE
LWKOPT = 6*N*NB
END IF
WORK( 1 ) = DBLE( LWKOPT ) WORK( 1 ) = DBLE( LWKOPT )
INITQ = LSAME( COMPQ, 'I' ) INITQ = LSAME( COMPQ, 'I' )
WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' )
@ -325,7 +330,6 @@
* *
* Quick return if possible * Quick return if possible
* *
NH = IHI - ILO + 1
IF( NH.LE.1 ) THEN IF( NH.LE.1 ) THEN
WORK( 1 ) = ONE WORK( 1 ) = ONE
RETURN RETURN
@ -885,6 +889,7 @@
IF ( JCOL.LT.IHI ) IF ( JCOL.LT.IHI )
$ CALL DGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q, $ CALL DGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q,
$ LDQ, Z, LDZ, IERR ) $ LDQ, Z, LDZ, IERR )
*
WORK( 1 ) = DBLE( LWKOPT ) WORK( 1 ) = DBLE( LWKOPT )
* *
RETURN RETURN

View File

@ -173,7 +173,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleOTHERcomputational *> \ingroup ggqrf
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -250,7 +250,7 @@
NB2 = ILAENV( 1, 'DGERQF', ' ', N, P, -1, -1 ) NB2 = ILAENV( 1, 'DGERQF', ' ', N, P, -1, -1 )
NB3 = ILAENV( 1, 'DORMQR', ' ', N, M, P, -1 ) NB3 = ILAENV( 1, 'DORMQR', ' ', N, M, P, -1 )
NB = MAX( NB1, NB2, NB3 ) NB = MAX( NB1, NB2, NB3 )
LWKOPT = MAX( N, M, P )*NB LWKOPT = MAX( 1, MAX( N, M, P )*NB )
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LT.0 ) THEN IF( N.LT.0 ) THEN
@ -287,6 +287,7 @@
* RQ factorization of N-by-P matrix B: B = T*Z. * RQ factorization of N-by-P matrix B: B = T*Z.
* *
CALL DGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO ) CALL DGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO )
*
WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) ) WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) )
* *
RETURN RETURN

View File

@ -172,7 +172,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleOTHERcomputational *> \ingroup ggrqf
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -249,7 +249,7 @@
NB2 = ILAENV( 1, 'DGEQRF', ' ', P, N, -1, -1 ) NB2 = ILAENV( 1, 'DGEQRF', ' ', P, N, -1, -1 )
NB3 = ILAENV( 1, 'DORMRQ', ' ', M, N, P, -1 ) NB3 = ILAENV( 1, 'DORMRQ', ' ', M, N, P, -1 )
NB = MAX( NB1, NB2, NB3 ) NB = MAX( NB1, NB2, NB3 )
LWKOPT = MAX( N, M, P )*NB LWKOPT = MAX( 1, MAX( N, M, P )*NB )
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN

View File

@ -278,7 +278,7 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
@ -328,7 +328,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleGEsing *> \ingroup ggsvd3
* *
*> \par Contributors: *> \par Contributors:
* ================== * ==================

View File

@ -227,7 +227,7 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
@ -250,7 +250,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleOTHERcomputational *> \ingroup ggsvp3
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================

View File

@ -127,17 +127,20 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK.
*> If SIDE = 'L', LWORK >= max(1,NB) * MB; *>
*> if SIDE = 'R', LWORK >= max(1,M) * MB. *> If MIN(M,N,K) = 0, LWORK >= 1.
*> If SIDE = 'L', LWORK >= max(1,NB*MB).
*> If SIDE = 'R', LWORK >= max(1,M*MB).
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA. *> message related to LWORK is issued by XERBLA.
*> \endverbatim *> \endverbatim
@ -189,29 +192,31 @@
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012 *> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup lamswlq
*>
* ===================================================================== * =====================================================================
SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO ) $ LDT, C, LDC, WORK, LWORK, INFO )
* *
* -- LAPACK computational routine -- * -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER SIDE, TRANS CHARACTER SIDE, TRANS
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
DOUBLE PRECISION A( LDA, * ), WORK( * ), C(LDC, * ), DOUBLE PRECISION A( LDA, * ), WORK( * ), C( LDC, * ),
$ T( LDT, * ) $ T( LDT, * )
* .. * ..
* *
* ===================================================================== * =====================================================================
* *
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER I, II, KK, CTR, LW INTEGER I, II, KK, CTR, LW, MINMNK, LWMIN
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -223,52 +228,60 @@
* *
* Test the input arguments * Test the input arguments
* *
LQUERY = LWORK.LT.0 LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' ) NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' ) TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' ) LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' ) RIGHT = LSAME( SIDE, 'R' )
IF (LEFT) THEN IF( LEFT ) THEN
LW = N * MB LW = N * MB
ELSE ELSE
LW = M * MB LW = M * MB
END IF END IF
*
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
* *
INFO = 0 INFO = 0
IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
INFO = -1 INFO = -1
ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
INFO = -2 INFO = -2
ELSE IF( K.LT.0 ) THEN ELSE IF( K.LT.0 ) THEN
INFO = -5 INFO = -5
ELSE IF( M.LT.K ) THEN ELSE IF( M.LT.K ) THEN
INFO = -3 INFO = -3
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
INFO = -4 INFO = -4
ELSE IF( K.LT.MB .OR. MB.LT.1) THEN ELSE IF( K.LT.MB .OR. MB.LT.1 ) THEN
INFO = -6 INFO = -6
ELSE IF( LDA.LT.MAX( 1, K ) ) THEN ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
INFO = -9 INFO = -9
ELSE IF( LDT.LT.MAX( 1, MB) ) THEN ELSE IF( LDT.LT.MAX( 1, MB ) ) THEN
INFO = -11 INFO = -11
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -13 INFO = -13
ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -15 INFO = -15
END IF END IF
* *
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DLAMSWLQ', -INFO ) CALL XERBLA( 'DLAMSWLQ', -INFO )
WORK(1) = LW
RETURN RETURN
ELSE IF (LQUERY) THEN ELSE IF( LQUERY ) THEN
WORK(1) = LW
RETURN RETURN
END IF END IF
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN(M,N,K).EQ.0 ) THEN IF( MINMNK.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
@ -402,7 +415,8 @@
* *
END IF END IF
* *
WORK(1) = LW WORK( 1 ) = LWMIN
*
RETURN RETURN
* *
* End of DLAMSWLQ * End of DLAMSWLQ

View File

@ -128,22 +128,24 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> *> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim *> \endverbatim
*>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK.
*> If MIN(M,N,K) = 0, LWORK >= 1.
*> If SIDE = 'L', LWORK >= max(1,N*NB).
*> If SIDE = 'R', LWORK >= max(1,MB*NB).
*> *>
*> If SIDE = 'L', LWORK >= max(1,N)*NB;
*> if SIDE = 'R', LWORK >= max(1,MB)*NB.
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA. *> message related to LWORK is issued by XERBLA.
*>
*> \endverbatim *> \endverbatim
*>
*> \param[out] INFO *> \param[out] INFO
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
@ -191,29 +193,31 @@
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012 *> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup lamtsqr
*>
* ===================================================================== * =====================================================================
SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO ) $ LDT, C, LDC, WORK, LWORK, INFO )
* *
* -- LAPACK computational routine -- * -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER SIDE, TRANS CHARACTER SIDE, TRANS
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
DOUBLE PRECISION A( LDA, * ), WORK( * ), C(LDC, * ), DOUBLE PRECISION A( LDA, * ), WORK( * ), C( LDC, * ),
$ T( LDT, * ) $ T( LDT, * )
* .. * ..
* *
* ===================================================================== * =====================================================================
* *
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER I, II, KK, LW, CTR, Q INTEGER I, II, KK, LW, CTR, Q, MINMNK, LWMIN
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -225,12 +229,13 @@
* *
* Test the input arguments * Test the input arguments
* *
LQUERY = LWORK.LT.0 INFO = 0
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' ) NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' ) TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' ) LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' ) RIGHT = LSAME( SIDE, 'R' )
IF (LEFT) THEN IF( LEFT ) THEN
LW = N * NB LW = N * NB
Q = M Q = M
ELSE ELSE
@ -238,11 +243,17 @@
Q = N Q = N
END IF END IF
* *
INFO = 0 MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
*
IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
INFO = -1 INFO = -1
ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
INFO = -2 INFO = -2
ELSE IF( M.LT.K ) THEN ELSE IF( M.LT.K ) THEN
INFO = -3 INFO = -3
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
@ -253,38 +264,38 @@
INFO = -7 INFO = -7
ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN
INFO = -9 INFO = -9
ELSE IF( LDT.LT.MAX( 1, NB) ) THEN ELSE IF( LDT.LT.MAX( 1, NB ) ) THEN
INFO = -11 INFO = -11
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -13 INFO = -13
ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -15 INFO = -15
END IF END IF
* *
* Determine the block size if it is tall skinny or short and wide IF( INFO.EQ.0 ) THEN
* WORK( 1 ) = LWMIN
IF( INFO.EQ.0) THEN
WORK(1) = LW
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DLAMTSQR', -INFO ) CALL XERBLA( 'DLAMTSQR', -INFO )
RETURN RETURN
ELSE IF (LQUERY) THEN ELSE IF( LQUERY ) THEN
RETURN RETURN
END IF END IF
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN(M,N,K).EQ.0 ) THEN IF( MINMNK.EQ.0 ) THEN
RETURN RETURN
END IF END IF
*
* Determine the block size if it is tall skinny or short and wide
* *
IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN
CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA,
$ T, LDT, C, LDC, WORK, INFO) $ T, LDT, C, LDC, WORK, INFO )
RETURN RETURN
END IF END IF
* *
IF(LEFT.AND.NOTRAN) THEN IF(LEFT.AND.NOTRAN) THEN
* *
@ -410,7 +421,8 @@
* *
END IF END IF
* *
WORK(1) = LW WORK( 1 ) = LWMIN
*
RETURN RETURN
* *
* End of DLAMTSQR * End of DLAMTSQR

View File

@ -99,19 +99,22 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> *> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim *> \endverbatim
*>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= MB*M. *> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MB*M, otherwise.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA. *> message related to LWORK is issued by XERBLA.
*>
*> \endverbatim *> \endverbatim
*>
*> \param[out] INFO *> \param[out] INFO
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
@ -159,33 +162,37 @@
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012 *> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup laswlq
*>
* ===================================================================== * =====================================================================
SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
$ INFO) $ INFO )
* *
* -- LAPACK computational routine -- * -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
DOUBLE PRECISION A( LDA, * ), WORK( * ), T( LDT, *) DOUBLE PRECISION A( LDA, * ), WORK( * ), T( LDT, * )
* .. * ..
* *
* ===================================================================== * =====================================================================
* *
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER I, II, KK, CTR INTEGER I, II, KK, CTR, MINMN, LWMIN
* .. * ..
* .. EXTERNAL FUNCTIONS .. * .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME LOGICAL LSAME
EXTERNAL LSAME EXTERNAL LSAME
* ..
* .. EXTERNAL SUBROUTINES .. * .. EXTERNAL SUBROUTINES ..
EXTERNAL DGELQT, DTPLQT, XERBLA EXTERNAL DGELQT, DTPLQT, XERBLA
* ..
* .. INTRINSIC FUNCTIONS .. * .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD INTRINSIC MAX, MIN, MOD
* .. * ..
@ -196,12 +203,19 @@
INFO = 0 INFO = 0
* *
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = M*MB
END IF
* *
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 .OR. N.LT.M ) THEN ELSE IF( N.LT.0 .OR. N.LT.M ) THEN
INFO = -2 INFO = -2
ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 ) ) THEN
INFO = -3 INFO = -3
ELSE IF( NB.LT.0 ) THEN ELSE IF( NB.LT.0 ) THEN
INFO = -4 INFO = -4
@ -209,60 +223,62 @@
INFO = -6 INFO = -6
ELSE IF( LDT.LT.MB ) THEN ELSE IF( LDT.LT.MB ) THEN
INFO = -8 INFO = -8
ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -10 INFO = -10
END IF END IF
IF( INFO.EQ.0) THEN *
WORK(1) = MB*M IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DLASWLQ', -INFO ) CALL XERBLA( 'DLASWLQ', -INFO )
RETURN RETURN
ELSE IF (LQUERY) THEN ELSE IF( LQUERY ) THEN
RETURN RETURN
END IF END IF
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN(M,N).EQ.0 ) THEN IF( MINMN.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
* The LQ Decomposition * The LQ Decomposition
* *
IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN IF( (M.GE.N) .OR. (NB.LE.M) .OR. (NB.GE.N) ) THEN
CALL DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO) CALL DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
RETURN RETURN
END IF END IF
* *
KK = MOD((N-M),(NB-M)) KK = MOD((N-M),(NB-M))
II=N-KK+1 II = N-KK+1
* *
* Compute the LQ factorization of the first block A(1:M,1:NB) * Compute the LQ factorization of the first block A(1:M,1:NB)
* *
CALL DGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO) CALL DGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO )
CTR = 1 CTR = 1
* *
DO I = NB+1, II-NB+M , (NB-M) DO I = NB+1, II-NB+M, (NB-M)
* *
* Compute the QR factorization of the current block A(1:M,I:I+NB-M) * Compute the QR factorization of the current block A(1:M,I:I+NB-M)
* *
CALL DTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), CALL DTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
$ LDA, T(1, CTR * M + 1), $ LDA, T(1, CTR * M + 1),
$ LDT, WORK, INFO ) $ LDT, WORK, INFO )
CTR = CTR + 1 CTR = CTR + 1
END DO END DO
* *
* Compute the QR factorization of the last block A(1:M,II:N) * Compute the QR factorization of the last block A(1:M,II:N)
* *
IF (II.LE.N) THEN IF( II.LE.N ) THEN
CALL DTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), CALL DTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ),
$ LDA, T(1, CTR * M + 1), LDT, $ LDA, T(1, CTR * M + 1), LDT,
$ WORK, INFO ) $ WORK, INFO )
END IF END IF
*
WORK( 1 ) = LWMIN
* *
WORK( 1 ) = M * MB
RETURN RETURN
* *
* End of DLASWLQ * End of DLASWLQ

View File

@ -151,13 +151,17 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, dimension (LWORK). *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)).
*> On exit, if INFO = 0, WORK(1) returns the optimal size of *> On exit, if INFO = 0, WORK(1) returns the optimal size of
*> WORK. *> WORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK.
*>
*> If MIN(N,NRHS) = 0, LWORK >= 1, else
*> LWORK >= MAX(1, 2*NBA * MAX(NBA, MIN(NRHS, 32)), where *> LWORK >= MAX(1, 2*NBA * MAX(NBA, MIN(NRHS, 32)), where
*> NBA = (N + NB - 1)/NB and NB is the optimal block size. *> NBA = (N + NB - 1)/NB and NB is the optimal block size.
*> *>
@ -165,6 +169,7 @@
*> only calculates the optimal dimensions of the WORK array, returns *> only calculates the optimal dimensions of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA. *> message related to LWORK is issued by XERBLA.
*> \endverbatim
*> *>
*> \param[out] INFO *> \param[out] INFO
*> \verbatim *> \verbatim
@ -181,7 +186,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleOTHERauxiliary *> \ingroup latrs3
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
* \verbatim * \verbatim
@ -253,7 +258,7 @@
LOGICAL LQUERY, NOTRAN, NOUNIT, UPPER LOGICAL LQUERY, NOTRAN, NOUNIT, UPPER
INTEGER AWRK, I, IFIRST, IINC, ILAST, II, I1, I2, J, INTEGER AWRK, I, IFIRST, IINC, ILAST, II, I1, I2, J,
$ JFIRST, JINC, JLAST, J1, J2, K, KK, K1, K2, $ JFIRST, JINC, JLAST, J1, J2, K, KK, K1, K2,
$ LANRM, LDS, LSCALE, NB, NBA, NBX, RHS $ LANRM, LDS, LSCALE, NB, NBA, NBX, RHS, LWMIN
DOUBLE PRECISION ANRM, BIGNUM, BNRM, RSCAL, SCAL, SCALOC, DOUBLE PRECISION ANRM, BIGNUM, BNRM, RSCAL, SCAL, SCALOC,
$ SCAMIN, SMLNUM, TMAX $ SCAMIN, SMLNUM, TMAX
* .. * ..
@ -292,15 +297,24 @@
* row. WORK( I+KK*LDS ) is the scale factor of the vector * row. WORK( I+KK*LDS ) is the scale factor of the vector
* segment associated with the I-th block row and the KK-th vector * segment associated with the I-th block row and the KK-th vector
* in the block column. * in the block column.
*
LSCALE = NBA * MAX( NBA, MIN( NRHS, NBRHS ) ) LSCALE = NBA * MAX( NBA, MIN( NRHS, NBRHS ) )
LDS = NBA LDS = NBA
*
* The second part stores upper bounds of the triangular A. There are * The second part stores upper bounds of the triangular A. There are
* a total of NBA x NBA blocks, of which only the upper triangular * a total of NBA x NBA blocks, of which only the upper triangular
* part or the lower triangular part is referenced. The upper bound of * part or the lower triangular part is referenced. The upper bound of
* the block A( I, J ) is stored as WORK( AWRK + I + J * NBA ). * the block A( I, J ) is stored as WORK( AWRK + I + J * NBA ).
*
LANRM = NBA * NBA LANRM = NBA * NBA
AWRK = LSCALE AWRK = LSCALE
WORK( 1 ) = LSCALE + LANRM *
IF( MIN( N, NRHS ).EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = LSCALE + LANRM
END IF
WORK( 1 ) = LWMIN
* *
* Test the input parameters * Test the input parameters
* *
@ -322,7 +336,7 @@
INFO = -8 INFO = -8
ELSE IF( LDX.LT.MAX( 1, N ) ) THEN ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
INFO = -10 INFO = -10
ELSE IF( .NOT.LQUERY .AND. LWORK.LT.WORK( 1 ) ) THEN ELSE IF( .NOT.LQUERY .AND. LWORK.LT.LWMIN ) THEN
INFO = -14 INFO = -14
END IF END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -649,6 +663,9 @@
END IF END IF
END DO END DO
END DO END DO
*
WORK( 1 ) = LWMIN
*
RETURN RETURN
* *
* End of DLATRS3 * End of DLATRS3

View File

@ -101,15 +101,18 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= NB*N. *> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA. *> message related to LWORK is issued by XERBLA.
*> \endverbatim *> \endverbatim
@ -161,27 +164,29 @@
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012 *> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup latsqr
*>
* ===================================================================== * =====================================================================
SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK,
$ LWORK, INFO) $ LWORK, INFO )
* *
* -- LAPACK computational routine -- * -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
DOUBLE PRECISION A( LDA, * ), WORK( * ), T(LDT, *) DOUBLE PRECISION A( LDA, * ), WORK( * ), T( LDT, * )
* .. * ..
* *
* ===================================================================== * =====================================================================
* *
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER I, II, KK, CTR INTEGER I, II, KK, CTR, MINMN, LWMIN
* .. * ..
* .. EXTERNAL FUNCTIONS .. * .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME LOGICAL LSAME
@ -198,6 +203,13 @@
INFO = 0 INFO = 0
* *
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = N*NB
END IF
* *
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
@ -205,65 +217,67 @@
INFO = -2 INFO = -2
ELSE IF( MB.LT.1 ) THEN ELSE IF( MB.LT.1 ) THEN
INFO = -3 INFO = -3
ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 ) ) THEN
INFO = -4 INFO = -4
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -6 INFO = -6
ELSE IF( LDT.LT.NB ) THEN ELSE IF( LDT.LT.NB ) THEN
INFO = -8 INFO = -8
ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -10 INFO = -10
END IF END IF
IF( INFO.EQ.0) THEN *
WORK(1) = NB*N IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
END IF END IF
*
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DLATSQR', -INFO ) CALL XERBLA( 'DLATSQR', -INFO )
RETURN RETURN
ELSE IF (LQUERY) THEN ELSE IF( LQUERY ) THEN
RETURN RETURN
END IF END IF
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN(M,N).EQ.0 ) THEN IF( MINMN.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
* The QR Decomposition * The QR Decomposition
* *
IF ((MB.LE.N).OR.(MB.GE.M)) THEN IF( (MB.LE.N) .OR. (MB.GE.M) ) THEN
CALL DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) CALL DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
RETURN RETURN
END IF END IF
* *
KK = MOD((M-N),(MB-N)) KK = MOD((M-N),(MB-N))
II=M-KK+1 II = M-KK+1
* *
* Compute the QR factorization of the first block A(1:MB,1:N) * Compute the QR factorization of the first block A(1:MB,1:N)
* *
CALL DGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) CALL DGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO )
* *
CTR = 1 CTR = 1
DO I = MB+1, II-MB+N , (MB-N) DO I = MB+1, II-MB+N, (MB-N)
* *
* Compute the QR factorization of the current block A(I:I+MB-N,1:N) * Compute the QR factorization of the current block A(I:I+MB-N,1:N)
* *
CALL DTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, CALL DTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA,
$ T(1, CTR * N + 1), $ T(1, CTR * N + 1),
$ LDT, WORK, INFO ) $ LDT, WORK, INFO )
CTR = CTR + 1 CTR = CTR + 1
END DO END DO
* *
* Compute the QR factorization of the last block A(II:M,1:N) * Compute the QR factorization of the last block A(II:M,1:N)
* *
IF (II.LE.M) THEN IF( II.LE.M ) THEN
CALL DTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, CALL DTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
$ T(1, CTR * N + 1), LDT, $ T(1, CTR * N + 1), LDT,
$ WORK, INFO ) $ WORK, INFO )
END IF END IF
* *
WORK( 1 ) = N*NB WORK( 1 ) = LWMIN
RETURN RETURN
* *
* End of DLATSQR * End of DLATSQR

View File

@ -20,7 +20,7 @@
* Definition: * Definition:
* =========== * ===========
* *
* SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, * SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
* INFO ) * INFO )
* *
* IMPLICIT NONE * IMPLICIT NONE
@ -97,7 +97,7 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, dimension LWORK *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
@ -105,12 +105,12 @@
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of the array WORK. LWORK >= 1, when N <= 1; *> The length of the array WORK. LWORK >= 1, when N <= 1;
*> otherwise *> otherwise
*> If JOBZ = 'N' and N > 1, LWORK must be queried. *> If JOBZ = 'N' and N > 1, LWORK must be queried.
*> LWORK = MAX(1, dimension) where *> LWORK = MAX(1, dimension) where
*> dimension = max(stage1,stage2) + (KD+1)*N + 2*N *> dimension = max(stage1,stage2) + (KD+1)*N + 2*N
*> = N*KD + N*max(KD+1,FACTOPTNB) *> = N*KD + N*max(KD+1,FACTOPTNB)
*> + max(2*KD*KD, KD*NTHREADS) *> + max(2*KD*KD, KD*NTHREADS)
*> + (KD+1)*N + 2*N *> + (KD+1)*N + 2*N
*> where KD is the blocking size of the reduction, *> where KD is the blocking size of the reduction,
*> FACTOPTNB is the blocking used by the QR or LQ *> FACTOPTNB is the blocking used by the QR or LQ
@ -143,7 +143,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYeigen *> \ingroup heev_2stage
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -161,7 +161,7 @@
*> http://doi.acm.org/10.1145/2063384.2063394 *> http://doi.acm.org/10.1145/2063384.2063394
*> *>
*> A. Haidar, J. Kurzak, P. Luszczek, 2013. *> A. Haidar, J. Kurzak, P. Luszczek, 2013.
*> An improved parallel singular value algorithm and its implementation *> An improved parallel singular value algorithm and its implementation
*> for multicore hardware, In Proceedings of 2013 International Conference *> for multicore hardware, In Proceedings of 2013 International Conference
*> for High Performance Computing, Networking, Storage and Analysis (SC '13). *> for High Performance Computing, Networking, Storage and Analysis (SC '13).
*> Denver, Colorado, USA, 2013. *> Denver, Colorado, USA, 2013.
@ -169,16 +169,16 @@
*> http://doi.acm.org/10.1145/2503210.2503292 *> http://doi.acm.org/10.1145/2503210.2503292
*> *>
*> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra. *> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure *> A novel hybrid CPU-GPU generalized eigensolver for electronic structure
*> calculations based on fine-grained memory aware tasks. *> calculations based on fine-grained memory aware tasks.
*> International Journal of High Performance Computing Applications. *> International Journal of High Performance Computing Applications.
*> Volume 28 Issue 2, Pages 196-209, May 2014. *> Volume 28 Issue 2, Pages 196-209, May 2014.
*> http://hpc.sagepub.com/content/28/2/196 *> http://hpc.sagepub.com/content/28/2/196
*> *>
*> \endverbatim *> \endverbatim
* *
* ===================================================================== * =====================================================================
SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
$ INFO ) $ INFO )
* *
IMPLICIT NONE IMPLICIT NONE
@ -305,7 +305,7 @@
LLWORK = LWORK - INDWRK + 1 LLWORK = LWORK - INDWRK + 1
* *
CALL DSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK( INDE ), CALL DSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK( INDE ),
$ WORK( INDTAU ), WORK( INDHOUS ), LHTRD, $ WORK( INDTAU ), WORK( INDHOUS ), LHTRD,
$ WORK( INDWRK ), LLWORK, IINFO ) $ WORK( INDWRK ), LLWORK, IINFO )
* *
* For eigenvalues only, call DSTERF. For eigenvectors, first call * For eigenvalues only, call DSTERF. For eigenvectors, first call

View File

@ -96,8 +96,7 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> dimension (LWORK)
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
@ -160,7 +159,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYeigen *> \ingroup heevd
* *
*> \par Contributors: *> \par Contributors:
* ================== * ==================

View File

@ -271,7 +271,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,26*N). *> The dimension of the array WORK.
*> If N <= 1, LWORK >= 1, else LWORK >= 26*N.
*> For optimal efficiency, LWORK >= (NB+6)*N, *> For optimal efficiency, LWORK >= (NB+6)*N,
*> where NB is the max of the blocksize for DSYTRD and DORMTR *> where NB is the max of the blocksize for DSYTRD and DORMTR
*> returned by ILAENV. *> returned by ILAENV.
@ -285,13 +286,14 @@
*> \param[out] IWORK *> \param[out] IWORK
*> \verbatim *> \verbatim
*> IWORK is INTEGER array, dimension (MAX(1,LIWORK)) *> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
*> On exit, if INFO = 0, IWORK(1) returns the optimal LWORK. *> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LIWORK *> \param[in] LIWORK
*> \verbatim *> \verbatim
*> LIWORK is INTEGER *> LIWORK is INTEGER
*> The dimension of the array IWORK. LIWORK >= max(1,10*N). *> The dimension of the array IWORK.
*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N.
*> *>
*> If LIWORK = -1, then a workspace query is assumed; the *> If LIWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the IWORK array, *> routine only calculates the optimal size of the IWORK array,
@ -315,7 +317,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYeigen *> \ingroup heevr
* *
*> \par Contributors: *> \par Contributors:
* ================== * ==================
@ -390,8 +392,13 @@
* *
LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) ) LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
* *
LWMIN = MAX( 1, 26*N ) IF( N.LE.1 ) THEN
LIWMIN = MAX( 1, 10*N ) LWMIN = 1
LIWMIN = 1
ELSE
LWMIN = 26*N
LIWMIN = 10*N
END IF
* *
INFO = 0 INFO = 0
IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
@ -450,7 +457,7 @@
END IF END IF
* *
IF( N.EQ.1 ) THEN IF( N.EQ.1 ) THEN
WORK( 1 ) = 7 WORK( 1 ) = 1
IF( ALLEIG .OR. INDEIG ) THEN IF( ALLEIG .OR. INDEIG ) THEN
M = 1 M = 1
W( 1 ) = A( 1, 1 ) W( 1 ) = A( 1, 1 )

View File

@ -263,7 +263,7 @@
*> indicating the nonzero elements in Z. The i-th eigenvector *> indicating the nonzero elements in Z. The i-th eigenvector
*> is nonzero only in elements ISUPPZ( 2*i-1 ) through *> is nonzero only in elements ISUPPZ( 2*i-1 ) through
*> ISUPPZ( 2*i ). This is an output of DSTEMR (tridiagonal *> ISUPPZ( 2*i ). This is an output of DSTEMR (tridiagonal
*> matrix). The support of the eigenvectors of A is typically *> matrix). The support of the eigenvectors of A is typically
*> 1:N because of the orthogonal transformations applied by DORMTR. *> 1:N because of the orthogonal transformations applied by DORMTR.
*> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1 *> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
*> \endverbatim *> \endverbatim
@ -277,12 +277,13 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK.
*> If N <= 1, LWORK must be at least 1.
*> If JOBZ = 'N' and N > 1, LWORK must be queried. *> If JOBZ = 'N' and N > 1, LWORK must be queried.
*> LWORK = MAX(1, 26*N, dimension) where *> LWORK = MAX(1, 26*N, dimension) where
*> dimension = max(stage1,stage2) + (KD+1)*N + 5*N *> dimension = max(stage1,stage2) + (KD+1)*N + 5*N
*> = N*KD + N*max(KD+1,FACTOPTNB) *> = N*KD + N*max(KD+1,FACTOPTNB)
*> + max(2*KD*KD, KD*NTHREADS) *> + max(2*KD*KD, KD*NTHREADS)
*> + (KD+1)*N + 5*N *> + (KD+1)*N + 5*N
*> where KD is the blocking size of the reduction, *> where KD is the blocking size of the reduction,
*> FACTOPTNB is the blocking used by the QR or LQ *> FACTOPTNB is the blocking used by the QR or LQ
@ -300,13 +301,14 @@
*> \param[out] IWORK *> \param[out] IWORK
*> \verbatim *> \verbatim
*> IWORK is INTEGER array, dimension (MAX(1,LIWORK)) *> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
*> On exit, if INFO = 0, IWORK(1) returns the optimal LWORK. *> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LIWORK *> \param[in] LIWORK
*> \verbatim *> \verbatim
*> LIWORK is INTEGER *> LIWORK is INTEGER
*> The dimension of the array IWORK. LIWORK >= max(1,10*N). *> The dimension of the array IWORK.
*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N.
*> *>
*> If LIWORK = -1, then a workspace query is assumed; the *> If LIWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the IWORK array, *> routine only calculates the optimal size of the IWORK array,
@ -330,7 +332,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYeigen *> \ingroup heevr_2stage
* *
*> \par Contributors: *> \par Contributors:
* ================== * ==================
@ -358,7 +360,7 @@
*> http://doi.acm.org/10.1145/2063384.2063394 *> http://doi.acm.org/10.1145/2063384.2063394
*> *>
*> A. Haidar, J. Kurzak, P. Luszczek, 2013. *> A. Haidar, J. Kurzak, P. Luszczek, 2013.
*> An improved parallel singular value algorithm and its implementation *> An improved parallel singular value algorithm and its implementation
*> for multicore hardware, In Proceedings of 2013 International Conference *> for multicore hardware, In Proceedings of 2013 International Conference
*> for High Performance Computing, Networking, Storage and Analysis (SC '13). *> for High Performance Computing, Networking, Storage and Analysis (SC '13).
*> Denver, Colorado, USA, 2013. *> Denver, Colorado, USA, 2013.
@ -366,11 +368,11 @@
*> http://doi.acm.org/10.1145/2503210.2503292 *> http://doi.acm.org/10.1145/2503210.2503292
*> *>
*> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra. *> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure *> A novel hybrid CPU-GPU generalized eigensolver for electronic structure
*> calculations based on fine-grained memory aware tasks. *> calculations based on fine-grained memory aware tasks.
*> International Journal of High Performance Computing Applications. *> International Journal of High Performance Computing Applications.
*> Volume 28 Issue 2, Pages 196-209, May 2014. *> Volume 28 Issue 2, Pages 196-209, May 2014.
*> http://hpc.sagepub.com/content/28/2/196 *> http://hpc.sagepub.com/content/28/2/196
*> *>
*> \endverbatim *> \endverbatim
* *
@ -444,8 +446,14 @@
IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 ) IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = MAX( 26*N, 5*N + LHTRD + LWTRD ) *
LIWMIN = MAX( 1, 10*N ) IF( N.LE.1 ) THEN
LWMIN = 1
LIWMIN = 1
ELSE
LWMIN = MAX( 26*N, 5*N + LHTRD + LWTRD )
LIWMIN = 10*N
END IF
* *
INFO = 0 INFO = 0
IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
@ -484,7 +492,7 @@
* NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) * NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
* NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) ) * NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) )
* LWKOPT = MAX( ( NB+1 )*N, LWMIN ) * LWKOPT = MAX( ( NB+1 )*N, LWMIN )
WORK( 1 ) = LWMIN WORK( 1 ) = LWMIN
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
END IF END IF
* *
@ -504,7 +512,7 @@
END IF END IF
* *
IF( N.EQ.1 ) THEN IF( N.EQ.1 ) THEN
WORK( 1 ) = 7 WORK( 1 ) = 1
IF( ALLEIG .OR. INDEIG ) THEN IF( ALLEIG .OR. INDEIG ) THEN
M = 1 M = 1
W( 1 ) = A( 1, 1 ) W( 1 ) = A( 1, 1 )
@ -608,7 +616,7 @@
* Call DSYTRD_2STAGE to reduce symmetric matrix to tridiagonal form. * Call DSYTRD_2STAGE to reduce symmetric matrix to tridiagonal form.
* *
* *
CALL DSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, WORK( INDD ), CALL DSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, WORK( INDD ),
$ WORK( INDE ), WORK( INDTAU ), WORK( INDHOUS ), $ WORK( INDE ), WORK( INDTAU ), WORK( INDHOUS ),
$ LHTRD, WORK( INDWK ), LLWORK, IINFO ) $ LHTRD, WORK( INDWK ), LLWORK, IINFO )
* *
@ -727,7 +735,7 @@
* *
* Set WORK(1) to optimal workspace size. * Set WORK(1) to optimal workspace size.
* *
WORK( 1 ) = LWMIN WORK( 1 ) = LWMIN
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
* *
RETURN RETURN

View File

@ -244,7 +244,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYeigen *> \ingroup heevx
* *
* ===================================================================== * =====================================================================
SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
@ -338,14 +338,14 @@
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
IF( N.LE.1 ) THEN IF( N.LE.1 ) THEN
LWKMIN = 1 LWKMIN = 1
WORK( 1 ) = LWKMIN LWKOPT = 1
ELSE ELSE
LWKMIN = 8*N LWKMIN = 8*N
NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) ) NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) )
LWKOPT = MAX( LWKMIN, ( NB + 3 )*N ) LWKOPT = MAX( LWKMIN, ( NB + 3 )*N )
WORK( 1 ) = LWKOPT
END IF END IF
WORK( 1 ) = LWKOPT
* *
IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
$ INFO = -17 $ INFO = -17

View File

@ -154,7 +154,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYsolve *> \ingroup hesv_aa
* *
* ===================================================================== * =====================================================================
SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
@ -177,7 +177,7 @@
* *
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS INTEGER LWKMIN, LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -196,6 +196,7 @@
* *
INFO = 0 INFO = 0
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N, 3*N-2 )
IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
@ -206,17 +207,17 @@
INFO = -5 INFO = -5
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -8 INFO = -8
ELSE IF( LWORK.LT.MAX(2*N, 3*N-2) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10 INFO = -10
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) CALL DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
LWKOPT_SYTRF = INT( WORK(1) ) LWKOPT_SYTRF = INT( WORK( 1 ) )
CALL DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, CALL DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
$ -1, INFO ) $ -1, INFO )
LWKOPT_SYTRS = INT( WORK(1) ) LWKOPT_SYTRS = INT( WORK( 1 ) )
LWKOPT = MAX( LWKOPT_SYTRF, LWKOPT_SYTRS ) LWKOPT = MAX( LWKMIN, LWKOPT_SYTRF, LWKOPT_SYTRS )
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
END IF END IF
* *

View File

@ -101,14 +101,14 @@
*> *>
*> \param[out] TB *> \param[out] TB
*> \verbatim *> \verbatim
*> TB is DOUBLE PRECISION array, dimension (LTB) *> TB is DOUBLE PRECISION array, dimension (MAX(1,LTB))
*> On exit, details of the LU factorization of the band matrix. *> On exit, details of the LU factorization of the band matrix.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LTB *> \param[in] LTB
*> \verbatim *> \verbatim
*> LTB is INTEGER *> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally *> The size of the array TB. LTB >= MAX(1,4*N), internally
*> used to select NB such that LTB >= (3*NB+1)*N. *> used to select NB such that LTB >= (3*NB+1)*N.
*> *>
*> If LTB = -1, then a workspace query is assumed; the *> If LTB = -1, then a workspace query is assumed; the
@ -148,14 +148,15 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION workspace of size LWORK *> WORK is DOUBLE PRECISION workspace of size (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB *> The size of WORK. LWORK >= MAX(1,N), internally used to
*> such that LWORK >= N*NB. *> select NB such that LWORK >= N*NB.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the *> If LWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the WORK array, *> routine only calculates the optimal size of the WORK array,
@ -179,7 +180,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYsolve *> \ingroup hesv_aa_2stage
* *
* ===================================================================== * =====================================================================
SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
@ -205,7 +206,7 @@
* *
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL UPPER, TQUERY, WQUERY LOGICAL UPPER, TQUERY, WQUERY
INTEGER LWKOPT INTEGER LWKMIN, LWKOPT
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -226,6 +227,7 @@
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
WQUERY = ( LWORK.EQ.-1 ) WQUERY = ( LWORK.EQ.-1 )
TQUERY = ( LTB.EQ.-1 ) TQUERY = ( LTB.EQ.-1 )
LWKMIN = MAX( 1, N )
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
@ -234,18 +236,19 @@
INFO = -3 INFO = -3
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -5 INFO = -5
ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN
INFO = -7 INFO = -7
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -11 INFO = -11
ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.WQUERY ) THEN
INFO = -13 INFO = -13
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV, CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
$ IPIV2, WORK, -1, INFO ) $ IPIV2, WORK, -1, INFO )
LWKOPT = INT( WORK(1) ) LWKOPT = MAX( LWKMIN, INT( WORK( 1 ) ) )
WORK( 1 ) = LWKOPT
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -255,7 +258,6 @@
RETURN RETURN
END IF END IF
* *
*
* Compute the factorization A = U**T*T*U or A = L*T*L**T. * Compute the factorization A = U**T*T*U or A = L*T*L**T.
* *
CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,

View File

@ -275,7 +275,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYsolve *> \ingroup hesvx
* *
* ===================================================================== * =====================================================================
SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B,
@ -305,7 +305,7 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY, NOFACT LOGICAL LQUERY, NOFACT
INTEGER LWKOPT, NB INTEGER LWKMIN, LWKOPT, NB
DOUBLE PRECISION ANORM DOUBLE PRECISION ANORM
* .. * ..
* .. External Functions .. * .. External Functions ..
@ -327,6 +327,7 @@
INFO = 0 INFO = 0
NOFACT = LSAME( FACT, 'N' ) NOFACT = LSAME( FACT, 'N' )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 3*N )
IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
@ -344,12 +345,12 @@
INFO = -11 INFO = -11
ELSE IF( LDX.LT.MAX( 1, N ) ) THEN ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
INFO = -13 INFO = -13
ELSE IF( LWORK.LT.MAX( 1, 3*N ) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -18 INFO = -18
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
LWKOPT = MAX( 1, 3*N ) LWKOPT = LWKMIN
IF( NOFACT ) THEN IF( NOFACT ) THEN
NB = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 )
LWKOPT = MAX( LWKOPT, N*NB ) LWKOPT = MAX( LWKOPT, N*NB )

View File

@ -139,7 +139,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYcomputational *> \ingroup hetrd
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -247,7 +247,7 @@
* Determine the block size. * Determine the block size.
* *
NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
LWKOPT = N*NB LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
END IF END IF
* *

View File

@ -4,23 +4,23 @@
* *
* =========== DOCUMENTATION =========== * =========== DOCUMENTATION ===========
* *
* Online html documentation available at * Online html documentation available at
* http://www.netlib.org/lapack/explore-html/ * http://www.netlib.org/lapack/explore-html/
* *
*> \htmlonly *> \htmlonly
*> Download DSYTRD_2STAGE + dependencies *> Download DSYTRD_2STAGE + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrd_2stage.f"> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrd_2stage.f">
*> [TGZ]</a> *> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrd_2stage.f"> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrd_2stage.f">
*> [ZIP]</a> *> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrd_2stage.f"> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrd_2stage.f">
*> [TXT]</a> *> [TXT]</a>
*> \endhtmlonly *> \endhtmlonly
* *
* Definition: * Definition:
* =========== * ===========
* *
* SUBROUTINE DSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, * SUBROUTINE DSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU,
* HOUS2, LHOUS2, WORK, LWORK, INFO ) * HOUS2, LHOUS2, WORK, LWORK, INFO )
* *
* IMPLICIT NONE * IMPLICIT NONE
@ -34,7 +34,7 @@
* DOUBLE PRECISION A( LDA, * ), TAU( * ), * DOUBLE PRECISION A( LDA, * ), TAU( * ),
* HOUS2( * ), WORK( * ) * HOUS2( * ), WORK( * )
* .. * ..
* *
* *
*> \par Purpose: *> \par Purpose:
* ============= * =============
@ -52,11 +52,11 @@
*> \param[in] VECT *> \param[in] VECT
*> \verbatim *> \verbatim
*> VECT is CHARACTER*1 *> VECT is CHARACTER*1
*> = 'N': No need for the Housholder representation, *> = 'N': No need for the Housholder representation,
*> in particular for the second stage (Band to *> in particular for the second stage (Band to
*> tridiagonal) and thus LHOUS2 is of size max(1, 4*N); *> tridiagonal) and thus LHOUS2 is of size max(1, 4*N);
*> = 'V': the Householder representation is needed to *> = 'V': the Householder representation is needed to
*> either generate Q1 Q2 or to apply Q1 Q2, *> either generate Q1 Q2 or to apply Q1 Q2,
*> then LHOUS2 is to be queried and computed. *> then LHOUS2 is to be queried and computed.
*> (NOT AVAILABLE IN THIS RELEASE). *> (NOT AVAILABLE IN THIS RELEASE).
*> \endverbatim *> \endverbatim
@ -86,7 +86,7 @@
*> triangular part of A is not referenced. *> triangular part of A is not referenced.
*> On exit, if UPLO = 'U', the band superdiagonal *> On exit, if UPLO = 'U', the band superdiagonal
*> of A are overwritten by the corresponding elements of the *> of A are overwritten by the corresponding elements of the
*> internal band-diagonal matrix AB, and the elements above *> internal band-diagonal matrix AB, and the elements above
*> the KD superdiagonal, with the array TAU, represent the orthogonal *> the KD superdiagonal, with the array TAU, represent the orthogonal
*> matrix Q1 as a product of elementary reflectors; if UPLO *> matrix Q1 as a product of elementary reflectors; if UPLO
*> = 'L', the diagonal and band subdiagonal of A are over- *> = 'L', the diagonal and band subdiagonal of A are over-
@ -117,13 +117,13 @@
*> \param[out] TAU *> \param[out] TAU
*> \verbatim *> \verbatim
*> TAU is DOUBLE PRECISION array, dimension (N-KD) *> TAU is DOUBLE PRECISION array, dimension (N-KD)
*> The scalar factors of the elementary reflectors of *> The scalar factors of the elementary reflectors of
*> the first stage (see Further Details). *> the first stage (see Further Details).
*> \endverbatim *> \endverbatim
*> *>
*> \param[out] HOUS2 *> \param[out] HOUS2
*> \verbatim *> \verbatim
*> HOUS2 is DOUBLE PRECISION array, dimension (LHOUS2) *> HOUS2 is DOUBLE PRECISION array, dimension (MAX(1,LHOUS2))
*> Stores the Householder representation of the stage2 *> Stores the Householder representation of the stage2
*> band to tridiagonal. *> band to tridiagonal.
*> \endverbatim *> \endverbatim
@ -132,6 +132,8 @@
*> \verbatim *> \verbatim
*> LHOUS2 is INTEGER *> LHOUS2 is INTEGER
*> The dimension of the array HOUS2. *> The dimension of the array HOUS2.
*> LHOUS2 >= 1.
*>
*> If LWORK = -1, or LHOUS2 = -1, *> If LWORK = -1, or LHOUS2 = -1,
*> then a query is assumed; the routine *> then a query is assumed; the routine
*> only calculates the optimal size of the HOUS2 array, returns *> only calculates the optimal size of the HOUS2 array, returns
@ -143,23 +145,26 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, dimension (LWORK) *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK = MAX(1, dimension) *> The dimension of the array WORK.
*> If LWORK = -1, or LHOUS2=-1, *> If N = 0, LWORK >= 1, else LWORK = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS2 = -1,
*> then a workspace query is assumed; the routine *> then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA. *> message related to LWORK is issued by XERBLA.
*> LWORK = MAX(1, dimension) where *> LWORK = MAX(1, dimension) where
*> dimension = max(stage1,stage2) + (KD+1)*N *> dimension = max(stage1,stage2) + (KD+1)*N
*> = N*KD + N*max(KD+1,FACTOPTNB) *> = N*KD + N*max(KD+1,FACTOPTNB)
*> + max(2*KD*KD, KD*NTHREADS) *> + max(2*KD*KD, KD*NTHREADS)
*> + (KD+1)*N *> + (KD+1)*N
*> where KD is the blocking size of the reduction, *> where KD is the blocking size of the reduction,
*> FACTOPTNB is the blocking used by the QR or LQ *> FACTOPTNB is the blocking used by the QR or LQ
*> algorithm, usually FACTOPTNB=128 is a good choice *> algorithm, usually FACTOPTNB=128 is a good choice
@ -177,12 +182,12 @@
* Authors: * Authors:
* ======== * ========
* *
*> \author Univ. of Tennessee *> \author Univ. of Tennessee
*> \author Univ. of California Berkeley *> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYcomputational *> \ingroup hetrd_2stage
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -202,7 +207,7 @@
*> http://doi.acm.org/10.1145/2063384.2063394 *> http://doi.acm.org/10.1145/2063384.2063394
*> *>
*> A. Haidar, J. Kurzak, P. Luszczek, 2013. *> A. Haidar, J. Kurzak, P. Luszczek, 2013.
*> An improved parallel singular value algorithm and its implementation *> An improved parallel singular value algorithm and its implementation
*> for multicore hardware, In Proceedings of 2013 International Conference *> for multicore hardware, In Proceedings of 2013 International Conference
*> for High Performance Computing, Networking, Storage and Analysis (SC '13). *> for High Performance Computing, Networking, Storage and Analysis (SC '13).
*> Denver, Colorado, USA, 2013. *> Denver, Colorado, USA, 2013.
@ -210,16 +215,16 @@
*> http://doi.acm.org/10.1145/2503210.2503292 *> http://doi.acm.org/10.1145/2503210.2503292
*> *>
*> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra. *> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure *> A novel hybrid CPU-GPU generalized eigensolver for electronic structure
*> calculations based on fine-grained memory aware tasks. *> calculations based on fine-grained memory aware tasks.
*> International Journal of High Performance Computing Applications. *> International Journal of High Performance Computing Applications.
*> Volume 28 Issue 2, Pages 196-209, May 2014. *> Volume 28 Issue 2, Pages 196-209, May 2014.
*> http://hpc.sagepub.com/content/28/2/196 *> http://hpc.sagepub.com/content/28/2/196
*> *>
*> \endverbatim *> \endverbatim
*> *>
* ===================================================================== * =====================================================================
SUBROUTINE DSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, SUBROUTINE DSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU,
$ HOUS2, LHOUS2, WORK, LWORK, INFO ) $ HOUS2, LHOUS2, WORK, LWORK, INFO )
* *
IMPLICIT NONE IMPLICIT NONE
@ -265,10 +270,13 @@
* *
KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', VECT, N, -1, -1, -1 ) KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', VECT, N, -1, -1, -1 )
IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', VECT, N, KD, -1, -1 ) IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', VECT, N, KD, -1, -1 )
LHMIN = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 ) IF( N.EQ.0 ) THEN
LWMIN = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 ) LHMIN = 1
* WRITE(*,*),'DSYTRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO, LWMIN = 1
* $ LHMIN, LWMIN ELSE
LHMIN = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
END IF
* *
IF( .NOT.LSAME( VECT, 'N' ) ) THEN IF( .NOT.LSAME( VECT, 'N' ) ) THEN
INFO = -1 INFO = -1
@ -309,14 +317,14 @@
LWRK = LWORK-LDAB*N LWRK = LWORK-LDAB*N
ABPOS = 1 ABPOS = 1
WPOS = ABPOS + LDAB*N WPOS = ABPOS + LDAB*N
CALL DSYTRD_SY2SB( UPLO, N, KD, A, LDA, WORK( ABPOS ), LDAB, CALL DSYTRD_SY2SB( UPLO, N, KD, A, LDA, WORK( ABPOS ), LDAB,
$ TAU, WORK( WPOS ), LWRK, INFO ) $ TAU, WORK( WPOS ), LWRK, INFO )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DSYTRD_SY2SB', -INFO ) CALL XERBLA( 'DSYTRD_SY2SB', -INFO )
RETURN RETURN
END IF END IF
CALL DSYTRD_SB2ST( 'Y', VECT, UPLO, N, KD, CALL DSYTRD_SB2ST( 'Y', VECT, UPLO, N, KD,
$ WORK( ABPOS ), LDAB, D, E, $ WORK( ABPOS ), LDAB, D, E,
$ HOUS2, LHOUS2, WORK( WPOS ), LWRK, INFO ) $ HOUS2, LHOUS2, WORK( WPOS ), LWRK, INFO )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DSYTRD_SB2ST', -INFO ) CALL XERBLA( 'DSYTRD_SB2ST', -INFO )
@ -324,8 +332,7 @@
END IF END IF
* *
* *
HOUS2( 1 ) = LHMIN WORK( 1 ) = LWMIN
WORK( 1 ) = LWMIN
RETURN RETURN
* *
* End of DSYTRD_2STAGE * End of DSYTRD_2STAGE

View File

@ -18,7 +18,7 @@
* Definition: * Definition:
* =========== * ===========
* *
* SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB,
* D, E, HOUS, LHOUS, WORK, LWORK, INFO ) * D, E, HOUS, LHOUS, WORK, LWORK, INFO )
* *
* #if defined(_OPENMP) * #if defined(_OPENMP)
@ -53,12 +53,12 @@
*> \param[in] STAGE1 *> \param[in] STAGE1
*> \verbatim *> \verbatim
*> STAGE1 is CHARACTER*1 *> STAGE1 is CHARACTER*1
*> = 'N': "No": to mention that the stage 1 of the reduction *> = 'N': "No": to mention that the stage 1 of the reduction
*> from dense to band using the dsytrd_sy2sb routine *> from dense to band using the dsytrd_sy2sb routine
*> was not called before this routine to reproduce AB. *> was not called before this routine to reproduce AB.
*> In other term this routine is called as standalone. *> In other term this routine is called as standalone.
*> = 'Y': "Yes": to mention that the stage 1 of the *> = 'Y': "Yes": to mention that the stage 1 of the
*> reduction from dense to band using the dsytrd_sy2sb *> reduction from dense to band using the dsytrd_sy2sb
*> routine has been called to produce AB (e.g., AB is *> routine has been called to produce AB (e.g., AB is
*> the output of dsytrd_sy2sb. *> the output of dsytrd_sy2sb.
*> \endverbatim *> \endverbatim
@ -66,10 +66,10 @@
*> \param[in] VECT *> \param[in] VECT
*> \verbatim *> \verbatim
*> VECT is CHARACTER*1 *> VECT is CHARACTER*1
*> = 'N': No need for the Housholder representation, *> = 'N': No need for the Housholder representation,
*> and thus LHOUS is of size max(1, 4*N); *> and thus LHOUS is of size max(1, 4*N);
*> = 'V': the Householder representation is needed to *> = 'V': the Householder representation is needed to
*> either generate or to apply Q later on, *> either generate or to apply Q later on,
*> then LHOUS is to be queried and computed. *> then LHOUS is to be queried and computed.
*> (NOT AVAILABLE IN THIS RELEASE). *> (NOT AVAILABLE IN THIS RELEASE).
*> \endverbatim *> \endverbatim
@ -132,34 +132,39 @@
*> *>
*> \param[out] HOUS *> \param[out] HOUS
*> \verbatim *> \verbatim
*> HOUS is DOUBLE PRECISION array, dimension LHOUS, that *> HOUS is DOUBLE PRECISION array, dimension (MAX(1,LHOUS))
*> store the Householder representation. *> Stores the Householder representation.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LHOUS *> \param[in] LHOUS
*> \verbatim *> \verbatim
*> LHOUS is INTEGER *> LHOUS is INTEGER
*> The dimension of the array HOUS. LHOUS = MAX(1, dimension) *> The dimension of the array HOUS.
*> If LWORK = -1, or LHOUS=-1, *> If N = 0 or KD <= 1, LHOUS >= 1, else LHOUS = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS = -1,
*> then a query is assumed; the routine *> then a query is assumed; the routine
*> only calculates the optimal size of the HOUS array, returns *> only calculates the optimal size of the HOUS array, returns
*> this value as the first entry of the HOUS array, and no error *> this value as the first entry of the HOUS array, and no error
*> message related to LHOUS is issued by XERBLA. *> message related to LHOUS is issued by XERBLA.
*> LHOUS = MAX(1, dimension) where *> LHOUS = MAX(1, dimension) where
*> dimension = 4*N if VECT='N' *> dimension = 4*N if VECT='N'
*> not available now if VECT='H' *> not available now if VECT='H'
*> \endverbatim *> \endverbatim
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, dimension LWORK. *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK = MAX(1, dimension) *> The dimension of the array WORK.
*> If LWORK = -1, or LHOUS=-1, *> If N = 0 or KD <= 1, LWORK >= 1, else LWORK = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS = -1,
*> then a workspace query is assumed; the routine *> then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
@ -188,7 +193,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup real16OTHERcomputational *> \ingroup hetrd_hb2st
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -208,7 +213,7 @@
*> http://doi.acm.org/10.1145/2063384.2063394 *> http://doi.acm.org/10.1145/2063384.2063394
*> *>
*> A. Haidar, J. Kurzak, P. Luszczek, 2013. *> A. Haidar, J. Kurzak, P. Luszczek, 2013.
*> An improved parallel singular value algorithm and its implementation *> An improved parallel singular value algorithm and its implementation
*> for multicore hardware, In Proceedings of 2013 International Conference *> for multicore hardware, In Proceedings of 2013 International Conference
*> for High Performance Computing, Networking, Storage and Analysis (SC '13). *> for High Performance Computing, Networking, Storage and Analysis (SC '13).
*> Denver, Colorado, USA, 2013. *> Denver, Colorado, USA, 2013.
@ -216,16 +221,16 @@
*> http://doi.acm.org/10.1145/2503210.2503292 *> http://doi.acm.org/10.1145/2503210.2503292
*> *>
*> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra. *> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure *> A novel hybrid CPU-GPU generalized eigensolver for electronic structure
*> calculations based on fine-grained memory aware tasks. *> calculations based on fine-grained memory aware tasks.
*> International Journal of High Performance Computing Applications. *> International Journal of High Performance Computing Applications.
*> Volume 28 Issue 2, Pages 196-209, May 2014. *> Volume 28 Issue 2, Pages 196-209, May 2014.
*> http://hpc.sagepub.com/content/28/2/196 *> http://hpc.sagepub.com/content/28/2/196
*> *>
*> \endverbatim *> \endverbatim
*> *>
* ===================================================================== * =====================================================================
SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB,
$ D, E, HOUS, LHOUS, WORK, LWORK, INFO ) $ D, E, HOUS, LHOUS, WORK, LWORK, INFO )
* *
#if defined(_OPENMP) #if defined(_OPENMP)
@ -258,11 +263,11 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY, WANTQ, UPPER, AFTERS1 LOGICAL LQUERY, WANTQ, UPPER, AFTERS1
INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST, INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST,
$ ED, STIND, EDIND, BLKLASTIND, COLPT, THED, $ ED, STIND, EDIND, BLKLASTIND, COLPT, THED,
$ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID, $ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID,
$ NBTILES, TTYPE, TID, NTHREADS, DEBUG, $ NBTILES, TTYPE, TID, NTHREADS,
$ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS, $ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS,
$ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU, $ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU,
$ SIDEV, SIZETAU, LDV, LHMIN, LWMIN $ SIDEV, SIZETAU, LDV, LHMIN, LWMIN
* .. * ..
@ -274,7 +279,7 @@
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER ILAENV2STAGE INTEGER ILAENV2STAGE
EXTERNAL LSAME, ILAENV2STAGE EXTERNAL LSAME, ILAENV2STAGE
* .. * ..
* .. Executable Statements .. * .. Executable Statements ..
@ -282,7 +287,6 @@
* Determine the minimal workspace size required. * Determine the minimal workspace size required.
* Test the input parameters * Test the input parameters
* *
DEBUG = 0
INFO = 0 INFO = 0
AFTERS1 = LSAME( STAGE1, 'Y' ) AFTERS1 = LSAME( STAGE1, 'Y' )
WANTQ = LSAME( VECT, 'V' ) WANTQ = LSAME( VECT, 'V' )
@ -291,9 +295,14 @@
* *
* Determine the block size, the workspace size and the hous size. * Determine the block size, the workspace size and the hous size.
* *
IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', VECT, N, KD, -1, -1 ) IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', VECT, N, KD, -1, -1 )
LHMIN = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 ) IF( N.EQ.0 .OR. KD.LE.1 ) THEN
LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 ) LHMIN = 1
LWMIN = 1
ELSE
LHMIN = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 )
END IF
* *
IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN
INFO = -1 INFO = -1
@ -355,7 +364,7 @@
ABDPOS = KD + 1 ABDPOS = KD + 1
ABOFDPOS = KD ABOFDPOS = KD
ELSE ELSE
APOS = INDA APOS = INDA
AWPOS = INDA + KD + 1 AWPOS = INDA + KD + 1
DPOS = APOS DPOS = APOS
OFDPOS = DPOS + 1 OFDPOS = DPOS + 1
@ -363,11 +372,11 @@
ABOFDPOS = 2 ABOFDPOS = 2
ENDIF ENDIF
* *
* Case KD=0: * Case KD=0:
* The matrix is diagonal. We just copy it (convert to "real" for * The matrix is diagonal. We just copy it (convert to "real" for
* real because D is double and the imaginary part should be 0) * real because D is double and the imaginary part should be 0)
* and store it in D. A sequential code here is better or * and store it in D. A sequential code here is better or
* in a parallel environment it might need two cores for D and E * in a parallel environment it might need two cores for D and E
* *
IF( KD.EQ.0 ) THEN IF( KD.EQ.0 ) THEN
@ -382,17 +391,17 @@
WORK( 1 ) = 1 WORK( 1 ) = 1
RETURN RETURN
END IF END IF
* *
* Case KD=1: * Case KD=1:
* The matrix is already Tridiagonal. We have to make diagonal * The matrix is already Tridiagonal. We have to make diagonal
* and offdiagonal elements real, and store them in D and E. * and offdiagonal elements real, and store them in D and E.
* For that, for real precision just copy the diag and offdiag * For that, for real precision just copy the diag and offdiag
* to D and E while for the COMPLEX case the bulge chasing is * to D and E while for the COMPLEX case the bulge chasing is
* performed to convert the hermetian tridiagonal to symmetric * performed to convert the hermetian tridiagonal to symmetric
* tridiagonal. A simpler conversion formula might be used, but then * tridiagonal. A simpler conversion formula might be used, but then
* updating the Q matrix will be required and based if Q is generated * updating the Q matrix will be required and based if Q is generated
* or not this might complicate the story. * or not this might complicate the story.
* *
IF( KD.EQ.1 ) THEN IF( KD.EQ.1 ) THEN
DO 50 I = 1, N DO 50 I = 1, N
D( I ) = ( AB( ABDPOS, I ) ) D( I ) = ( AB( ABDPOS, I ) )
@ -413,7 +422,7 @@
RETURN RETURN
END IF END IF
* *
* Main code start here. * Main code start here.
* Reduce the symmetric band of A to a tridiagonal matrix. * Reduce the symmetric band of A to a tridiagonal matrix.
* *
THGRSIZ = N THGRSIZ = N
@ -422,7 +431,7 @@
NBTILES = CEILING( REAL(N)/REAL(KD) ) NBTILES = CEILING( REAL(N)/REAL(KD) )
STEPERCOL = CEILING( REAL(SHIFT)/REAL(GRSIZ) ) STEPERCOL = CEILING( REAL(SHIFT)/REAL(GRSIZ) )
THGRNB = CEILING( REAL(N-1)/REAL(THGRSIZ) ) THGRNB = CEILING( REAL(N-1)/REAL(THGRSIZ) )
* *
CALL DLACPY( "A", KD+1, N, AB, LDAB, WORK( APOS ), LDA ) CALL DLACPY( "A", KD+1, N, AB, LDAB, WORK( APOS ), LDA )
CALL DLASET( "A", KD, N, ZERO, ZERO, WORK( AWPOS ), LDA ) CALL DLASET( "A", KD, N, ZERO, ZERO, WORK( AWPOS ), LDA )
* *
@ -431,7 +440,7 @@
* *
#if defined(_OPENMP) #if defined(_OPENMP)
!$OMP PARALLEL PRIVATE( TID, THGRID, BLKLASTIND ) !$OMP PARALLEL PRIVATE( TID, THGRID, BLKLASTIND )
!$OMP$ PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID ) !$OMP$ PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID )
!$OMP$ PRIVATE( MYID, TTYPE, COLPT, STIND, EDIND ) !$OMP$ PRIVATE( MYID, TTYPE, COLPT, STIND, EDIND )
!$OMP$ SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK) !$OMP$ SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK)
!$OMP$ SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA ) !$OMP$ SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA )
@ -440,7 +449,7 @@
#endif #endif
* *
* main bulge chasing loop * main bulge chasing loop
* *
DO 100 THGRID = 1, THGRNB DO 100 THGRID = 1, THGRNB
STT = (THGRID-1)*THGRSIZ+1 STT = (THGRID-1)*THGRSIZ+1
THED = MIN( (STT + THGRSIZ -1), (N-1)) THED = MIN( (STT + THGRSIZ -1), (N-1))
@ -451,7 +460,7 @@
ST = STT ST = STT
DO 130 SWEEPID = ST, ED DO 130 SWEEPID = ST, ED
DO 140 K = 1, GRSIZ DO 140 K = 1, GRSIZ
MYID = (I-SWEEPID)*(STEPERCOL*GRSIZ) MYID = (I-SWEEPID)*(STEPERCOL*GRSIZ)
$ + (M-1)*GRSIZ + K $ + (M-1)*GRSIZ + K
IF ( MYID.EQ.1 ) THEN IF ( MYID.EQ.1 ) THEN
TTYPE = 1 TTYPE = 1
@ -477,16 +486,16 @@
ENDIF ENDIF
* *
* Call the kernel * Call the kernel
* *
#if defined(_OPENMP) && _OPENMP >= 201307 #if defined(_OPENMP) && _OPENMP >= 201307
IF( TTYPE.NE.1 ) THEN IF( TTYPE.NE.1 ) THEN
!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
!$OMP$ DEPEND(in:WORK(MYID-1)) !$OMP$ DEPEND(in:WORK(MYID-1))
!$OMP$ DEPEND(out:WORK(MYID)) !$OMP$ DEPEND(out:WORK(MYID))
TID = OMP_GET_THREAD_NUM() TID = OMP_GET_THREAD_NUM()
CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE, CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE,
$ STIND, EDIND, SWEEPID, N, KD, IB, $ STIND, EDIND, SWEEPID, N, KD, IB,
$ WORK ( INDA ), LDA, $ WORK ( INDA ), LDA,
$ HOUS( INDV ), HOUS( INDTAU ), LDV, $ HOUS( INDV ), HOUS( INDTAU ), LDV,
$ WORK( INDW + TID*KD ) ) $ WORK( INDW + TID*KD ) )
!$OMP END TASK !$OMP END TASK
@ -494,20 +503,20 @@
!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
!$OMP$ DEPEND(out:WORK(MYID)) !$OMP$ DEPEND(out:WORK(MYID))
TID = OMP_GET_THREAD_NUM() TID = OMP_GET_THREAD_NUM()
CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE, CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE,
$ STIND, EDIND, SWEEPID, N, KD, IB, $ STIND, EDIND, SWEEPID, N, KD, IB,
$ WORK ( INDA ), LDA, $ WORK ( INDA ), LDA,
$ HOUS( INDV ), HOUS( INDTAU ), LDV, $ HOUS( INDV ), HOUS( INDTAU ), LDV,
$ WORK( INDW + TID*KD ) ) $ WORK( INDW + TID*KD ) )
!$OMP END TASK !$OMP END TASK
ENDIF ENDIF
#else #else
CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE, CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE,
$ STIND, EDIND, SWEEPID, N, KD, IB, $ STIND, EDIND, SWEEPID, N, KD, IB,
$ WORK ( INDA ), LDA, $ WORK ( INDA ), LDA,
$ HOUS( INDV ), HOUS( INDTAU ), LDV, $ HOUS( INDV ), HOUS( INDTAU ), LDV,
$ WORK( INDW ) ) $ WORK( INDW ) )
#endif #endif
IF ( BLKLASTIND.GE.(N-1) ) THEN IF ( BLKLASTIND.GE.(N-1) ) THEN
STT = STT + 1 STT = STT + 1
EXIT EXIT
@ -522,14 +531,14 @@
!$OMP END MASTER !$OMP END MASTER
!$OMP END PARALLEL !$OMP END PARALLEL
#endif #endif
* *
* Copy the diagonal from A to D. Note that D is REAL thus only * Copy the diagonal from A to D. Note that D is REAL thus only
* the Real part is needed, the imaginary part should be zero. * the Real part is needed, the imaginary part should be zero.
* *
DO 150 I = 1, N DO 150 I = 1, N
D( I ) = ( WORK( DPOS+(I-1)*LDA ) ) D( I ) = ( WORK( DPOS+(I-1)*LDA ) )
150 CONTINUE 150 CONTINUE
* *
* Copy the off diagonal from A to E. Note that E is REAL thus only * Copy the off diagonal from A to E. Note that E is REAL thus only
* the Real part is needed, the imaginary part should be zero. * the Real part is needed, the imaginary part should be zero.
* *
@ -543,11 +552,10 @@
170 CONTINUE 170 CONTINUE
ENDIF ENDIF
* *
HOUS( 1 ) = LHMIN
WORK( 1 ) = LWMIN WORK( 1 ) = LWMIN
RETURN RETURN
* *
* End of DSYTRD_SB2ST * End of DSYTRD_SB2ST
* *
END END

View File

@ -123,8 +123,8 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, dimension (LWORK) *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, or if LWORK=-1, *> On exit, if INFO = 0, or if LWORK = -1,
*> WORK(1) returns the size of LWORK. *> WORK(1) returns the size of LWORK.
*> \endverbatim *> \endverbatim
*> *>
@ -132,7 +132,9 @@
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK which should be calculated *> The dimension of the array WORK which should be calculated
*> by a workspace query. LWORK = MAX(1, LWORK_QUERY) *> by a workspace query.
*> If N <= KD+1, LWORK >= 1, else LWORK = MAX(1, LWORK_QUERY)
*>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
@ -158,7 +160,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYcomputational *> \ingroup hetrd_he2hb
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -293,8 +295,12 @@
INFO = 0 INFO = 0
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SY2SB', '', N, KD, -1, -1 ) IF( N.LE.KD+1 ) THEN
LWMIN = 1
ELSE
LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SY2SB', ' ', N, KD, -1, -1 )
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN

View File

@ -101,8 +101,10 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of WORK. LWORK >= MAX(1,2*N). For optimum performance *> The length of WORK.
*> LWORK >= N*(1+NB), where NB is the optimal blocksize. *> LWORK >= 1, if N <= 1, and LWORK >= 2*N, otherwise.
*> For optimum performance LWORK >= N*(1+NB), where NB is
*> the optimal blocksize, returned by ILAENV.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
@ -125,10 +127,10 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYcomputational *> \ingroup hetrf_aa
* *
* ===================================================================== * =====================================================================
SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
* *
* -- LAPACK computational routine -- * -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
@ -152,7 +154,7 @@
* *
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY, UPPER LOGICAL LQUERY, UPPER
INTEGER J, LWKOPT INTEGER J, LWKMIN, LWKOPT
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
DOUBLE PRECISION ALPHA DOUBLE PRECISION ALPHA
* .. * ..
@ -179,18 +181,25 @@
INFO = 0 INFO = 0
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LE.1 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = 2*N
LWKOPT = (NB+1)*N
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4 INFO = -4
ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -7 INFO = -7
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
LWKOPT = (NB+1)*N
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
END IF END IF
* *
@ -203,11 +212,11 @@
* *
* Quick return * Quick return
* *
IF ( N.EQ.0 ) THEN IF( N.EQ.0 ) THEN
RETURN RETURN
ENDIF ENDIF
IPIV( 1 ) = 1 IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN IF( N.EQ.1 ) THEN
RETURN RETURN
END IF END IF
* *

View File

@ -87,14 +87,14 @@
*> *>
*> \param[out] TB *> \param[out] TB
*> \verbatim *> \verbatim
*> TB is DOUBLE PRECISION array, dimension (LTB) *> TB is DOUBLE PRECISION array, dimension (MAX(1,LTB))
*> On exit, details of the LU factorization of the band matrix. *> On exit, details of the LU factorization of the band matrix.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LTB *> \param[in] LTB
*> \verbatim *> \verbatim
*> LTB is INTEGER *> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally *> The size of the array TB. LTB >= MAX(1,4*N), internally
*> used to select NB such that LTB >= (3*NB+1)*N. *> used to select NB such that LTB >= (3*NB+1)*N.
*> *>
*> If LTB = -1, then a workspace query is assumed; the *> If LTB = -1, then a workspace query is assumed; the
@ -121,14 +121,14 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION workspace of size LWORK *> WORK is DOUBLE PRECISION workspace of size (MAX(1,LWORK))
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB *> The size of WORK. LWORK >= MAX(1,N), internally used
*> such that LWORK >= N*NB. *> to select NB such that LWORK >= N*NB.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the *> If LWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the WORK array, *> routine only calculates the optimal size of the WORK array,
@ -152,7 +152,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYcomputational *> \ingroup hetrf_aa_2stage
* *
* ===================================================================== * =====================================================================
SUBROUTINE DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, SUBROUTINE DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
@ -211,9 +211,9 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4 INFO = -4
ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN
INFO = -6 INFO = -6
ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN
INFO = -10 INFO = -10
END IF END IF
* *
@ -227,10 +227,10 @@
NB = ILAENV( 1, 'DSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'DSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 )
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
IF( TQUERY ) THEN IF( TQUERY ) THEN
TB( 1 ) = (3*NB+1)*N TB( 1 ) = MAX( 1, (3*NB+1)*N )
END IF END IF
IF( WQUERY ) THEN IF( WQUERY ) THEN
WORK( 1 ) = N*NB WORK( 1 ) = MAX( 1, N*NB )
END IF END IF
END IF END IF
IF( TQUERY .OR. WQUERY ) THEN IF( TQUERY .OR. WQUERY ) THEN
@ -239,7 +239,7 @@
* *
* Quick return * Quick return
* *
IF ( N.EQ.0 ) THEN IF( N.EQ.0 ) THEN
RETURN RETURN
ENDIF ENDIF
* *

View File

@ -177,14 +177,14 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, dimension ( MAX(1,LWORK) ). *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)).
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of WORK. LWORK >=1. For best performance *> The length of WORK. LWORK >= 1. For best performance
*> LWORK >= N*NB, where NB is the block size returned *> LWORK >= N*NB, where NB is the block size returned
*> by ILAENV. *> by ILAENV.
*> *>
@ -229,7 +229,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYcomputational *> \ingroup hetrf_rk
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================

View File

@ -118,7 +118,7 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of WORK. LWORK >=1. For best performance *> The length of WORK. LWORK >= 1. For best performance
*> LWORK >= N*NB, where NB is the block size returned by ILAENV. *> LWORK >= N*NB, where NB is the block size returned by ILAENV.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
@ -146,7 +146,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYcomputational *> \ingroup hetrf_rook
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================

View File

@ -88,16 +88,16 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, dimension (N+NB+1)*(NB+3) *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK.
*> WORK is size >= (N+NB+1)*(NB+3) *> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3).
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> calculates: *> calculates:
*> - the optimal size of the WORK array, returns *> - the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, *> this value as the first entry of the WORK array,
*> - and no error message related to LWORK is issued by XERBLA. *> - and no error message related to LWORK is issued by XERBLA.
@ -120,7 +120,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYcomputational *> \ingroup hetri2
* *
* ===================================================================== * =====================================================================
SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
@ -159,9 +159,13 @@
INFO = 0 INFO = 0
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
*
* Get blocksize * Get blocksize
*
NBMAX = ILAENV( 1, 'DSYTRI2', UPLO, N, -1, -1, -1 ) NBMAX = ILAENV( 1, 'DSYTRI2', UPLO, N, -1, -1, -1 )
IF ( NBMAX .GE. N ) THEN IF( N.EQ.0 ) THEN
MINSIZE = 1
ELSE IF( NBMAX.GE.N ) THEN
MINSIZE = N MINSIZE = N
ELSE ELSE
MINSIZE = (N+NBMAX+1)*(NBMAX+3) MINSIZE = (N+NBMAX+1)*(NBMAX+3)
@ -173,28 +177,29 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4 INFO = -4
ELSE IF (LWORK .LT. MINSIZE .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN
INFO = -7 INFO = -7
END IF END IF
*
* Quick return if possible
*
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DSYTRI2', -INFO ) CALL XERBLA( 'DSYTRI2', -INFO )
RETURN RETURN
ELSE IF( LQUERY ) THEN ELSE IF( LQUERY ) THEN
WORK(1)=MINSIZE WORK( 1 ) = MINSIZE
RETURN RETURN
END IF END IF
*
* Quick return if possible
*
IF( N.EQ.0 ) IF( N.EQ.0 )
$ RETURN $ RETURN
IF( NBMAX .GE. N ) THEN IF( NBMAX.GE.N ) THEN
CALL DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
ELSE ELSE
CALL DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO ) CALL DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
END IF END IF
*
RETURN RETURN
* *
* End of DSYTRI2 * End of DSYTRI2

View File

@ -119,16 +119,17 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is DOUBLE PRECISION array, dimension (N+NB+1)*(NB+3). *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)).
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of WORK. LWORK >= (N+NB+1)*(NB+3). *> The length of WORK.
*> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3).
*> *>
*> If LDWORK = -1, then a workspace query is assumed; *> If LWORK = -1, then a workspace query is assumed;
*> the routine only calculates the optimal size of the optimal *> the routine only calculates the optimal size of the optimal
*> size of the WORK array, returns this value as the first *> size of the WORK array, returns this value as the first
*> entry of the WORK array, and no error message related to *> entry of the WORK array, and no error message related to
@ -152,7 +153,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYcomputational *> \ingroup hetri_3
* *
*> \par Contributors: *> \par Contributors:
* ================== * ==================
@ -208,8 +209,13 @@
* *
* Determine the block size * Determine the block size
* *
NB = MAX( 1, ILAENV( 1, 'DSYTRI_3', UPLO, N, -1, -1, -1 ) ) IF( N.EQ.0 ) THEN
LWKOPT = ( N+NB+1 ) * ( NB+3 ) LWKOPT = 1
ELSE
NB = MAX( 1, ILAENV( 1, 'DSYTRI_3', UPLO, N, -1, -1, -1 ) )
LWKOPT = ( N+NB+1 ) * ( NB+3 )
END IF
WORK( 1 ) = LWKOPT
* *
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
@ -217,7 +223,7 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4 INFO = -4
ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN
INFO = -8 INFO = -8
END IF END IF
* *
@ -225,7 +231,6 @@
CALL XERBLA( 'DSYTRI_3', -INFO ) CALL XERBLA( 'DSYTRI_3', -INFO )
RETURN RETURN
ELSE IF( LQUERY ) THEN ELSE IF( LQUERY ) THEN
WORK( 1 ) = LWKOPT
RETURN RETURN
END IF END IF
* *

View File

@ -105,7 +105,13 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,3*N-2). *> The dimension of the array WORK.
*> If MIN(N,NRHS) = 0, LWORK >= 1, else LWORK >= 3*N-2.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*> \endverbatim *> \endverbatim
*> *>
*> \param[out] INFO *> \param[out] INFO
@ -123,7 +129,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYcomputational *> \ingroup hetrs_aa
* *
* ===================================================================== * =====================================================================
SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
@ -151,7 +157,7 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY, UPPER LOGICAL LQUERY, UPPER
INTEGER K, KP, LWKOPT INTEGER K, KP, LWKMIN
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -161,13 +167,19 @@
EXTERNAL DLACPY, DGTSV, DSWAP, DTRSM, XERBLA EXTERNAL DLACPY, DGTSV, DSWAP, DTRSM, XERBLA
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC MAX INTRINSIC MIN, MAX
* .. * ..
* .. Executable Statements .. * .. Executable Statements ..
* *
INFO = 0 INFO = 0
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( MIN( N, NRHS ).EQ.0 ) THEN
LWKMIN = 1
ELSE
LWKMIN = 3*N-2
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
@ -178,21 +190,20 @@
INFO = -5 INFO = -5
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -8 INFO = -8
ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10 INFO = -10
END IF END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DSYTRS_AA', -INFO ) CALL XERBLA( 'DSYTRS_AA', -INFO )
RETURN RETURN
ELSE IF( LQUERY ) THEN ELSE IF( LQUERY ) THEN
LWKOPT = (3*N-2) WORK( 1 ) = LWKMIN
WORK( 1 ) = LWKOPT
RETURN RETURN
END IF END IF
* *
* Quick return if possible * Quick return if possible
* *
IF( N.EQ.0 .OR. NRHS.EQ.0 ) IF( MIN( N, NRHS ).EQ.0 )
$ RETURN $ RETURN
* *
IF( UPPER ) THEN IF( UPPER ) THEN