floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

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

26
lapack-netlib/SRC/dgebrd.f
View File

@ -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

24
lapack-netlib/SRC/dgehrd.f
View File

@ -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

4
lapack-netlib/SRC/dgelq.f
View File

@ -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 )

20
lapack-netlib/SRC/dgelqf.f
View File

@ -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

7
lapack-netlib/SRC/dgelsd.f
View File

@ -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].
*

26
lapack-netlib/SRC/dgemlq.f
View File

@ -111,13 +111,14 @@
*>
*> \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
@ -165,6 +166,8 @@
*> 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
*

26
lapack-netlib/SRC/dgemqr.f
View File

@ -111,13 +111,14 @@
*>
*> \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
@ -166,6 +167,8 @@
*>
*> \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
*

10
lapack-netlib/SRC/dgeqlf.f
View File

@ -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
*

3
lapack-netlib/SRC/dgeqp3rk.f
View File

@ -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.

20
lapack-netlib/SRC/dgeqr.f
View File

@ -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
*

24
lapack-netlib/SRC/dgeqrfp.f
View File

@ -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.

4
lapack-netlib/SRC/dgerqf.f
View File

@ -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

32
lapack-netlib/SRC/dgesvj.f
View File

@ -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

5
lapack-netlib/SRC/dgetri.f
View File

@ -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

12
lapack-netlib/SRC/dgetsls.f
View File

@ -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]
*

16
lapack-netlib/SRC/dgetsqrhrt.f
View File

@ -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
*

12
lapack-netlib/SRC/dgges.f
View File

@ -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
*

39
lapack-netlib/SRC/dgges3.f
View File

@ -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
*

37
lapack-netlib/SRC/dggev3.f
View File

@ -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
*

17
lapack-netlib/SRC/dgghd3.f
View File

@ -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

5
lapack-netlib/SRC/dggqrf.f
View File

@ -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

4
lapack-netlib/SRC/dggrqf.f
View File

@ -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

4
lapack-netlib/SRC/dggsvd3.f
View File

@ -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:
* ==================

4
lapack-netlib/SRC/dggsvp3.f
View File

@ -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:
* =====================

62
lapack-netlib/SRC/dlamswlq.f
View File

@ -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

74
lapack-netlib/SRC/dlamtsqr.f
View File

@ -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

92
lapack-netlib/SRC/dlaswlq.f
View File

@ -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

27
lapack-netlib/SRC/dlatrs3.f
View File

@ -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

92
lapack-netlib/SRC/dlatsqr.f
View File

@ -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

4
lapack-netlib/SRC/dsyev_2stage.f
View File

@ -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
*>
@ -143,7 +143,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup doubleSYeigen
*> \ingroup heev_2stage
*
*> \par Further Details:
* =====================

5
lapack-netlib/SRC/dsyevd.f
View File

@ -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:
* ==================

21
lapack-netlib/SRC/dsyevr.f
View File

@ -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 )

24
lapack-netlib/SRC/dsyevr_2stage.f
View File

@ -278,6 +278,7 @@
*> \verbatim
*> LWORK is INTEGER
*> 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
@ -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:
* ==================
@ -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 )
@ -727,7 +735,7 @@
*
* Set WORK(1) to optimal workspace size.
*
WORK( 1 ) = LWMIN
WORK( 1 ) = LWMIN
IWORK( 1 ) = LIWMIN
*
RETURN

6
lapack-netlib/SRC/dsyevx.f
View File

@ -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

13
lapack-netlib/SRC/dsysv_aa.f
View File

@ -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
*

24
lapack-netlib/SRC/dsysv_aa_2stage.f
View File

@ -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,

9
lapack-netlib/SRC/dsysvx.f
View File

@ -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 )

4
lapack-netlib/SRC/dsytrd.f
View File

@ -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
*

29
lapack-netlib/SRC/dsytrd_2stage.f
View File

@ -123,7 +123,7 @@
*>
*> \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,14 +145,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 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
@ -182,7 +187,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup doubleSYcomputational
*> \ingroup hetrd_2stage
*
*> \par Further Details:
* =====================
@ -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
@ -324,8 +332,7 @@
END IF
*
*
HOUS2( 1 ) = LHMIN
WORK( 1 ) = LWMIN
WORK( 1 ) = LWMIN
RETURN
*
* End of DSYTRD_2STAGE

36
lapack-netlib/SRC/dsytrd_sb2st.F
View File

@ -132,15 +132,17 @@
*>
*> \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
@ -152,14 +154,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 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:
* =====================
@ -261,7 +266,7 @@
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,
$ NBTILES, TTYPE, TID, NTHREADS,
$ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS,
$ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU,
$ SIDEV, SIZETAU, LDV, LHMIN, LWMIN
@ -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
@ -543,7 +552,6 @@
170 CONTINUE
ENDIF
*
HOUS( 1 ) = LHMIN
WORK( 1 ) = LWMIN
RETURN
*

18
lapack-netlib/SRC/dsytrd_sy2sb.f
View File

@ -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

27
lapack-netlib/SRC/dsytrf_aa.f
View File

@ -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
*

22
lapack-netlib/SRC/dsytrf_aa_2stage.f
View File

@ -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
*

6
lapack-netlib/SRC/dsytrf_rk.f
View File

@ -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:
* =====================

4
lapack-netlib/SRC/dsytrf_rook.f
View File

@ -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:
* =====================

27
lapack-netlib/SRC/dsytri2.f
View File

@ -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

21
lapack-netlib/SRC/dsytri_3.f
View File

@ -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
*

27
lapack-netlib/SRC/dsytrs_aa.f
View File

@ -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