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 20:16:33 +01:00 committed by GitHub
parent c082669ad4
commit 45ef0d7361
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
42 changed files with 733 additions and 504 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

23
lapack-netlib/SRC/zgehrd.f
View File

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

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

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

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

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

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

@ -109,13 +109,14 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) *> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1, then a workspace query is assumed. The routine *> If LWORK = -1, then a workspace query is assumed. The routine
*> only calculates the size of the WORK array, returns this *> only calculates the size of the WORK array, returns this
*> value as WORK(1), and no error message related to WORK *> value as WORK(1), and no error message related to WORK
@ -163,6 +164,8 @@
*> Further Details in ZLAMSWLQ or ZGEMLQT. *> Further Details in ZLAMSWLQ or ZGEMLQT.
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup gemlq
*>
* ===================================================================== * =====================================================================
SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
$ C, LDC, WORK, LWORK, INFO ) $ C, LDC, WORK, LWORK, INFO )
@ -184,7 +187,7 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER MB, NB, LW, NBLCKS, MN INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -200,7 +203,7 @@
* *
* Test the input arguments * Test the input arguments
* *
LQUERY = LWORK.EQ.-1 LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' ) NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' ) TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' ) LEFT = LSAME( SIDE, 'L' )
@ -215,6 +218,13 @@
LW = M * MB LW = M * MB
MN = N MN = N
END IF END IF
*
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
* *
IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
@ -243,7 +253,7 @@
INFO = -9 INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -11 INFO = -11
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN ELSE IF( ( LWORK.LT.LWMIN ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13 INFO = -13
END IF END IF
* *
@ -260,7 +270,7 @@
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN( M, N, K ).EQ.0 ) THEN IF( MINMNK.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *

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

@ -111,13 +111,14 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) *> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1, then a workspace query is assumed. The routine *> If LWORK = -1, then a workspace query is assumed. The routine
*> only calculates the size of the WORK array, returns this *> only calculates the size of the WORK array, returns this
*> value as WORK(1), and no error message related to WORK *> value as WORK(1), and no error message related to WORK
@ -166,6 +167,8 @@
*> *>
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup gemqr
*>
* ===================================================================== * =====================================================================
SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
$ C, LDC, WORK, LWORK, INFO ) $ C, LDC, WORK, LWORK, INFO )
@ -187,7 +190,7 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER MB, NB, LW, NBLCKS, MN INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -203,7 +206,7 @@
* *
* Test the input arguments * Test the input arguments
* *
LQUERY = LWORK.EQ.-1 LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' ) NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' ) TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' ) LEFT = LSAME( SIDE, 'L' )
@ -218,6 +221,13 @@
LW = MB * NB LW = MB * NB
MN = N MN = N
END IF END IF
*
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
* *
IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN
IF( MOD( MN - K, MB - K ).EQ.0 ) THEN IF( MOD( MN - K, MB - K ).EQ.0 ) THEN
@ -246,12 +256,12 @@
INFO = -9 INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -11 INFO = -11
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
INFO = -13 INFO = -13
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LW WORK( 1 ) = LWMIN
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -263,7 +273,7 @@
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN( M, N, K ).EQ.0 ) THEN IF( MINMNK.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
@ -276,7 +286,7 @@
$ NB, C, LDC, WORK, LWORK, INFO ) $ NB, C, LDC, WORK, LWORK, INFO )
END IF END IF
* *
WORK( 1 ) = LW WORK( 1 ) = LWMIN
* *
RETURN RETURN
* *

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

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

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

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

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

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

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

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

83
lapack-netlib/SRC/zgesvj.f
View File

@ -200,23 +200,25 @@
*> \verbatim *> \verbatim
*> LDV is INTEGER *> LDV is INTEGER
*> The leading dimension of the array V, LDV >= 1. *> The leading dimension of the array V, LDV >= 1.
*> If JOBV = 'V', then LDV >= max(1,N). *> If JOBV = 'V', then LDV >= MAX(1,N).
*> If JOBV = 'A', then LDV >= max(1,MV) . *> If JOBV = 'A', then LDV >= MAX(1,MV) .
*> \endverbatim *> \endverbatim
*> *>
*> \param[in,out] CWORK *> \param[in,out] CWORK
*> \verbatim *> \verbatim
*> CWORK is COMPLEX*16 array, dimension (max(1,LWORK)) *> CWORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
*> Used as workspace. *> Used as workspace.
*> If on entry LWORK = -1, then a workspace query is assumed and
*> no computation is done; CWORK(1) is set to the minial (and optimal)
*> length of CWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER. *> LWORK is INTEGER.
*> Length of CWORK, LWORK >= M+N. *> Length of CWORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M+N, otherwise.
*>
*> If on entry LWORK = -1, then a workspace query is assumed and
*> no computation is done; CWORK(1) is set to the minial (and optimal)
*> length of CWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in,out] RWORK *> \param[in,out] RWORK
@ -247,15 +249,17 @@
*> RWORK(6) = the largest absolute value over all sines of the *> RWORK(6) = the largest absolute value over all sines of the
*> Jacobi rotation angles in the last sweep. It can be *> Jacobi rotation angles in the last sweep. It can be
*> useful for a post festum analysis. *> useful for a post festum analysis.
*> If on entry LRWORK = -1, then a workspace query is assumed and
*> no computation is done; RWORK(1) is set to the minial (and optimal)
*> length of RWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LRWORK *> \param[in] LRWORK
*> \verbatim *> \verbatim
*> LRWORK is INTEGER *> LRWORK is INTEGER
*> Length of RWORK, LRWORK >= MAX(6,N). *> Length of RWORK.
*> LRWORK >= 1, if MIN(M,N) = 0, and LRWORK >= MAX(6,N), otherwise.
*>
*> If on entry LRWORK = -1, then a workspace query is assumed and
*> no computation is done; RWORK(1) is set to the minial (and optimal)
*> length of RWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[out] INFO *> \param[out] INFO
@ -276,7 +280,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16GEcomputational *> \ingroup gesvj
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -367,23 +371,25 @@
* *
* .. Local Parameters .. * .. Local Parameters ..
DOUBLE PRECISION ZERO, HALF, ONE DOUBLE PRECISION ZERO, HALF, ONE
PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0) PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0)
COMPLEX*16 CZERO, CONE COMPLEX*16 CZERO, CONE
PARAMETER ( CZERO = (0.0D0, 0.0D0), CONE = (1.0D0, 0.0D0) ) PARAMETER ( CZERO = (0.0D0, 0.0D0), CONE = (1.0D0, 0.0D0) )
INTEGER NSWEEP INTEGER NSWEEP
PARAMETER ( NSWEEP = 30 ) PARAMETER ( NSWEEP = 30 )
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
COMPLEX*16 AAPQ, OMPQ COMPLEX*16 AAPQ, OMPQ
DOUBLE PRECISION AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG, DOUBLE PRECISION AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG,
$ BIGTHETA, CS, CTOL, EPSLN, MXAAPQ, $ BIGTHETA, CS, CTOL, EPSLN, MXAAPQ,
$ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL, $ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL,
$ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN, TOL $ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN,
INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1, $ TOL
$ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34, INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
$ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, SWBAND $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34,
LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, ROTOK, $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP,
$ RSVEC, UCTOL, UPPER $ SWBAND, MINMN, LWMIN, LRWMIN
LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE,
$ ROTOK, RSVEC, UCTOL, UPPER
* .. * ..
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
@ -422,7 +428,16 @@
UPPER = LSAME( JOBA, 'U' ) UPPER = LSAME( JOBA, 'U' )
LOWER = LSAME( JOBA, 'L' ) LOWER = LSAME( JOBA, 'L' )
* *
LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 ) MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
LRWMIN = 1
ELSE
LWMIN = M+N
LRWMIN = MAX( 6, N )
END IF
*
LQUERY = ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 )
IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN
INFO = -1 INFO = -1
ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN
@ -442,9 +457,9 @@
INFO = -11 INFO = -11
ELSE IF( UCTOL .AND. ( RWORK( 1 ).LE.ONE ) ) THEN ELSE IF( UCTOL .AND. ( RWORK( 1 ).LE.ONE ) ) THEN
INFO = -12 INFO = -12
ELSE IF( ( LWORK.LT.( M+N ) ) .AND. ( .NOT.LQUERY ) ) THEN ELSE IF( LWORK.LT.LWMIN .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13 INFO = -13
ELSE IF( ( LRWORK.LT.MAX( N, 6 ) ) .AND. ( .NOT.LQUERY ) ) THEN ELSE IF( LRWORK.LT.LRWMIN .AND. ( .NOT.LQUERY ) ) THEN
INFO = -15 INFO = -15
ELSE ELSE
INFO = 0 INFO = 0
@ -454,15 +469,15 @@
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGESVJ', -INFO ) CALL XERBLA( 'ZGESVJ', -INFO )
RETURN RETURN
ELSE IF ( LQUERY ) THEN ELSE IF( LQUERY ) THEN
CWORK(1) = M + N CWORK( 1 ) = LWMIN
RWORK(1) = MAX( N, 6 ) RWORK( 1 ) = LRWMIN
RETURN RETURN
END IF END IF
* *
* #:) Quick return for void matrix * #:) Quick return for void matrix
* *
IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN IF( MINMN.EQ.0 ) RETURN
* *
* Set numerical parameters * Set numerical parameters
* The stopping criterion for Jacobi rotations is * The stopping criterion for Jacobi rotations is

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

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

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

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

15
lapack-netlib/SRC/zgetsqrhrt.f
View File

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

34
lapack-netlib/SRC/zgges3.f
View File

@ -215,7 +215,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= MAX(1,2*N)
*> For good performance, LWORK must generally be larger.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
@ -260,7 +261,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16GEeigen *> \ingroup gges3
* *
* ===================================================================== * =====================================================================
SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B,
@ -300,7 +301,8 @@
LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL, LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
$ LQUERY, WANTST $ LQUERY, WANTST
INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
$ ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK, LWKOPT $ ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK, LWKOPT,
$ LWKMIN
DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL, DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL,
$ PVSR, SMLNUM $ PVSR, SMLNUM
* .. * ..
@ -309,9 +311,8 @@
DOUBLE PRECISION DIF( 2 ) DOUBLE PRECISION DIF( 2 )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, ZLAQZ0,
$ ZLAQZ0, ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, $ ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, ZUNMQR
$ ZUNMQR
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -353,6 +354,8 @@
* *
INFO = 0 INFO = 0
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N )
*
IF( IJOBVL.LE.0 ) THEN IF( IJOBVL.LE.0 ) THEN
INFO = -1 INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN ELSE IF( IJOBVR.LE.0 ) THEN
@ -369,7 +372,7 @@
INFO = -14 INFO = -14
ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
INFO = -16 INFO = -16
ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -18 INFO = -18
END IF END IF
* *
@ -377,28 +380,32 @@
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL ZGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) CALL ZGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
LWKOPT = MAX( 1, N + INT ( WORK( 1 ) ) ) LWKOPT = MAX( LWKMIN, N + INT( WORK( 1 ) ) )
CALL ZUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK, CALL ZUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK,
$ -1, IERR ) $ -1, IERR )
LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) )
IF( ILVSL ) THEN IF( ILVSL ) THEN
CALL ZUNGQR( N, N, N, VSL, LDVSL, WORK, WORK, -1, IERR ) CALL ZUNGQR( N, N, N, VSL, LDVSL, WORK, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) )
END IF END IF
CALL ZGGHD3( JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, VSL, CALL ZGGHD3( JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, VSL,
$ LDVSL, VSR, LDVSR, WORK, -1, IERR ) $ LDVSL, VSR, LDVSR, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) )
CALL ZLAQZ0( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, CALL ZLAQZ0( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB,
$ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, -1, $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, -1,
$ RWORK, 0, IERR ) $ RWORK, 0, IERR )
LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, INT( WORK( 1 ) ) )
IF( WANTST ) THEN IF( WANTST ) THEN
CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB,
$ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, SDIM,
$ PVSL, PVSR, DIF, WORK, -1, IDUM, 1, IERR ) $ PVSL, PVSR, DIF, WORK, -1, IDUM, 1, IERR )
LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, INT( WORK( 1 ) ) )
END IF
IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = DCMPLX( LWKOPT )
END IF END IF
WORK( 1 ) = DCMPLX( LWKOPT )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -420,7 +427,6 @@
EPS = DLAMCH( 'P' ) EPS = DLAMCH( 'P' )
SMLNUM = DLAMCH( 'S' ) SMLNUM = DLAMCH( 'S' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
SMLNUM = SQRT( SMLNUM ) / EPS SMLNUM = SQRT( SMLNUM ) / EPS
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
* *

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

@ -174,7 +174,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= MAX(1,2*N).
*> For good performance, LWORK must generally be larger.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
@ -208,7 +209,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16GEeigen *> \ingroup ggev3
* *
* ===================================================================== * =====================================================================
SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
@ -243,7 +244,7 @@
CHARACTER CHTEMP CHARACTER CHTEMP
INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO, INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
$ IN, IRIGHT, IROWS, IRWRK, ITAU, IWRK, JC, JR, $ IN, IRIGHT, IROWS, IRWRK, ITAU, IWRK, JC, JR,
$ LWKOPT $ LWKMIN, LWKOPT
DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
$ SMLNUM, TEMP $ SMLNUM, TEMP
COMPLEX*16 X COMPLEX*16 X
@ -252,9 +253,8 @@
LOGICAL LDUMMA( 1 ) LOGICAL LDUMMA( 1 )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, ZLAQZ0,
$ ZLAQZ0, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR, $ ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR, ZUNMQR
$ ZUNMQR
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -301,6 +301,7 @@
* *
INFO = 0 INFO = 0
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N )
IF( IJOBVL.LE.0 ) THEN IF( IJOBVL.LE.0 ) THEN
INFO = -1 INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN ELSE IF( IJOBVR.LE.0 ) THEN
@ -315,7 +316,7 @@
INFO = -11 INFO = -11
ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
INFO = -13 INFO = -13
ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -15 INFO = -15
END IF END IF
* *
@ -323,7 +324,7 @@
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL ZGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) CALL ZGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
LWKOPT = MAX( 1, N+INT( WORK( 1 ) ) ) LWKOPT = MAX( LWKMIN, N+INT( WORK( 1 ) ) )
CALL ZUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK, CALL ZUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK,
$ -1, IERR ) $ -1, IERR )
LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
@ -348,7 +349,11 @@
$ RWORK, 0, IERR ) $ RWORK, 0, IERR )
LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
END IF END IF
WORK( 1 ) = DCMPLX( LWKOPT ) IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = DCMPLX( LWKOPT )
END IF
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -368,7 +373,6 @@
EPS = DLAMCH( 'E' )*DLAMCH( 'B' ) EPS = DLAMCH( 'E' )*DLAMCH( 'B' )
SMLNUM = DLAMCH( 'S' ) SMLNUM = DLAMCH( 'S' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
SMLNUM = SQRT( SMLNUM ) / EPS SMLNUM = SQRT( SMLNUM ) / EPS
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
* *

15
lapack-netlib/SRC/zgghd3.f
View File

@ -176,14 +176,14 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX*16 array, dimension (LWORK) *> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of the array WORK. LWORK >= 1. *> The length of the array WORK. LWORK >= 1.
*> For optimum performance LWORK >= 6*N*NB, where NB is the *> For optimum performance LWORK >= 6*N*NB, where NB is the
*> optimal blocksize. *> optimal blocksize.
*> *>
@ -208,7 +208,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16OTHERcomputational *> \ingroup gghd3
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -275,7 +275,12 @@
* *
INFO = 0 INFO = 0
NB = ILAENV( 1, 'ZGGHD3', ' ', N, ILO, IHI, -1 ) NB = ILAENV( 1, 'ZGGHD3', ' ', 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 ) = DCMPLX( LWKOPT ) WORK( 1 ) = DCMPLX( LWKOPT )
INITQ = LSAME( COMPQ, 'I' ) INITQ = LSAME( COMPQ, 'I' )
WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' )
@ -325,7 +330,6 @@
* *
* Quick return if possible * Quick return if possible
* *
NH = IHI - ILO + 1
IF( NH.LE.1 ) THEN IF( NH.LE.1 ) THEN
WORK( 1 ) = CONE WORK( 1 ) = CONE
RETURN RETURN
@ -883,6 +887,7 @@
IF ( JCOL.LT.IHI ) IF ( JCOL.LT.IHI )
$ CALL ZGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q, $ CALL ZGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q,
$ LDQ, Z, LDZ, IERR ) $ LDQ, Z, LDZ, IERR )
*
WORK( 1 ) = DCMPLX( LWKOPT ) WORK( 1 ) = DCMPLX( LWKOPT )
* *
RETURN RETURN

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

@ -173,7 +173,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16OTHERcomputational *> \ingroup ggqrf
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -250,7 +250,7 @@
NB2 = ILAENV( 1, 'ZGERQF', ' ', N, P, -1, -1 ) NB2 = ILAENV( 1, 'ZGERQF', ' ', N, P, -1, -1 )
NB3 = ILAENV( 1, 'ZUNMQR', ' ', N, M, P, -1 ) NB3 = ILAENV( 1, 'ZUNMQR', ' ', N, M, P, -1 )
NB = MAX( NB1, NB2, NB3 ) NB = MAX( NB1, NB2, NB3 )
LWKOPT = MAX( N, M, P )*NB LWKOPT = MAX( 1, MAX( N, M, P )*NB )
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LT.0 ) THEN IF( N.LT.0 ) THEN

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

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

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

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

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

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

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

@ -116,8 +116,7 @@
*> *>
*> \param[out] RWORK *> \param[out] RWORK
*> \verbatim *> \verbatim
*> RWORK is DOUBLE PRECISION array, *> RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK))
*> dimension (LRWORK)
*> On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK. *> On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
*> \endverbatim *> \endverbatim
*> *>
@ -180,7 +179,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16HEeigen *> \ingroup heevd
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================

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

@ -272,7 +272,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of the array WORK. LWORK >= max(1,2*N). *> The length of the array WORK.
*> If N <= 1, LWORK >= 1, else LWORK >= 2*N.
*> For optimal efficiency, LWORK >= (NB+1)*N, *> For optimal efficiency, LWORK >= (NB+1)*N,
*> where NB is the max of the blocksize for ZHETRD and for *> where NB is the max of the blocksize for ZHETRD and for
*> ZUNMTR as returned by ILAENV. *> ZUNMTR as returned by ILAENV.
@ -294,7 +295,8 @@
*> \param[in] LRWORK *> \param[in] LRWORK
*> \verbatim *> \verbatim
*> LRWORK is INTEGER *> LRWORK is INTEGER
*> The length of the array RWORK. LRWORK >= max(1,24*N). *> The length of the array RWORK.
*> If N <= 1, LRWORK >= 1, else LRWORK >= 24*N.
*> *>
*> If LRWORK = -1, then a workspace query is assumed; the *> If LRWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal sizes of the WORK, RWORK *> routine only calculates the optimal sizes of the WORK, RWORK
@ -313,7 +315,8 @@
*> \param[in] LIWORK *> \param[in] LIWORK
*> \verbatim *> \verbatim
*> LIWORK is INTEGER *> LIWORK is INTEGER
*> The dimension of the array IWORK. LIWORK >= max(1,10*N). *> The dimension of the array IWORK.
*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N.
*> *>
*> If LIWORK = -1, then a workspace query is assumed; the *> If LIWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal sizes of the WORK, RWORK *> routine only calculates the optimal sizes of the WORK, RWORK
@ -338,7 +341,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16HEeigen *> \ingroup heevr
* *
*> \par Contributors: *> \par Contributors:
* ================== * ==================
@ -417,9 +420,15 @@
LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR. LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR.
$ ( LIWORK.EQ.-1 ) ) $ ( LIWORK.EQ.-1 ) )
* *
LRWMIN = MAX( 1, 24*N ) IF( N.LE.1 ) THEN
LIWMIN = MAX( 1, 10*N ) LWMIN = 1
LWMIN = MAX( 1, 2*N ) LRWMIN = 1
LIWMIN = 1
ELSE
LWMIN = 2*N
LRWMIN = 24*N
LIWMIN = 10*N
END IF
* *
INFO = 0 INFO = 0
IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
@ -454,7 +463,7 @@
NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 )
NB = MAX( NB, ILAENV( 1, 'ZUNMTR', UPLO, N, -1, -1, -1 ) ) NB = MAX( NB, ILAENV( 1, 'ZUNMTR', UPLO, N, -1, -1, -1 ) )
LWKOPT = MAX( ( NB+1 )*N, LWMIN ) LWKOPT = MAX( ( NB+1 )*N, LWMIN )
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
RWORK( 1 ) = LRWMIN RWORK( 1 ) = LRWMIN
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
* *
@ -483,7 +492,7 @@
END IF END IF
* *
IF( N.EQ.1 ) THEN IF( N.EQ.1 ) THEN
WORK( 1 ) = 2 WORK( 1 ) = 1
IF( ALLEIG .OR. INDEIG ) THEN IF( ALLEIG .OR. INDEIG ) THEN
M = 1 M = 1
W( 1 ) = DBLE( A( 1, 1 ) ) W( 1 ) = DBLE( A( 1, 1 ) )
@ -710,7 +719,7 @@
* *
* Set WORK(1) to optimal workspace size. * Set WORK(1) to optimal workspace size.
* *
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
RWORK( 1 ) = LRWMIN RWORK( 1 ) = LRWMIN
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
* *

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

@ -280,6 +280,7 @@
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK.
*> If N <= 1, LWORK must be at least 1.
*> If JOBZ = 'N' and N > 1, LWORK must be queried. *> If JOBZ = 'N' and N > 1, LWORK must be queried.
*> LWORK = MAX(1, 26*N, dimension) where *> LWORK = MAX(1, 26*N, dimension) where
*> dimension = max(stage1,stage2) + (KD+1)*N + N *> dimension = max(stage1,stage2) + (KD+1)*N + N
@ -310,7 +311,8 @@
*> \param[in] LRWORK *> \param[in] LRWORK
*> \verbatim *> \verbatim
*> LRWORK is INTEGER *> LRWORK is INTEGER
*> The length of the array RWORK. LRWORK >= max(1,24*N). *> The length of the array RWORK.
*> If N <= 1, LRWORK >= 1, else LRWORK >= 24*N.
*> *>
*> If LRWORK = -1, then a workspace query is assumed; the *> If LRWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal sizes of the WORK, RWORK *> routine only calculates the optimal sizes of the WORK, RWORK
@ -329,7 +331,8 @@
*> \param[in] LIWORK *> \param[in] LIWORK
*> \verbatim *> \verbatim
*> LIWORK is INTEGER *> LIWORK is INTEGER
*> The dimension of the array IWORK. LIWORK >= max(1,10*N). *> The dimension of the array IWORK.
*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N.
*> *>
*> If LIWORK = -1, then a workspace query is assumed; the *> If LIWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal sizes of the WORK, RWORK *> routine only calculates the optimal sizes of the WORK, RWORK
@ -354,7 +357,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16HEeigen *> \ingroup heevr_2stage
* *
*> \par Contributors: *> \par Contributors:
* ================== * ==================
@ -472,9 +475,16 @@
IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 ) IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD *
LRWMIN = MAX( 1, 24*N ) IF( N.LE.1 ) THEN
LIWMIN = MAX( 1, 10*N ) LWMIN = 1
LRWMIN = 1
LIWMIN = 1
ELSE
LWMIN = N + LHTRD + LWTRD
LRWMIN = 24*N
LIWMIN = 10*N
END IF
* *
INFO = 0 INFO = 0
IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
@ -535,7 +545,7 @@
END IF END IF
* *
IF( N.EQ.1 ) THEN IF( N.EQ.1 ) THEN
WORK( 1 ) = 2 WORK( 1 ) = 1
IF( ALLEIG .OR. INDEIG ) THEN IF( ALLEIG .OR. INDEIG ) THEN
M = 1 M = 1
W( 1 ) = DBLE( A( 1, 1 ) ) W( 1 ) = DBLE( A( 1, 1 ) )

15
lapack-netlib/SRC/zhesv_aa.f
View File

@ -128,7 +128,7 @@
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of WORK. LWORK >= MAX(1,2*N,3*N-2), and for best *> The length of WORK. LWORK >= MAX(1,2*N,3*N-2), and for best
*> performance LWORK >= max(1,N*NB), where NB is the optimal *> performance LWORK >= max(1,N*NB), where NB is the optimal
*> blocksize for ZHETRF. *> blocksize for ZHETRF_AA.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
@ -154,7 +154,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16HEsolve *> \ingroup hesv_aa
* *
* ===================================================================== * =====================================================================
SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
@ -177,7 +177,7 @@
* *
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER LWKOPT, LWKOPT_HETRF, LWKOPT_HETRS INTEGER LWKMIN, LWKOPT, LWKOPT_HETRF, LWKOPT_HETRS
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -196,6 +196,7 @@
* *
INFO = 0 INFO = 0
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N, 3*N-2 )
IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
@ -206,17 +207,17 @@
INFO = -5 INFO = -5
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -8 INFO = -8
ELSE IF( LWORK.LT.MAX(2*N, 3*N-2) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10 INFO = -10
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) CALL ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
LWKOPT_HETRF = INT( WORK(1) ) LWKOPT_HETRF = INT( WORK( 1 ) )
CALL ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, CALL ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
$ -1, INFO ) $ -1, INFO )
LWKOPT_HETRS = INT( WORK(1) ) LWKOPT_HETRS = INT( WORK( 1 ) )
LWKOPT = MAX( LWKOPT_HETRF, LWKOPT_HETRS ) LWKOPT = MAX( LWKMIN, LWKOPT_HETRF, LWKOPT_HETRS )
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
END IF END IF
* *

23
lapack-netlib/SRC/zhesv_aa_2stage.f
View File

@ -100,14 +100,14 @@
*> *>
*> \param[out] TB *> \param[out] TB
*> \verbatim *> \verbatim
*> TB is COMPLEX*16 array, dimension (LTB) *> TB is COMPLEX*16 array, dimension (MAX(1,LTB)).
*> On exit, details of the LU factorization of the band matrix. *> On exit, details of the LU factorization of the band matrix.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LTB *> \param[in] LTB
*> \verbatim *> \verbatim
*> LTB is INTEGER *> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally *> The size of the array TB. LTB >= MAX(1,4*N), internally
*> used to select NB such that LTB >= (3*NB+1)*N. *> used to select NB such that LTB >= (3*NB+1)*N.
*> *>
*> If LTB = -1, then a workspace query is assumed; the *> If LTB = -1, then a workspace query is assumed; the
@ -147,14 +147,15 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX*16 workspace of size LWORK *> WORK is COMPLEX*16 workspace of size (MAX(1,LWORK)).
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB *> The size of WORK. LWORK >= MAX(1,N), internally used to
*> such that LWORK >= N*NB. *> select NB such that LWORK >= N*NB.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the *> If LWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the WORK array, *> routine only calculates the optimal size of the WORK array,
@ -178,7 +179,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16HEsolve *> \ingroup hesv_aa_2stage
* *
* ===================================================================== * =====================================================================
SUBROUTINE ZHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, SUBROUTINE ZHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
@ -208,7 +209,7 @@
* *
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL UPPER, TQUERY, WQUERY LOGICAL UPPER, TQUERY, WQUERY
INTEGER LWKOPT INTEGER LWKOPT, LWKMIN
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -229,6 +230,7 @@
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
WQUERY = ( LWORK.EQ.-1 ) WQUERY = ( LWORK.EQ.-1 )
TQUERY = ( LTB.EQ.-1 ) TQUERY = ( LTB.EQ.-1 )
LWKMIN = MAX( 1, N )
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
@ -237,18 +239,19 @@
INFO = -3 INFO = -3
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -5 INFO = -5
ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN
INFO = -7 INFO = -7
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -11 INFO = -11
ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.WQUERY ) THEN
INFO = -13 INFO = -13
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV, CALL ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
$ IPIV2, WORK, -1, INFO ) $ IPIV2, WORK, -1, INFO )
LWKOPT = INT( WORK(1) ) LWKOPT = MAX( LWKMIN, INT( WORK( 1 ) ) )
WORK( 1 ) = LWKOPT
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN

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

@ -234,8 +234,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of WORK. LWORK >= max(1,2*N), and for best *> The length of WORK. LWORK >= MAX(1,2*N), and for best
*> performance, when FACT = 'N', LWORK >= max(1,2*N,N*NB), where *> performance, when FACT = 'N', LWORK >= MAX(1,2*N,N*NB), where
*> NB is the optimal blocksize for ZHETRF. *> NB is the optimal blocksize for ZHETRF.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
@ -276,7 +276,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16HEsolve *> \ingroup hesvx
* *
* ===================================================================== * =====================================================================
SUBROUTINE ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, SUBROUTINE ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B,
@ -307,7 +307,7 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY, NOFACT LOGICAL LQUERY, NOFACT
INTEGER LWKOPT, NB INTEGER LWKOPT, LWKMIN, NB
DOUBLE PRECISION ANORM DOUBLE PRECISION ANORM
* .. * ..
* .. External Functions .. * .. External Functions ..
@ -329,6 +329,7 @@
INFO = 0 INFO = 0
NOFACT = LSAME( FACT, 'N' ) NOFACT = LSAME( FACT, 'N' )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N )
IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
@ -346,12 +347,12 @@
INFO = -11 INFO = -11
ELSE IF( LDX.LT.MAX( 1, N ) ) THEN ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
INFO = -13 INFO = -13
ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -18 INFO = -18
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
LWKOPT = MAX( 1, 2*N ) LWKOPT = LWKMIN
IF( NOFACT ) THEN IF( NOFACT ) THEN
NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 )
LWKOPT = MAX( LWKOPT, N*NB ) LWKOPT = MAX( LWKOPT, N*NB )

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

@ -123,7 +123,7 @@
*> *>
*> \param[out] HOUS2 *> \param[out] HOUS2
*> \verbatim *> \verbatim
*> HOUS2 is COMPLEX*16 array, dimension (LHOUS2) *> HOUS2 is COMPLEX*16 array, dimension (MAX(1,LHOUS2))
*> Stores the Householder representation of the stage2 *> Stores the Householder representation of the stage2
*> band to tridiagonal. *> band to tridiagonal.
*> \endverbatim *> \endverbatim
@ -132,6 +132,8 @@
*> \verbatim *> \verbatim
*> LHOUS2 is INTEGER *> LHOUS2 is INTEGER
*> The dimension of the array HOUS2. *> The dimension of the array HOUS2.
*> LHOUS2 >= 1.
*>
*> If LWORK = -1, or LHOUS2 = -1, *> If LWORK = -1, or LHOUS2 = -1,
*> then a query is assumed; the routine *> then a query is assumed; the routine
*> only calculates the optimal size of the HOUS2 array, returns *> only calculates the optimal size of the HOUS2 array, returns
@ -143,14 +145,17 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX*16 array, dimension (LWORK) *> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK = MAX(1, dimension) *> The dimension of the array WORK.
*> If LWORK = -1, or LHOUS2=-1, *> If N = 0, LWORK >= 1, else LWORK = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS2 = -1,
*> then a workspace query is assumed; the routine *> then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
@ -182,7 +187,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16HEcomputational *> \ingroup hetrd_2stage
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -265,10 +270,13 @@
* *
KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', VECT, N, -1, -1, -1 ) KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', VECT, N, -1, -1, -1 )
IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', VECT, N, KD, -1, -1 ) IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', VECT, N, KD, -1, -1 )
LHMIN = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 ) IF( N.EQ.0 ) THEN
LWMIN = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 ) LHMIN = 1
* WRITE(*,*),'ZHETRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO, LWMIN = 1
* $ LHMIN, LWMIN ELSE
LHMIN = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 )
END IF
* *
IF( .NOT.LSAME( VECT, 'N' ) ) THEN IF( .NOT.LSAME( VECT, 'N' ) ) THEN
INFO = -1 INFO = -1
@ -324,7 +332,6 @@
END IF END IF
* *
* *
HOUS2( 1 ) = LHMIN
WORK( 1 ) = LWMIN WORK( 1 ) = LWMIN
RETURN RETURN
* *

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

@ -132,15 +132,17 @@
*> *>
*> \param[out] HOUS *> \param[out] HOUS
*> \verbatim *> \verbatim
*> HOUS is COMPLEX*16 array, dimension LHOUS, that *> HOUS is COMPLEX*16 array, dimension (MAX(1,LHOUS))
*> store the Householder representation. *> Stores the Householder representation.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LHOUS *> \param[in] LHOUS
*> \verbatim *> \verbatim
*> LHOUS is INTEGER *> LHOUS is INTEGER
*> The dimension of the array HOUS. LHOUS = MAX(1, dimension) *> The dimension of the array HOUS.
*> If LWORK = -1, or LHOUS=-1, *> If N = 0 or KD <= 1, LHOUS >= 1, else LHOUS = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS = -1,
*> then a query is assumed; the routine *> then a query is assumed; the routine
*> only calculates the optimal size of the HOUS array, returns *> only calculates the optimal size of the HOUS array, returns
*> this value as the first entry of the HOUS array, and no error *> this value as the first entry of the HOUS array, and no error
@ -152,14 +154,17 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX*16 array, dimension LWORK. *> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)).
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK = MAX(1, dimension) *> The dimension of the array WORK.
*> If LWORK = -1, or LHOUS=-1, *> If N = 0 or KD <= 1, LWORK >= 1, else LWORK = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS = -1,
*> then a workspace query is assumed; the routine *> then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
@ -188,7 +193,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16OTHERcomputational *> \ingroup hetrd_hb2st
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -262,7 +267,7 @@
INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST, INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST,
$ ED, STIND, EDIND, BLKLASTIND, COLPT, THED, $ ED, STIND, EDIND, BLKLASTIND, COLPT, THED,
$ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID, $ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID,
$ NBTILES, TTYPE, TID, NTHREADS, DEBUG, $ NBTILES, TTYPE, TID, NTHREADS,
$ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS, $ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS,
$ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU, $ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU,
$ SIZEV, SIZETAU, LDV, LHMIN, LWMIN $ SIZEV, SIZETAU, LDV, LHMIN, LWMIN
@ -285,7 +290,6 @@
* Determine the minimal workspace size required. * Determine the minimal workspace size required.
* Test the input parameters * Test the input parameters
* *
DEBUG = 0
INFO = 0 INFO = 0
AFTERS1 = LSAME( STAGE1, 'Y' ) AFTERS1 = LSAME( STAGE1, 'Y' )
WANTQ = LSAME( VECT, 'V' ) WANTQ = LSAME( VECT, 'V' )
@ -294,9 +298,14 @@
* *
* Determine the block size, the workspace size and the hous size. * Determine the block size, the workspace size and the hous size.
* *
IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', VECT, N, KD, -1, -1 ) IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', VECT, N, KD, -1, -1 )
LHMIN = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 ) IF( N.EQ.0 .OR. KD.LE.1 ) THEN
LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 ) LHMIN = 1
LWMIN = 1
ELSE
LHMIN = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 )
END IF
* *
IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN
INFO = -1 INFO = -1
@ -575,7 +584,6 @@ C END IF
170 CONTINUE 170 CONTINUE
ENDIF ENDIF
* *
HOUS( 1 ) = LHMIN
WORK( 1 ) = LWMIN WORK( 1 ) = LWMIN
RETURN RETURN
* *

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

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

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

@ -107,7 +107,7 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of WORK. LWORK >=1. For best performance *> The length of WORK. LWORK >= 1. For best performance
*> LWORK >= N*NB, where NB is the block size returned by ILAENV. *> LWORK >= N*NB, where NB is the block size returned by ILAENV.
*> \endverbatim *> \endverbatim
*> *>
@ -130,7 +130,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16HEcomputational *> \ingroup hetrf
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -227,7 +227,7 @@
* Determine the block size * Determine the block size
* *
NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 )
LWKOPT = N*NB LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
END IF END IF
* *
@ -346,6 +346,7 @@
END IF END IF
* *
40 CONTINUE 40 CONTINUE
*
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
RETURN RETURN
* *

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

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

28
lapack-netlib/SRC/zhetrf_aa_2stage.f
View File

@ -87,14 +87,14 @@
*> *>
*> \param[out] TB *> \param[out] TB
*> \verbatim *> \verbatim
*> TB is COMPLEX*16 array, dimension (LTB) *> TB is COMPLEX*16 array, dimension (MAX(1,LTB))
*> On exit, details of the LU factorization of the band matrix. *> On exit, details of the LU factorization of the band matrix.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LTB *> \param[in] LTB
*> \verbatim *> \verbatim
*> LTB is INTEGER *> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally *> The size of the array TB. LTB >= MAX(1,4*N), internally
*> used to select NB such that LTB >= (3*NB+1)*N. *> used to select NB such that LTB >= (3*NB+1)*N.
*> *>
*> If LTB = -1, then a workspace query is assumed; the *> If LTB = -1, then a workspace query is assumed; the
@ -121,14 +121,14 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX*16 workspace of size LWORK *> WORK is COMPLEX*16 workspace of size (MAX(1,LWORK))
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB *> The size of WORK. LWORK >= MAX(1,N), internally used to
*> such that LWORK >= N*NB. *> select NB such that LWORK >= N*NB.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the *> If LWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the WORK array, *> routine only calculates the optimal size of the WORK array,
@ -152,7 +152,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complex16SYcomputational *> \ingroup hetrf_aa_2stage
* *
* ===================================================================== * =====================================================================
SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
@ -182,7 +182,7 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL UPPER, TQUERY, WQUERY LOGICAL UPPER, TQUERY, WQUERY
INTEGER I, J, K, I1, I2, TD INTEGER I, J, K, I1, I2, TD
INTEGER LDTB, NB, KB, JB, NT, IINFO INTEGER LWKOPT, LDTB, NB, KB, JB, NT, IINFO
COMPLEX*16 PIV COMPLEX*16 PIV
* .. * ..
* .. External Functions .. * .. External Functions ..
@ -212,9 +212,9 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4 INFO = -4
ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN
INFO = -6 INFO = -6
ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN
INFO = -10 INFO = -10
END IF END IF
* *
@ -228,10 +228,10 @@
NB = ILAENV( 1, 'ZHETRF_AA_2STAGE', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'ZHETRF_AA_2STAGE', UPLO, N, -1, -1, -1 )
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
IF( TQUERY ) THEN IF( TQUERY ) THEN
TB( 1 ) = (3*NB+1)*N TB( 1 ) = MAX( 1, (3*NB+1)*N )
END IF END IF
IF( WQUERY ) THEN IF( WQUERY ) THEN
WORK( 1 ) = N*NB WORK( 1 ) = MAX( 1, N*NB )
END IF END IF
END IF END IF
IF( TQUERY .OR. WQUERY ) THEN IF( TQUERY .OR. WQUERY ) THEN
@ -240,7 +240,7 @@
* *
* Quick return * Quick return
* *
IF ( N.EQ.0 ) THEN IF( N.EQ.0 ) THEN
RETURN RETURN
ENDIF ENDIF
* *
@ -392,7 +392,7 @@
CALL ZGETRF( N-(J+1)*NB, NB, CALL ZGETRF( N-(J+1)*NB, NB,
$ WORK, N, $ WORK, N,
$ IPIV( (J+1)*NB+1 ), IINFO ) $ IPIV( (J+1)*NB+1 ), IINFO )
c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN c IF( IINFO.NE.0 .AND. INFO.EQ.0 ) THEN
c INFO = IINFO+(J+1)*NB c INFO = IINFO+(J+1)*NB
c END IF c END IF
* *
@ -587,7 +587,7 @@ c END IF
CALL ZGETRF( N-(J+1)*NB, NB, CALL ZGETRF( N-(J+1)*NB, NB,
$ A( (J+1)*NB+1, J*NB+1 ), LDA, $ A( (J+1)*NB+1, J*NB+1 ), LDA,
$ IPIV( (J+1)*NB+1 ), IINFO ) $ IPIV( (J+1)*NB+1 ), IINFO )
c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN c IF( IINFO.NE.0 .AND. INFO.EQ.0 ) THEN
c INFO = IINFO+(J+1)*NB c INFO = IINFO+(J+1)*NB
c END IF c END IF
* *

8
lapack-netlib/SRC/zhetrf_rk.f
View File

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

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

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

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

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

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

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

68
lapack-netlib/SRC/zlamswlq.f
View File

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

76
lapack-netlib/SRC/zlamtsqr.f
View File

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

91
lapack-netlib/SRC/zlaswlq.f
View File

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

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

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

95
lapack-netlib/SRC/zlatsqr.f
View File

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