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

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

@ -123,7 +123,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of the array WORK. LWORK >= max(1,M,N).
*> The length of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(M,N), otherwise.
*> For optimum performance LWORK >= (M+N)*NB, where NB
*> is the optimal blocksize.
*>
@ -148,7 +149,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complexGEcomputational
*> \ingroup gebrd
*
*> \par Further Details:
* =====================
@ -225,8 +226,8 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
$ NBMIN, NX, WS
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT,
$ MINMN, NB, NBMIN, NX, WS
* ..
* .. External Subroutines ..
EXTERNAL CGEBD2, CGEMM, CLABRD, XERBLA
@ -236,16 +237,24 @@
* ..
* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
REAL SROUNDUP_LWORK
EXTERNAL ILAENV, SROUNDUP_LWORK
* ..
* .. Executable Statements ..
*
* Test the input parameters
*
INFO = 0
NB = MAX( 1, ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) )
LWKOPT = ( M+N )*NB
WORK( 1 ) = REAL( LWKOPT )
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 ) )
LWKOPT = ( M+N )*NB
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
@ -253,7 +262,7 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
IF( INFO.LT.0 ) THEN
@ -265,7 +274,6 @@
*
* Quick return if possible
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
WORK( 1 ) = 1
RETURN
@ -284,7 +292,7 @@
* Determine when to switch from blocked to unblocked code.
*
IF( NX.LT.MINMN ) THEN
WS = ( M+N )*NB
WS = LWKOPT
IF( LWORK.LT.WS ) THEN
*
* Not enough work space for the optimal NB, consider using
@ -343,7 +351,7 @@
*
CALL CGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ),
$ TAUQ( I ), TAUP( I ), WORK, IINFO )
WORK( 1 ) = WS
WORK( 1 ) = SROUNDUP_LWORK( WS )
RETURN
*
* End of CGEBRD

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

@ -89,7 +89,7 @@
*>
*> \param[out] WORK
*> \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
*>
@ -222,13 +222,19 @@
INFO = -8
END IF
*
NH = IHI - ILO + 1
IF( INFO.EQ.0 ) THEN
*
* Compute the workspace requirements
*
NB = MIN( NBMAX, ILAENV( 1, 'CGEHRD', ' ', N, ILO, IHI, -1 ) )
LWKOPT = N*NB + TSIZE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
IF( NH.LE.1 ) THEN
LWKOPT = 1
ELSE
NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI,
$ -1 ) )
LWKOPT = N*NB + TSIZE
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
*
IF( INFO.NE.0 ) THEN
@ -249,7 +255,6 @@
*
* Quick return if possible
*
NH = IHI - ILO + 1
IF( NH.LE.1 ) THEN
WORK( 1 ) = 1
RETURN
@ -269,7 +274,7 @@
*
* Determine if workspace is large enough for blocked code
*
IF( LWORK.LT.N*NB+TSIZE ) THEN
IF( LWORK.LT.LWKOPT ) THEN
*
* Not enough workspace to use optimal NB: determine the
* minimum value of NB, and reduce NB or force use of
@ -345,7 +350,8 @@
* Use unblocked code to reduce the rest of the matrix
*
CALL CGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
*
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

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

@ -98,7 +98,7 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
*> only calculates the sizes of the T and WORK arrays, returns these
*> values as the first entries of the T and WORK arrays, and no error
@ -295,9 +295,9 @@
T( 2 ) = MB
T( 3 ) = NB
IF( MINW ) THEN
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
ELSE
WORK( 1 ) = SROUNDUP_LWORK(LWREQ)
WORK( 1 ) = SROUNDUP_LWORK( LWREQ )
END IF
END IF
IF( INFO.NE.0 ) THEN
@ -322,7 +322,7 @@
$ LWORK, INFO )
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(LWREQ)
WORK( 1 ) = SROUNDUP_LWORK( LWREQ )
*
RETURN
*

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

@ -93,7 +93,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,M).
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M, otherwise.
*> For optimum performance LWORK >= M*NB, where NB is the
*> optimal blocksize.
*>
@ -175,9 +176,8 @@
* Test the input arguments
*
INFO = 0
K = MIN( M, N )
NB = ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 )
LWKOPT = M*NB
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
@ -185,19 +185,25 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
INFO = -7
ELSE IF( .NOT.LQUERY ) THEN
IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) )
$ INFO = -7
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGELQF', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
IF( K.EQ.0 ) THEN
LWKOPT = 1
ELSE
LWKOPT = M*NB
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
END IF
*
* Quick return if possible
*
K = MIN( M, N )
IF( K.EQ.0 ) THEN
WORK( 1 ) = 1
RETURN
@ -267,7 +273,7 @@
$ CALL CGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
$ IINFO )
*
WORK( 1 ) = SROUNDUP_LWORK(IWS)
WORK( 1 ) = SROUNDUP_LWORK( IWS )
RETURN
*
* End of CGELQF

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

@ -110,16 +110,17 @@
*>
*> \param[out] WORK
*> \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
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1, then a workspace query is assumed. The routine
*> only calculates the size of the WORK array, returns this
*> value as WORK(1), and no error message related to WORK
*> value as WORK(1), and no error message related to WORK
*> is issued by XERBLA.
*> \endverbatim
*>
@ -143,7 +144,7 @@
*>
*> \verbatim
*>
*> These details are particular for this LAPACK implementation. Users should not
*> These details are particular for this LAPACK implementation. Users should not
*> take them for granted. These details may change in the future, and are not likely
*> true for another LAPACK implementation. These details are relevant if one wants
*> to try to understand the code. They are not part of the interface.
@ -159,11 +160,13 @@
*> block sizes MB and NB returned by ILAENV, CGELQ will use either
*> CLASWLQ (if the matrix is wide-and-short) or CGELQT to compute
*> the LQ factorization.
*> This version of CGEMLQ will use either CLAMSWLQ or CGEMLQT to
*> This version of CGEMLQ will use either CLAMSWLQ or CGEMLQT to
*> multiply matrix Q by another matrix.
*> Further Details in CLAMSWLQ or CGEMLQT.
*> \endverbatim
*>
*> \ingroup gemlq
*>
* =====================================================================
SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
$ C, LDC, WORK, LWORK, INFO )
@ -185,11 +188,12 @@
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER MB, NB, LW, NBLCKS, MN
INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL CLAMSWLQ, CGEMLQT, XERBLA
@ -201,7 +205,7 @@
*
* Test the input arguments
*
LQUERY = LWORK.EQ.-1
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' )
@ -216,6 +220,13 @@
LW = M * MB
MN = N
END IF
*
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
*
IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
@ -244,12 +255,12 @@
INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -11
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
ELSE IF( ( LWORK.LT.LWMIN ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
END IF
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = REAL( LW )
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
*
IF( INFO.NE.0 ) THEN
@ -261,7 +272,7 @@
*
* Quick return if possible
*
IF( MIN( M, N, K ).EQ.0 ) THEN
IF( MINMNK.EQ.0 ) THEN
RETURN
END IF
*
@ -274,7 +285,7 @@
$ MB, C, LDC, WORK, LWORK, INFO )
END IF
*
WORK( 1 ) = REAL( LW )
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
*
RETURN
*

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

@ -111,16 +111,17 @@
*>
*> \param[out] WORK
*> \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
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1, then a workspace query is assumed. The routine
*> only calculates the size of the WORK array, returns this
*> value as WORK(1), and no error message related to WORK
*> value as WORK(1), and no error message related to WORK
*> is issued by XERBLA.
*> \endverbatim
*>
@ -144,7 +145,7 @@
*>
*> \verbatim
*>
*> These details are particular for this LAPACK implementation. Users should not
*> These details are particular for this LAPACK implementation. Users should not
*> take them for granted. These details may change in the future, and are not likely
*> true for another LAPACK implementation. These details are relevant if one wants
*> to try to understand the code. They are not part of the interface.
@ -166,6 +167,8 @@
*>
*> \endverbatim
*>
*> \ingroup gemqr
*>
* =====================================================================
SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
$ C, LDC, WORK, LWORK, INFO )
@ -187,11 +190,12 @@
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER MB, NB, LW, NBLCKS, MN
INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL CGEMQRT, CLAMTSQR, XERBLA
@ -203,7 +207,7 @@
*
* Test the input arguments
*
LQUERY = LWORK.EQ.-1
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' )
@ -218,6 +222,13 @@
LW = MB * NB
MN = N
END IF
*
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
*
IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN
IF( MOD( MN - K, MB - K ).EQ.0 ) THEN
@ -251,7 +262,7 @@
END IF
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LW
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
*
IF( INFO.NE.0 ) THEN
@ -263,7 +274,7 @@
*
* Quick return if possible
*
IF( MIN( M, N, K ).EQ.0 ) THEN
IF( MINMNK.EQ.0 ) THEN
RETURN
END IF
*
@ -276,7 +287,7 @@
$ NB, C, LDC, WORK, LWORK, INFO )
END IF
*
WORK( 1 ) = LW
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
*
RETURN
*

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

@ -88,7 +88,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,N).
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise.
*> For optimum performance LWORK >= N*NB, where NB is
*> the optimal blocksize.
*>
@ -187,10 +188,11 @@
NB = ILAENV( 1, 'CGEQLF', ' ', M, N, -1, -1 )
LWKOPT = N*NB
END IF
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
INFO = -7
IF( .NOT.LQUERY ) THEN
IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) )
$ INFO = -7
END IF
END IF
*
@ -277,7 +279,7 @@
IF( MU.GT.0 .AND. NU.GT.0 )
$ CALL CGEQL2( MU, NU, A, LDA, TAU, WORK, IINFO )
*
WORK( 1 ) = SROUNDUP_LWORK(IWS)
WORK( 1 ) = SROUNDUP_LWORK( IWS )
RETURN
*
* End of CGEQLF

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

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

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

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

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

@ -97,7 +97,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,N).
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise.
*> For optimum performance LWORK >= N*NB, where NB is
*> the optimal blocksize.
*>
@ -162,8 +163,8 @@
*
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
$ NBMIN, NX
INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKMIN, LWKOPT,
$ NB, NBMIN, NX
* ..
* .. External Subroutines ..
EXTERNAL CGEQR2P, CLARFB, CLARFT, XERBLA
@ -182,8 +183,16 @@
*
INFO = 0
NB = ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 )
LWKOPT = N*NB
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
K = MIN( M, N )
IF( K.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = N
LWKOPT = N*NB
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
@ -191,7 +200,7 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -7
END IF
IF( INFO.NE.0 ) THEN
@ -203,7 +212,6 @@
*
* Quick return if possible
*
K = MIN( M, N )
IF( K.EQ.0 ) THEN
WORK( 1 ) = 1
RETURN
@ -211,7 +219,7 @@
*
NBMIN = 2
NX = 0
IWS = N
IWS = LWKMIN
IF( NB.GT.1 .AND. NB.LT.K ) THEN
*
* Determine when to cross over from blocked to unblocked code.
@ -273,7 +281,7 @@
$ CALL CGEQR2P( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
$ IINFO )
*
WORK( 1 ) = SROUNDUP_LWORK(IWS)
WORK( 1 ) = SROUNDUP_LWORK( IWS )
RETURN
*
* End of CGEQRFP

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

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

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

@ -208,15 +208,17 @@
*> \verbatim
*> CWORK is COMPLEX array, dimension (max(1,LWORK))
*> 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
*>
*> \param[in] LWORK
*> \verbatim
*> 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
*>
*> \param[in,out] RWORK
@ -247,15 +249,17 @@
*> RWORK(6) = the largest absolute value over all sines of the
*> Jacobi rotation angles in the last sweep. It can be
*> 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
*>
*> \param[in] LRWORK
*> \verbatim
*> 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
*>
*> \param[out] INFO
@ -276,7 +280,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complexGEcomputational
*> \ingroup gesvj
*
*> \par Further Details:
* =====================
@ -374,16 +378,17 @@
PARAMETER ( NSWEEP = 30 )
* ..
* .. Local Scalars ..
COMPLEX AAPQ, OMPQ
REAL AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG,
$ BIGTHETA, CS, CTOL, EPSLN, MXAAPQ,
$ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL,
$ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN, TOL
INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
$ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34,
$ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, SWBAND
LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, ROTOK,
$ RSVEC, UCTOL, UPPER
COMPLEX AAPQ, OMPQ
REAL AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG,
$ BIGTHETA, CS, CTOL, EPSLN, MXAAPQ,
$ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL,
$ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN, TOL
INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
$ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34,
$ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, SWBAND,
$ MINMN, LWMIN, LRWMIN
LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, ROTOK,
$ RSVEC, UCTOL, UPPER
* ..
* ..
* .. Intrinsic Functions ..
@ -398,8 +403,8 @@
INTEGER ISAMAX
EXTERNAL ISAMAX
* from LAPACK
REAL SLAMCH
EXTERNAL SLAMCH
REAL SLAMCH, SROUNDUP_LWORK
EXTERNAL SLAMCH, SROUNDUP_LWORK
LOGICAL LSAME
EXTERNAL LSAME
* ..
@ -422,7 +427,16 @@
UPPER = LSAME( JOBA, 'U' )
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
INFO = -1
ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN
@ -442,9 +456,9 @@
INFO = -11
ELSE IF( UCTOL .AND. ( RWORK( 1 ).LE.ONE ) ) THEN
INFO = -12
ELSE IF( LWORK.LT.( M+N ) .AND. ( .NOT.LQUERY ) ) THEN
ELSE IF( LWORK.LT.LWMIN .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
ELSE IF( LRWORK.LT.MAX( N, 6 ) .AND. ( .NOT.LQUERY ) ) THEN
ELSE IF( LRWORK.LT.LRWMIN .AND. ( .NOT.LQUERY ) ) THEN
INFO = -15
ELSE
INFO = 0
@ -454,15 +468,15 @@
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGESVJ', -INFO )
RETURN
ELSE IF ( LQUERY ) THEN
CWORK(1) = M + N
RWORK(1) = MAX( N, 6 )
ELSE IF( LQUERY ) THEN
CWORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN )
RETURN
END IF
*
* #:) Quick return for void matrix
*
IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN
IF( MINMN.EQ.0 ) RETURN
*
* Set numerical parameters
* The stopping criterion for Jacobi rotations is

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

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

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

@ -127,7 +127,7 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1 or -2, then a workspace query is assumed.
*> If LWORK = -1, the routine calculates optimal size of WORK for the
*> optimal performance and returns this value in WORK(1).
@ -229,7 +229,10 @@
*
* 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 )
TSZO = INT( TQ( 1 ) )
LWO = INT( WORKQ( 1 ) )

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

@ -131,13 +131,15 @@
*> \param[in] LWORK
*> \verbatim
*> The dimension of the array WORK.
*> LWORK >= MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ),
*> If MIN(M,N) = 0, LWORK >= 1, else
*> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ),
*> where
*> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)),
*> NB1LOCAL = MIN(NB1,N).
*> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL,
*> LW1 = NB1LOCAL * N,
*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ),
*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ).
*>
*> If LWORK = -1, then a workspace query is assumed.
*> The routine only calculates the optimal size of the WORK
*> array, returns this value as the first entry of the WORK
@ -160,7 +162,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup comlpexOTHERcomputational
*> \ingroup getsqrhrt
*
*> \par Contributors:
* ==================
@ -200,6 +202,10 @@
INTEGER I, IINFO, J, LW1, LW2, LWT, LDWT, LWORKOPT,
$ NB1LOCAL, NB2LOCAL, NUM_ALL_ROW_BLOCKS
* ..
* .. External Functions ..
REAL SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL CCOPY, CLATSQR, CUNGTSQR_ROW, CUNHR_COL,
$ XERBLA
@ -212,7 +218,7 @@
* Test the input arguments
*
INFO = 0
LQUERY = LWORK.EQ.-1
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
ELSE IF( N.LT.0 .OR. M.LT.N ) THEN
@ -225,7 +231,7 @@
INFO = -5
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -7
ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN
ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN
INFO = -9
ELSE
*
@ -263,8 +269,9 @@
LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) )
*
LWORKOPT = MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) )
LWORKOPT = MAX( 1, LWORKOPT )
*
IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN
IF( LWORK.LT.LWORKOPT .AND. .NOT.LQUERY ) THEN
INFO = -11
END IF
*
@ -277,14 +284,14 @@
CALL XERBLA( 'CGETSQRHRT', -INFO )
RETURN
ELSE IF ( LQUERY ) THEN
WORK( 1 ) = CMPLX( LWORKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT )
RETURN
END IF
*
* Quick return if possible
*
IF( MIN( M, N ).EQ.0 ) THEN
WORK( 1 ) = CMPLX( LWORKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT )
RETURN
END IF
*
@ -341,9 +348,9 @@
END IF
END DO
*
WORK( 1 ) = CMPLX( LWORKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT )
RETURN
*
* End of CGETSQRHRT
*
END
END

40
lapack-netlib/SRC/cgges3.f
View File

@ -215,7 +215,8 @@
*> \param[in] LWORK
*> \verbatim
*> 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
*> only calculates the optimal size of the WORK array, returns
@ -260,7 +261,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complexGEeigen
*> \ingroup gges3
*
* =====================================================================
SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B,
@ -300,7 +301,8 @@
LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
$ LQUERY, WANTST
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,
$ PVSR, SMLNUM
* ..
@ -310,13 +312,12 @@
* ..
* .. External Subroutines ..
EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY,
$ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, SLABAD,
$ XERBLA
$ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
REAL CLANGE, SLAMCH
EXTERNAL LSAME, CLANGE, SLAMCH
REAL CLANGE, SLAMCH, SROUNDUP_LWORK
EXTERNAL LSAME, CLANGE, SLAMCH, SROUNDUP_LWORK
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, SQRT
@ -353,6 +354,8 @@
*
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N )
*
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@ -369,7 +372,7 @@
INFO = -14
ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
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
END IF
*
@ -377,29 +380,33 @@
*
IF( INFO.EQ.0 ) THEN
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,
$ -1, IERR )
LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) )
IF( ILVSL ) THEN
CALL CUNGQR( N, N, N, VSL, LDVSL, WORK, WORK, -1,
$ IERR )
LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) )
END IF
CALL CGGHD3( JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, VSL,
$ 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,
$ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, -1,
$ RWORK, 0, IERR )
LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, INT( WORK( 1 ) ) )
IF( WANTST ) THEN
CALL CTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB,
$ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, SDIM,
$ 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
WORK( 1 ) = CMPLX( LWKOPT )
END IF
*
@ -422,7 +429,6 @@
EPS = SLAMCH( 'P' )
SMLNUM = SLAMCH( 'S' )
BIGNUM = ONE / SMLNUM
CALL SLABAD( SMLNUM, BIGNUM )
SMLNUM = SQRT( SMLNUM ) / EPS
BIGNUM = ONE / SMLNUM
*
@ -585,7 +591,7 @@
*
30 CONTINUE
*
WORK( 1 ) = CMPLX( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

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

@ -174,7 +174,8 @@
*> \param[in] LWORK
*> \verbatim
*> 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
*> only calculates the optimal size of the WORK array, returns
@ -208,7 +209,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complexGEeigen
*> \ingroup ggev3
*
* =====================================================================
SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
@ -243,7 +244,7 @@
CHARACTER CHTEMP
INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
$ IN, IRIGHT, IROWS, IRWRK, ITAU, IWRK, JC, JR,
$ LWKOPT
$ LWKOPT, LWKMIN
REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
$ SMLNUM, TEMP
COMPLEX X
@ -253,13 +254,12 @@
* ..
* .. External Subroutines ..
EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY,
$ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, SLABAD,
$ XERBLA
$ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
REAL CLANGE, SLAMCH
EXTERNAL LSAME, CLANGE, SLAMCH
REAL CLANGE, SLAMCH, SROUNDUP_LWORK
EXTERNAL LSAME, CLANGE, SLAMCH, SROUNDUP_LWORK
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, AIMAG, MAX, REAL, SQRT
@ -301,6 +301,7 @@
*
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N )
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@ -315,7 +316,7 @@
INFO = -11
ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
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
END IF
*
@ -323,7 +324,7 @@
*
IF( INFO.EQ.0 ) THEN
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,
$ -1, IERR )
LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
@ -348,7 +349,11 @@
$ RWORK, 0, IERR )
LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
END IF
WORK( 1 ) = CMPLX( LWKOPT )
IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
END IF
*
IF( INFO.NE.0 ) THEN
@ -368,7 +373,6 @@
EPS = SLAMCH( 'E' )*SLAMCH( 'B' )
SMLNUM = SLAMCH( 'S' )
BIGNUM = ONE / SMLNUM
CALL SLABAD( SMLNUM, BIGNUM )
SMLNUM = SQRT( SMLNUM ) / EPS
BIGNUM = ONE / SMLNUM
*
@ -549,7 +553,7 @@
IF( ILBSCL )
$ CALL CLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
*
WORK( 1 ) = CMPLX( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
*
* End of CGGEV3

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

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

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

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

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

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

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

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

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

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

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

@ -116,8 +116,7 @@
*>
*> \param[out] RWORK
*> \verbatim
*> RWORK is REAL array,
*> dimension (LRWORK)
*> RWORK is REAL array, dimension (MAX(1,LRWORK))
*> On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
*> \endverbatim
*>
@ -282,8 +281,8 @@
LROPT = LRWMIN
LIOPT = LIWMIN
END IF
WORK( 1 ) = SROUNDUP_LWORK(LOPT)
RWORK( 1 ) = LROPT
WORK( 1 ) = SROUNDUP_LWORK( LOPT )
RWORK( 1 ) = SROUNDUP_LWORK( LROPT )
IWORK( 1 ) = LIOPT
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
@ -378,8 +377,8 @@
CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(LOPT)
RWORK( 1 ) = LROPT
WORK( 1 ) = SROUNDUP_LWORK( LOPT )
RWORK( 1 ) = SROUNDUP_LWORK( LROPT )
IWORK( 1 ) = LIOPT
*
RETURN

31
lapack-netlib/SRC/cheevr.f
View File

@ -272,7 +272,8 @@
*> \param[in] LWORK
*> \verbatim
*> 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,
*> where NB is the max of the blocksize for CHETRD and for
*> CUNMTR as returned by ILAENV.
@ -294,7 +295,8 @@
*> \param[in] LRWORK
*> \verbatim
*> 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
*> routine only calculates the optimal sizes of the WORK, RWORK
@ -313,7 +315,8 @@
*> \param[in] LIWORK
*> \verbatim
*> LIWORK is INTEGER
*> The dimension of the array IWORK. LIWORK >= max(1,10*N).
*> The dimension of the array IWORK.
*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N.
*>
*> If LIWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal sizes of the WORK, RWORK
@ -417,9 +420,15 @@
LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR.
$ ( LIWORK.EQ.-1 ) )
*
LRWMIN = MAX( 1, 24*N )
LIWMIN = MAX( 1, 10*N )
LWMIN = MAX( 1, 2*N )
IF( N.LE.1 ) THEN
LWMIN = 1
LRWMIN = 1
LIWMIN = 1
ELSE
LWMIN = 2*N
LRWMIN = 24*N
LIWMIN = 10*N
END IF
*
INFO = 0
IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
@ -454,8 +463,8 @@
NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 )
NB = MAX( NB, ILAENV( 1, 'CUNMTR', UPLO, N, -1, -1, -1 ) )
LWKOPT = MAX( ( NB+1 )*N, LWMIN )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
RWORK( 1 ) = LRWMIN
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN )
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
@ -483,7 +492,7 @@
END IF
*
IF( N.EQ.1 ) THEN
WORK( 1 ) = 2
WORK( 1 ) = 1
IF( ALLEIG .OR. INDEIG ) THEN
M = 1
W( 1 ) = REAL( A( 1, 1 ) )
@ -710,8 +719,8 @@
*
* Set WORK(1) to optimal workspace size.
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
RWORK( 1 ) = LRWMIN
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN )
IWORK( 1 ) = LIWMIN
*
RETURN

57
lapack-netlib/SRC/cheevr_2stage.f
View File

@ -265,7 +265,7 @@
*> indicating the nonzero elements in Z. The i-th eigenvector
*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
*> ISUPPZ( 2*i ). This is an output of CSTEMR (tridiagonal
*> matrix). The support of the eigenvectors of A is typically
*> matrix). The support of the eigenvectors of A is typically
*> 1:N because of the unitary transformations applied by CUNMTR.
*> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
*> \endverbatim
@ -279,12 +279,13 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK.
*> If N <= 1, LWORK must be at least 1.
*> If JOBZ = 'N' and N > 1, LWORK must be queried.
*> LWORK = MAX(1, 26*N, dimension) where
*> dimension = max(stage1,stage2) + (KD+1)*N + N
*> = N*KD + N*max(KD+1,FACTOPTNB)
*> + max(2*KD*KD, KD*NTHREADS)
*> = N*KD + N*max(KD+1,FACTOPTNB)
*> + max(2*KD*KD, KD*NTHREADS)
*> + (KD+1)*N + N
*> where KD is the blocking size of the reduction,
*> FACTOPTNB is the blocking used by the QR or LQ
@ -310,7 +311,8 @@
*> \param[in] LRWORK
*> \verbatim
*> 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
*> routine only calculates the optimal sizes of the WORK, RWORK
@ -329,7 +331,8 @@
*> \param[in] LIWORK
*> \verbatim
*> LIWORK is INTEGER
*> The dimension of the array IWORK. LIWORK >= max(1,10*N).
*> The dimension of the array IWORK.
*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N.
*>
*> If LIWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal sizes of the WORK, RWORK
@ -354,7 +357,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complexHEeigen
*> \ingroup heevr_2stage
*
*> \par Contributors:
* ==================
@ -382,7 +385,7 @@
*> http://doi.acm.org/10.1145/2063384.2063394
*>
*> A. Haidar, J. Kurzak, P. Luszczek, 2013.
*> An improved parallel singular value algorithm and its implementation
*> An improved parallel singular value algorithm and its implementation
*> for multicore hardware, In Proceedings of 2013 International Conference
*> for High Performance Computing, Networking, Storage and Analysis (SC '13).
*> Denver, Colorado, USA, 2013.
@ -390,11 +393,11 @@
*> http://doi.acm.org/10.1145/2503210.2503292
*>
*> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure
*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure
*> calculations based on fine-grained memory aware tasks.
*> International Journal of High Performance Computing Applications.
*> Volume 28 Issue 2, Pages 196-209, May 2014.
*> http://hpc.sagepub.com/content/28/2/196
*> http://hpc.sagepub.com/content/28/2/196
*>
*> \endverbatim
*
@ -443,8 +446,9 @@
* .. External Functions ..
LOGICAL LSAME
INTEGER ILAENV, ILAENV2STAGE
REAL SLAMCH, CLANSY
EXTERNAL LSAME, SLAMCH, CLANSY, ILAENV, ILAENV2STAGE
REAL SLAMCH, CLANSY, SROUNDUP_LWORK
EXTERNAL LSAME, SLAMCH, CLANSY, ILAENV, ILAENV2STAGE,
$ SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CSSCAL,
@ -472,9 +476,16 @@
IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD
LRWMIN = MAX( 1, 24*N )
LIWMIN = MAX( 1, 10*N )
*
IF( N.LE.1 ) THEN
LWMIN = 1
LRWMIN = 1
LIWMIN = 1
ELSE
LWMIN = N + LHTRD + LWTRD
LRWMIN = 24*N
LIWMIN = 10*N
END IF
*
INFO = 0
IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
@ -506,8 +517,8 @@
END IF
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
RWORK( 1 ) = LRWMIN
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN )
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
@ -535,7 +546,7 @@
END IF
*
IF( N.EQ.1 ) THEN
WORK( 1 ) = 2
WORK( 1 ) = 1
IF( ALLEIG .OR. INDEIG ) THEN
M = 1
W( 1 ) = REAL( A( 1, 1 ) )
@ -643,9 +654,9 @@
*
* Call CHETRD_2STAGE to reduce Hermitian matrix to tridiagonal form.
*
CALL CHETRD_2STAGE( JOBZ, UPLO, N, A, LDA, RWORK( INDRD ),
CALL CHETRD_2STAGE( JOBZ, UPLO, N, A, LDA, RWORK( INDRD ),
$ RWORK( INDRE ), WORK( INDTAU ),
$ WORK( INDHOUS ), LHTRD,
$ WORK( INDHOUS ), LHTRD,
$ WORK( INDWK ), LLWORK, IINFO )
*
* If all eigenvalues are desired
@ -666,7 +677,7 @@
CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 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.
ELSE
TRYRAC = .FALSE.
@ -765,8 +776,8 @@
*
* Set WORK(1) to optimal workspace size.
*
WORK( 1 ) = LWMIN
RWORK( 1 ) = LRWMIN
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN )
IWORK( 1 ) = LIWMIN
*
RETURN

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

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

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

@ -177,7 +177,7 @@
*
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER LWKOPT, LWKOPT_HETRF, LWKOPT_HETRS
INTEGER LWKMIN, LWKOPT, LWKOPT_HETRF, LWKOPT_HETRS
* ..
* .. External Functions ..
LOGICAL LSAME
@ -197,6 +197,7 @@
*
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N, 3*N-2 )
IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@ -207,18 +208,18 @@
INFO = -5
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -8
ELSE IF( LWORK.LT.MAX( 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
*
IF( INFO.EQ.0 ) THEN
CALL 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,
$ -1, INFO )
LWKOPT_HETRS = INT( WORK(1) )
LWKOPT = MAX( LWKOPT_HETRF, LWKOPT_HETRS )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
LWKOPT_HETRS = INT( WORK( 1 ) )
LWKOPT = MAX( LWKMIN, LWKOPT_HETRF, LWKOPT_HETRS )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
*
IF( INFO.NE.0 ) THEN
@ -240,7 +241,7 @@
*
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

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

@ -99,14 +99,14 @@
*>
*> \param[out] TB
*> \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.
*> \endverbatim
*>
*> \param[in] LTB
*> \verbatim
*> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally
*> The size of the array TB. LTB >= MAX(1,4*N), internally
*> used to select NB such that LTB >= (3*NB+1)*N.
*>
*> If LTB = -1, then a workspace query is assumed; the
@ -146,14 +146,15 @@
*>
*> \param[out] WORK
*> \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
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB
*> such that LWORK >= N*NB.
*> The size of WORK. LWORK >= MAX(1,N), internally used to
*> select NB such that LWORK >= N*NB.
*>
*> If LWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the WORK array,
@ -203,7 +204,7 @@
*
* .. Local Scalars ..
LOGICAL UPPER, TQUERY, WQUERY
INTEGER LWKOPT
INTEGER LWKMIN, LWKOPT
* ..
* .. External Functions ..
LOGICAL LSAME
@ -225,6 +226,7 @@
UPPER = LSAME( UPLO, 'U' )
WQUERY = ( LWORK.EQ.-1 )
TQUERY = ( LTB.EQ.-1 )
LWKMIN = MAX( 1, N )
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@ -233,18 +235,19 @@
INFO = -3
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -5
ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN
ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN
INFO = -7
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -11
ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.WQUERY ) THEN
INFO = -13
END IF
*
IF( INFO.EQ.0 ) THEN
CALL CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
$ IPIV2, WORK, -1, INFO )
LWKOPT = INT( WORK(1) )
LWKOPT = MAX( LWKMIN, INT( WORK( 1 ) ) )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
*
IF( INFO.NE.0 ) THEN
@ -254,7 +257,6 @@
RETURN
END IF
*
*
* 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,
@ -268,7 +270,7 @@
*
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

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

@ -307,7 +307,7 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY, NOFACT
INTEGER LWKOPT, NB
INTEGER LWKMIN, LWKOPT, NB
REAL ANORM
* ..
* .. External Functions ..
@ -329,6 +329,7 @@
INFO = 0
NOFACT = LSAME( FACT, 'N' )
LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N )
IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
INFO = -1
ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
@ -346,17 +347,17 @@
INFO = -11
ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
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
END IF
*
IF( INFO.EQ.0 ) THEN
LWKOPT = MAX( 1, 2*N )
LWKOPT = LWKMIN
IF( NOFACT ) THEN
NB = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 )
LWKOPT = MAX( LWKOPT, N*NB )
END IF
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
*
IF( INFO.NE.0 ) THEN
@ -405,7 +406,7 @@
IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
$ INFO = N + 1
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

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

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

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

@ -132,15 +132,17 @@
*>
*> \param[out] HOUS
*> \verbatim
*> HOUS is COMPLEX array, dimension LHOUS, that
*> store the Householder representation.
*> HOUS is COMPLEX array, dimension (MAX(1,LHOUS))
*> Stores the Householder representation.
*> \endverbatim
*>
*> \param[in] LHOUS
*> \verbatim
*> LHOUS is INTEGER
*> The dimension of the array HOUS. LHOUS = MAX(1, dimension)
*> If LWORK = -1, or LHOUS=-1,
*> The dimension of the array HOUS.
*> If N = 0 or KD <= 1, LHOUS >= 1, else LHOUS = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS = -1,
*> then a query is assumed; the routine
*> only calculates the optimal size of the HOUS array, returns
*> this value as the first entry of the HOUS array, and no error
@ -152,14 +154,17 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX array, dimension LWORK.
*> WORK is COMPLEX array, dimension (MAX(1,LWORK)).
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK = MAX(1, dimension)
*> If LWORK = -1, or LHOUS=-1,
*> The dimension of the array WORK.
*> If N = 0 or KD <= 1, LWORK >= 1, else LWORK = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS = -1,
*> then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
@ -262,7 +267,7 @@
INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST,
$ ED, STIND, EDIND, BLKLASTIND, COLPT, THED,
$ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID,
$ NBTILES, TTYPE, TID, NTHREADS, DEBUG,
$ NBTILES, TTYPE, TID, NTHREADS,
$ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS,
$ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU,
$ SICEV, SIZETAU, LDV, LHMIN, LWMIN
@ -286,7 +291,6 @@
* Determine the minimal workspace size required.
* Test the input parameters
*
DEBUG = 0
INFO = 0
AFTERS1 = LSAME( STAGE1, 'Y' )
WANTQ = LSAME( VECT, 'V' )
@ -295,9 +299,14 @@
*
* Determine the block size, the workspace size and the hous size.
*
IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', VECT, N, KD, -1, -1 )
LHMIN = ILAENV2STAGE( 3, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'CHETRD_HB2ST', VECT, N, KD, IB, -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 )
LWMIN = ILAENV2STAGE( 4, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 )
END IF
*
IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN
INFO = -1
@ -318,8 +327,8 @@
END IF
*
IF( INFO.EQ.0 ) THEN
HOUS( 1 ) = LHMIN
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
HOUS( 1 ) = SROUNDUP_LWORK( LHMIN )
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
*
IF( INFO.NE.0 ) THEN
@ -575,8 +584,7 @@ C END IF
170 CONTINUE
ENDIF
*
HOUS( 1 ) = LHMIN
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
*
* End of CHETRD_HB2ST

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

@ -123,8 +123,8 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX array, dimension (LWORK)
*> On exit, if INFO = 0, or if LWORK=-1,
*> WORK is COMPLEX array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, or if LWORK = -1,
*> WORK(1) returns the size of LWORK.
*> \endverbatim
*>
@ -132,7 +132,9 @@
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK which should be calculated
*> by a workspace query. LWORK = MAX(1, LWORK_QUERY)
*> by a workspace query.
*> If N <= KD+1, LWORK >= 1, else LWORK = MAX(1, LWORK_QUERY).
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
@ -294,8 +296,12 @@
INFO = 0
UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 )
LWMIN = ILAENV2STAGE( 4, 'CHETRD_HE2HB', '', N, KD, -1, -1 )
IF( N.LE.KD+1 ) THEN
LWMIN = 1
ELSE
LWMIN = ILAENV2STAGE( 4, 'CHETRD_HE2HB', '', N, KD, -1, -1 )
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@ -314,7 +320,7 @@
CALL XERBLA( 'CHETRD_HE2HB', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
END IF
*
@ -507,7 +513,7 @@
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
*
* End of CHETRD_HE2HB

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

@ -107,7 +107,7 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >=1. For best performance
*> The length of WORK. LWORK >= 1. For best performance
*> LWORK >= N*NB, where NB is the block size returned by ILAENV.
*> \endverbatim
*>
@ -228,8 +228,8 @@
* Determine the block size
*
NB = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 )
LWKOPT = N*NB
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
*
IF( INFO.NE.0 ) THEN
@ -347,7 +347,7 @@
END IF
*
40 CONTINUE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
*
* End of CHETRF

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

@ -101,8 +101,10 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >= 2*N. For optimum performance
*> LWORK >= N*(1+NB), where NB is the optimal blocksize.
*> The length of WORK.
*> LWORK >= 1, if N <= 1, and LWORK >= 2*N, otherwise.
*> For optimum performance LWORK >= N*(1+NB), where NB is
*> the optimal blocksize, returned by ILAENV.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@ -128,7 +130,7 @@
*> \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 is a software package provided by Univ. of Tennessee, --
@ -152,7 +154,7 @@
*
* .. Local Scalars ..
LOGICAL LQUERY, UPPER
INTEGER J, LWKOPT
INTEGER J, LWKMIN, LWKOPT
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
COMPLEX ALPHA
* ..
@ -179,19 +181,26 @@
INFO = 0
UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 )
IF( N.LE.1 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = 2*N
LWKOPT = (NB+1)*N
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4
ELSE IF( LWORK.LT.( 2*N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -7
END IF
*
IF( INFO.EQ.0 ) THEN
LWKOPT = (NB+1)*N
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
*
IF( INFO.NE.0 ) THEN
@ -203,11 +212,11 @@
*
* Quick return
*
IF ( N.EQ.0 ) THEN
IF( N.EQ.0 ) THEN
RETURN
ENDIF
IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN
IF( N.EQ.1 ) THEN
A( 1, 1 ) = REAL( A( 1, 1 ) )
RETURN
END IF
@ -460,7 +469,7 @@
END IF
*
20 CONTINUE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
*
* End of CHETRF_AA

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

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

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

@ -177,14 +177,14 @@
*>
*> \param[out] WORK
*> \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.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >=1. For best performance
*> The length of WORK. LWORK >= 1. For best performance
*> LWORK >= N*NB, where NB is the block size returned
*> by ILAENV.
*>
@ -311,8 +311,8 @@
* Determine the block size
*
NB = ILAENV( 1, 'CHETRF_RK', UPLO, N, -1, -1, -1 )
LWKOPT = N*NB
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
*
IF( INFO.NE.0 ) THEN
@ -488,7 +488,7 @@
*
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
*
* End of CHETRF_RK

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

@ -122,7 +122,7 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >=1. For best performance
*> The length of WORK. LWORK >= 1. For best performance
*> LWORK >= N*NB, where NB is the block size returned by ILAENV.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
@ -264,7 +264,7 @@
*
NB = ILAENV( 1, 'CHETRF_ROOK', UPLO, N, -1, -1, -1 )
LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
*
IF( INFO.NE.0 ) THEN
@ -387,7 +387,7 @@
END IF
*
40 CONTINUE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
*
* End of CHETRF_ROOK

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

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

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

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

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

@ -105,7 +105,13 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,3*N-2).
*> The dimension of the array WORK.
*> If MIN(N,NRHS) = 0, LWORK >= 1, else LWORK >= 3*N-2.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*> \endverbatim
*>
*> \param[out] INFO
@ -151,24 +157,30 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY, UPPER
INTEGER K, KP, LWKOPT
INTEGER K, KP, LWKMIN
* ..
* .. External Functions ..
LOGICAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL LSAME,SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL CLACPY, CLACGV, CGTSV, CSWAP, CTRSM, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
INTRINSIC MIN, MAX
* ..
* .. Executable Statements ..
*
INFO = 0
UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 )
IF( MIN( N, NRHS ).EQ.0 ) THEN
LWKMIN = 1
ELSE
LWKMIN = 3*N-2
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@ -179,21 +191,20 @@
INFO = -5
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -8
ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CHETRS_AA', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
LWKOPT = (3*N-2)
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKMIN )
RETURN
END IF
*
* Quick return if possible
*
IF( N.EQ.0 .OR. NRHS.EQ.0 )
IF( MIN( N, NRHS ).EQ.0 )
$ RETURN
*
IF( UPPER ) THEN

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

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

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

@ -128,22 +128,24 @@
*>
*> \param[out] WORK
*> \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
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> If MIN(M,N,K) = 0, LWORK >= 1.
*> If SIDE = 'L', LWORK >= max(1,N*NB).
*> If SIDE = 'R', LWORK >= max(1,MB*NB).
*>
*> If SIDE = 'L', LWORK >= max(1,N)*NB;
*> if SIDE = 'R', LWORK >= max(1,MB)*NB.
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*>
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@ -195,45 +197,47 @@
*>
* =====================================================================
SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
$ LDT, C, LDC, WORK, LWORK, INFO )
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
CHARACTER SIDE, TRANS
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
* ..
* .. Array Arguments ..
COMPLEX A( LDA, * ), WORK( * ), C(LDC, * ),
$ T( LDT, * )
COMPLEX A( LDA, * ), WORK( * ), C( LDC, * ),
$ T( LDT, * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER I, II, KK, LW, CTR, Q
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER I, II, KK, LW, CTR, Q, MINMNK, LWMIN
* ..
* .. External Functions ..
LOGICAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL CGEMQRT, CTPMQRT, XERBLA
EXTERNAL CGEMQRT, CTPMQRT, XERBLA
* ..
* .. Executable Statements ..
*
* Test the input arguments
*
LQUERY = LWORK.LT.0
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
IF (LEFT) THEN
IF( LEFT ) THEN
LW = N * NB
Q = M
ELSE
@ -241,11 +245,17 @@
Q = N
END IF
*
INFO = 0
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
*
IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
INFO = -1
INFO = -1
ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
INFO = -2
INFO = -2
ELSE IF( M.LT.K ) THEN
INFO = -3
ELSE IF( N.LT.0 ) THEN
@ -256,38 +266,38 @@
INFO = -7
ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN
INFO = -9
ELSE IF( LDT.LT.MAX( 1, NB) ) THEN
ELSE IF( LDT.LT.MAX( 1, NB ) ) THEN
INFO = -11
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -13
ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
INFO = -13
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -15
END IF
*
* Determine the block size if it is tall skinny or short and wide
*
IF( INFO.EQ.0) THEN
WORK(1) = SROUNDUP_LWORK(LW)
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CLAMTSQR', -INFO )
RETURN
ELSE IF (LQUERY) THEN
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( MIN(M,N,K).EQ.0 ) THEN
IF( MINMNK.EQ.0 ) THEN
RETURN
END IF
*
* Determine the block size if it is tall skinny or short and wide
*
IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN
CALL CGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA,
$ T, LDT, C, LDC, WORK, INFO)
$ T, LDT, C, LDC, WORK, INFO )
RETURN
END IF
END IF
*
IF(LEFT.AND.NOTRAN) THEN
*
@ -412,7 +422,7 @@
*
END IF
*
WORK(1) = SROUNDUP_LWORK(LW)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
*
* End of CLAMTSQR

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

@ -96,22 +96,24 @@
*> The leading dimension of the array T. LDT >= MB.
*> \endverbatim
*>
*>
*> \param[out] WORK
*> \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
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= MB*M.
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MB*M, otherwise.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*>
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@ -163,33 +165,35 @@
*>
* =====================================================================
SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
$ INFO)
$ INFO )
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
* ..
* .. Array Arguments ..
COMPLEX A( LDA, * ), WORK( * ), T( LDT, *)
COMPLEX A( LDA, * ), WORK( * ), T( LDT, * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, II, KK, CTR
LOGICAL LQUERY
INTEGER I, II, KK, CTR, MINMN, LWMIN
* ..
* .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME
INTEGER ILAENV
REAL SROUNDUP_LWORK
EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK
* ..
* .. EXTERNAL SUBROUTINES ..
EXTERNAL CGELQT, CTPLQT, XERBLA
* ..
* .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD
* ..
@ -200,12 +204,19 @@
INFO = 0
*
LQUERY = ( LWORK.EQ.-1 )
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = M*MB
END IF
*
IF( M.LT.0 ) THEN
INFO = -1
ELSE IF( N.LT.0 .OR. N.LT.M ) THEN
INFO = -2
ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN
ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 ) ) THEN
INFO = -3
ELSE IF( NB.LE.0 ) THEN
INFO = -4
@ -213,60 +224,61 @@
INFO = -6
ELSE IF( LDT.LT.MB ) THEN
INFO = -8
ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -10
END IF
IF( INFO.EQ.0) THEN
WORK(1) = SROUNDUP_LWORK(MB*M)
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CLASWLQ', -INFO )
RETURN
ELSE IF (LQUERY) THEN
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( MIN(M,N).EQ.0 ) THEN
RETURN
IF( MINMN.EQ.0 ) THEN
RETURN
END IF
*
* The LQ Decomposition
*
IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
IF( (M.GE.N) .OR. (NB.LE.M) .OR. (NB.GE.N) ) THEN
CALL CGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO)
RETURN
END IF
END IF
*
KK = MOD((N-M),(NB-M))
II=N-KK+1
KK = MOD((N-M),(NB-M))
II = N-KK+1
*
* Compute the LQ factorization of the first block A(1:M,1:NB)
* Compute the LQ factorization of the first block A(1:M,1:NB)
*
CALL CGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO)
CTR = 1
CALL CGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO)
CTR = 1
*
DO I = NB+1, II-NB+M , (NB-M)
DO I = NB+1, II-NB+M , (NB-M)
*
* Compute the QR factorization of the current block A(1:M,I:I+NB-M)
* Compute the QR factorization of the current block A(1:M,I:I+NB-M)
*
CALL CTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
CALL CTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
$ LDA, T(1,CTR*M+1),
$ LDT, WORK, INFO )
CTR = CTR + 1
END DO
CTR = CTR + 1
END DO
*
* Compute the QR factorization of the last block A(1:M,II:N)
*
IF (II.LE.N) THEN
IF( II.LE.N ) THEN
CALL CTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ),
$ LDA, T(1,CTR*M+1), LDT,
$ WORK, INFO )
END IF
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(M * MB)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
*
* End of CLASWLQ

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

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

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

@ -101,15 +101,18 @@
*>
*> \param[out] WORK
*> \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
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= NB*N.
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*> \endverbatim
@ -165,32 +168,34 @@
*>
* =====================================================================
SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK,
$ LWORK, INFO)
$ LWORK, INFO )
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK
INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK
* ..
* .. Array Arguments ..
COMPLEX A( LDA, * ), WORK( * ), T(LDT, *)
COMPLEX A( LDA, * ), WORK( * ), T( LDT, * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, II, KK, CTR
LOGICAL LQUERY
INTEGER I, II, KK, CTR, LWMIN, MINMN
* ..
* .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
* ..
* .. EXTERNAL SUBROUTINES ..
EXTERNAL CGEQRT, CTPQRT, XERBLA
EXTERNAL CGEQRT, CTPQRT, XERBLA
* ..
* .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD
* ..
@ -201,6 +206,13 @@
INFO = 0
*
LQUERY = ( LWORK.EQ.-1 )
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = N*NB
END IF
*
IF( M.LT.0 ) THEN
INFO = -1
@ -208,64 +220,65 @@
INFO = -2
ELSE IF( MB.LT.1 ) THEN
INFO = -3
ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN
ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 ) ) THEN
INFO = -4
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -6
ELSE IF( LDT.LT.NB ) THEN
INFO = -8
ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -10
END IF
IF( INFO.EQ.0) THEN
WORK(1) = SROUNDUP_LWORK(NB*N)
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CLATSQR', -INFO )
RETURN
ELSE IF (LQUERY) THEN
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( MIN(M,N).EQ.0 ) THEN
RETURN
IF( MINMN.EQ.0 ) THEN
RETURN
END IF
*
* The QR Decomposition
*
IF ((MB.LE.N).OR.(MB.GE.M)) THEN
CALL CGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO)
RETURN
END IF
KK = MOD((M-N),(MB-N))
II=M-KK+1
IF ( (MB.LE.N) .OR. (MB.GE.M) ) THEN
CALL CGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
RETURN
END IF
KK = MOD((M-N),(MB-N))
II = M-KK+1
*
* Compute the QR factorization of the first block A(1:MB,1:N)
* Compute the QR factorization of the first block A(1:MB,1:N)
*
CALL CGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO )
CTR = 1
CALL CGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO )
CTR = 1
*
DO I = MB+1, II-MB+N , (MB-N)
DO I = MB+1, II-MB+N, (MB-N)
*
* Compute the QR factorization of the current block A(I:I+MB-N,1:N)
* Compute the QR factorization of the current block A(I:I+MB-N,1:N)
*
CALL CTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA,
CALL CTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA,
$ T(1,CTR * N + 1),
$ LDT, WORK, INFO )
CTR = CTR + 1
END DO
$ LDT, WORK, INFO )
CTR = CTR + 1
END DO
*
* Compute the QR factorization of the last block A(II:M,1:N)
* Compute the QR factorization of the last block A(II:M,1:N)
*
IF (II.LE.M) THEN
CALL CTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
IF( II.LE.M ) THEN
CALL CTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
$ T(1, CTR * N + 1), LDT,
$ WORK, INFO )
END IF
$ WORK, INFO )
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(N*NB)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
*
* End of CLATSQR

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

@ -107,7 +107,7 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >=1. For best performance
*> The length of WORK. LWORK >= 1. For best performance
*> LWORK >= N*NB, where NB is the block size returned by ILAENV.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
@ -135,7 +135,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup doubleSYcomputational
*> \ingroup hetrf
*
*> \par Further Details:
* =====================
@ -352,6 +352,7 @@
END IF
*
40 CONTINUE
*
WORK( 1 ) = LWKOPT
RETURN
*

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

@ -132,15 +132,17 @@
*>
*> \param[out] HOUS
*> \verbatim
*> HOUS is REAL array, dimension LHOUS, that
*> store the Householder representation.
*> HOUS is REAL array, dimension (MAX(1,LHOUS))
*> Stores the Householder representation.
*> \endverbatim
*>
*> \param[in] LHOUS
*> \verbatim
*> LHOUS is INTEGER
*> The dimension of the array HOUS. LHOUS = MAX(1, dimension)
*> If LWORK = -1, or LHOUS=-1,
*> The dimension of the array HOUS.
*> If N = 0 or KD <= 1, LHOUS >= 1, else LHOUS = MAX(1, dimension)
*>
*> If LWORK = -1, or LHOUS = -1,
*> then a query is assumed; the routine
*> only calculates the optimal size of the HOUS array, returns
*> this value as the first entry of the HOUS array, and no error
@ -152,14 +154,17 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is REAL array, dimension LWORK.
*> WORK is REAL array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns optimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK = MAX(1, dimension)
*> If LWORK = -1, or LHOUS=-1,
*> The dimension of the array WORK.
*> IF N = 0 or KD <= 1, LWORK >= 1, else LWORK = MAX(1, dimension)
*>
*> If LWORK = -1, or LHOUS = -1,
*> then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
@ -261,7 +266,7 @@
INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST,
$ ED, STIND, EDIND, BLKLASTIND, COLPT, THED,
$ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID,
$ NBTILES, TTYPE, TID, NTHREADS, DEBUG,
$ NBTILES, TTYPE, TID, NTHREADS,
$ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS,
$ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU,
$ SISEV, SIZETAU, LDV, LHMIN, LWMIN
@ -283,7 +288,6 @@
* Determine the minimal workspace size required.
* Test the input parameters
*
DEBUG = 0
INFO = 0
AFTERS1 = LSAME( STAGE1, 'Y' )
WANTQ = LSAME( VECT, 'V' )
@ -292,9 +296,14 @@
*
* Determine the block size, the workspace size and the hous size.
*
IB = ILAENV2STAGE( 2, 'SSYTRD_SB2ST', VECT, N, KD, -1, -1 )
LHMIN = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', VECT, N, KD, IB, -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 )
LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 )
END IF
*
IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN
INFO = -1
@ -315,8 +324,8 @@
END IF
*
IF( INFO.EQ.0 ) THEN
HOUS( 1 ) = LHMIN
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
HOUS( 1 ) = SROUNDUP_LWORK( LHMIN )
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
*
IF( INFO.NE.0 ) THEN
@ -544,8 +553,7 @@
170 CONTINUE
ENDIF
*
HOUS( 1 ) = LHMIN
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
*
* End of SSYTRD_SB2ST