Handle corner cases of LWORK (Reference-LAPACK PR 942)
This commit is contained in:
parent
0814491d96
commit
29d6024ec5
|
@ -122,7 +122,8 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> is the optimal blocksize.
|
||||
*>
|
||||
|
@ -147,7 +148,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEcomputational
|
||||
*> \ingroup gebrd
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -223,8 +224,8 @@
|
|||
* ..
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LQUERY
|
||||
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
|
||||
$ NBMIN, NX, WS
|
||||
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT,
|
||||
$ MINMN, NB, NBMIN, NX, WS
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DGEBD2, DGEMM, DLABRD, XERBLA
|
||||
|
@ -241,9 +242,17 @@
|
|||
* Test the input parameters
|
||||
*
|
||||
INFO = 0
|
||||
NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) )
|
||||
LWKOPT = ( M+N )*NB
|
||||
MINMN = MIN( M, N )
|
||||
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 )
|
||||
*
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
|
@ -251,7 +260,7 @@
|
|||
INFO = -2
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
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
|
||||
END IF
|
||||
IF( INFO.LT.0 ) THEN
|
||||
|
@ -263,7 +272,6 @@
|
|||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
MINMN = MIN( M, N )
|
||||
IF( MINMN.EQ.0 ) THEN
|
||||
WORK( 1 ) = 1
|
||||
RETURN
|
||||
|
@ -282,7 +290,7 @@
|
|||
* Determine when to switch from blocked to unblocked code.
|
||||
*
|
||||
IF( NX.LT.MINMN ) THEN
|
||||
WS = ( M+N )*NB
|
||||
WS = LWKOPT
|
||||
IF( LWORK.LT.WS ) THEN
|
||||
*
|
||||
* Not enough work space for the optimal NB, consider using
|
||||
|
|
|
@ -89,7 +89,7 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
|
@ -120,7 +120,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEcomputational
|
||||
*> \ingroup gehrd
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -173,7 +173,7 @@
|
|||
INTEGER IHI, ILO, INFO, LDA, LWORK, N
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
|
||||
DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
|
@ -182,7 +182,7 @@
|
|||
INTEGER NBMAX, LDT, TSIZE
|
||||
PARAMETER ( NBMAX = 64, LDT = NBMAX+1,
|
||||
$ TSIZE = LDT*NBMAX )
|
||||
DOUBLE PRECISION ZERO, ONE
|
||||
DOUBLE PRECISION ZERO, ONE
|
||||
PARAMETER ( ZERO = 0.0D+0,
|
||||
$ ONE = 1.0D+0 )
|
||||
* ..
|
||||
|
@ -190,7 +190,7 @@
|
|||
LOGICAL LQUERY
|
||||
INTEGER I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB,
|
||||
$ NBMIN, NH, NX
|
||||
DOUBLE PRECISION EI
|
||||
DOUBLE PRECISION EI
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DAXPY, DGEHD2, DGEMM, DLAHR2, DLARFB, DTRMM,
|
||||
|
@ -221,12 +221,18 @@
|
|||
INFO = -8
|
||||
END IF
|
||||
*
|
||||
NH = IHI - ILO + 1
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
*
|
||||
* Compute the workspace requirements
|
||||
*
|
||||
NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
|
||||
LWKOPT = N*NB + TSIZE
|
||||
IF( NH.LE.1 ) THEN
|
||||
LWKOPT = 1
|
||||
ELSE
|
||||
NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI,
|
||||
$ -1 ) )
|
||||
LWKOPT = N*NB + TSIZE
|
||||
ENDIF
|
||||
WORK( 1 ) = LWKOPT
|
||||
END IF
|
||||
*
|
||||
|
@ -248,7 +254,6 @@
|
|||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
NH = IHI - ILO + 1
|
||||
IF( NH.LE.1 ) THEN
|
||||
WORK( 1 ) = 1
|
||||
RETURN
|
||||
|
@ -268,7 +273,7 @@
|
|||
*
|
||||
* 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
|
||||
* 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
|
||||
*
|
||||
CALL DGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
|
||||
*
|
||||
WORK( 1 ) = LWKOPT
|
||||
*
|
||||
RETURN
|
||||
|
|
|
@ -98,7 +98,7 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> 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
|
||||
|
@ -166,6 +166,8 @@
|
|||
*> the LQ factorization.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \ingroup gelq
|
||||
*>
|
||||
* =====================================================================
|
||||
SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
|
||||
$ INFO )
|
||||
|
|
|
@ -93,7 +93,8 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> optimal blocksize.
|
||||
*>
|
||||
|
@ -118,7 +119,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEcomputational
|
||||
*> \ingroup gelqf
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -174,9 +175,8 @@
|
|||
* Test the input arguments
|
||||
*
|
||||
INFO = 0
|
||||
K = MIN( M, N )
|
||||
NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
|
||||
LWKOPT = M*NB
|
||||
WORK( 1 ) = LWKOPT
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
|
@ -184,19 +184,25 @@
|
|||
INFO = -2
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -4
|
||||
ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
|
||||
INFO = -7
|
||||
ELSE IF( .NOT.LQUERY ) THEN
|
||||
IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) )
|
||||
$ INFO = -7
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DGELQF', -INFO )
|
||||
RETURN
|
||||
ELSE IF( LQUERY ) THEN
|
||||
IF( K.EQ.0 ) THEN
|
||||
LWKOPT = 1
|
||||
ELSE
|
||||
LWKOPT = M*NB
|
||||
END IF
|
||||
WORK( 1 ) = LWKOPT
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
K = MIN( M, N )
|
||||
IF( K.EQ.0 ) THEN
|
||||
WORK( 1 ) = 1
|
||||
RETURN
|
||||
|
|
|
@ -188,7 +188,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEsolve
|
||||
*> \ingroup gelsd
|
||||
*
|
||||
*> \par Contributors:
|
||||
* ==================
|
||||
|
@ -228,7 +228,7 @@
|
|||
DOUBLE PRECISION ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DGEBRD, DGELQF, DGEQRF, DLABAD, DLACPY, DLALSD,
|
||||
EXTERNAL DGEBRD, DGELQF, DGEQRF, DLACPY, DLALSD,
|
||||
$ DLASCL, DLASET, DORMBR, DORMLQ, DORMQR, XERBLA
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
|
@ -276,7 +276,7 @@
|
|||
$ LOG( TWO ) ) + 1, 0 )
|
||||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
MAXWRK = 0
|
||||
MAXWRK = 1
|
||||
LIWORK = 3*MINMN*NLVL + 11*MINMN
|
||||
MM = M
|
||||
IF( M.GE.N .AND. M.GE.MNTHR ) THEN
|
||||
|
@ -372,7 +372,6 @@
|
|||
SFMIN = DLAMCH( 'S' )
|
||||
SMLNUM = SFMIN / EPS
|
||||
BIGNUM = ONE / SMLNUM
|
||||
CALL DLABAD( SMLNUM, BIGNUM )
|
||||
*
|
||||
* Scale A if max entry outside range [SMLNUM,BIGNUM].
|
||||
*
|
||||
|
|
|
@ -111,16 +111,17 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> 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.
|
||||
*> \endverbatim
|
||||
*>
|
||||
|
@ -144,7 +145,7 @@
|
|||
*>
|
||||
*> \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
|
||||
*> 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.
|
||||
|
@ -160,11 +161,13 @@
|
|||
*> block sizes MB and NB returned by ILAENV, DGELQ will use either
|
||||
*> DLASWLQ (if the matrix is wide-and-short) or DGELQT to compute
|
||||
*> 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.
|
||||
*> Further Details in DLAMSWLQ or DGEMLQT.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \ingroup gemlq
|
||||
*>
|
||||
* =====================================================================
|
||||
SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
|
||||
$ C, LDC, WORK, LWORK, INFO )
|
||||
|
@ -186,7 +189,7 @@
|
|||
* ..
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
|
||||
INTEGER MB, NB, LW, NBLCKS, MN
|
||||
INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
|
@ -202,7 +205,7 @@
|
|||
*
|
||||
* Test the input arguments
|
||||
*
|
||||
LQUERY = LWORK.EQ.-1
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
NOTRAN = LSAME( TRANS, 'N' )
|
||||
TRAN = LSAME( TRANS, 'T' )
|
||||
LEFT = LSAME( SIDE, 'L' )
|
||||
|
@ -217,6 +220,13 @@
|
|||
LW = M * MB
|
||||
MN = N
|
||||
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( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
|
||||
|
@ -245,12 +255,12 @@
|
|||
INFO = -9
|
||||
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -11
|
||||
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
|
||||
ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
|
||||
INFO = -13
|
||||
END IF
|
||||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
WORK( 1 ) = LW
|
||||
WORK( 1 ) = LWMIN
|
||||
END IF
|
||||
*
|
||||
IF( INFO.NE.0 ) THEN
|
||||
|
@ -262,7 +272,7 @@
|
|||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( MIN( M, N, K ).EQ.0 ) THEN
|
||||
IF( MINMNK.EQ.0 ) THEN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
|
@ -275,7 +285,7 @@
|
|||
$ MB, C, LDC, WORK, LWORK, INFO )
|
||||
END IF
|
||||
*
|
||||
WORK( 1 ) = LW
|
||||
WORK( 1 ) = LWMIN
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
|
|
|
@ -111,16 +111,17 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> 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.
|
||||
*> \endverbatim
|
||||
*>
|
||||
|
@ -144,7 +145,7 @@
|
|||
*>
|
||||
*> \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
|
||||
*> 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.
|
||||
|
@ -160,12 +161,14 @@
|
|||
*> block sizes MB and NB returned by ILAENV, DGEQR will use either
|
||||
*> DLATSQR (if the matrix is tall-and-skinny) or DGEQRT to compute
|
||||
*> 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.
|
||||
*> Further Details in DLATMSQR or DGEMQRT.
|
||||
*>
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \ingroup gemqr
|
||||
*>
|
||||
* =====================================================================
|
||||
SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
|
||||
$ C, LDC, WORK, LWORK, INFO )
|
||||
|
@ -187,7 +190,7 @@
|
|||
* ..
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
|
||||
INTEGER MB, NB, LW, NBLCKS, MN
|
||||
INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
|
@ -203,7 +206,7 @@
|
|||
*
|
||||
* Test the input arguments
|
||||
*
|
||||
LQUERY = LWORK.EQ.-1
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
NOTRAN = LSAME( TRANS, 'N' )
|
||||
TRAN = LSAME( TRANS, 'T' )
|
||||
LEFT = LSAME( SIDE, 'L' )
|
||||
|
@ -218,6 +221,13 @@
|
|||
LW = MB * NB
|
||||
MN = N
|
||||
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( MOD( MN - K, MB - K ).EQ.0 ) THEN
|
||||
|
@ -246,12 +256,12 @@
|
|||
INFO = -9
|
||||
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -11
|
||||
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
|
||||
ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
|
||||
INFO = -13
|
||||
END IF
|
||||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
WORK( 1 ) = LW
|
||||
WORK( 1 ) = LWMIN
|
||||
END IF
|
||||
*
|
||||
IF( INFO.NE.0 ) THEN
|
||||
|
@ -263,7 +273,7 @@
|
|||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( MIN( M, N, K ).EQ.0 ) THEN
|
||||
IF( MINMNK.EQ.0 ) THEN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
|
@ -276,7 +286,7 @@
|
|||
$ NB, C, LDC, WORK, LWORK, INFO )
|
||||
END IF
|
||||
*
|
||||
WORK( 1 ) = LW
|
||||
WORK( 1 ) = LWMIN
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
|
|
|
@ -88,7 +88,8 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> optimal blocksize.
|
||||
*>
|
||||
|
@ -113,7 +114,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEcomputational
|
||||
*> \ingroup geqlf
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -188,8 +189,9 @@
|
|||
END IF
|
||||
WORK( 1 ) = LWKOPT
|
||||
*
|
||||
IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
|
||||
INFO = -7
|
||||
IF( .NOT.LQUERY ) THEN
|
||||
IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) )
|
||||
$ INFO = -7
|
||||
END IF
|
||||
END IF
|
||||
*
|
||||
|
|
|
@ -427,7 +427,8 @@
|
|||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> 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 )),
|
||||
*> where NB is the optimal block size for DGEQP3RK returned
|
||||
*> by ILAENV. Minimal block size MINNB=2.
|
||||
|
|
|
@ -99,7 +99,7 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> 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
|
||||
|
@ -168,6 +168,8 @@
|
|||
*>
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \ingroup geqr
|
||||
*>
|
||||
* =====================================================================
|
||||
SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
|
||||
$ INFO )
|
||||
|
@ -188,7 +190,7 @@
|
|||
* ..
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LQUERY, LMINWS, MINT, MINW
|
||||
INTEGER MB, NB, MINTSZ, NBLCKS
|
||||
INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWREQ
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
|
@ -244,8 +246,10 @@
|
|||
*
|
||||
* Determine if the workspace size satisfies minimal size
|
||||
*
|
||||
LWMIN = MAX( 1, N )
|
||||
LWREQ = MAX( 1, N*NB )
|
||||
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. ( .NOT.LQUERY ) ) THEN
|
||||
IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN
|
||||
|
@ -253,7 +257,7 @@
|
|||
NB = 1
|
||||
MB = M
|
||||
END IF
|
||||
IF( LWORK.LT.NB*N ) THEN
|
||||
IF( LWORK.LT.LWREQ ) THEN
|
||||
LMINWS = .TRUE.
|
||||
NB = 1
|
||||
END IF
|
||||
|
@ -268,7 +272,7 @@
|
|||
ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 )
|
||||
$ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
|
||||
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
|
||||
INFO = -8
|
||||
END IF
|
||||
|
@ -282,9 +286,9 @@
|
|||
T( 2 ) = MB
|
||||
T( 3 ) = NB
|
||||
IF( MINW ) THEN
|
||||
WORK( 1 ) = MAX( 1, N )
|
||||
WORK( 1 ) = LWMIN
|
||||
ELSE
|
||||
WORK( 1 ) = MAX( 1, NB*N )
|
||||
WORK( 1 ) = LWREQ
|
||||
END IF
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
|
@ -309,7 +313,7 @@
|
|||
$ LWORK, INFO )
|
||||
END IF
|
||||
*
|
||||
WORK( 1 ) = MAX( 1, NB*N )
|
||||
WORK( 1 ) = LWREQ
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
|
|
|
@ -97,7 +97,8 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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 optimal blocksize.
|
||||
*>
|
||||
|
@ -122,7 +123,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEcomputational
|
||||
*> \ingroup geqrfp
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -162,8 +163,8 @@
|
|||
*
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LQUERY
|
||||
INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
|
||||
$ NBMIN, NX
|
||||
INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKMIN, LWKOPT,
|
||||
$ NB, NBMIN, NX
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DGEQR2P, DLARFB, DLARFT, XERBLA
|
||||
|
@ -181,8 +182,16 @@
|
|||
*
|
||||
INFO = 0
|
||||
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
|
||||
*
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
|
@ -190,7 +199,7 @@
|
|||
INFO = -2
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -4
|
||||
ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
|
||||
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
|
||||
INFO = -7
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
|
@ -202,7 +211,6 @@
|
|||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
K = MIN( M, N )
|
||||
IF( K.EQ.0 ) THEN
|
||||
WORK( 1 ) = 1
|
||||
RETURN
|
||||
|
@ -210,7 +218,7 @@
|
|||
*
|
||||
NBMIN = 2
|
||||
NX = 0
|
||||
IWS = N
|
||||
IWS = LWKMIN
|
||||
IF( NB.GT.1 .AND. NB.LT.K ) THEN
|
||||
*
|
||||
* Determine when to cross over from blocked to unblocked code.
|
||||
|
|
|
@ -114,7 +114,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEcomputational
|
||||
*> \ingroup gerqf
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -189,7 +189,7 @@
|
|||
END IF
|
||||
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 ) ) )
|
||||
$ INFO = -7
|
||||
END IF
|
||||
|
|
|
@ -208,7 +208,7 @@
|
|||
*>
|
||||
*> \param[in,out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is DOUBLE PRECISION array, dimension (LWORK)
|
||||
*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
|
||||
*> On entry :
|
||||
*> If JOBU = 'C' :
|
||||
*> WORK(1) = CTOL, where CTOL defines the threshold for convergence.
|
||||
|
@ -239,7 +239,12 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
|
@ -260,7 +265,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEcomputational
|
||||
*> \ingroup gesvj
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -365,9 +370,9 @@
|
|||
INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
|
||||
$ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34,
|
||||
$ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP,
|
||||
$ SWBAND
|
||||
LOGICAL APPLV, GOSCALE, LOWER, LSVEC, NOSCALE, ROTOK,
|
||||
$ RSVEC, UCTOL, UPPER
|
||||
$ SWBAND, MINMN, LWMIN
|
||||
LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE,
|
||||
$ ROTOK, RSVEC, UCTOL, UPPER
|
||||
* ..
|
||||
* .. Local Arrays ..
|
||||
DOUBLE PRECISION FASTR( 5 )
|
||||
|
@ -408,6 +413,14 @@
|
|||
UPPER = LSAME( JOBA, 'U' )
|
||||
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
|
||||
INFO = -1
|
||||
ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN
|
||||
|
@ -427,7 +440,7 @@
|
|||
INFO = -11
|
||||
ELSE IF( UCTOL .AND. ( WORK( 1 ).LE.ONE ) ) THEN
|
||||
INFO = -12
|
||||
ELSE IF( LWORK.LT.MAX( M+N, 6 ) ) THEN
|
||||
ELSE IF( LWORK.LT.LWMIN .AND. ( .NOT.LQUERY ) ) THEN
|
||||
INFO = -13
|
||||
ELSE
|
||||
INFO = 0
|
||||
|
@ -437,11 +450,14 @@
|
|||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DGESVJ', -INFO )
|
||||
RETURN
|
||||
ELSE IF( LQUERY ) THEN
|
||||
WORK( 1 ) = LWMIN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* #:) Quick return for void matrix
|
||||
*
|
||||
IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN
|
||||
IF( MINMN.EQ.0 ) RETURN
|
||||
*
|
||||
* Set numerical parameters
|
||||
* The stopping criterion for Jacobi rotations is
|
||||
|
|
|
@ -107,7 +107,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEcomputational
|
||||
*> \ingroup getri
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
|
||||
|
@ -151,8 +151,9 @@
|
|||
*
|
||||
INFO = 0
|
||||
NB = ILAENV( 1, 'DGETRI', ' ', N, -1, -1, -1 )
|
||||
LWKOPT = N*NB
|
||||
LWKOPT = MAX( 1, N*NB )
|
||||
WORK( 1 ) = LWKOPT
|
||||
*
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
IF( N.LT.0 ) THEN
|
||||
INFO = -1
|
||||
|
|
|
@ -127,7 +127,7 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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, the routine calculates optimal size of WORK for the
|
||||
*> optimal performance and returns this value in WORK(1).
|
||||
|
@ -154,7 +154,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEsolve
|
||||
*> \ingroup getsls
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
|
||||
|
@ -189,7 +189,7 @@
|
|||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
DOUBLE PRECISION DLAMCH, DLANGE
|
||||
EXTERNAL LSAME, DLABAD, DLAMCH, DLANGE
|
||||
EXTERNAL LSAME, DLAMCH, DLANGE
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DGEQR, DGEMQR, DLASCL, DLASET,
|
||||
|
@ -226,7 +226,10 @@
|
|||
*
|
||||
* 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 )
|
||||
TSZO = INT( TQ( 1 ) )
|
||||
LWO = INT( WORKQ( 1 ) )
|
||||
|
@ -294,7 +297,6 @@
|
|||
*
|
||||
SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
|
||||
BIGNUM = ONE / SMLNUM
|
||||
CALL DLABAD( SMLNUM, BIGNUM )
|
||||
*
|
||||
* Scale A, B if max element outside range [SMLNUM,BIGNUM]
|
||||
*
|
||||
|
|
|
@ -130,14 +130,17 @@
|
|||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> 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
|
||||
*> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)),
|
||||
*> NB1LOCAL = MIN(NB1,N).
|
||||
*> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL,
|
||||
*> LW1 = NB1LOCAL * N,
|
||||
*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ),
|
||||
*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ).
|
||||
*>
|
||||
*> If LWORK = -1, then a workspace query is assumed.
|
||||
*> The routine only calculates the optimal size of the WORK
|
||||
*> array, returns this value as the first entry of the WORK
|
||||
|
@ -160,7 +163,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleOTHERcomputational
|
||||
*> \ingroup getsqrhrt
|
||||
*
|
||||
*> \par Contributors:
|
||||
* ==================
|
||||
|
@ -212,7 +215,7 @@
|
|||
* Test the input arguments
|
||||
*
|
||||
INFO = 0
|
||||
LQUERY = LWORK.EQ.-1
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 .OR. M.LT.N ) THEN
|
||||
|
@ -225,7 +228,7 @@
|
|||
INFO = -5
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -7
|
||||
ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN
|
||||
ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN
|
||||
INFO = -9
|
||||
ELSE
|
||||
*
|
||||
|
@ -263,8 +266,9 @@
|
|||
LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) )
|
||||
*
|
||||
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
|
||||
END IF
|
||||
*
|
||||
|
@ -346,4 +350,4 @@
|
|||
*
|
||||
* End of DGETSQRHRT
|
||||
*
|
||||
END
|
||||
END
|
||||
|
|
|
@ -234,8 +234,8 @@
|
|||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The dimension of the array WORK.
|
||||
*> If N = 0, LWORK >= 1, else LWORK >= 8*N+16.
|
||||
*> For good performance , LWORK must generally be larger.
|
||||
*> If N = 0, LWORK >= 1, else LWORK >= MAX(8*N,6*N+16).
|
||||
*> For good performance, LWORK must generally be larger.
|
||||
*>
|
||||
*> If LWORK = -1, then a workspace query is assumed; the routine
|
||||
*> only calculates the optimal size of the WORK array, returns
|
||||
|
@ -275,7 +275,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEeigen
|
||||
*> \ingroup gges
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB,
|
||||
|
@ -321,9 +321,8 @@
|
|||
DOUBLE PRECISION DIF( 2 )
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD,
|
||||
$ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGSEN,
|
||||
$ XERBLA
|
||||
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY,
|
||||
$ DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, XERBLA
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
|
@ -431,7 +430,6 @@
|
|||
EPS = DLAMCH( 'P' )
|
||||
SAFMIN = DLAMCH( 'S' )
|
||||
SAFMAX = ONE / SAFMIN
|
||||
CALL DLABAD( SAFMIN, SAFMAX )
|
||||
SMLNUM = SQRT( SAFMIN ) / EPS
|
||||
BIGNUM = ONE / SMLNUM
|
||||
*
|
||||
|
|
|
@ -234,6 +234,8 @@
|
|||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> 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
|
||||
*> only calculates the optimal size of the WORK array, returns
|
||||
|
@ -273,7 +275,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEeigen
|
||||
*> \ingroup gges3
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B,
|
||||
|
@ -309,7 +311,8 @@
|
|||
LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
|
||||
$ LQUERY, LST2SL, WANTST
|
||||
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,
|
||||
$ PVSR, SAFMAX, SAFMIN, SMLNUM
|
||||
* ..
|
||||
|
@ -318,9 +321,8 @@
|
|||
DOUBLE PRECISION DIF( 2 )
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLABAD,
|
||||
$ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGSEN,
|
||||
$ XERBLA
|
||||
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLACPY,
|
||||
$ DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, XERBLA
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
|
@ -362,6 +364,12 @@
|
|||
*
|
||||
INFO = 0
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
IF( N.EQ.0 ) THEN
|
||||
LWKMIN = 1
|
||||
ELSE
|
||||
LWKMIN = 6*N+16
|
||||
END IF
|
||||
*
|
||||
IF( IJOBVL.LE.0 ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( IJOBVR.LE.0 ) THEN
|
||||
|
@ -378,7 +386,7 @@
|
|||
INFO = -15
|
||||
ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
|
||||
INFO = -17
|
||||
ELSE IF( LWORK.LT.6*N+16 .AND. .NOT.LQUERY ) THEN
|
||||
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
|
||||
INFO = -19
|
||||
END IF
|
||||
*
|
||||
|
@ -386,29 +394,33 @@
|
|||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
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,
|
||||
$ -1, IERR )
|
||||
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) )
|
||||
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
|
||||
IF( ILVSL ) THEN
|
||||
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
|
||||
CALL DGGHD3( JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, VSL,
|
||||
$ 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,
|
||||
$ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
|
||||
$ WORK, -1, 0, IERR )
|
||||
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK ( 1 ) ) )
|
||||
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
|
||||
IF( WANTST ) THEN
|
||||
CALL DTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB,
|
||||
$ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
|
||||
$ SDIM, PVSL, PVSR, DIF, WORK, -1, IDUM, 1,
|
||||
$ 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
|
||||
WORK( 1 ) = LWKOPT
|
||||
END IF
|
||||
*
|
||||
IF( INFO.NE.0 ) THEN
|
||||
|
@ -430,7 +442,6 @@
|
|||
EPS = DLAMCH( 'P' )
|
||||
SAFMIN = DLAMCH( 'S' )
|
||||
SAFMAX = ONE / SAFMIN
|
||||
CALL DLABAD( SAFMIN, SAFMAX )
|
||||
SMLNUM = SQRT( SAFMIN ) / EPS
|
||||
BIGNUM = ONE / SMLNUM
|
||||
*
|
||||
|
|
|
@ -188,7 +188,9 @@
|
|||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \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
|
||||
*> only calculates the optimal size of the WORK array, returns
|
||||
|
@ -217,7 +219,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEeigen
|
||||
*> \ingroup ggev3
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR,
|
||||
|
@ -248,7 +250,8 @@
|
|||
LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
|
||||
CHARACTER CHTEMP
|
||||
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,
|
||||
$ SMLNUM, TEMP
|
||||
* ..
|
||||
|
@ -256,9 +259,8 @@
|
|||
LOGICAL LDUMMA( 1 )
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLABAD,
|
||||
$ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGEVC,
|
||||
$ XERBLA
|
||||
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLACPY,
|
||||
$ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, XERBLA
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
|
@ -299,6 +301,7 @@
|
|||
*
|
||||
INFO = 0
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
LWKMIN = MAX( 1, 8*N )
|
||||
IF( IJOBVL.LE.0 ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( IJOBVR.LE.0 ) THEN
|
||||
|
@ -313,7 +316,7 @@
|
|||
INFO = -12
|
||||
ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
|
||||
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
|
||||
END IF
|
||||
*
|
||||
|
@ -321,13 +324,13 @@
|
|||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
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,
|
||||
$ IERR )
|
||||
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) )
|
||||
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
|
||||
IF( ILVL ) THEN
|
||||
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
|
||||
IF( ILV ) THEN
|
||||
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,
|
||||
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
|
||||
$ WORK, -1, 0, IERR )
|
||||
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK ( 1 ) ) )
|
||||
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
|
||||
ELSE
|
||||
CALL DGGHD3( 'N', 'N', N, 1, N, A, LDA, B, LDB, VL, LDVL,
|
||||
$ 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,
|
||||
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
|
||||
$ 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
|
||||
|
||||
WORK( 1 ) = LWKOPT
|
||||
END IF
|
||||
*
|
||||
IF( INFO.NE.0 ) THEN
|
||||
|
@ -367,7 +373,6 @@
|
|||
EPS = DLAMCH( 'P' )
|
||||
SMLNUM = DLAMCH( 'S' )
|
||||
BIGNUM = ONE / SMLNUM
|
||||
CALL DLABAD( SMLNUM, BIGNUM )
|
||||
SMLNUM = SQRT( SMLNUM ) / EPS
|
||||
BIGNUM = ONE / SMLNUM
|
||||
*
|
||||
|
|
|
@ -179,14 +179,14 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> optimal blocksize.
|
||||
*>
|
||||
|
@ -211,7 +211,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleOTHERcomputational
|
||||
*> \ingroup gghd3
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -275,7 +275,12 @@
|
|||
*
|
||||
INFO = 0
|
||||
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 )
|
||||
INITQ = LSAME( COMPQ, 'I' )
|
||||
WANTQ = INITQ .OR. LSAME( COMPQ, 'V' )
|
||||
|
@ -325,7 +330,6 @@
|
|||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
NH = IHI - ILO + 1
|
||||
IF( NH.LE.1 ) THEN
|
||||
WORK( 1 ) = ONE
|
||||
RETURN
|
||||
|
@ -885,6 +889,7 @@
|
|||
IF ( JCOL.LT.IHI )
|
||||
$ CALL DGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q,
|
||||
$ LDQ, Z, LDZ, IERR )
|
||||
*
|
||||
WORK( 1 ) = DBLE( LWKOPT )
|
||||
*
|
||||
RETURN
|
||||
|
|
|
@ -173,7 +173,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleOTHERcomputational
|
||||
*> \ingroup ggqrf
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -250,7 +250,7 @@
|
|||
NB2 = ILAENV( 1, 'DGERQF', ' ', N, P, -1, -1 )
|
||||
NB3 = ILAENV( 1, 'DORMQR', ' ', N, M, P, -1 )
|
||||
NB = MAX( NB1, NB2, NB3 )
|
||||
LWKOPT = MAX( N, M, P )*NB
|
||||
LWKOPT = MAX( 1, MAX( N, M, P )*NB )
|
||||
WORK( 1 ) = LWKOPT
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
IF( N.LT.0 ) THEN
|
||||
|
@ -287,6 +287,7 @@
|
|||
* RQ factorization of N-by-P matrix B: B = T*Z.
|
||||
*
|
||||
CALL DGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO )
|
||||
*
|
||||
WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) )
|
||||
*
|
||||
RETURN
|
||||
|
|
|
@ -172,7 +172,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleOTHERcomputational
|
||||
*> \ingroup ggrqf
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -249,7 +249,7 @@
|
|||
NB2 = ILAENV( 1, 'DGEQRF', ' ', P, N, -1, -1 )
|
||||
NB3 = ILAENV( 1, 'DORMRQ', ' ', M, N, P, -1 )
|
||||
NB = MAX( NB1, NB2, NB3 )
|
||||
LWKOPT = MAX( N, M, P )*NB
|
||||
LWKOPT = MAX( 1, MAX( N, M, P )*NB )
|
||||
WORK( 1 ) = LWKOPT
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
IF( M.LT.0 ) THEN
|
||||
|
|
|
@ -278,7 +278,7 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> only calculates the optimal size of the WORK array, returns
|
||||
|
@ -328,7 +328,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleGEsing
|
||||
*> \ingroup ggsvd3
|
||||
*
|
||||
*> \par Contributors:
|
||||
* ==================
|
||||
|
|
|
@ -227,7 +227,7 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> only calculates the optimal size of the WORK array, returns
|
||||
|
@ -250,7 +250,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleOTHERcomputational
|
||||
*> \ingroup ggsvp3
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
|
|
@ -127,17 +127,20 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> 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
|
||||
*> 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
|
||||
*> message related to LWORK is issued by XERBLA.
|
||||
*> \endverbatim
|
||||
|
@ -189,29 +192,31 @@
|
|||
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \ingroup lamswlq
|
||||
*>
|
||||
* =====================================================================
|
||||
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 is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
CHARACTER SIDE, TRANS
|
||||
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
|
||||
CHARACTER SIDE, TRANS
|
||||
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( LDA, * ), WORK( * ), C(LDC, * ),
|
||||
$ T( LDT, * )
|
||||
DOUBLE PRECISION A( LDA, * ), WORK( * ), C( LDC, * ),
|
||||
$ T( LDT, * )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* ..
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
|
||||
INTEGER I, II, KK, CTR, LW
|
||||
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
|
||||
INTEGER I, II, KK, CTR, LW, MINMNK, LWMIN
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
|
@ -223,52 +228,60 @@
|
|||
*
|
||||
* Test the input arguments
|
||||
*
|
||||
LQUERY = LWORK.LT.0
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
NOTRAN = LSAME( TRANS, 'N' )
|
||||
TRAN = LSAME( TRANS, 'T' )
|
||||
LEFT = LSAME( SIDE, 'L' )
|
||||
RIGHT = LSAME( SIDE, 'R' )
|
||||
IF (LEFT) THEN
|
||||
IF( LEFT ) THEN
|
||||
LW = N * MB
|
||||
ELSE
|
||||
LW = M * MB
|
||||
END IF
|
||||
*
|
||||
MINMNK = MIN( M, N, K )
|
||||
IF( MINMNK.EQ.0 ) THEN
|
||||
LWMIN = 1
|
||||
ELSE
|
||||
LWMIN = MAX( 1, LW )
|
||||
END IF
|
||||
*
|
||||
INFO = 0
|
||||
IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
|
||||
INFO = -1
|
||||
INFO = -1
|
||||
ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
|
||||
INFO = -2
|
||||
INFO = -2
|
||||
ELSE IF( K.LT.0 ) THEN
|
||||
INFO = -5
|
||||
ELSE IF( M.LT.K ) THEN
|
||||
INFO = -3
|
||||
ELSE IF( N.LT.0 ) THEN
|
||||
INFO = -4
|
||||
ELSE IF( K.LT.MB .OR. MB.LT.1) THEN
|
||||
ELSE IF( K.LT.MB .OR. MB.LT.1 ) THEN
|
||||
INFO = -6
|
||||
ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
|
||||
INFO = -9
|
||||
ELSE IF( LDT.LT.MAX( 1, MB) ) THEN
|
||||
ELSE IF( LDT.LT.MAX( 1, MB ) ) THEN
|
||||
INFO = -11
|
||||
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -13
|
||||
ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
|
||||
INFO = -13
|
||||
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
|
||||
INFO = -15
|
||||
END IF
|
||||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
WORK( 1 ) = LWMIN
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DLAMSWLQ', -INFO )
|
||||
WORK(1) = LW
|
||||
RETURN
|
||||
ELSE IF (LQUERY) THEN
|
||||
WORK(1) = LW
|
||||
ELSE IF( LQUERY ) THEN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( MIN(M,N,K).EQ.0 ) THEN
|
||||
IF( MINMNK.EQ.0 ) THEN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
|
@ -402,7 +415,8 @@
|
|||
*
|
||||
END IF
|
||||
*
|
||||
WORK(1) = LW
|
||||
WORK( 1 ) = LWMIN
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of DLAMSWLQ
|
||||
|
|
|
@ -128,22 +128,24 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> 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
|
||||
*> 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
|
||||
*> message related to LWORK is issued by XERBLA.
|
||||
*>
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
*> INFO is INTEGER
|
||||
|
@ -191,29 +193,31 @@
|
|||
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \ingroup lamtsqr
|
||||
*>
|
||||
* =====================================================================
|
||||
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 is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
CHARACTER SIDE, TRANS
|
||||
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
|
||||
CHARACTER SIDE, TRANS
|
||||
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( LDA, * ), WORK( * ), C(LDC, * ),
|
||||
$ T( LDT, * )
|
||||
DOUBLE PRECISION A( LDA, * ), WORK( * ), C( LDC, * ),
|
||||
$ T( LDT, * )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* ..
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
|
||||
INTEGER I, II, KK, LW, CTR, Q
|
||||
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
|
||||
INTEGER I, II, KK, LW, CTR, Q, MINMNK, LWMIN
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
|
@ -225,12 +229,13 @@
|
|||
*
|
||||
* Test the input arguments
|
||||
*
|
||||
LQUERY = LWORK.LT.0
|
||||
INFO = 0
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
NOTRAN = LSAME( TRANS, 'N' )
|
||||
TRAN = LSAME( TRANS, 'T' )
|
||||
LEFT = LSAME( SIDE, 'L' )
|
||||
RIGHT = LSAME( SIDE, 'R' )
|
||||
IF (LEFT) THEN
|
||||
IF( LEFT ) THEN
|
||||
LW = N * NB
|
||||
Q = M
|
||||
ELSE
|
||||
|
@ -238,11 +243,17 @@
|
|||
Q = N
|
||||
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
|
||||
INFO = -1
|
||||
INFO = -1
|
||||
ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
|
||||
INFO = -2
|
||||
INFO = -2
|
||||
ELSE IF( M.LT.K ) THEN
|
||||
INFO = -3
|
||||
ELSE IF( N.LT.0 ) THEN
|
||||
|
@ -253,38 +264,38 @@
|
|||
INFO = -7
|
||||
ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN
|
||||
INFO = -9
|
||||
ELSE IF( LDT.LT.MAX( 1, NB) ) THEN
|
||||
ELSE IF( LDT.LT.MAX( 1, NB ) ) THEN
|
||||
INFO = -11
|
||||
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -13
|
||||
ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
|
||||
INFO = -13
|
||||
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
|
||||
INFO = -15
|
||||
END IF
|
||||
*
|
||||
* Determine the block size if it is tall skinny or short and wide
|
||||
*
|
||||
IF( INFO.EQ.0) THEN
|
||||
WORK(1) = LW
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
WORK( 1 ) = LWMIN
|
||||
END IF
|
||||
*
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DLAMTSQR', -INFO )
|
||||
RETURN
|
||||
ELSE IF (LQUERY) THEN
|
||||
RETURN
|
||||
ELSE IF( LQUERY ) THEN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( MIN(M,N,K).EQ.0 ) THEN
|
||||
IF( MINMNK.EQ.0 ) THEN
|
||||
RETURN
|
||||
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
|
||||
CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA,
|
||||
$ T, LDT, C, LDC, WORK, INFO)
|
||||
$ T, LDT, C, LDC, WORK, INFO )
|
||||
RETURN
|
||||
END IF
|
||||
END IF
|
||||
*
|
||||
IF(LEFT.AND.NOTRAN) THEN
|
||||
*
|
||||
|
@ -410,7 +421,8 @@
|
|||
*
|
||||
END IF
|
||||
*
|
||||
WORK(1) = LW
|
||||
WORK( 1 ) = LWMIN
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of DLAMTSQR
|
||||
|
|
|
@ -99,19 +99,22 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> 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
|
||||
*> message related to LWORK is issued by XERBLA.
|
||||
*>
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
*> INFO is INTEGER
|
||||
|
@ -159,33 +162,37 @@
|
|||
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \ingroup laswlq
|
||||
*>
|
||||
* =====================================================================
|
||||
SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
|
||||
$ INFO)
|
||||
$ INFO )
|
||||
*
|
||||
* -- LAPACK computational routine --
|
||||
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
|
||||
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( LDA, * ), WORK( * ), T( LDT, *)
|
||||
DOUBLE PRECISION A( LDA, * ), WORK( * ), T( LDT, * )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* ..
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LQUERY
|
||||
INTEGER I, II, KK, CTR
|
||||
LOGICAL LQUERY
|
||||
INTEGER I, II, KK, CTR, MINMN, LWMIN
|
||||
* ..
|
||||
* .. EXTERNAL FUNCTIONS ..
|
||||
LOGICAL LSAME
|
||||
EXTERNAL LSAME
|
||||
* ..
|
||||
* .. EXTERNAL SUBROUTINES ..
|
||||
EXTERNAL DGELQT, DTPLQT, XERBLA
|
||||
* ..
|
||||
* .. INTRINSIC FUNCTIONS ..
|
||||
INTRINSIC MAX, MIN, MOD
|
||||
* ..
|
||||
|
@ -196,12 +203,19 @@
|
|||
INFO = 0
|
||||
*
|
||||
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
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 .OR. N.LT.M ) THEN
|
||||
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
|
||||
ELSE IF( NB.LT.0 ) THEN
|
||||
INFO = -4
|
||||
|
@ -209,60 +223,62 @@
|
|||
INFO = -6
|
||||
ELSE IF( LDT.LT.MB ) THEN
|
||||
INFO = -8
|
||||
ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN
|
||||
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
|
||||
INFO = -10
|
||||
END IF
|
||||
IF( INFO.EQ.0) THEN
|
||||
WORK(1) = MB*M
|
||||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
WORK( 1 ) = LWMIN
|
||||
END IF
|
||||
*
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DLASWLQ', -INFO )
|
||||
RETURN
|
||||
ELSE IF (LQUERY) THEN
|
||||
RETURN
|
||||
ELSE IF( LQUERY ) THEN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( MIN(M,N).EQ.0 ) THEN
|
||||
RETURN
|
||||
IF( MINMN.EQ.0 ) THEN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* The LQ Decomposition
|
||||
*
|
||||
IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
|
||||
CALL DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO)
|
||||
IF( (M.GE.N) .OR. (NB.LE.M) .OR. (NB.GE.N) ) THEN
|
||||
CALL DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
|
||||
RETURN
|
||||
END IF
|
||||
END IF
|
||||
*
|
||||
KK = MOD((N-M),(NB-M))
|
||||
II=N-KK+1
|
||||
KK = MOD((N-M),(NB-M))
|
||||
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)
|
||||
CTR = 1
|
||||
CALL DGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO )
|
||||
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 ),
|
||||
$ LDA, T(1, CTR * M + 1),
|
||||
$ LDT, WORK, INFO )
|
||||
CTR = CTR + 1
|
||||
END DO
|
||||
CALL DTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
|
||||
$ LDA, T(1, CTR * M + 1),
|
||||
$ LDT, WORK, INFO )
|
||||
CTR = CTR + 1
|
||||
END DO
|
||||
*
|
||||
* 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 ),
|
||||
$ LDA, T(1, CTR * M + 1), LDT,
|
||||
$ WORK, INFO )
|
||||
END IF
|
||||
$ LDA, T(1, CTR * M + 1), LDT,
|
||||
$ WORK, INFO )
|
||||
END IF
|
||||
*
|
||||
WORK( 1 ) = LWMIN
|
||||
*
|
||||
WORK( 1 ) = M * MB
|
||||
RETURN
|
||||
*
|
||||
* End of DLASWLQ
|
||||
|
|
|
@ -151,13 +151,17 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*> WORK.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> 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
|
||||
*> this value as the first entry of the WORK array, and no error
|
||||
*> message related to LWORK is issued by XERBLA.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
|
@ -181,7 +186,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleOTHERauxiliary
|
||||
*> \ingroup latrs3
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
* \verbatim
|
||||
|
@ -253,7 +258,7 @@
|
|||
LOGICAL LQUERY, NOTRAN, NOUNIT, UPPER
|
||||
INTEGER AWRK, I, IFIRST, IINC, ILAST, II, I1, I2, J,
|
||||
$ 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,
|
||||
$ SCAMIN, SMLNUM, TMAX
|
||||
* ..
|
||||
|
@ -292,15 +297,24 @@
|
|||
* 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
|
||||
* in the block column.
|
||||
*
|
||||
LSCALE = NBA * MAX( NBA, MIN( NRHS, NBRHS ) )
|
||||
LDS = NBA
|
||||
*
|
||||
* 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
|
||||
* 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 ).
|
||||
*
|
||||
LANRM = NBA * NBA
|
||||
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
|
||||
*
|
||||
|
@ -322,7 +336,7 @@
|
|||
INFO = -8
|
||||
ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
|
||||
INFO = -10
|
||||
ELSE IF( .NOT.LQUERY .AND. LWORK.LT.WORK( 1 ) ) THEN
|
||||
ELSE IF( .NOT.LQUERY .AND. LWORK.LT.LWMIN ) THEN
|
||||
INFO = -14
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
|
@ -649,6 +663,9 @@
|
|||
END IF
|
||||
END DO
|
||||
END DO
|
||||
*
|
||||
WORK( 1 ) = LWMIN
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of DLATRS3
|
||||
|
|
|
@ -101,15 +101,18 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> 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
|
||||
*> message related to LWORK is issued by XERBLA.
|
||||
*> \endverbatim
|
||||
|
@ -161,27 +164,29 @@
|
|||
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \ingroup latsqr
|
||||
*>
|
||||
* =====================================================================
|
||||
SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK,
|
||||
$ LWORK, INFO)
|
||||
$ LWORK, INFO )
|
||||
*
|
||||
* -- LAPACK computational routine --
|
||||
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK
|
||||
INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( LDA, * ), WORK( * ), T(LDT, *)
|
||||
DOUBLE PRECISION A( LDA, * ), WORK( * ), T( LDT, * )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* ..
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LQUERY
|
||||
INTEGER I, II, KK, CTR
|
||||
LOGICAL LQUERY
|
||||
INTEGER I, II, KK, CTR, MINMN, LWMIN
|
||||
* ..
|
||||
* .. EXTERNAL FUNCTIONS ..
|
||||
LOGICAL LSAME
|
||||
|
@ -198,6 +203,13 @@
|
|||
INFO = 0
|
||||
*
|
||||
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
|
||||
INFO = -1
|
||||
|
@ -205,65 +217,67 @@
|
|||
INFO = -2
|
||||
ELSE IF( MB.LT.1 ) THEN
|
||||
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
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -6
|
||||
ELSE IF( LDT.LT.NB ) THEN
|
||||
INFO = -8
|
||||
ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN
|
||||
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
|
||||
INFO = -10
|
||||
END IF
|
||||
IF( INFO.EQ.0) THEN
|
||||
WORK(1) = NB*N
|
||||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
WORK( 1 ) = LWMIN
|
||||
END IF
|
||||
*
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DLATSQR', -INFO )
|
||||
RETURN
|
||||
ELSE IF (LQUERY) THEN
|
||||
RETURN
|
||||
ELSE IF( LQUERY ) THEN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( MIN(M,N).EQ.0 ) THEN
|
||||
RETURN
|
||||
IF( MINMN.EQ.0 ) THEN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* The QR Decomposition
|
||||
*
|
||||
IF ((MB.LE.N).OR.(MB.GE.M)) THEN
|
||||
CALL DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO)
|
||||
RETURN
|
||||
END IF
|
||||
IF( (MB.LE.N) .OR. (MB.GE.M) ) THEN
|
||||
CALL DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
KK = MOD((M-N),(MB-N))
|
||||
II=M-KK+1
|
||||
KK = MOD((M-N),(MB-N))
|
||||
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
|
||||
DO I = MB+1, II-MB+N , (MB-N)
|
||||
CTR = 1
|
||||
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,
|
||||
$ T(1, CTR * N + 1),
|
||||
$ LDT, WORK, INFO )
|
||||
CTR = CTR + 1
|
||||
END DO
|
||||
CALL DTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA,
|
||||
$ T(1, CTR * N + 1),
|
||||
$ LDT, WORK, INFO )
|
||||
CTR = CTR + 1
|
||||
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
|
||||
CALL DTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
|
||||
$ T(1, CTR * N + 1), LDT,
|
||||
$ WORK, INFO )
|
||||
END IF
|
||||
IF( II.LE.M ) THEN
|
||||
CALL DTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
|
||||
$ T(1, CTR * N + 1), LDT,
|
||||
$ WORK, INFO )
|
||||
END IF
|
||||
*
|
||||
WORK( 1 ) = N*NB
|
||||
WORK( 1 ) = LWMIN
|
||||
RETURN
|
||||
*
|
||||
* End of DLATSQR
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
|
||||
* SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
|
||||
* INFO )
|
||||
*
|
||||
* IMPLICIT NONE
|
||||
|
@ -97,7 +97,7 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
|
@ -105,12 +105,12 @@
|
|||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The length of the array WORK. LWORK >= 1, when N <= 1;
|
||||
*> otherwise
|
||||
*> otherwise
|
||||
*> If JOBZ = 'N' and N > 1, LWORK must be queried.
|
||||
*> LWORK = MAX(1, dimension) where
|
||||
*> dimension = max(stage1,stage2) + (KD+1)*N + 2*N
|
||||
*> = N*KD + N*max(KD+1,FACTOPTNB)
|
||||
*> + max(2*KD*KD, KD*NTHREADS)
|
||||
*> = N*KD + N*max(KD+1,FACTOPTNB)
|
||||
*> + max(2*KD*KD, KD*NTHREADS)
|
||||
*> + (KD+1)*N + 2*N
|
||||
*> where KD is the blocking size of the reduction,
|
||||
*> FACTOPTNB is the blocking used by the QR or LQ
|
||||
|
@ -143,7 +143,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYeigen
|
||||
*> \ingroup heev_2stage
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -161,7 +161,7 @@
|
|||
*> http://doi.acm.org/10.1145/2063384.2063394
|
||||
*>
|
||||
*> 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 High Performance Computing, Networking, Storage and Analysis (SC '13).
|
||||
*> Denver, Colorado, USA, 2013.
|
||||
|
@ -169,16 +169,16 @@
|
|||
*> http://doi.acm.org/10.1145/2503210.2503292
|
||||
*>
|
||||
*> 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.
|
||||
*> International Journal of High Performance Computing Applications.
|
||||
*> 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
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
|
||||
SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
|
||||
$ INFO )
|
||||
*
|
||||
IMPLICIT NONE
|
||||
|
@ -305,7 +305,7 @@
|
|||
LLWORK = LWORK - INDWRK + 1
|
||||
*
|
||||
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 )
|
||||
*
|
||||
* For eigenvalues only, call DSTERF. For eigenvectors, first call
|
||||
|
|
|
@ -96,8 +96,7 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
|
@ -160,7 +159,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYeigen
|
||||
*> \ingroup heevd
|
||||
*
|
||||
*> \par Contributors:
|
||||
* ==================
|
||||
|
|
|
@ -271,7 +271,8 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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,
|
||||
*> where NB is the max of the blocksize for DSYTRD and DORMTR
|
||||
*> returned by ILAENV.
|
||||
|
@ -285,13 +286,14 @@
|
|||
*> \param[out] IWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*>
|
||||
*> \param[in] LIWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> routine only calculates the optimal size of the IWORK array,
|
||||
|
@ -315,7 +317,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYeigen
|
||||
*> \ingroup heevr
|
||||
*
|
||||
*> \par Contributors:
|
||||
* ==================
|
||||
|
@ -390,8 +392,13 @@
|
|||
*
|
||||
LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
|
||||
*
|
||||
LWMIN = MAX( 1, 26*N )
|
||||
LIWMIN = MAX( 1, 10*N )
|
||||
IF( N.LE.1 ) THEN
|
||||
LWMIN = 1
|
||||
LIWMIN = 1
|
||||
ELSE
|
||||
LWMIN = 26*N
|
||||
LIWMIN = 10*N
|
||||
END IF
|
||||
*
|
||||
INFO = 0
|
||||
IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
|
||||
|
@ -450,7 +457,7 @@
|
|||
END IF
|
||||
*
|
||||
IF( N.EQ.1 ) THEN
|
||||
WORK( 1 ) = 7
|
||||
WORK( 1 ) = 1
|
||||
IF( ALLEIG .OR. INDEIG ) THEN
|
||||
M = 1
|
||||
W( 1 ) = A( 1, 1 )
|
||||
|
|
|
@ -263,7 +263,7 @@
|
|||
*> indicating the nonzero elements in Z. The i-th eigenvector
|
||||
*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
|
||||
*> 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.
|
||||
*> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
|
||||
*> \endverbatim
|
||||
|
@ -277,12 +277,13 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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.
|
||||
*> LWORK = MAX(1, 26*N, dimension) where
|
||||
*> dimension = max(stage1,stage2) + (KD+1)*N + 5*N
|
||||
*> = N*KD + N*max(KD+1,FACTOPTNB)
|
||||
*> + max(2*KD*KD, KD*NTHREADS)
|
||||
*> = N*KD + N*max(KD+1,FACTOPTNB)
|
||||
*> + max(2*KD*KD, KD*NTHREADS)
|
||||
*> + (KD+1)*N + 5*N
|
||||
*> where KD is the blocking size of the reduction,
|
||||
*> FACTOPTNB is the blocking used by the QR or LQ
|
||||
|
@ -300,13 +301,14 @@
|
|||
*> \param[out] IWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*>
|
||||
*> \param[in] LIWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> routine only calculates the optimal size of the IWORK array,
|
||||
|
@ -330,7 +332,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYeigen
|
||||
*> \ingroup heevr_2stage
|
||||
*
|
||||
*> \par Contributors:
|
||||
* ==================
|
||||
|
@ -358,7 +360,7 @@
|
|||
*> http://doi.acm.org/10.1145/2063384.2063394
|
||||
*>
|
||||
*> 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 High Performance Computing, Networking, Storage and Analysis (SC '13).
|
||||
*> Denver, Colorado, USA, 2013.
|
||||
|
@ -366,11 +368,11 @@
|
|||
*> http://doi.acm.org/10.1145/2503210.2503292
|
||||
*>
|
||||
*> 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.
|
||||
*> International Journal of High Performance Computing Applications.
|
||||
*> 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
|
||||
*
|
||||
|
@ -444,8 +446,14 @@
|
|||
IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
|
||||
LHTRD = ILAENV2STAGE( 3, '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
|
||||
IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
|
||||
|
@ -484,7 +492,7 @@
|
|||
* NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
|
||||
* NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) )
|
||||
* LWKOPT = MAX( ( NB+1 )*N, LWMIN )
|
||||
WORK( 1 ) = LWMIN
|
||||
WORK( 1 ) = LWMIN
|
||||
IWORK( 1 ) = LIWMIN
|
||||
END IF
|
||||
*
|
||||
|
@ -504,7 +512,7 @@
|
|||
END IF
|
||||
*
|
||||
IF( N.EQ.1 ) THEN
|
||||
WORK( 1 ) = 7
|
||||
WORK( 1 ) = 1
|
||||
IF( ALLEIG .OR. INDEIG ) THEN
|
||||
M = 1
|
||||
W( 1 ) = A( 1, 1 )
|
||||
|
@ -608,7 +616,7 @@
|
|||
* 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 ),
|
||||
$ LHTRD, WORK( INDWK ), LLWORK, IINFO )
|
||||
*
|
||||
|
@ -727,7 +735,7 @@
|
|||
*
|
||||
* Set WORK(1) to optimal workspace size.
|
||||
*
|
||||
WORK( 1 ) = LWMIN
|
||||
WORK( 1 ) = LWMIN
|
||||
IWORK( 1 ) = LIWMIN
|
||||
*
|
||||
RETURN
|
||||
|
|
|
@ -244,7 +244,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYeigen
|
||||
*> \ingroup heevx
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
|
||||
|
@ -338,14 +338,14 @@
|
|||
IF( INFO.EQ.0 ) THEN
|
||||
IF( N.LE.1 ) THEN
|
||||
LWKMIN = 1
|
||||
WORK( 1 ) = LWKMIN
|
||||
LWKOPT = 1
|
||||
ELSE
|
||||
LWKMIN = 8*N
|
||||
NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
|
||||
NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) )
|
||||
LWKOPT = MAX( LWKMIN, ( NB + 3 )*N )
|
||||
WORK( 1 ) = LWKOPT
|
||||
END IF
|
||||
WORK( 1 ) = LWKOPT
|
||||
*
|
||||
IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
|
||||
$ INFO = -17
|
||||
|
|
|
@ -154,7 +154,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYsolve
|
||||
*> \ingroup hesv_aa
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
|
||||
|
@ -177,7 +177,7 @@
|
|||
*
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LQUERY
|
||||
INTEGER LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS
|
||||
INTEGER LWKMIN, LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
|
@ -196,6 +196,7 @@
|
|||
*
|
||||
INFO = 0
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
LWKMIN = MAX( 1, 2*N, 3*N-2 )
|
||||
IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 ) THEN
|
||||
|
@ -206,17 +207,17 @@
|
|||
INFO = -5
|
||||
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
|
||||
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
|
||||
END IF
|
||||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
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,
|
||||
$ -1, INFO )
|
||||
LWKOPT_SYTRS = INT( WORK(1) )
|
||||
LWKOPT = MAX( LWKOPT_SYTRF, LWKOPT_SYTRS )
|
||||
LWKOPT_SYTRS = INT( WORK( 1 ) )
|
||||
LWKOPT = MAX( LWKMIN, LWKOPT_SYTRF, LWKOPT_SYTRS )
|
||||
WORK( 1 ) = LWKOPT
|
||||
END IF
|
||||
*
|
||||
|
|
|
@ -101,14 +101,14 @@
|
|||
*>
|
||||
*> \param[out] TB
|
||||
*> \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.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LTB
|
||||
*> \verbatim
|
||||
*> 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.
|
||||
*>
|
||||
*> If LTB = -1, then a workspace query is assumed; the
|
||||
|
@ -148,14 +148,15 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The size of WORK. LWORK >= N, internally used to select NB
|
||||
*> such that LWORK >= N*NB.
|
||||
*> The size of WORK. LWORK >= MAX(1,N), internally used to
|
||||
*> select NB such that LWORK >= N*NB.
|
||||
*>
|
||||
*> If LWORK = -1, then a workspace query is assumed; the
|
||||
*> routine only calculates the optimal size of the WORK array,
|
||||
|
@ -179,7 +180,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYsolve
|
||||
*> \ingroup hesv_aa_2stage
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
|
||||
|
@ -205,7 +206,7 @@
|
|||
*
|
||||
* .. Local Scalars ..
|
||||
LOGICAL UPPER, TQUERY, WQUERY
|
||||
INTEGER LWKOPT
|
||||
INTEGER LWKMIN, LWKOPT
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
|
@ -226,6 +227,7 @@
|
|||
UPPER = LSAME( UPLO, 'U' )
|
||||
WQUERY = ( LWORK.EQ.-1 )
|
||||
TQUERY = ( LTB.EQ.-1 )
|
||||
LWKMIN = MAX( 1, N )
|
||||
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 ) THEN
|
||||
|
@ -234,18 +236,19 @@
|
|||
INFO = -3
|
||||
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
|
||||
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
|
||||
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
|
||||
INFO = -11
|
||||
ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN
|
||||
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.WQUERY ) THEN
|
||||
INFO = -13
|
||||
END IF
|
||||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
|
||||
$ IPIV2, WORK, -1, INFO )
|
||||
LWKOPT = INT( WORK(1) )
|
||||
LWKOPT = MAX( LWKMIN, INT( WORK( 1 ) ) )
|
||||
WORK( 1 ) = LWKOPT
|
||||
END IF
|
||||
*
|
||||
IF( INFO.NE.0 ) THEN
|
||||
|
@ -255,7 +258,6 @@
|
|||
RETURN
|
||||
END IF
|
||||
*
|
||||
*
|
||||
* 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,
|
||||
|
|
|
@ -275,7 +275,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYsolve
|
||||
*> \ingroup hesvx
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B,
|
||||
|
@ -305,7 +305,7 @@
|
|||
* ..
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LQUERY, NOFACT
|
||||
INTEGER LWKOPT, NB
|
||||
INTEGER LWKMIN, LWKOPT, NB
|
||||
DOUBLE PRECISION ANORM
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
|
@ -327,6 +327,7 @@
|
|||
INFO = 0
|
||||
NOFACT = LSAME( FACT, 'N' )
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
LWKMIN = MAX( 1, 3*N )
|
||||
IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
|
||||
|
@ -344,12 +345,12 @@
|
|||
INFO = -11
|
||||
ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
|
||||
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
|
||||
END IF
|
||||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
LWKOPT = MAX( 1, 3*N )
|
||||
LWKOPT = LWKMIN
|
||||
IF( NOFACT ) THEN
|
||||
NB = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 )
|
||||
LWKOPT = MAX( LWKOPT, N*NB )
|
||||
|
|
|
@ -139,7 +139,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYcomputational
|
||||
*> \ingroup hetrd
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -247,7 +247,7 @@
|
|||
* Determine the block size.
|
||||
*
|
||||
NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
|
||||
LWKOPT = N*NB
|
||||
LWKOPT = MAX( 1, N*NB )
|
||||
WORK( 1 ) = LWKOPT
|
||||
END IF
|
||||
*
|
||||
|
|
|
@ -4,23 +4,23 @@
|
|||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
*> \htmlonly
|
||||
*> Download DSYTRD_2STAGE + dependencies
|
||||
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrd_2stage.f">
|
||||
*> [TGZ]</a>
|
||||
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrd_2stage.f">
|
||||
*> [ZIP]</a>
|
||||
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrd_2stage.f">
|
||||
*> Download DSYTRD_2STAGE + dependencies
|
||||
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrd_2stage.f">
|
||||
*> [TGZ]</a>
|
||||
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrd_2stage.f">
|
||||
*> [ZIP]</a>
|
||||
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrd_2stage.f">
|
||||
*> [TXT]</a>
|
||||
*> \endhtmlonly
|
||||
*> \endhtmlonly
|
||||
*
|
||||
* 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 )
|
||||
*
|
||||
* IMPLICIT NONE
|
||||
|
@ -34,7 +34,7 @@
|
|||
* DOUBLE PRECISION A( LDA, * ), TAU( * ),
|
||||
* HOUS2( * ), WORK( * )
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
|
@ -52,11 +52,11 @@
|
|||
*> \param[in] VECT
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> tridiagonal) and thus LHOUS2 is of size max(1, 4*N);
|
||||
*> = 'V': the Householder representation is needed to
|
||||
*> either generate Q1 Q2 or to apply Q1 Q2,
|
||||
*> = 'V': the Householder representation is needed to
|
||||
*> either generate Q1 Q2 or to apply Q1 Q2,
|
||||
*> then LHOUS2 is to be queried and computed.
|
||||
*> (NOT AVAILABLE IN THIS RELEASE).
|
||||
*> \endverbatim
|
||||
|
@ -86,7 +86,7 @@
|
|||
*> triangular part of A is not referenced.
|
||||
*> On exit, if UPLO = 'U', the band superdiagonal
|
||||
*> 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
|
||||
*> matrix Q1 as a product of elementary reflectors; if UPLO
|
||||
*> = 'L', the diagonal and band subdiagonal of A are over-
|
||||
|
@ -117,13 +117,13 @@
|
|||
*> \param[out] TAU
|
||||
*> \verbatim
|
||||
*> 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).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] HOUS2
|
||||
*> \verbatim
|
||||
*> HOUS2 is DOUBLE PRECISION array, dimension (LHOUS2)
|
||||
*> HOUS2 is DOUBLE PRECISION array, dimension (MAX(1,LHOUS2))
|
||||
*> Stores the Householder representation of the stage2
|
||||
*> band to tridiagonal.
|
||||
*> \endverbatim
|
||||
|
@ -132,6 +132,8 @@
|
|||
*> \verbatim
|
||||
*> LHOUS2 is INTEGER
|
||||
*> The dimension of the array HOUS2.
|
||||
*> LHOUS2 >= 1.
|
||||
*>
|
||||
*> If LWORK = -1, or LHOUS2 = -1,
|
||||
*> then a query is assumed; the routine
|
||||
*> only calculates the optimal size of the HOUS2 array, returns
|
||||
|
@ -143,23 +145,26 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The dimension of the array WORK. LWORK = MAX(1, dimension)
|
||||
*> If LWORK = -1, or LHOUS2=-1,
|
||||
*> The dimension of the array WORK.
|
||||
*> If N = 0, LWORK >= 1, else LWORK = MAX(1, dimension).
|
||||
*>
|
||||
*> If LWORK = -1, or LHOUS2 = -1,
|
||||
*> then a workspace query is assumed; the routine
|
||||
*> only calculates the optimal 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.
|
||||
*> LWORK = MAX(1, dimension) where
|
||||
*> dimension = max(stage1,stage2) + (KD+1)*N
|
||||
*> = N*KD + N*max(KD+1,FACTOPTNB)
|
||||
*> + max(2*KD*KD, KD*NTHREADS)
|
||||
*> + (KD+1)*N
|
||||
*> = N*KD + N*max(KD+1,FACTOPTNB)
|
||||
*> + max(2*KD*KD, KD*NTHREADS)
|
||||
*> + (KD+1)*N
|
||||
*> where KD is the blocking size of the reduction,
|
||||
*> FACTOPTNB is the blocking used by the QR or LQ
|
||||
*> algorithm, usually FACTOPTNB=128 is a good choice
|
||||
|
@ -177,12 +182,12 @@
|
|||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Univ. of Tennessee
|
||||
*> \author Univ. of California Berkeley
|
||||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*> \author Univ. of Tennessee
|
||||
*> \author Univ. of California Berkeley
|
||||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYcomputational
|
||||
*> \ingroup hetrd_2stage
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -202,7 +207,7 @@
|
|||
*> http://doi.acm.org/10.1145/2063384.2063394
|
||||
*>
|
||||
*> 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 High Performance Computing, Networking, Storage and Analysis (SC '13).
|
||||
*> Denver, Colorado, USA, 2013.
|
||||
|
@ -210,16 +215,16 @@
|
|||
*> http://doi.acm.org/10.1145/2503210.2503292
|
||||
*>
|
||||
*> 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.
|
||||
*> International Journal of High Performance Computing Applications.
|
||||
*> 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
|
||||
*>
|
||||
* =====================================================================
|
||||
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 )
|
||||
*
|
||||
IMPLICIT NONE
|
||||
|
@ -265,10 +270,13 @@
|
|||
*
|
||||
KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', VECT, N, -1, -1, -1 )
|
||||
IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', VECT, N, KD, -1, -1 )
|
||||
LHMIN = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
|
||||
LWMIN = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
|
||||
* WRITE(*,*),'DSYTRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO,
|
||||
* $ LHMIN, LWMIN
|
||||
IF( N.EQ.0 ) THEN
|
||||
LHMIN = 1
|
||||
LWMIN = 1
|
||||
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
|
||||
INFO = -1
|
||||
|
@ -309,14 +317,14 @@
|
|||
LWRK = LWORK-LDAB*N
|
||||
ABPOS = 1
|
||||
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 )
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DSYTRD_SY2SB', -INFO )
|
||||
RETURN
|
||||
END IF
|
||||
CALL DSYTRD_SB2ST( 'Y', VECT, UPLO, N, KD,
|
||||
$ WORK( ABPOS ), LDAB, D, E,
|
||||
CALL DSYTRD_SB2ST( 'Y', VECT, UPLO, N, KD,
|
||||
$ WORK( ABPOS ), LDAB, D, E,
|
||||
$ HOUS2, LHOUS2, WORK( WPOS ), LWRK, INFO )
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DSYTRD_SB2ST', -INFO )
|
||||
|
@ -324,8 +332,7 @@
|
|||
END IF
|
||||
*
|
||||
*
|
||||
HOUS2( 1 ) = LHMIN
|
||||
WORK( 1 ) = LWMIN
|
||||
WORK( 1 ) = LWMIN
|
||||
RETURN
|
||||
*
|
||||
* End of DSYTRD_2STAGE
|
||||
|
|
|
@ -18,7 +18,7 @@
|
|||
* 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 )
|
||||
*
|
||||
* #if defined(_OPENMP)
|
||||
|
@ -53,12 +53,12 @@
|
|||
*> \param[in] STAGE1
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> was not called before this routine to reproduce AB.
|
||||
*> In other term this routine is called as standalone.
|
||||
*> = 'Y': "Yes": to mention that the stage 1 of the
|
||||
*> reduction from dense to band using the dsytrd_sy2sb
|
||||
*> was not called before this routine to reproduce AB.
|
||||
*> In other term this routine is called as standalone.
|
||||
*> = 'Y': "Yes": to mention that the stage 1 of the
|
||||
*> reduction from dense to band using the dsytrd_sy2sb
|
||||
*> routine has been called to produce AB (e.g., AB is
|
||||
*> the output of dsytrd_sy2sb.
|
||||
*> \endverbatim
|
||||
|
@ -66,10 +66,10 @@
|
|||
*> \param[in] VECT
|
||||
*> \verbatim
|
||||
*> 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);
|
||||
*> = 'V': the Householder representation is needed to
|
||||
*> either generate or to apply Q later on,
|
||||
*> = 'V': the Householder representation is needed to
|
||||
*> either generate or to apply Q later on,
|
||||
*> then LHOUS is to be queried and computed.
|
||||
*> (NOT AVAILABLE IN THIS RELEASE).
|
||||
*> \endverbatim
|
||||
|
@ -132,34 +132,39 @@
|
|||
*>
|
||||
*> \param[out] HOUS
|
||||
*> \verbatim
|
||||
*> HOUS is DOUBLE PRECISION array, dimension LHOUS, that
|
||||
*> store the Householder representation.
|
||||
*> HOUS is DOUBLE PRECISION array, dimension (MAX(1,LHOUS))
|
||||
*> Stores the Householder representation.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LHOUS
|
||||
*> \verbatim
|
||||
*> LHOUS is INTEGER
|
||||
*> The dimension of the array HOUS. LHOUS = MAX(1, dimension)
|
||||
*> If LWORK = -1, or LHOUS=-1,
|
||||
*> The dimension of the array HOUS.
|
||||
*> 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
|
||||
*> only calculates the optimal size of the HOUS array, returns
|
||||
*> this value as the first entry of the HOUS array, and no error
|
||||
*> message related to LHOUS is issued by XERBLA.
|
||||
*> LHOUS = MAX(1, dimension) where
|
||||
*> dimension = 4*N if VECT='N'
|
||||
*> not available now if VECT='H'
|
||||
*> not available now if VECT='H'
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The dimension of the array WORK. LWORK = MAX(1, dimension)
|
||||
*> If LWORK = -1, or LHOUS=-1,
|
||||
*> The dimension of the array WORK.
|
||||
*> 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
|
||||
*> only calculates the optimal size of the WORK array, returns
|
||||
*> this value as the first entry of the WORK array, and no error
|
||||
|
@ -188,7 +193,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup real16OTHERcomputational
|
||||
*> \ingroup hetrd_hb2st
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -208,7 +213,7 @@
|
|||
*> http://doi.acm.org/10.1145/2063384.2063394
|
||||
*>
|
||||
*> 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 High Performance Computing, Networking, Storage and Analysis (SC '13).
|
||||
*> Denver, Colorado, USA, 2013.
|
||||
|
@ -216,16 +221,16 @@
|
|||
*> http://doi.acm.org/10.1145/2503210.2503292
|
||||
*>
|
||||
*> 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.
|
||||
*> International Journal of High Performance Computing Applications.
|
||||
*> 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
|
||||
*>
|
||||
* =====================================================================
|
||||
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 )
|
||||
*
|
||||
#if defined(_OPENMP)
|
||||
|
@ -258,11 +263,11 @@
|
|||
* ..
|
||||
* .. Local Scalars ..
|
||||
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,
|
||||
$ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID,
|
||||
$ NBTILES, TTYPE, TID, NTHREADS, DEBUG,
|
||||
$ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS,
|
||||
$ NBTILES, TTYPE, TID, NTHREADS,
|
||||
$ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS,
|
||||
$ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU,
|
||||
$ SIDEV, SIZETAU, LDV, LHMIN, LWMIN
|
||||
* ..
|
||||
|
@ -274,7 +279,7 @@
|
|||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
INTEGER ILAENV2STAGE
|
||||
INTEGER ILAENV2STAGE
|
||||
EXTERNAL LSAME, ILAENV2STAGE
|
||||
* ..
|
||||
* .. Executable Statements ..
|
||||
|
@ -282,7 +287,6 @@
|
|||
* Determine the minimal workspace size required.
|
||||
* Test the input parameters
|
||||
*
|
||||
DEBUG = 0
|
||||
INFO = 0
|
||||
AFTERS1 = LSAME( STAGE1, 'Y' )
|
||||
WANTQ = LSAME( VECT, 'V' )
|
||||
|
@ -291,9 +295,14 @@
|
|||
*
|
||||
* Determine the block size, the workspace size and the hous size.
|
||||
*
|
||||
IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', VECT, N, KD, -1, -1 )
|
||||
LHMIN = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 )
|
||||
LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 )
|
||||
IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', VECT, N, KD, -1, -1 )
|
||||
IF( N.EQ.0 .OR. KD.LE.1 ) THEN
|
||||
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
|
||||
INFO = -1
|
||||
|
@ -355,7 +364,7 @@
|
|||
ABDPOS = KD + 1
|
||||
ABOFDPOS = KD
|
||||
ELSE
|
||||
APOS = INDA
|
||||
APOS = INDA
|
||||
AWPOS = INDA + KD + 1
|
||||
DPOS = APOS
|
||||
OFDPOS = DPOS + 1
|
||||
|
@ -363,11 +372,11 @@
|
|||
ABOFDPOS = 2
|
||||
|
||||
ENDIF
|
||||
*
|
||||
* Case KD=0:
|
||||
* The matrix is diagonal. We just copy it (convert to "real" for
|
||||
* real because D is double and the imaginary part should be 0)
|
||||
* and store it in D. A sequential code here is better or
|
||||
*
|
||||
* Case KD=0:
|
||||
* The matrix is diagonal. We just copy it (convert to "real" for
|
||||
* real because D is double and the imaginary part should be 0)
|
||||
* 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
|
||||
*
|
||||
IF( KD.EQ.0 ) THEN
|
||||
|
@ -382,17 +391,17 @@
|
|||
WORK( 1 ) = 1
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Case KD=1:
|
||||
* The matrix is already Tridiagonal. We have to make diagonal
|
||||
*
|
||||
* Case KD=1:
|
||||
* The matrix is already Tridiagonal. We have to make diagonal
|
||||
* and offdiagonal elements real, and store them in D and E.
|
||||
* For that, for real precision just copy the diag and offdiag
|
||||
* to D and E while for the COMPLEX case the bulge chasing is
|
||||
* performed to convert the hermetian tridiagonal to symmetric
|
||||
* tridiagonal. A simpler conversion formula might be used, but then
|
||||
* For that, for real precision just copy the diag and offdiag
|
||||
* to D and E while for the COMPLEX case the bulge chasing is
|
||||
* performed to convert the hermetian tridiagonal to symmetric
|
||||
* tridiagonal. A simpler conversion formula might be used, but then
|
||||
* 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
|
||||
DO 50 I = 1, N
|
||||
D( I ) = ( AB( ABDPOS, I ) )
|
||||
|
@ -413,7 +422,7 @@
|
|||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Main code start here.
|
||||
* Main code start here.
|
||||
* Reduce the symmetric band of A to a tridiagonal matrix.
|
||||
*
|
||||
THGRSIZ = N
|
||||
|
@ -422,7 +431,7 @@
|
|||
NBTILES = CEILING( REAL(N)/REAL(KD) )
|
||||
STEPERCOL = CEILING( REAL(SHIFT)/REAL(GRSIZ) )
|
||||
THGRNB = CEILING( REAL(N-1)/REAL(THGRSIZ) )
|
||||
*
|
||||
*
|
||||
CALL DLACPY( "A", KD+1, N, AB, LDAB, WORK( APOS ), LDA )
|
||||
CALL DLASET( "A", KD, N, ZERO, ZERO, WORK( AWPOS ), LDA )
|
||||
*
|
||||
|
@ -431,7 +440,7 @@
|
|||
*
|
||||
#if defined(_OPENMP)
|
||||
!$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$ SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK)
|
||||
!$OMP$ SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA )
|
||||
|
@ -440,7 +449,7 @@
|
|||
#endif
|
||||
*
|
||||
* main bulge chasing loop
|
||||
*
|
||||
*
|
||||
DO 100 THGRID = 1, THGRNB
|
||||
STT = (THGRID-1)*THGRSIZ+1
|
||||
THED = MIN( (STT + THGRSIZ -1), (N-1))
|
||||
|
@ -451,7 +460,7 @@
|
|||
ST = STT
|
||||
DO 130 SWEEPID = ST, ED
|
||||
DO 140 K = 1, GRSIZ
|
||||
MYID = (I-SWEEPID)*(STEPERCOL*GRSIZ)
|
||||
MYID = (I-SWEEPID)*(STEPERCOL*GRSIZ)
|
||||
$ + (M-1)*GRSIZ + K
|
||||
IF ( MYID.EQ.1 ) THEN
|
||||
TTYPE = 1
|
||||
|
@ -477,16 +486,16 @@
|
|||
ENDIF
|
||||
*
|
||||
* Call the kernel
|
||||
*
|
||||
*
|
||||
#if defined(_OPENMP) && _OPENMP >= 201307
|
||||
IF( TTYPE.NE.1 ) THEN
|
||||
IF( TTYPE.NE.1 ) THEN
|
||||
!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
|
||||
!$OMP$ DEPEND(in:WORK(MYID-1))
|
||||
!$OMP$ DEPEND(out:WORK(MYID))
|
||||
TID = OMP_GET_THREAD_NUM()
|
||||
CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE,
|
||||
CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE,
|
||||
$ STIND, EDIND, SWEEPID, N, KD, IB,
|
||||
$ WORK ( INDA ), LDA,
|
||||
$ WORK ( INDA ), LDA,
|
||||
$ HOUS( INDV ), HOUS( INDTAU ), LDV,
|
||||
$ WORK( INDW + TID*KD ) )
|
||||
!$OMP END TASK
|
||||
|
@ -494,20 +503,20 @@
|
|||
!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
|
||||
!$OMP$ DEPEND(out:WORK(MYID))
|
||||
TID = OMP_GET_THREAD_NUM()
|
||||
CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE,
|
||||
CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE,
|
||||
$ STIND, EDIND, SWEEPID, N, KD, IB,
|
||||
$ WORK ( INDA ), LDA,
|
||||
$ WORK ( INDA ), LDA,
|
||||
$ HOUS( INDV ), HOUS( INDTAU ), LDV,
|
||||
$ WORK( INDW + TID*KD ) )
|
||||
!$OMP END TASK
|
||||
ENDIF
|
||||
#else
|
||||
CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE,
|
||||
CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE,
|
||||
$ STIND, EDIND, SWEEPID, N, KD, IB,
|
||||
$ WORK ( INDA ), LDA,
|
||||
$ WORK ( INDA ), LDA,
|
||||
$ HOUS( INDV ), HOUS( INDTAU ), LDV,
|
||||
$ WORK( INDW ) )
|
||||
#endif
|
||||
#endif
|
||||
IF ( BLKLASTIND.GE.(N-1) ) THEN
|
||||
STT = STT + 1
|
||||
EXIT
|
||||
|
@ -522,14 +531,14 @@
|
|||
!$OMP END MASTER
|
||||
!$OMP END PARALLEL
|
||||
#endif
|
||||
*
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
DO 150 I = 1, N
|
||||
D( I ) = ( WORK( DPOS+(I-1)*LDA ) )
|
||||
150 CONTINUE
|
||||
*
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
|
@ -543,11 +552,10 @@
|
|||
170 CONTINUE
|
||||
ENDIF
|
||||
*
|
||||
HOUS( 1 ) = LHMIN
|
||||
WORK( 1 ) = LWMIN
|
||||
RETURN
|
||||
*
|
||||
* End of DSYTRD_SB2ST
|
||||
*
|
||||
END
|
||||
|
||||
|
||||
|
|
|
@ -123,8 +123,8 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is DOUBLE PRECISION array, dimension (LWORK)
|
||||
*> On exit, if INFO = 0, or if LWORK=-1,
|
||||
*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
|
||||
*> On exit, if INFO = 0, or if LWORK = -1,
|
||||
*> WORK(1) returns the size of LWORK.
|
||||
*> \endverbatim
|
||||
*>
|
||||
|
@ -132,7 +132,9 @@
|
|||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> 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
|
||||
*> only calculates the optimal size of the WORK array, returns
|
||||
*> this value as the first entry of the WORK array, and no error
|
||||
|
@ -158,7 +160,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYcomputational
|
||||
*> \ingroup hetrd_he2hb
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
@ -293,8 +295,12 @@
|
|||
INFO = 0
|
||||
UPPER = LSAME( UPLO, 'U' )
|
||||
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
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 ) THEN
|
||||
|
|
|
@ -101,8 +101,10 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The length of WORK. LWORK >= MAX(1,2*N). For optimum performance
|
||||
*> LWORK >= N*(1+NB), where NB is the optimal blocksize.
|
||||
*> The length of WORK.
|
||||
*> 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
|
||||
*> only calculates the optimal size of the WORK array, returns
|
||||
|
@ -125,10 +127,10 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \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 is a software package provided by Univ. of Tennessee, --
|
||||
|
@ -152,7 +154,7 @@
|
|||
*
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LQUERY, UPPER
|
||||
INTEGER J, LWKOPT
|
||||
INTEGER J, LWKMIN, LWKOPT
|
||||
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
|
||||
DOUBLE PRECISION ALPHA
|
||||
* ..
|
||||
|
@ -179,18 +181,25 @@
|
|||
INFO = 0
|
||||
UPPER = LSAME( UPLO, 'U' )
|
||||
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
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 ) THEN
|
||||
INFO = -2
|
||||
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
|
||||
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
|
||||
END IF
|
||||
*
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
LWKOPT = (NB+1)*N
|
||||
WORK( 1 ) = LWKOPT
|
||||
END IF
|
||||
*
|
||||
|
@ -203,11 +212,11 @@
|
|||
*
|
||||
* Quick return
|
||||
*
|
||||
IF ( N.EQ.0 ) THEN
|
||||
IF( N.EQ.0 ) THEN
|
||||
RETURN
|
||||
ENDIF
|
||||
IPIV( 1 ) = 1
|
||||
IF ( N.EQ.1 ) THEN
|
||||
IF( N.EQ.1 ) THEN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
|
|
|
@ -87,14 +87,14 @@
|
|||
*>
|
||||
*> \param[out] TB
|
||||
*> \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.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LTB
|
||||
*> \verbatim
|
||||
*> 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.
|
||||
*>
|
||||
*> If LTB = -1, then a workspace query is assumed; the
|
||||
|
@ -121,14 +121,14 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is DOUBLE PRECISION workspace of size LWORK
|
||||
*> WORK is DOUBLE PRECISION workspace of size (MAX(1,LWORK))
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The size of WORK. LWORK >= N, internally used to select NB
|
||||
*> such that LWORK >= N*NB.
|
||||
*> The size of WORK. LWORK >= MAX(1,N), internally used
|
||||
*> to select NB such that LWORK >= N*NB.
|
||||
*>
|
||||
*> If LWORK = -1, then a workspace query is assumed; the
|
||||
*> routine only calculates the optimal size of the WORK array,
|
||||
|
@ -152,7 +152,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYcomputational
|
||||
*> \ingroup hetrf_aa_2stage
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
|
||||
|
@ -211,9 +211,9 @@
|
|||
INFO = -2
|
||||
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
|
||||
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
|
||||
ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN
|
||||
ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN
|
||||
INFO = -10
|
||||
END IF
|
||||
*
|
||||
|
@ -227,10 +227,10 @@
|
|||
NB = ILAENV( 1, 'DSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 )
|
||||
IF( INFO.EQ.0 ) THEN
|
||||
IF( TQUERY ) THEN
|
||||
TB( 1 ) = (3*NB+1)*N
|
||||
TB( 1 ) = MAX( 1, (3*NB+1)*N )
|
||||
END IF
|
||||
IF( WQUERY ) THEN
|
||||
WORK( 1 ) = N*NB
|
||||
WORK( 1 ) = MAX( 1, N*NB )
|
||||
END IF
|
||||
END IF
|
||||
IF( TQUERY .OR. WQUERY ) THEN
|
||||
|
@ -239,7 +239,7 @@
|
|||
*
|
||||
* Quick return
|
||||
*
|
||||
IF ( N.EQ.0 ) THEN
|
||||
IF( N.EQ.0 ) THEN
|
||||
RETURN
|
||||
ENDIF
|
||||
*
|
||||
|
|
|
@ -177,14 +177,14 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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.
|
||||
*>
|
||||
|
@ -229,7 +229,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYcomputational
|
||||
*> \ingroup hetrf_rk
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
|
|
@ -118,7 +118,7 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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.
|
||||
*>
|
||||
*> If LWORK = -1, then a workspace query is assumed; the routine
|
||||
|
@ -146,7 +146,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYcomputational
|
||||
*> \ingroup hetrf_rook
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
|
|
|
@ -88,16 +88,16 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is DOUBLE PRECISION array, dimension (N+NB+1)*(NB+3)
|
||||
*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> 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
|
||||
*> calculates:
|
||||
*> calculates:
|
||||
*> - the optimal 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.
|
||||
|
@ -120,7 +120,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYcomputational
|
||||
*> \ingroup hetri2
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
|
||||
|
@ -159,9 +159,13 @@
|
|||
INFO = 0
|
||||
UPPER = LSAME( UPLO, 'U' )
|
||||
LQUERY = ( LWORK.EQ.-1 )
|
||||
*
|
||||
* Get blocksize
|
||||
*
|
||||
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
|
||||
ELSE
|
||||
MINSIZE = (N+NBMAX+1)*(NBMAX+3)
|
||||
|
@ -173,28 +177,29 @@
|
|||
INFO = -2
|
||||
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
|
||||
INFO = -4
|
||||
ELSE IF (LWORK .LT. MINSIZE .AND. .NOT.LQUERY ) THEN
|
||||
ELSE IF( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN
|
||||
INFO = -7
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
*
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DSYTRI2', -INFO )
|
||||
RETURN
|
||||
ELSE IF( LQUERY ) THEN
|
||||
WORK(1)=MINSIZE
|
||||
WORK( 1 ) = MINSIZE
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( N.EQ.0 )
|
||||
$ RETURN
|
||||
|
||||
IF( NBMAX .GE. N ) THEN
|
||||
IF( NBMAX.GE.N ) THEN
|
||||
CALL DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
|
||||
ELSE
|
||||
CALL DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
|
||||
END IF
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of DSYTRI2
|
||||
|
|
|
@ -119,16 +119,17 @@
|
|||
*>
|
||||
*> \param[out] WORK
|
||||
*> \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.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*> size of the WORK array, returns this value as the first
|
||||
*> entry of the WORK array, and no error message related to
|
||||
|
@ -152,7 +153,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYcomputational
|
||||
*> \ingroup hetri_3
|
||||
*
|
||||
*> \par Contributors:
|
||||
* ==================
|
||||
|
@ -208,8 +209,13 @@
|
|||
*
|
||||
* Determine the block size
|
||||
*
|
||||
NB = MAX( 1, ILAENV( 1, 'DSYTRI_3', UPLO, N, -1, -1, -1 ) )
|
||||
LWKOPT = ( N+NB+1 ) * ( NB+3 )
|
||||
IF( N.EQ.0 ) THEN
|
||||
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
|
||||
INFO = -1
|
||||
|
@ -217,7 +223,7 @@
|
|||
INFO = -2
|
||||
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
|
||||
INFO = -4
|
||||
ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN
|
||||
ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN
|
||||
INFO = -8
|
||||
END IF
|
||||
*
|
||||
|
@ -225,7 +231,6 @@
|
|||
CALL XERBLA( 'DSYTRI_3', -INFO )
|
||||
RETURN
|
||||
ELSE IF( LQUERY ) THEN
|
||||
WORK( 1 ) = LWKOPT
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
|
|
|
@ -105,7 +105,13 @@
|
|||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> 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
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
|
@ -123,7 +129,7 @@
|
|||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup doubleSYcomputational
|
||||
*> \ingroup hetrs_aa
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
|
||||
|
@ -151,7 +157,7 @@
|
|||
* ..
|
||||
* .. Local Scalars ..
|
||||
LOGICAL LQUERY, UPPER
|
||||
INTEGER K, KP, LWKOPT
|
||||
INTEGER K, KP, LWKMIN
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
|
@ -161,13 +167,19 @@
|
|||
EXTERNAL DLACPY, DGTSV, DSWAP, DTRSM, XERBLA
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
INTRINSIC MIN, MAX
|
||||
* ..
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
INFO = 0
|
||||
UPPER = LSAME( UPLO, 'U' )
|
||||
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
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 ) THEN
|
||||
|
@ -178,21 +190,20 @@
|
|||
INFO = -5
|
||||
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
|
||||
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
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DSYTRS_AA', -INFO )
|
||||
RETURN
|
||||
ELSE IF( LQUERY ) THEN
|
||||
LWKOPT = (3*N-2)
|
||||
WORK( 1 ) = LWKOPT
|
||||
WORK( 1 ) = LWKMIN
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( N.EQ.0 .OR. NRHS.EQ.0 )
|
||||
IF( MIN( N, NRHS ).EQ.0 )
|
||||
$ RETURN
|
||||
*
|
||||
IF( UPPER ) THEN
|
||||
|
|
Loading…
Reference in New Issue