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

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

This commit is contained in:
Martin Kroeker 2023-12-23 19:37:03 +01:00 committed by GitHub
parent 5c11b2ff41
commit 0814491d96
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
47 changed files with 783 additions and 533 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -123,7 +123,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.
*> *>
@ -148,7 +149,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complexGEcomputational *> \ingroup gebrd
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -225,8 +226,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 CGEBD2, CGEMM, CLABRD, XERBLA EXTERNAL CGEBD2, CGEMM, CLABRD, XERBLA
@ -236,16 +237,24 @@
* .. * ..
* .. External Functions .. * .. External Functions ..
INTEGER ILAENV INTEGER ILAENV
EXTERNAL ILAENV REAL SROUNDUP_LWORK
EXTERNAL ILAENV, SROUNDUP_LWORK
* .. * ..
* .. Executable Statements .. * .. Executable Statements ..
* *
* Test the input parameters * Test the input parameters
* *
INFO = 0 INFO = 0
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = MAX( M, N )
NB = MAX( 1, ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) ) NB = MAX( 1, ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) )
LWKOPT = ( M+N )*NB LWKOPT = ( M+N )*NB
WORK( 1 ) = REAL( LWKOPT ) END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
@ -253,7 +262,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
@ -265,7 +274,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
@ -284,7 +292,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
@ -343,7 +351,7 @@
* *
CALL CGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ), CALL CGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ),
$ TAUQ( I ), TAUP( I ), WORK, IINFO ) $ TAUQ( I ), TAUP( I ), WORK, IINFO )
WORK( 1 ) = WS WORK( 1 ) = SROUNDUP_LWORK( WS )
RETURN RETURN
* *
* End of CGEBRD * End of CGEBRD

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

@ -89,7 +89,7 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX array, dimension (LWORK) *> WORK is COMPLEX 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
*> *>
@ -222,13 +222,19 @@
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, 'CGEHRD', ' ', N, ILO, IHI, -1 ) ) IF( NH.LE.1 ) THEN
LWKOPT = 1
ELSE
NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI,
$ -1 ) )
LWKOPT = N*NB + TSIZE LWKOPT = N*NB + TSIZE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -249,7 +255,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
@ -269,7 +274,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
@ -345,7 +350,8 @@
* Use unblocked code to reduce the rest of the matrix * Use unblocked code to reduce the rest of the matrix
* *
CALL CGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO ) CALL CGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) *
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

8
lapack-netlib/SRC/cgelq.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
@ -295,9 +295,9 @@
T( 2 ) = MB T( 2 ) = MB
T( 3 ) = NB T( 3 ) = NB
IF( MINW ) THEN IF( MINW ) THEN
WORK( 1 ) = SROUNDUP_LWORK(LWMIN) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
ELSE ELSE
WORK( 1 ) = SROUNDUP_LWORK(LWREQ) WORK( 1 ) = SROUNDUP_LWORK( LWREQ )
END IF END IF
END IF END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -322,7 +322,7 @@
$ LWORK, INFO ) $ LWORK, INFO )
END IF END IF
* *
WORK( 1 ) = SROUNDUP_LWORK(LWREQ) WORK( 1 ) = SROUNDUP_LWORK( LWREQ )
* *
RETURN RETURN
* *

20
lapack-netlib/SRC/cgelqf.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.
*> *>
@ -175,9 +176,8 @@
* Test the input arguments * Test the input arguments
* *
INFO = 0 INFO = 0
K = MIN( M, N )
NB = ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 ) NB = ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 )
LWKOPT = M*NB
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
@ -185,19 +185,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( 'CGELQF', -INFO ) CALL XERBLA( 'CGELQF', -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 ) = SROUNDUP_LWORK( 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
@ -267,7 +273,7 @@
$ CALL CGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK, $ CALL CGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
$ IINFO ) $ IINFO )
* *
WORK( 1 ) = SROUNDUP_LWORK(IWS) WORK( 1 ) = SROUNDUP_LWORK( IWS )
RETURN RETURN
* *
* End of CGELQF * End of CGELQF

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

@ -111,12 +111,13 @@
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) *> (workspace) COMPLEX 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
@ -164,6 +165,8 @@
*> Further Details in CLAMSWLQ or CGEMLQT. *> Further Details in CLAMSWLQ or CGEMLQT.
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup gemlq
*>
* ===================================================================== * =====================================================================
SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
$ C, LDC, WORK, LWORK, INFO ) $ C, LDC, WORK, LWORK, INFO )
@ -185,11 +188,12 @@
* .. * ..
* .. 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
EXTERNAL LSAME REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CLAMSWLQ, CGEMLQT, XERBLA EXTERNAL CLAMSWLQ, CGEMLQT, XERBLA
@ -201,7 +205,7 @@
* *
* Test the input arguments * Test the input arguments
* *
LQUERY = LWORK.EQ.-1 LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' ) NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' ) TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' ) LEFT = LSAME( SIDE, 'L' )
@ -216,6 +220,13 @@
LW = M * MB LW = M * MB
MN = N MN = N
END IF END IF
*
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
* *
IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
@ -244,12 +255,12 @@
INFO = -9 INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -11 INFO = -11
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN ELSE IF( ( LWORK.LT.LWMIN ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13 INFO = -13
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
WORK( 1 ) = REAL( LW ) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -261,7 +272,7 @@
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN( M, N, K ).EQ.0 ) THEN IF( MINMNK.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
@ -274,7 +285,7 @@
$ MB, C, LDC, WORK, LWORK, INFO ) $ MB, C, LDC, WORK, LWORK, INFO )
END IF END IF
* *
WORK( 1 ) = REAL( LW ) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
* *
RETURN RETURN
* *

25
lapack-netlib/SRC/cgemqr.f
View File

@ -112,12 +112,13 @@
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) *> (workspace) COMPLEX 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 CGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
$ C, LDC, WORK, LWORK, INFO ) $ C, LDC, WORK, LWORK, INFO )
@ -187,11 +190,12 @@
* .. * ..
* .. 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
EXTERNAL LSAME REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CGEMQRT, CLAMTSQR, XERBLA EXTERNAL CGEMQRT, CLAMTSQR, XERBLA
@ -203,7 +207,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 +222,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
@ -251,7 +262,7 @@
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LW WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -263,7 +274,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 +287,7 @@
$ NB, C, LDC, WORK, LWORK, INFO ) $ NB, C, LDC, WORK, LWORK, INFO )
END IF END IF
* *
WORK( 1 ) = LW WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
* *
RETURN RETURN
* *

12
lapack-netlib/SRC/cgeqlf.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.
*> *>
@ -187,10 +188,11 @@
NB = ILAENV( 1, 'CGEQLF', ' ', M, N, -1, -1 ) NB = ILAENV( 1, 'CGEQLF', ' ', M, N, -1, -1 )
LWKOPT = N*NB LWKOPT = N*NB
END IF END IF
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( 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
* *
@ -277,7 +279,7 @@
IF( MU.GT.0 .AND. NU.GT.0 ) IF( MU.GT.0 .AND. NU.GT.0 )
$ CALL CGEQL2( MU, NU, A, LDA, TAU, WORK, IINFO ) $ CALL CGEQL2( MU, NU, A, LDA, TAU, WORK, IINFO )
* *
WORK( 1 ) = SROUNDUP_LWORK(IWS) WORK( 1 ) = SROUNDUP_LWORK( IWS )
RETURN RETURN
* *
* End of CGEQLF * End of CGEQLF

24
lapack-netlib/SRC/cgeqp3rk.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 CGEQP3RK returned *> where NB is the optimal block size for CGEQP3RK returned
*> by ILAENV. Minimal block size MINNB=2. *> by ILAENV. Minimal block size MINNB=2.
@ -627,8 +628,9 @@
* .. External Functions .. * .. External Functions ..
LOGICAL SISNAN LOGICAL SISNAN
INTEGER ISAMAX, ILAENV INTEGER ISAMAX, ILAENV
REAL SLAMCH, SCNRM2 REAL SLAMCH, SCNRM2, SROUNDUP_LWORK
EXTERNAL SISNAN, SLAMCH, SCNRM2, ISAMAX, ILAENV EXTERNAL SISNAN, SLAMCH, SCNRM2, ISAMAX, ILAENV,
$ SROUNDUP_LWORK
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC CMPLX, MAX, MIN INTRINSIC CMPLX, MAX, MIN
@ -703,7 +705,7 @@
* *
LWKOPT = 2*N + NB*( N+NRHS+1 ) LWKOPT = 2*N + NB*( N+NRHS+1 )
END IF END IF
WORK( 1 ) = CMPLX( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
INFO = -15 INFO = -15
@ -726,7 +728,7 @@
K = 0 K = 0
MAXC2NRMK = ZERO MAXC2NRMK = ZERO
RELMAXC2NRMK = ZERO RELMAXC2NRMK = ZERO
WORK( 1 ) = CMPLX( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
END IF END IF
* *
@ -778,7 +780,7 @@
* *
* Array TAU is not set and contains undefined elements. * Array TAU is not set and contains undefined elements.
* *
WORK( 1 ) = CMPLX( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
END IF END IF
* *
@ -797,7 +799,7 @@
TAU( J ) = CZERO TAU( J ) = CZERO
END DO END DO
* *
WORK( 1 ) = CMPLX( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
* *
END IF END IF
@ -828,7 +830,7 @@
DO J = 1, MINMN DO J = 1, MINMN
TAU( J ) = CZERO TAU( J ) = CZERO
END DO END DO
WORK( 1 ) = CMPLX( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
END IF END IF
* *
@ -873,7 +875,7 @@
TAU( J ) = CZERO TAU( J ) = CZERO
END DO END DO
* *
WORK( 1 ) = CMPLX( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
END IF END IF
* *
@ -991,7 +993,7 @@
* *
* Return from the routine. * Return from the routine.
* *
WORK( 1 ) = CMPLX( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *
@ -1082,7 +1084,7 @@
* *
END IF END IF
* *
WORK( 1 ) = CMPLX( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

23
lapack-netlib/SRC/cgeqr.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 CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
$ INFO ) $ INFO )
@ -188,11 +190,12 @@
* .. * ..
* .. 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
EXTERNAL LSAME REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CLATSQR, CGEQRT, XERBLA EXTERNAL CLATSQR, CGEQRT, XERBLA
@ -244,8 +247,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 +258,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 +273,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 +287,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 ) = SROUNDUP_LWORK( LWMIN )
ELSE ELSE
WORK( 1 ) = MAX( 1, NB*N ) WORK( 1 ) = SROUNDUP_LWORK( LWREQ )
END IF END IF
END IF END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -309,7 +314,7 @@
$ LWORK, INFO ) $ LWORK, INFO )
END IF END IF
* *
WORK( 1 ) = MAX( 1, NB*N ) WORK( 1 ) = SROUNDUP_LWORK( LWREQ )
* *
RETURN RETURN
* *

24
lapack-netlib/SRC/cgeqrfp.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.
*> *>
@ -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 CGEQR2P, CLARFB, CLARFT, XERBLA EXTERNAL CGEQR2P, CLARFB, CLARFT, XERBLA
@ -182,8 +183,16 @@
* *
INFO = 0 INFO = 0
NB = ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 ) NB = ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 )
K = MIN( M, N )
IF( K.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = N
LWKOPT = N*NB LWKOPT = N*NB
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
@ -191,7 +200,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
@ -203,7 +212,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
@ -211,7 +219,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.
@ -273,7 +281,7 @@
$ CALL CGEQR2P( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK, $ CALL CGEQR2P( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
$ IINFO ) $ IINFO )
* *
WORK( 1 ) = SROUNDUP_LWORK(IWS) WORK( 1 ) = SROUNDUP_LWORK( IWS )
RETURN RETURN
* *
* End of CGEQRFP * End of CGEQRFP

14
lapack-netlib/SRC/cgesvdx.f
View File

@ -208,7 +208,7 @@
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) *> WORK is COMPLEX 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
@ -261,7 +261,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complexGEsing *> \ingroup gesvdx
* *
* ===================================================================== * =====================================================================
SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
@ -312,8 +312,8 @@
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER ILAENV INTEGER ILAENV
REAL SLAMCH, CLANGE REAL SLAMCH, CLANGE, SROUNDUP_LWORK
EXTERNAL LSAME, ILAENV, SLAMCH, CLANGE EXTERNAL LSAME, ILAENV, SLAMCH, CLANGE, SROUNDUP_LWORK
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC MAX, MIN, SQRT INTRINSIC MAX, MIN, SQRT
@ -448,7 +448,7 @@
END IF END IF
END IF END IF
MAXWRK = MAX( MAXWRK, MINWRK ) MAXWRK = MAX( MAXWRK, MINWRK )
WORK( 1 ) = CMPLX( REAL( MAXWRK ), ZERO ) WORK( 1 ) = SROUNDUP_LWORK( MAXWRK )
* *
IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
INFO = -19 INFO = -19
@ -464,7 +464,7 @@
* *
* Quick return if possible * Quick return if possible
* *
IF( M.EQ.0 .OR. N.EQ.0 ) THEN IF( MINMN.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
@ -846,7 +846,7 @@
* *
* Return optimal workspace in WORK(1) * Return optimal workspace in WORK(1)
* *
WORK( 1 ) = CMPLX( REAL( MAXWRK ), ZERO ) WORK( 1 ) = SROUNDUP_LWORK( MAXWRK )
* *
RETURN RETURN
* *

52
lapack-netlib/SRC/cgesvj.f
View File

@ -208,15 +208,17 @@
*> \verbatim *> \verbatim
*> CWORK is COMPLEX array, dimension (max(1,LWORK)) *> CWORK is COMPLEX 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 complexGEcomputational *> \ingroup gesvj
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -381,7 +385,8 @@
$ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN, TOL $ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN, TOL
INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1, INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
$ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34, $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34,
$ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, SWBAND $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, SWBAND,
$ MINMN, LWMIN, LRWMIN
LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, ROTOK, LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, ROTOK,
$ RSVEC, UCTOL, UPPER $ RSVEC, UCTOL, UPPER
* .. * ..
@ -398,8 +403,8 @@
INTEGER ISAMAX INTEGER ISAMAX
EXTERNAL ISAMAX EXTERNAL ISAMAX
* from LAPACK * from LAPACK
REAL SLAMCH REAL SLAMCH, SROUNDUP_LWORK
EXTERNAL SLAMCH EXTERNAL SLAMCH, SROUNDUP_LWORK
LOGICAL LSAME LOGICAL LSAME
EXTERNAL LSAME EXTERNAL LSAME
* .. * ..
@ -422,7 +427,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 +456,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 +468,15 @@
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGESVJ', -INFO ) CALL XERBLA( 'CGESVJ', -INFO )
RETURN RETURN
ELSE IF ( LQUERY ) THEN ELSE IF( LQUERY ) THEN
CWORK(1) = M + N CWORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RWORK(1) = MAX( N, 6 ) RWORK( 1 ) = SROUNDUP_LWORK( 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

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

@ -153,8 +153,8 @@
* *
INFO = 0 INFO = 0
NB = ILAENV( 1, 'CGETRI', ' ', N, -1, -1, -1 ) NB = ILAENV( 1, 'CGETRI', ' ', N, -1, -1, -1 )
LWKOPT = N*NB LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LT.0 ) THEN IF( N.LT.0 ) THEN
INFO = -1 INFO = -1
@ -252,7 +252,7 @@
$ CALL CSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 ) $ CALL CSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 )
60 CONTINUE 60 CONTINUE
* *
WORK( 1 ) = SROUNDUP_LWORK(IWS) WORK( 1 ) = SROUNDUP_LWORK( IWS )
RETURN RETURN
* *
* End of CGETRI * End of CGETRI

7
lapack-netlib/SRC/cgetsls.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).
@ -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 CGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 ) CALL CGEQR( 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 ) )

23
lapack-netlib/SRC/cgetsqrhrt.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 comlpexOTHERcomputational *> \ingroup getsqrhrt
* *
*> \par Contributors: *> \par Contributors:
* ================== * ==================
@ -200,6 +202,10 @@
INTEGER I, IINFO, J, LW1, LW2, LWT, LDWT, LWORKOPT, INTEGER I, IINFO, J, LW1, LW2, LWT, LDWT, LWORKOPT,
$ NB1LOCAL, NB2LOCAL, NUM_ALL_ROW_BLOCKS $ NB1LOCAL, NB2LOCAL, NUM_ALL_ROW_BLOCKS
* .. * ..
* .. External Functions ..
REAL SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CCOPY, CLATSQR, CUNGTSQR_ROW, CUNHR_COL, EXTERNAL CCOPY, CLATSQR, CUNGTSQR_ROW, CUNHR_COL,
$ XERBLA $ XERBLA
@ -212,7 +218,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
@ -263,8 +269,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
* *
@ -277,14 +284,14 @@
CALL XERBLA( 'CGETSQRHRT', -INFO ) CALL XERBLA( 'CGETSQRHRT', -INFO )
RETURN RETURN
ELSE IF ( LQUERY ) THEN ELSE IF ( LQUERY ) THEN
WORK( 1 ) = CMPLX( LWORKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT )
RETURN RETURN
END IF END IF
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN( M, N ).EQ.0 ) THEN IF( MIN( M, N ).EQ.0 ) THEN
WORK( 1 ) = CMPLX( LWORKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT )
RETURN RETURN
END IF END IF
* *
@ -341,7 +348,7 @@
END IF END IF
END DO END DO
* *
WORK( 1 ) = CMPLX( LWORKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT )
RETURN RETURN
* *
* End of CGETSQRHRT * End of CGETSQRHRT

40
lapack-netlib/SRC/cgges3.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 complexGEeigen *> \ingroup gges3
* *
* ===================================================================== * =====================================================================
SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, SUBROUTINE CGGES3( 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
REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL, REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL,
$ PVSR, SMLNUM $ PVSR, SMLNUM
* .. * ..
@ -310,13 +312,12 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY, EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY,
$ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, SLABAD, $ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, XERBLA
$ XERBLA
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
REAL CLANGE, SLAMCH REAL CLANGE, SLAMCH, SROUNDUP_LWORK
EXTERNAL LSAME, CLANGE, SLAMCH EXTERNAL LSAME, CLANGE, SLAMCH, SROUNDUP_LWORK
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC MAX, SQRT INTRINSIC MAX, SQRT
@ -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,29 +380,33 @@
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL CGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) CALL CGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
LWKOPT = MAX( 1, N + INT ( WORK( 1 ) ) ) LWKOPT = MAX( LWKMIN, N + INT( WORK( 1 ) ) )
CALL CUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK, CALL CUNMQR( '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 CUNGQR( N, N, N, VSL, LDVSL, WORK, WORK, -1, CALL CUNGQR( N, N, N, VSL, LDVSL, WORK, WORK, -1,
$ IERR ) $ IERR )
LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) )
END IF END IF
CALL CGGHD3( JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, VSL, CALL CGGHD3( 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 CLAQZ0( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, CALL CLAQZ0( '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 CTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, CALL CTGSEN( 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 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
WORK( 1 ) = CMPLX( LWKOPT )
END IF END IF
* *
@ -422,7 +429,6 @@
EPS = SLAMCH( 'P' ) EPS = SLAMCH( 'P' )
SMLNUM = SLAMCH( 'S' ) SMLNUM = SLAMCH( 'S' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
CALL SLABAD( SMLNUM, BIGNUM )
SMLNUM = SQRT( SMLNUM ) / EPS SMLNUM = SQRT( SMLNUM ) / EPS
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
* *
@ -585,7 +591,7 @@
* *
30 CONTINUE 30 CONTINUE
* *
WORK( 1 ) = CMPLX( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

28
lapack-netlib/SRC/cggev3.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 complexGEeigen *> \ingroup ggev3
* *
* ===================================================================== * =====================================================================
SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, SUBROUTINE CGGEV3( 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 $ LWKOPT, LWKMIN
REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
$ SMLNUM, TEMP $ SMLNUM, TEMP
COMPLEX X COMPLEX X
@ -253,13 +254,12 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY, EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY,
$ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, SLABAD, $ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, XERBLA
$ XERBLA
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
REAL CLANGE, SLAMCH REAL CLANGE, SLAMCH, SROUNDUP_LWORK
EXTERNAL LSAME, CLANGE, SLAMCH EXTERNAL LSAME, CLANGE, SLAMCH, SROUNDUP_LWORK
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, AIMAG, MAX, REAL, SQRT INTRINSIC ABS, AIMAG, MAX, REAL, SQRT
@ -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 CGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) CALL CGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
LWKOPT = MAX( N, N+INT( WORK( 1 ) ) ) LWKOPT = MAX( LWKMIN, N+INT( WORK( 1 ) ) )
CALL CUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK, CALL CUNMQR( '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 ) = CMPLX( LWKOPT ) IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -368,7 +373,6 @@
EPS = SLAMCH( 'E' )*SLAMCH( 'B' ) EPS = SLAMCH( 'E' )*SLAMCH( 'B' )
SMLNUM = SLAMCH( 'S' ) SMLNUM = SLAMCH( 'S' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
CALL SLABAD( SMLNUM, BIGNUM )
SMLNUM = SQRT( SMLNUM ) / EPS SMLNUM = SQRT( SMLNUM ) / EPS
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
* *
@ -549,7 +553,7 @@
IF( ILBSCL ) IF( ILBSCL )
$ CALL CLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR ) $ CALL CLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
* *
WORK( 1 ) = CMPLX( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
* *
* End of CGGEV3 * End of CGGEV3

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

@ -180,7 +180,7 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX array, dimension (LWORK) *> WORK is COMPLEX 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
*> *>
@ -212,7 +212,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complexOTHERcomputational *> \ingroup gghd3
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -265,7 +265,8 @@
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER ILAENV INTEGER ILAENV
EXTERNAL ILAENV, LSAME REAL SROUNDUP_LWORK
EXTERNAL ILAENV, LSAME, SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CGGHRD, CLARTG, CLASET, CUNM22, CROT, CGEMM, EXTERNAL CGGHRD, CLARTG, CLASET, CUNM22, CROT, CGEMM,
@ -280,8 +281,13 @@
* *
INFO = 0 INFO = 0
NB = ILAENV( 1, 'CGGHD3', ' ', N, ILO, IHI, -1 ) NB = ILAENV( 1, 'CGGHD3', ' ', N, ILO, IHI, -1 )
LWKOPT = MAX( 6*N*NB, 1 ) NH = IHI - ILO + 1
WORK( 1 ) = CMPLX( LWKOPT ) IF( NH.LE.1 ) THEN
LWKOPT = 1
ELSE
LWKOPT = 6*N*NB
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
INITQ = LSAME( COMPQ, 'I' ) INITQ = LSAME( COMPQ, 'I' )
WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' )
INITZ = LSAME( COMPZ, 'I' ) INITZ = LSAME( COMPZ, 'I' )
@ -330,7 +336,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
@ -888,7 +893,8 @@
IF ( JCOL.LT.IHI ) IF ( JCOL.LT.IHI )
$ CALL CGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q, $ CALL CGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q,
$ LDQ, Z, LDZ, IERR ) $ LDQ, Z, LDZ, IERR )
WORK( 1 ) = CMPLX( LWKOPT ) *
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

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

@ -251,8 +251,8 @@
NB2 = ILAENV( 1, 'CGERQF', ' ', N, P, -1, -1 ) NB2 = ILAENV( 1, 'CGERQF', ' ', N, P, -1, -1 )
NB3 = ILAENV( 1, 'CUNMQR', ' ', N, M, P, -1 ) NB3 = ILAENV( 1, 'CUNMQR', ' ', 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 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LT.0 ) THEN IF( N.LT.0 ) THEN
INFO = -1 INFO = -1
@ -288,7 +288,7 @@
* RQ factorization of N-by-P matrix B: B = T*Z. * RQ factorization of N-by-P matrix B: B = T*Z.
* *
CALL CGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO ) CALL CGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO )
WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) ) WORK( 1 ) = SROUNDUP_LWORK( MAX( LOPT, INT( WORK( 1 ) ) ) )
* *
RETURN RETURN
* *

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

@ -250,8 +250,8 @@
NB2 = ILAENV( 1, 'CGEQRF', ' ', P, N, -1, -1 ) NB2 = ILAENV( 1, 'CGEQRF', ' ', P, N, -1, -1 )
NB3 = ILAENV( 1, 'CUNMRQ', ' ', M, N, P, -1 ) NB3 = ILAENV( 1, 'CUNMRQ', ' ', 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 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
@ -288,7 +288,7 @@
* QR factorization of P-by-N matrix B: B = Z*T * QR factorization of P-by-N matrix B: B = Z*T
* *
CALL CGEQRF( P, N, B, LDB, TAUB, WORK, LWORK, INFO ) CALL CGEQRF( P, N, B, LDB, TAUB, WORK, LWORK, INFO )
WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) ) WORK( 1 ) = SROUNDUP_LWORK( MAX( LOPT, INT( WORK( 1 ) ) ) )
* *
RETURN RETURN
* *

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

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

4
lapack-netlib/SRC/cggsvp3.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 complexOTHERcomputational *> \ingroup ggsvp3
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================

11
lapack-netlib/SRC/cheevd.f
View File

@ -116,8 +116,7 @@
*> *>
*> \param[out] RWORK *> \param[out] RWORK
*> \verbatim *> \verbatim
*> RWORK is REAL array, *> RWORK is REAL 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
*> *>
@ -282,8 +281,8 @@
LROPT = LRWMIN LROPT = LRWMIN
LIOPT = LIWMIN LIOPT = LIWMIN
END IF END IF
WORK( 1 ) = SROUNDUP_LWORK(LOPT) WORK( 1 ) = SROUNDUP_LWORK( LOPT )
RWORK( 1 ) = LROPT RWORK( 1 ) = SROUNDUP_LWORK( LROPT )
IWORK( 1 ) = LIOPT IWORK( 1 ) = LIOPT
* *
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
@ -378,8 +377,8 @@
CALL SSCAL( IMAX, ONE / SIGMA, W, 1 ) CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
END IF END IF
* *
WORK( 1 ) = SROUNDUP_LWORK(LOPT) WORK( 1 ) = SROUNDUP_LWORK( LOPT )
RWORK( 1 ) = LROPT RWORK( 1 ) = SROUNDUP_LWORK( LROPT )
IWORK( 1 ) = LIOPT IWORK( 1 ) = LIOPT
* *
RETURN RETURN

31
lapack-netlib/SRC/cheevr.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 CHETRD and for *> where NB is the max of the blocksize for CHETRD and for
*> CUNMTR as returned by ILAENV. *> CUNMTR 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
@ -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,8 +463,8 @@
NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 )
NB = MAX( NB, ILAENV( 1, 'CUNMTR', UPLO, N, -1, -1, -1 ) ) NB = MAX( NB, ILAENV( 1, 'CUNMTR', UPLO, N, -1, -1, -1 ) )
LWKOPT = MAX( ( NB+1 )*N, LWMIN ) LWKOPT = MAX( ( NB+1 )*N, LWMIN )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RWORK( 1 ) = LRWMIN RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN )
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
* *
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
@ -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 ) = REAL( A( 1, 1 ) ) W( 1 ) = REAL( A( 1, 1 ) )
@ -710,8 +719,8 @@
* *
* Set WORK(1) to optimal workspace size. * Set WORK(1) to optimal workspace size.
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RWORK( 1 ) = LRWMIN RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN )
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
* *
RETURN RETURN

37
lapack-netlib/SRC/cheevr_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 complexHEeigen *> \ingroup heevr_2stage
* *
*> \par Contributors: *> \par Contributors:
* ================== * ==================
@ -443,8 +446,9 @@
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER ILAENV, ILAENV2STAGE INTEGER ILAENV, ILAENV2STAGE
REAL SLAMCH, CLANSY REAL SLAMCH, CLANSY, SROUNDUP_LWORK
EXTERNAL LSAME, SLAMCH, CLANSY, ILAENV, ILAENV2STAGE EXTERNAL LSAME, SLAMCH, CLANSY, ILAENV, ILAENV2STAGE,
$ SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CSSCAL, EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CSSCAL,
@ -472,9 +476,16 @@
IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 ) IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
*
IF( N.LE.1 ) THEN
LWMIN = 1
LRWMIN = 1
LIWMIN = 1
ELSE
LWMIN = N + LHTRD + LWTRD LWMIN = N + LHTRD + LWTRD
LRWMIN = MAX( 1, 24*N ) LRWMIN = 24*N
LIWMIN = MAX( 1, 10*N ) LIWMIN = 10*N
END IF
* *
INFO = 0 INFO = 0
IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
@ -506,8 +517,8 @@
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RWORK( 1 ) = LRWMIN RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN )
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
* *
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
@ -535,7 +546,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 ) = REAL( A( 1, 1 ) ) W( 1 ) = REAL( A( 1, 1 ) )
@ -666,7 +677,7 @@
CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 )
CALL SCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 ) CALL SCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 )
* *
IF (ABSTOL .LE. TWO*N*EPS) THEN IF ( ABSTOL .LE. TWO*N*EPS ) THEN
TRYRAC = .TRUE. TRYRAC = .TRUE.
ELSE ELSE
TRYRAC = .FALSE. TRYRAC = .FALSE.
@ -765,8 +776,8 @@
* *
* Set WORK(1) to optimal workspace size. * Set WORK(1) to optimal workspace size.
* *
WORK( 1 ) = LWMIN WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RWORK( 1 ) = LRWMIN RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN )
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
* *
RETURN RETURN

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

@ -348,14 +348,14 @@
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
IF( N.LE.1 ) THEN IF( N.LE.1 ) THEN
LWKMIN = 1 LWKMIN = 1
WORK( 1 ) = LWKMIN LWKOPT = 1
ELSE ELSE
LWKMIN = 2*N LWKMIN = 2*N
NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 )
NB = MAX( NB, ILAENV( 1, 'CUNMTR', UPLO, N, -1, -1, -1 ) ) NB = MAX( NB, ILAENV( 1, 'CUNMTR', UPLO, N, -1, -1, -1 ) )
LWKOPT = MAX( 1, ( NB + 1 )*N ) LWKOPT = ( NB + 1 )*N
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
END IF END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
$ INFO = -17 $ INFO = -17

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

@ -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
@ -197,6 +197,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
@ -207,18 +208,18 @@
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 CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) CALL CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
LWKOPT_HETRF = INT( WORK(1) ) LWKOPT_HETRF = INT( WORK( 1 ) )
CALL CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, CALL CHETRS_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 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -240,7 +241,7 @@
* *
END IF END IF
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

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

@ -99,14 +99,14 @@
*> *>
*> \param[out] TB *> \param[out] TB
*> \verbatim *> \verbatim
*> TB is COMPLEX array, dimension (LTB) *> TB is COMPLEX 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
@ -146,14 +146,15 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX workspace of size LWORK *> WORK is COMPLEX 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,
@ -203,7 +204,7 @@
* *
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL UPPER, TQUERY, WQUERY LOGICAL UPPER, TQUERY, WQUERY
INTEGER LWKOPT INTEGER LWKMIN, LWKOPT
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -225,6 +226,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
@ -233,18 +235,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 CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV, CALL CHETRF_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 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -254,7 +257,6 @@
RETURN RETURN
END IF END IF
* *
*
* Compute the factorization A = U**H*T*U or A = L*T*L**H. * Compute the factorization A = U**H*T*U or A = L*T*L**H.
* *
CALL CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, CALL CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,
@ -268,7 +270,7 @@
* *
END IF END IF
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

11
lapack-netlib/SRC/chesvx.f
View File

@ -307,7 +307,7 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY, NOFACT LOGICAL LQUERY, NOFACT
INTEGER LWKOPT, NB INTEGER LWKMIN, LWKOPT, NB
REAL ANORM REAL 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,17 +347,17 @@
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, 'CHETRF', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 )
LWKOPT = MAX( LWKOPT, N*NB ) LWKOPT = MAX( LWKOPT, N*NB )
END IF END IF
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -405,7 +406,7 @@
IF( RCOND.LT.SLAMCH( 'Epsilon' ) ) IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
$ INFO = N + 1 $ INFO = N + 1
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

30
lapack-netlib/SRC/chetrd_2stage.f
View File

@ -123,7 +123,7 @@
*> *>
*> \param[out] HOUS2 *> \param[out] HOUS2
*> \verbatim *> \verbatim
*> HOUS2 is COMPLEX array, dimension (LHOUS2) *> HOUS2 is COMPLEX 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,13 +145,16 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX array, dimension (LWORK) *> WORK is COMPLEX 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 N = 0, LWORK >= 1, else LWORK = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS2 = -1, *> 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
@ -182,7 +187,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complexHEcomputational *> \ingroup hetrd_2stage
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -250,7 +255,8 @@
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER ILAENV2STAGE INTEGER ILAENV2STAGE
EXTERNAL LSAME, ILAENV2STAGE REAL SROUNDUP_LWORK
EXTERNAL LSAME, ILAENV2STAGE, SROUNDUP_LWORK
* .. * ..
* .. Executable Statements .. * .. Executable Statements ..
* *
@ -265,10 +271,13 @@
* *
KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', VECT, N, -1, -1, -1 ) KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', VECT, N, -1, -1, -1 )
IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', VECT, N, KD, -1, -1 ) IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', VECT, N, KD, -1, -1 )
IF( N.EQ.0 ) THEN
LHMIN = 1
LWMIN = 1
ELSE
LHMIN = ILAENV2STAGE( 3, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 ) LHMIN = ILAENV2STAGE( 3, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 ) LWMIN = ILAENV2STAGE( 4, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 )
* WRITE(*,*),'CHETRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO, END IF
* $ LHMIN, LWMIN
* *
IF( .NOT.LSAME( VECT, 'N' ) ) THEN IF( .NOT.LSAME( VECT, 'N' ) ) THEN
INFO = -1 INFO = -1
@ -285,8 +294,8 @@
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
HOUS2( 1 ) = LHMIN HOUS2( 1 ) = SROUNDUP_LWORK( LHMIN )
WORK( 1 ) = LWMIN WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -324,8 +333,7 @@
END IF END IF
* *
* *
HOUS2( 1 ) = LHMIN WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
WORK( 1 ) = LWMIN
RETURN RETURN
* *
* End of CHETRD_2STAGE * End of CHETRD_2STAGE

34
lapack-netlib/SRC/chetrd_hb2st.F
View File

@ -132,15 +132,17 @@
*> *>
*> \param[out] HOUS *> \param[out] HOUS
*> \verbatim *> \verbatim
*> HOUS is COMPLEX array, dimension LHOUS, that *> HOUS is COMPLEX 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 array, dimension LWORK. *> WORK is COMPLEX 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
@ -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,
$ SICEV, SIZETAU, LDV, LHMIN, LWMIN $ SICEV, SIZETAU, LDV, LHMIN, LWMIN
@ -286,7 +291,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' )
@ -296,8 +300,13 @@
* 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, 'CHETRD_HB2ST', VECT, N, KD, -1, -1 ) IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', VECT, N, KD, -1, -1 )
IF( N.EQ.0 .OR. KD.LE.1 ) THEN
LHMIN = 1
LWMIN = 1
ELSE
LHMIN = ILAENV2STAGE( 3, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) LHMIN = ILAENV2STAGE( 3, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) LWMIN = ILAENV2STAGE( 4, 'CHETRD_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
@ -318,8 +327,8 @@
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
HOUS( 1 ) = LHMIN HOUS( 1 ) = SROUNDUP_LWORK( LHMIN )
WORK( 1 ) = SROUNDUP_LWORK(LWMIN) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -575,8 +584,7 @@ C END IF
170 CONTINUE 170 CONTINUE
ENDIF ENDIF
* *
HOUS( 1 ) = LHMIN WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
RETURN RETURN
* *
* End of CHETRD_HB2ST * End of CHETRD_HB2ST

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

@ -123,8 +123,8 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX array, dimension (LWORK) *> WORK is COMPLEX 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
@ -294,8 +296,12 @@
INFO = 0 INFO = 0
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LE.KD+1 ) THEN
LWMIN = 1
ELSE
LWMIN = ILAENV2STAGE( 4, 'CHETRD_HE2HB', '', N, KD, -1, -1 ) LWMIN = ILAENV2STAGE( 4, 'CHETRD_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
@ -314,7 +320,7 @@
CALL XERBLA( 'CHETRD_HE2HB', -INFO ) CALL XERBLA( 'CHETRD_HE2HB', -INFO )
RETURN RETURN
ELSE IF( LQUERY ) THEN ELSE IF( LQUERY ) THEN
WORK( 1 ) = SROUNDUP_LWORK(LWMIN) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN RETURN
END IF END IF
* *
@ -507,7 +513,7 @@
END IF END IF
* *
WORK( 1 ) = SROUNDUP_LWORK(LWMIN) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN RETURN
* *
* End of CHETRD_HE2HB * End of CHETRD_HE2HB

8
lapack-netlib/SRC/chetrf.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
*> *>
@ -228,8 +228,8 @@
* Determine the block size * Determine the block size
* *
NB = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 )
LWKOPT = N*NB LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -347,7 +347,7 @@
END IF END IF
* *
40 CONTINUE 40 CONTINUE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
* *
* End of CHETRF * End of CHETRF

29
lapack-netlib/SRC/chetrf_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 >= 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
@ -128,7 +130,7 @@
*> \ingroup hetrf_aa *> \ingroup hetrf_aa
* *
* ===================================================================== * =====================================================================
SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) SUBROUTINE CHETRF_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 ALPHA COMPLEX ALPHA
* .. * ..
@ -179,19 +181,26 @@
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.( 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 ) = SROUNDUP_LWORK( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -203,11 +212,11 @@
* *
* Quick return * Quick return
* *
IF ( N.EQ.0 ) THEN IF( N.EQ.0 ) THEN
RETURN RETURN
ENDIF ENDIF
IPIV( 1 ) = 1 IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN IF( N.EQ.1 ) THEN
A( 1, 1 ) = REAL( A( 1, 1 ) ) A( 1, 1 ) = REAL( A( 1, 1 ) )
RETURN RETURN
END IF END IF
@ -460,7 +469,7 @@
END IF END IF
* *
20 CONTINUE 20 CONTINUE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
* *
* End of CHETRF_AA * End of CHETRF_AA

25
lapack-netlib/SRC/chetrf_aa_2stage.f
View File

@ -87,14 +87,14 @@
*> *>
*> \param[out] TB *> \param[out] TB
*> \verbatim *> \verbatim
*> TB is COMPLEX array, dimension (LTB) *> TB is COMPLEX 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 workspace of size LWORK *> WORK is COMPLEX workspace of size (MAX(1,LWORK))
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB *> The size of WORK. LWORK >= MAX(1,N), internally used
*> such that LWORK >= N*NB. *> to select NB such that LWORK >= N*NB.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the *> If LWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the WORK array, *> routine only calculates the optimal size of the WORK array,
@ -152,7 +152,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complexSYcomputational *> \ingroup hetrf_aa_2stage
* *
* ===================================================================== * =====================================================================
SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
@ -188,7 +188,8 @@
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER ILAENV INTEGER ILAENV
EXTERNAL LSAME, ILAENV REAL SROUNDUP_LWORK
EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
@ -213,9 +214,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
* *
@ -229,10 +230,10 @@
NB = ILAENV( 1, 'CHETRF_AA_2STAGE', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'CHETRF_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 ) = SROUNDUP_LWORK( MAX( 1, (3*NB+1)*N ) )
END IF END IF
IF( WQUERY ) THEN IF( WQUERY ) THEN
WORK( 1 ) = N*NB WORK( 1 ) = SROUNDUP_LWORK( MAX( 1, N*NB ) )
END IF END IF
END IF END IF
IF( TQUERY .OR. WQUERY ) THEN IF( TQUERY .OR. WQUERY ) THEN
@ -241,7 +242,7 @@
* *
* Quick return * Quick return
* *
IF ( N.EQ.0 ) THEN IF( N.EQ.0 ) THEN
RETURN RETURN
ENDIF ENDIF
* *

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

@ -177,14 +177,14 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX array, dimension ( MAX(1,LWORK) ). *> WORK is COMPLEX 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.
*> *>
@ -311,8 +311,8 @@
* Determine the block size * Determine the block size
* *
NB = ILAENV( 1, 'CHETRF_RK', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'CHETRF_RK', UPLO, N, -1, -1, -1 )
LWKOPT = N*NB LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -488,7 +488,7 @@
* *
END IF END IF
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
* *
* End of CHETRF_RK * End of CHETRF_RK

6
lapack-netlib/SRC/chetrf_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
@ -264,7 +264,7 @@
* *
NB = ILAENV( 1, 'CHETRF_ROOK', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'CHETRF_ROOK', UPLO, N, -1, -1, -1 )
LWKOPT = MAX( 1, N*NB ) LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -387,7 +387,7 @@
END IF END IF
* *
40 CONTINUE 40 CONTINUE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
* *
* End of CHETRF_ROOK * End of CHETRF_ROOK

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

@ -88,14 +88,14 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX array, dimension (N+NB+1)*(NB+3) *> WORK is COMPLEX 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
@ -120,7 +120,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup complexHEcomputational *> \ingroup hetri2
* *
* ===================================================================== * =====================================================================
SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
@ -147,7 +147,8 @@
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER ILAENV INTEGER ILAENV
EXTERNAL LSAME, ILAENV REAL SROUNDUP_LWORK
EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CHETRI2X, CHETRI, XERBLA EXTERNAL CHETRI2X, CHETRI, XERBLA
@ -159,9 +160,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, 'CHETRF', UPLO, N, -1, -1, -1 ) NBMAX = ILAENV( 1, 'CHETRF', 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 +178,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( 'CHETRI2', -INFO ) CALL XERBLA( 'CHETRI2', -INFO )
RETURN RETURN
ELSE IF( LQUERY ) THEN ELSE IF( LQUERY ) THEN
WORK(1)=MINSIZE WORK( 1 ) = SROUNDUP_LWORK( 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 CHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL CHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
ELSE ELSE
CALL CHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO ) CALL CHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
END IF END IF
*
RETURN RETURN
* *
* End of CHETRI2 * End of CHETRI2

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

@ -119,16 +119,17 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is COMPLEX array, dimension (N+NB+1)*(NB+3). *> WORK is COMPLEX array, dimension (MAX(1,LWORK)).
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of WORK. LWORK >= (N+NB+1)*(NB+3). *> The length of WORK.
*> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3).
*> *>
*> If LDWORK = -1, then a workspace query is assumed; *> If LWORK = -1, then a workspace query is assumed;
*> the routine only calculates the optimal size of the optimal *> the routine only calculates the optimal size of the optimal
*> size of the WORK array, returns this value as the first *> size of the WORK array, returns this value as the first
*> entry of the WORK array, and no error message related to *> entry of the WORK array, and no error message related to
@ -209,8 +210,13 @@
* *
* Determine the block size * Determine the block size
* *
IF( N.EQ.0 ) THEN
LWKOPT = 1
ELSE
NB = MAX( 1, ILAENV( 1, 'CHETRI_3', UPLO, N, -1, -1, -1 ) ) NB = MAX( 1, ILAENV( 1, 'CHETRI_3', UPLO, N, -1, -1, -1 ) )
LWKOPT = ( N+NB+1 ) * ( NB+3 ) LWKOPT = ( N+NB+1 ) * ( NB+3 )
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
@ -218,7 +224,7 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4 INFO = -4
ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN
INFO = -8 INFO = -8
END IF END IF
* *
@ -226,7 +232,6 @@
CALL XERBLA( 'CHETRI_3', -INFO ) CALL XERBLA( 'CHETRI_3', -INFO )
RETURN RETURN
ELSE IF( LQUERY ) THEN ELSE IF( LQUERY ) THEN
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
RETURN RETURN
END IF END IF
* *
@ -237,7 +242,7 @@
* *
CALL CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) CALL CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

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

@ -105,7 +105,13 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,3*N-2). *> The dimension of the array WORK.
*> If MIN(N,NRHS) = 0, LWORK >= 1, else LWORK >= 3*N-2.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*> \endverbatim *> \endverbatim
*> *>
*> \param[out] INFO *> \param[out] INFO
@ -151,24 +157,30 @@
* .. * ..
* .. 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
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL LSAME,SROUNDUP_LWORK EXTERNAL LSAME, SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CLACPY, CLACGV, CGTSV, CSWAP, CTRSM, XERBLA EXTERNAL CLACPY, CLACGV, CGTSV, CSWAP, CTRSM, 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( 'CHETRS_AA', -INFO ) CALL XERBLA( 'CHETRS_AA', -INFO )
RETURN RETURN
ELSE IF( LQUERY ) THEN ELSE IF( LQUERY ) THEN
LWKOPT = (3*N-2) WORK( 1 ) = SROUNDUP_LWORK( LWKMIN )
WORK( 1 ) = SROUNDUP_LWORK(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

46
lapack-netlib/SRC/clamswlq.f
View File

@ -128,16 +128,19 @@
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) *> (workspace) COMPLEX 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
@ -204,7 +207,7 @@
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 A( LDA, * ), WORK( * ), C(LDC, * ), COMPLEX A( LDA, * ), WORK( * ), C( LDC, * ),
$ T( LDT, * ) $ T( LDT, * )
* .. * ..
* *
@ -213,12 +216,13 @@
* .. * ..
* .. 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
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK EXTERNAL LSAME, SROUNDUP_LWORK
* ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CTPMLQT, CGEMLQT, XERBLA EXTERNAL CTPMLQT, CGEMLQT, XERBLA
* .. * ..
@ -226,18 +230,25 @@
* *
* 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
@ -248,36 +259,37 @@
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 ) = SROUNDUP_LWORK( LWMIN )
END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CLAMSWLQ', -INFO ) CALL XERBLA( 'CLAMSWLQ', -INFO )
WORK(1) = SROUNDUP_LWORK(LW)
RETURN RETURN
ELSE IF (LQUERY) THEN ELSE IF( LQUERY ) THEN
WORK(1) = SROUNDUP_LWORK(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 CGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, CALL CGEMLQT( 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
* *
@ -404,7 +416,7 @@
* *
END IF END IF
* *
WORK(1) = SROUNDUP_LWORK(LW) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN RETURN
* *
* End of CLAMSWLQ * End of CLAMSWLQ

50
lapack-netlib/SRC/clamtsqr.f
View File

@ -129,21 +129,23 @@
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) *> (workspace) COMPLEX 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
@ -206,7 +208,7 @@
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 A( LDA, * ), WORK( * ), C(LDC, * ), COMPLEX A( LDA, * ), WORK( * ), C( LDC, * ),
$ T( LDT, * ) $ T( LDT, * )
* .. * ..
* *
@ -215,12 +217,13 @@
* .. * ..
* .. 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
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK EXTERNAL LSAME, SROUNDUP_LWORK
* ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CGEMQRT, CTPMQRT, XERBLA EXTERNAL CGEMQRT, CTPMQRT, XERBLA
* .. * ..
@ -228,12 +231,13 @@
* *
* Test the input arguments * Test the input arguments
* *
LQUERY = LWORK.LT.0 INFO = 0
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' ) NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, '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
@ -241,7 +245,13 @@
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
@ -256,36 +266,36 @@
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 ) = SROUNDUP_LWORK( LWMIN )
IF( INFO.EQ.0) THEN
WORK(1) = SROUNDUP_LWORK(LW)
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CLAMTSQR', -INFO ) CALL XERBLA( 'CLAMTSQR', -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 CGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, CALL CGEMQRT( 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
* *
@ -412,7 +422,7 @@
* *
END IF END IF
* *
WORK(1) = SROUNDUP_LWORK(LW) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN RETURN
* *
* End of CLAMTSQR * End of CLAMTSQR

48
lapack-netlib/SRC/claswlq.f
View File

@ -96,22 +96,24 @@
*> 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 array, dimension (MAX(1,LWORK)) *> (workspace) COMPLEX 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
@ -163,7 +165,7 @@
*> *>
* ===================================================================== * =====================================================================
SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, SUBROUTINE CLASWLQ( 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, --
@ -173,7 +175,7 @@
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
COMPLEX A( LDA, * ), WORK( * ), T( LDT, *) COMPLEX A( LDA, * ), WORK( * ), T( LDT, * )
* .. * ..
* *
* ===================================================================== * =====================================================================
@ -181,15 +183,17 @@
* .. * ..
* .. 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
INTEGER ILAENV INTEGER ILAENV
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK
* ..
* .. EXTERNAL SUBROUTINES .. * .. EXTERNAL SUBROUTINES ..
EXTERNAL CGELQT, CTPLQT, XERBLA EXTERNAL CGELQT, CTPLQT, XERBLA
* ..
* .. INTRINSIC FUNCTIONS .. * .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD INTRINSIC MAX, MIN, MOD
* .. * ..
@ -200,12 +204,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
@ -213,35 +224,36 @@
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) = SROUNDUP_LWORK(MB*M) IF( INFO.EQ.0 ) THEN
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CLASWLQ', -INFO ) CALL XERBLA( 'CLASWLQ', -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 CGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO) CALL CGELQT( 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)
* *
@ -260,13 +272,13 @@
* *
* 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 CTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), CALL CTPLQT( 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 ) = SROUNDUP_LWORK(M * MB) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN RETURN
* *
* End of CLASWLQ * End of CLASWLQ

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

@ -152,13 +152,17 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is REAL array, dimension (LWORK). *> WORK is REAL array, dimension (MAX(1,LWORK)).
*> On exit, if INFO = 0, WORK(1) returns the optimal size of *> On exit, if INFO = 0, WORK(1) returns the optimal size of
*> WORK. *> WORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK.
*>
*> If MIN(N,NRHS) = 0, LWORK >= 1, else
*> LWORK >= MAX(1, 2*NBA * MAX(NBA, MIN(NRHS, 32)), where *> LWORK >= MAX(1, 2*NBA * MAX(NBA, MIN(NRHS, 32)), where
*> NBA = (N + NB - 1)/NB and NB is the optimal block size. *> NBA = (N + NB - 1)/NB and NB is the optimal block size.
*> *>
@ -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,15 +262,16 @@
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
REAL ANRM, BIGNUM, BNRM, RSCAL, SCAL, SCALOC, REAL ANRM, BIGNUM, BNRM, RSCAL, SCAL, SCALOC,
$ SCAMIN, SMLNUM, TMAX $ SCAMIN, SMLNUM, TMAX
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER ILAENV INTEGER ILAENV
REAL SLAMCH, CLANGE, SLARMM REAL SLAMCH, CLANGE, SLARMM, SROUNDUP_LWORK
EXTERNAL ILAENV, LSAME, SLAMCH, CLANGE, SLARMM EXTERNAL ILAENV, LSAME, SLAMCH, CLANGE, SLARMM,
$ SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CLATRS, CSSCAL, XERBLA EXTERNAL CLATRS, CSSCAL, XERBLA
@ -296,15 +302,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 ) = SROUNDUP_LWORK( LWMIN )
* *
* Test the input parameters. * Test the input parameters.
* *
@ -326,7 +341,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
@ -659,6 +674,9 @@
END IF END IF
END DO END DO
END DO END DO
*
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
*
RETURN RETURN
* *
* End of CLATRS3 * End of CLATRS3

47
lapack-netlib/SRC/clatsqr.f
View File

@ -102,14 +102,17 @@
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) *> (workspace) COMPLEX 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
@ -165,7 +168,7 @@
*> *>
* ===================================================================== * =====================================================================
SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, SUBROUTINE CLATSQR( 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, --
@ -175,7 +178,7 @@
INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
COMPLEX A( LDA, * ), WORK( * ), T(LDT, *) COMPLEX A( LDA, * ), WORK( * ), T( LDT, * )
* .. * ..
* *
* ===================================================================== * =====================================================================
@ -183,14 +186,16 @@
* .. * ..
* .. 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
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK EXTERNAL LSAME, SROUNDUP_LWORK
* ..
* .. EXTERNAL SUBROUTINES .. * .. EXTERNAL SUBROUTINES ..
EXTERNAL CGEQRT, CTPQRT, XERBLA EXTERNAL CGEQRT, CTPQRT, XERBLA
* ..
* .. INTRINSIC FUNCTIONS .. * .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD INTRINSIC MAX, MIN, MOD
* .. * ..
@ -201,6 +206,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
@ -208,46 +220,47 @@
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) = SROUNDUP_LWORK(NB*N) IF( INFO.EQ.0 ) THEN
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CLATSQR', -INFO ) CALL XERBLA( 'CLATSQR', -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 CGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) CALL CGEQRT( 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 CGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) CALL CGEQRT( 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)
* *
@ -259,13 +272,13 @@
* *
* 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 CTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, CALL CTPQRT( 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 ) = SROUNDUP_LWORK(N*NB) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN RETURN
* *
* End of CLATSQR * End of CLATSQR

5
lapack-netlib/SRC/dsytrf.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.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
@ -135,7 +135,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup doubleSYcomputational *> \ingroup hetrf
* *
*> \par Further Details: *> \par Further Details:
* ===================== * =====================
@ -352,6 +352,7 @@
END IF END IF
* *
40 CONTINUE 40 CONTINUE
*
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
RETURN RETURN
* *

34
lapack-netlib/SRC/ssytrd_sb2st.F
View File

@ -132,15 +132,17 @@
*> *>
*> \param[out] HOUS *> \param[out] HOUS
*> \verbatim *> \verbatim
*> HOUS is REAL array, dimension LHOUS, that *> HOUS is REAL 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 REAL array, dimension LWORK. *> WORK is REAL array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns 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
@ -261,7 +266,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,
$ SISEV, SIZETAU, LDV, LHMIN, LWMIN $ SISEV, SIZETAU, LDV, LHMIN, LWMIN
@ -283,7 +288,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' )
@ -293,8 +297,13 @@
* 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, 'SSYTRD_SB2ST', VECT, N, KD, -1, -1 ) IB = ILAENV2STAGE( 2, 'SSYTRD_SB2ST', VECT, N, KD, -1, -1 )
IF( N.EQ.0 .OR. KD.LE.1 ) THEN
LHMIN = 1
LWMIN = 1
ELSE
LHMIN = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 ) LHMIN = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 ) LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 )
END IF
* *
IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN
INFO = -1 INFO = -1
@ -315,8 +324,8 @@
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
HOUS( 1 ) = LHMIN HOUS( 1 ) = SROUNDUP_LWORK( LHMIN )
WORK( 1 ) = SROUNDUP_LWORK(LWMIN) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -544,8 +553,7 @@
170 CONTINUE 170 CONTINUE
ENDIF ENDIF
* *
HOUS( 1 ) = LHMIN WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
RETURN RETURN
* *
* End of SSYTRD_SB2ST * End of SSYTRD_SB2ST