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

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

This commit is contained in:
Martin Kroeker 2023-12-23 20:05:03 +01:00 committed by GitHub
parent 29d6024ec5
commit c082669ad4
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
43 changed files with 671 additions and 418 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -122,7 +122,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of the array WORK. LWORK >= max(1,M,N).
*> The length of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(M,N), otherwise.
*> For optimum performance LWORK >= (M+N)*NB, where NB
*> is the optimal blocksize.
*>
@ -223,8 +224,8 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
$ NBMIN, NX, WS
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT,
$ MINMN, NB, NBMIN, NX, WS
* ..
* .. External Subroutines ..
EXTERNAL SGEBD2, SGEMM, SLABRD, XERBLA
@ -242,9 +243,16 @@
* Test the input parameters
*
INFO = 0
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = MAX( M, N )
NB = MAX( 1, ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 ) )
LWKOPT = ( M+N )*NB
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
ENDIF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
@ -252,7 +260,7 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
IF( INFO.LT.0 ) THEN
@ -264,7 +272,6 @@
*
* Quick return if possible
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
WORK( 1 ) = 1
RETURN
@ -283,7 +290,7 @@
* Determine when to switch from blocked to unblocked code.
*
IF( NX.LT.MINMN ) THEN
WS = ( M+N )*NB
WS = LWKOPT
IF( LWORK.LT.WS ) THEN
*
* Not enough work space for the optimal NB, consider using
@ -342,7 +349,8 @@
*
CALL SGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ),
$ TAUQ( I ), TAUP( I ), WORK, IINFO )
WORK( 1 ) = SROUNDUP_LWORK(WS)
*
WORK( 1 ) = SROUNDUP_LWORK( WS )
RETURN
*
* End of SGEBRD

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

@ -89,7 +89,7 @@
*>
*> \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 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, 'SGEHRD', ' ', N, ILO, IHI, -1 ) )
IF( NH.LE.1 ) THEN
LWKOPT = 1
ELSE
NB = MIN( NBMAX, ILAENV( 1, 'SGEHRD', ' ', N, ILO, IHI,
$ -1 ) )
LWKOPT = N*NB + TSIZE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
ENDIF
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 SGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
*
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

8
lapack-netlib/SRC/sgelq.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
*
* End of SGELQ

20
lapack-netlib/SRC/sgelqf.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, 'SGELQF', ' ', 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( 'SGELQF', -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 SGELQ2( 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 SGELQF

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

@ -110,13 +110,14 @@
*>
*> \param[out] WORK
*> \verbatim
*> (workspace) REAL array, dimension (MAX(1,LWORK))
*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1, then a workspace query is assumed. The routine
*> only calculates the size of the WORK array, returns this
*> value as WORK(1), and no error message related to WORK
@ -187,7 +188,7 @@
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER MB, NB, LW, NBLCKS, MN
INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
* ..
* .. External Functions ..
LOGICAL LSAME
@ -207,7 +208,7 @@
*
* Test the input arguments
*
LQUERY = LWORK.EQ.-1
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' )
@ -222,6 +223,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
@ -250,12 +258,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 ) = SROUNDUP_LWORK( LW )
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
*
IF( INFO.NE.0 ) THEN
@ -267,7 +275,7 @@
*
* Quick return if possible
*
IF( MIN( M, N, K ).EQ.0 ) THEN
IF( MINMNK.EQ.0 ) THEN
RETURN
END IF
*
@ -280,7 +288,7 @@
$ MB, C, LDC, WORK, LWORK, INFO )
END IF
*
WORK( 1 ) = SROUNDUP_LWORK( LW )
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
*
RETURN
*

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

@ -189,12 +189,13 @@
* ..
* .. 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 SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL SGEMQRT, SLAMTSQR, XERBLA
@ -206,7 +207,7 @@
*
* Test the input arguments
*
LQUERY = LWORK.EQ.-1
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' )
@ -221,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
@ -249,12 +257,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 ) = SROUNDUP_LWORK(LW)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
*
IF( INFO.NE.0 ) THEN
@ -266,7 +274,7 @@
*
* Quick return if possible
*
IF( MIN( M, N, K ).EQ.0 ) THEN
IF( MINMNK.EQ.0 ) THEN
RETURN
END IF
*
@ -279,7 +287,7 @@
$ NB, C, LDC, WORK, LWORK, INFO )
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(LW)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
*
RETURN
*

8
lapack-netlib/SRC/sgeqlf.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.
*>
@ -189,8 +190,9 @@
END IF
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
*

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

@ -427,7 +427,8 @@
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*. LWORK >= (3*N + NRHS - 1)
*> LWORK >= 1, if MIN(M,N) = 0, and
*> LWORK >= (3*N+NRHS-1), otherwise.
*> For optimal performance LWORK >= (2*N + NB*( N+NRHS+1 )),
*> where NB is the optimal block size for SGEQP3RK returned
*> by ILAENV. Minimal block size MINNB=2.
@ -618,8 +619,9 @@
* .. External Functions ..
LOGICAL SISNAN
INTEGER ISAMAX, ILAENV
REAL SLAMCH, SNRM2
EXTERNAL SISNAN, SLAMCH, SNRM2, ISAMAX, ILAENV
REAL SLAMCH, SNRM2, SROUNDUP_LWORK
EXTERNAL SISNAN, SLAMCH, SNRM2, ISAMAX, ILAENV,
$ SROUNDUP_LWORK
* ..
* .. Intrinsic Functions ..
INTRINSIC REAL, MAX, MIN
@ -696,7 +698,7 @@
*
LWKOPT = 2*N + NB*( N+NRHS+1 )
END IF
WORK( 1 ) = REAL( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
INFO = -15
@ -719,7 +721,7 @@
K = 0
MAXC2NRMK = ZERO
RELMAXC2NRMK = ZERO
WORK( 1 ) = REAL( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
END IF
*
@ -772,7 +774,7 @@
*
* Array TAU is not set and contains undefined elements.
*
WORK( 1 ) = REAL( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
END IF
*
@ -791,7 +793,7 @@
TAU( J ) = ZERO
END DO
*
WORK( 1 ) = REAL( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
*
END IF
@ -822,7 +824,7 @@
DO J = 1, MINMN
TAU( J ) = ZERO
END DO
WORK( 1 ) = REAL( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
END IF
*
@ -867,7 +869,7 @@
TAU( J ) = ZERO
END DO
*
WORK( 1 ) = REAL( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
END IF
*
@ -985,7 +987,7 @@
*
* Return from the routine.
*
WORK( 1 ) = REAL( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*
@ -1072,7 +1074,7 @@
*
END IF
*
WORK( 1 ) = REAL( LWKOPT )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

22
lapack-netlib/SRC/sgeqr.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 SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
$ INFO )
@ -188,11 +190,13 @@
* ..
* .. 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 SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL SLATSQR, SGEQRT, XERBLA
@ -244,8 +248,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 +259,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 +274,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 +288,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 +315,7 @@
$ LWORK, INFO )
END IF
*
WORK( 1 ) = MAX( 1, NB*N )
WORK( 1 ) = SROUNDUP_LWORK( LWREQ )
*
RETURN
*

26
lapack-netlib/SRC/sgeqrfp.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 SGEQR2P, SLARFB, SLARFT, XERBLA
@ -173,8 +174,9 @@
* ..
* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
REAL SROUNDUP_LWORK
EXTERNAL ILAENV, SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. Executable Statements ..
*
@ -182,8 +184,16 @@
*
INFO = 0
NB = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
K = MIN( M, N )
IF( K.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = N
LWKOPT = N*NB
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
@ -191,7 +201,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
@ -211,7 +221,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 +283,7 @@
$ CALL SGEQR2P( 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 SGEQRFP

36
lapack-netlib/SRC/sgesvj.f
View File

@ -208,7 +208,7 @@
*>
*> \param[in,out] WORK
*> \verbatim
*> WORK is REAL array, dimension (LWORK)
*> WORK is REAL array, dimension (MAX(1,LWORK))
*> On entry,
*> If JOBU = 'C' :
*> WORK(1) = CTOL, where CTOL defines the threshold for convergence.
@ -239,7 +239,12 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> length of WORK, WORK >= MAX(6,M+N)
*> Length of WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(6,M+N), otherwise.
*>
*> If on entry LWORK = -1, then a workspace query is assumed and
*> no computation is done; WORK(1) is set to the minial (and optimal)
*> length of WORK.
*> \endverbatim
*>
*> \param[out] INFO
@ -260,7 +265,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup realGEcomputational
*> \ingroup gesvj
*
*> \par Further Details:
* =====================
@ -351,9 +356,9 @@
INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
$ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34,
$ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP,
$ SWBAND
LOGICAL APPLV, GOSCALE, LOWER, LSVEC, NOSCALE, ROTOK,
$ RSVEC, UCTOL, UPPER
$ SWBAND, MINMN, LWMIN
LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE,
$ ROTOK, RSVEC, UCTOL, UPPER
* ..
* .. Local Arrays ..
REAL FASTR( 5 )
@ -369,8 +374,8 @@
INTEGER ISAMAX
EXTERNAL ISAMAX
* from LAPACK
REAL SLAMCH
EXTERNAL SLAMCH
REAL SLAMCH, SROUNDUP_LWORK
EXTERNAL SLAMCH, SROUNDUP_LWORK
LOGICAL LSAME
EXTERNAL LSAME
* ..
@ -394,6 +399,14 @@
UPPER = LSAME( JOBA, 'U' )
LOWER = LSAME( JOBA, 'L' )
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 6, M+N )
END IF
*
LQUERY = ( LWORK.EQ.-1 )
IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN
INFO = -1
ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN
@ -413,7 +426,7 @@
INFO = -11
ELSE IF( UCTOL .AND. ( WORK( 1 ).LE.ONE ) ) THEN
INFO = -12
ELSE IF( LWORK.LT.MAX( M+N, 6 ) ) THEN
ELSE IF( LWORK.LT.LWMIN .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
ELSE
INFO = 0
@ -423,11 +436,14 @@
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGESVJ', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
END IF
*
* #:) Quick return for void matrix
*
IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN
IF( MINMN.EQ.0 ) RETURN
*
* Set numerical parameters
* The stopping criterion for Jacobi rotations is

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

@ -137,8 +137,9 @@
* ..
* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
REAL SROUNDUP_LWORK
EXTERNAL ILAENV, SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL SGEMM, SGEMV, SSWAP, STRSM, STRTRI, XERBLA
@ -152,8 +153,9 @@
*
INFO = 0
NB = ILAENV( 1, 'SGETRI', ' ', 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
@ -251,7 +253,7 @@
$ CALL SSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 )
60 CONTINUE
*
WORK( 1 ) = SROUNDUP_LWORK(IWS)
WORK( 1 ) = SROUNDUP_LWORK( IWS )
RETURN
*
* End of SGETRI

7
lapack-netlib/SRC/sgetsls.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).
@ -226,7 +226,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 SGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) )
LWO = INT( WORKQ( 1 ) )

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

@ -130,14 +130,17 @@
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> LWORK >= MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ),
*> If MIN(M,N) = 0, LWORK >= 1, else
*> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ),
*> where
*> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)),
*> NB1LOCAL = MIN(NB1,N).
*> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL,
*> LW1 = NB1LOCAL * N,
*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ),
*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ).
*>
*> If LWORK = -1, then a workspace query is assumed.
*> The routine only calculates the optimal size of the WORK
*> array, returns this value as the first entry of the WORK
@ -216,7 +219,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
@ -267,8 +270,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
*

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

@ -234,6 +234,8 @@
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> If N = 0, LWORK >= 1, else LWORK >= 6*N+16.
*> For good performance, LWORK must generally be larger.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@ -309,7 +311,8 @@
LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
$ LQUERY, LST2SL, WANTST
INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
$ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, LWKOPT
$ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, LWKOPT,
$ LWKMIN
REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL,
$ PVSR, SAFMAX, SAFMIN, SMLNUM
* ..
@ -361,6 +364,12 @@
*
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
IF( N.EQ.0 ) THEN
LWKMIN = 1
ELSE
LWKMIN = 6*N+16
END IF
*
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@ -377,7 +386,7 @@
INFO = -15
ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
INFO = -17
ELSE IF( LWORK.LT.6*N+16 .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -19
END IF
*
@ -385,7 +394,7 @@
*
IF( INFO.EQ.0 ) THEN
CALL SGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
LWKOPT = MAX( 6*N+16, 3*N+INT( WORK( 1 ) ) )
LWKOPT = MAX( LWKMIN, 3*N+INT( WORK( 1 ) ) )
CALL SORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK,
$ -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
@ -407,7 +416,11 @@
$ IERR )
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
END IF
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
END IF
*
IF( INFO.NE.0 ) THEN
@ -421,6 +434,7 @@
*
IF( N.EQ.0 ) THEN
SDIM = 0
WORK( 1 ) = 1
RETURN
END IF
*
@ -657,7 +671,7 @@
*
40 CONTINUE
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

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

@ -189,6 +189,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= MAX(1,8*N).
*> For good performance, LWORK should generally be larger.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@ -248,7 +250,8 @@
LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
CHARACTER CHTEMP
INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
$ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, LWKOPT
$ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, LWKOPT,
$ LWKMIN
REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
$ SMLNUM, TEMP
* ..
@ -298,6 +301,7 @@
*
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 8*N )
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@ -312,7 +316,7 @@
INFO = -12
ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
INFO = -14
ELSE IF( LWORK.LT.MAX( 1, 8*N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -16
END IF
*
@ -320,28 +324,31 @@
*
IF( INFO.EQ.0 ) THEN
CALL SGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
LWKOPT = MAX( 1, 8*N, 3*N+INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKMIN, 3*N+INT( WORK( 1 ) ) )
CALL SORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK,
$ -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
CALL SGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL, LDVL,
$ VR, LDVR, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
IF( ILVL ) THEN
CALL SORGQR( N, N, N, VL, LDVL, WORK, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
CALL SLAQZ0( 'S', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
$ WORK, -1, 0, IERR )
LWKOPT = MAX( LWKOPT, 2*N+INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
ELSE
CALL SLAQZ0( 'E', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
$ WORK, -1, 0, IERR )
LWKOPT = MAX( LWKOPT, 2*N+INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
END IF
IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
END IF
END IF
*
IF( INFO.NE.0 ) THEN

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

@ -179,7 +179,7 @@
*>
*> \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 LWORK.
*> \endverbatim
*>
@ -276,7 +276,12 @@
*
INFO = 0
NB = ILAENV( 1, 'SGGHD3', ' ', N, ILO, IHI, -1 )
LWKOPT = MAX( 6*N*NB, 1 )
NH = IHI - ILO + 1
IF( NH.LE.1 ) THEN
LWKOPT = 1
ELSE
LWKOPT = 6*N*NB
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
INITQ = LSAME( COMPQ, 'I' )
WANTQ = INITQ .OR. LSAME( COMPQ, 'V' )
@ -326,7 +331,6 @@
*
* Quick return if possible
*
NH = IHI - ILO + 1
IF( NH.LE.1 ) THEN
WORK( 1 ) = ONE
RETURN
@ -886,6 +890,7 @@
IF ( JCOL.LT.IHI )
$ CALL SGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q,
$ LDQ, Z, LDZ, IERR )
*
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN

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

@ -236,8 +236,9 @@
* ..
* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
REAL SROUNDUP_LWORK
EXTERNAL ILAENV, SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN
@ -251,8 +252,9 @@
NB2 = ILAENV( 1, 'SGERQF', ' ', N, P, -1, -1 )
NB3 = ILAENV( 1, 'SORMQR', ' ', 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
@ -289,6 +291,7 @@
*
CALL SGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO )
LWKOPT = MAX( LOPT, INT( WORK( 1 ) ) )
*
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN

2
lapack-netlib/SRC/sggrqf.f
View File

@ -250,7 +250,7 @@
NB2 = ILAENV( 1, 'SGEQRF', ' ', P, N, -1, -1 )
NB3 = ILAENV( 1, 'SORMRQ', ' ', M, N, P, -1 )
NB = MAX( NB1, NB2, NB3 )
LWKOPT = MAX( N, M, P)*NB
LWKOPT = MAX( 1, MAX( N, M, P )*NB )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN

2
lapack-netlib/SRC/sggsvd3.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

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

@ -227,7 +227,7 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK. LWORK >= 1.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@ -300,8 +300,9 @@
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL SGEQP3, SGEQR2, SGERQ2, SLACPY, SLAPMT,

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

@ -128,16 +128,19 @@
*> \param[out] WORK
*> \verbatim
*> (workspace) REAL array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> If SIDE = 'L', LWORK >= max(1,NB) * MB;
*> if SIDE = 'R', LWORK >= max(1,M) * MB.
*>
*> If MIN(M,N,K) = 0, LWORK >= 1.
*> If SIDE = 'L', LWORK >= max(1,NB*MB).
*> If SIDE = 'R', LWORK >= max(1,M*MB).
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*> \endverbatim
@ -189,6 +192,8 @@
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
*> \endverbatim
*>
*> \ingroup lamswlq
*>
* =====================================================================
SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
@ -202,7 +207,7 @@
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
* ..
* .. Array Arguments ..
REAL A( LDA, * ), WORK( * ), C(LDC, * ),
REAL A( LDA, * ), WORK( * ), C( LDC, * ),
$ T( LDT, * )
* ..
*
@ -211,11 +216,14 @@
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER I, II, KK, LW, CTR
INTEGER I, II, KK, LW, CTR, MINMNK, LWMIN
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL STPMLQT, SGEMLQT, XERBLA
* ..
@ -223,16 +231,23 @@
*
* Test the input arguments
*
LQUERY = LWORK.LT.0
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
IF (LEFT) THEN
IF( LEFT ) THEN
LW = N * MB
ELSE
LW = M * MB
END IF
*
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
*
INFO = 0
IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
@ -245,30 +260,31 @@
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
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( 'SLAMSWLQ', -INFO )
WORK(1) = LW
RETURN
ELSE IF (LQUERY) THEN
WORK(1) = LW
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( MIN(M,N,K).EQ.0 ) THEN
IF( MINMNK.EQ.0 ) THEN
RETURN
END IF
*
@ -402,7 +418,7 @@
*
END IF
*
WORK(1) = LW
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
*
* End of SLAMSWLQ

54
lapack-netlib/SRC/slamtsqr.f
View File

@ -129,21 +129,23 @@
*> \param[out] WORK
*> \verbatim
*> (workspace) REAL array, dimension (MAX(1,LWORK))
*>
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> If MIN(M,N,K) = 0, LWORK >= 1.
*> If SIDE = 'L', LWORK >= max(1,N*NB).
*> If SIDE = 'R', LWORK >= max(1,MB*NB).
*>
*> If SIDE = 'L', LWORK >= max(1,N)*NB;
*> if SIDE = 'R', LWORK >= max(1,MB)*NB.
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*>
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@ -191,6 +193,8 @@
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
*> \endverbatim
*>
*> \ingroup lamtsqr
*>
* =====================================================================
SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
@ -204,7 +208,7 @@
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
* ..
* .. Array Arguments ..
REAL A( LDA, * ), WORK( * ), C(LDC, * ),
REAL A( LDA, * ), WORK( * ), C( LDC, * ),
$ T( LDT, * )
* ..
*
@ -213,11 +217,14 @@
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER I, II, KK, LW, CTR, Q
INTEGER I, II, KK, LW, CTR, Q, MINMNK, LWMIN
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL SGEMQRT, STPMQRT, XERBLA
* ..
@ -225,12 +232,13 @@
*
* Test the input arguments
*
LQUERY = LWORK.LT.0
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
IF (LEFT) THEN
IF( LEFT ) THEN
LW = N * NB
Q = M
ELSE
@ -238,7 +246,13 @@
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
ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
@ -253,36 +267,36 @@
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
ELSE IF( LWORK.LT.LWMIN. AND. (.NOT.LQUERY) ) THEN
INFO = -15
END IF
*
* Determine the block size if it is tall skinny or short and wide
*
IF( INFO.EQ.0) THEN
WORK(1) = LW
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SLAMTSQR', -INFO )
RETURN
ELSE IF (LQUERY) THEN
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 SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA,
$ T, LDT, C, LDC, WORK, INFO)
$ T, LDT, C, LDC, WORK, INFO )
RETURN
END IF
*
@ -410,7 +424,7 @@
*
END IF
*
WORK(1) = LW
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
*
* End of SLAMTSQR

56
lapack-netlib/SRC/slaswlq.f
View File

@ -96,22 +96,24 @@
*> The leading dimension of the array T. LDT >= MB.
*> \endverbatim
*>
*>
*> \param[out] WORK
*> \verbatim
*> (workspace) REAL 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,7 +165,7 @@
*>
* =====================================================================
SUBROUTINE SLASWLQ( 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, --
@ -173,7 +175,7 @@
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
* ..
* .. Array Arguments ..
REAL A( LDA, * ), WORK( * ), T( LDT, *)
REAL A( LDA, * ), WORK( * ), T( LDT, * )
* ..
*
* =====================================================================
@ -181,14 +183,17 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, II, KK, CTR
INTEGER I, II, KK, CTR, MINMN, LWMIN
* ..
* .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. EXTERNAL SUBROUTINES ..
EXTERNAL SGELQT, SGEQRT, STPLQT, STPQRT, XERBLA
* ..
* .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD
* ..
@ -199,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
@ -212,42 +224,42 @@
INFO = -6
ELSE IF( LDT.LT.MB ) THEN
INFO = -8
ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -10
END IF
IF( INFO.EQ.0) THEN
WORK(1) = MB*M
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SLASWLQ', -INFO )
RETURN
ELSE IF (LQUERY) THEN
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( MIN(M,N).EQ.0 ) THEN
IF( MINMN.EQ.0 ) THEN
RETURN
END IF
*
* The LQ Decomposition
*
IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
CALL SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO)
IF( (M.GE.N) .OR. (NB.LE.M) .OR. (NB.GE.N) ) THEN
CALL SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
RETURN
END IF
*
KK = MOD((N-M),(NB-M))
II=N-KK+1
II = N-KK+1
*
* Compute the LQ factorization of the first block A(1:M,1:NB)
*
CALL SGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO)
CALL SGELQT( 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)
*
@ -259,13 +271,13 @@
*
* Compute the QR factorization of the last block A(1:M,II:N)
*
IF (II.LE.N) THEN
IF( II.LE.N ) THEN
CALL STPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ),
$ LDA, T(1, CTR * M + 1), LDT,
$ WORK, INFO )
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(M * MB)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
*
* End of SLASWLQ

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

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

51
lapack-netlib/SRC/slatsqr.f
View File

@ -102,14 +102,17 @@
*> \param[out] WORK
*> \verbatim
*> (workspace) REAL array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= NB*N.
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*> \endverbatim
@ -161,9 +164,11 @@
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
*> \endverbatim
*>
*> \ingroup latsqr
*>
* =====================================================================
SUBROUTINE SLATSQR( 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, --
@ -173,7 +178,7 @@
INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK
* ..
* .. Array Arguments ..
REAL A( LDA, * ), WORK( * ), T(LDT, *)
REAL A( LDA, * ), WORK( * ), T( LDT, * )
* ..
*
* =====================================================================
@ -181,13 +186,17 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, II, KK, CTR
INTEGER I, II, KK, CTR, MINMN, LWMIN
* ..
* .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. EXTERNAL SUBROUTINES ..
EXTERNAL SGEQRT, STPQRT, XERBLA
* ..
* .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD
* ..
@ -198,6 +207,13 @@
INFO = 0
*
LQUERY = ( LWORK.EQ.-1 )
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = N*NB
END IF
*
IF( M.LT.0 ) THEN
INFO = -1
@ -205,46 +221,47 @@
INFO = -2
ELSE IF( MB.LT.1 ) THEN
INFO = -3
ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN
ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 ) ) THEN
INFO = -4
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -6
ELSE IF( LDT.LT.NB ) THEN
INFO = -8
ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -10
END IF
IF( INFO.EQ.0) THEN
WORK(1) = NB*N
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SLATSQR', -INFO )
RETURN
ELSE IF (LQUERY) THEN
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( MIN(M,N).EQ.0 ) THEN
IF( MINMN.EQ.0 ) THEN
RETURN
END IF
*
* The QR Decomposition
*
IF ((MB.LE.N).OR.(MB.GE.M)) THEN
CALL SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO)
IF( (MB.LE.N) .OR. (MB.GE.M) ) THEN
CALL SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
RETURN
END IF
KK = MOD((M-N),(MB-N))
II=M-KK+1
II = M-KK+1
*
* Compute the QR factorization of the first block A(1:MB,1:N)
*
CALL SGEQRT( 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)
*
@ -256,13 +273,13 @@
*
* Compute the QR factorization of the last block A(II:M,1:N)
*
IF (II.LE.M) THEN
IF( II.LE.M ) THEN
CALL STPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
$ T(1, CTR * N + 1), LDT,
$ WORK, INFO )
END IF
*
work( 1 ) = N*NB
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN
*
* End of SLATSQR

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

@ -96,8 +96,7 @@
*>
*> \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 LWORK.
*> \endverbatim
*>
@ -251,7 +250,7 @@
$ N*ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) )
LIOPT = LIWMIN
END IF
WORK( 1 ) = SROUNDUP_LWORK(LOPT)
WORK( 1 ) = SROUNDUP_LWORK( LOPT )
IWORK( 1 ) = LIOPT
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
@ -335,7 +334,7 @@
IF( ISCALE.EQ.1 )
$ CALL SSCAL( N, ONE / SIGMA, W, 1 )
*
WORK( 1 ) = SROUNDUP_LWORK(LOPT)
WORK( 1 ) = SROUNDUP_LWORK( LOPT )
IWORK( 1 ) = LIOPT
*
RETURN

19
lapack-netlib/SRC/ssyevr.f
View File

@ -271,7 +271,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,26*N).
*> The dimension of the array WORK.
*> If N <= 1, LWORK >= 1, else LWORK >= 26*N.
*> For optimal efficiency, LWORK >= (NB+6)*N,
*> where NB is the max of the blocksize for SSYTRD and SORMTR
*> returned by ILAENV.
@ -292,7 +293,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 and
@ -392,8 +394,13 @@
*
LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
*
LWMIN = MAX( 1, 26*N )
LIWMIN = MAX( 1, 10*N )
IF( N.LE.1 ) THEN
LWMIN = 1
LIWMIN = 1
ELSE
LWMIN = 26*N
LIWMIN = 10*N
END IF
*
INFO = 0
IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
@ -428,7 +435,7 @@
NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 )
NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, -1 ) )
LWKOPT = MAX( ( NB+1 )*N, LWMIN )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
@ -677,7 +684,7 @@
*
* Set WORK(1) to optimal workspace size.
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
IWORK( 1 ) = LIWMIN
*
RETURN

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

@ -278,6 +278,7 @@
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> If N <= 1, LWORK must be at least 1.
*> If JOBZ = 'N' and N > 1, LWORK must be queried.
*> LWORK = MAX(1, 26*N, dimension) where
*> dimension = max(stage1,stage2) + (KD+1)*N + 5*N
@ -300,13 +301,14 @@
*> \param[out] IWORK
*> \verbatim
*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
*> On exit, if INFO = 0, IWORK(1) returns the optimal LWORK.
*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
*> \endverbatim
*>
*> \param[in] LIWORK
*> \verbatim
*> LIWORK is INTEGER
*> The dimension of the array IWORK. LIWORK >= max(1,10*N).
*> The dimension of the array IWORK.
*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N.
*>
*> If LIWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the IWORK array,
@ -445,8 +447,14 @@
IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
*
IF( N.LE.1 ) THEN
LWMIN = 1
LIWMIN = 1
ELSE
LWMIN = MAX( 26*N, 5*N + LHTRD + LWTRD )
LIWMIN = MAX( 1, 10*N )
LIWMIN = 10*N
END IF
*
INFO = 0
IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
@ -485,7 +493,7 @@
* NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 )
* NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, -1 ) )
* LWKOPT = MAX( ( NB+1 )*N, LWMIN )
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
IWORK( 1 ) = LIWMIN
END IF
*
@ -505,7 +513,7 @@
END IF
*
IF( N.EQ.1 ) THEN
WORK( 1 ) = 26
WORK( 1 ) = 1
IF( ALLEIG .OR. INDEIG ) THEN
M = 1
W( 1 ) = A( 1, 1 )
@ -733,7 +741,7 @@
*
* Set WORK(1) to optimal workspace size.
*
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
IWORK( 1 ) = LIWMIN
*
RETURN

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

@ -338,14 +338,14 @@
IF( INFO.EQ.0 ) THEN
IF( N.LE.1 ) THEN
LWKMIN = 1
WORK( 1 ) = SROUNDUP_LWORK(LWKMIN)
LWKOPT = 1
ELSE
LWKMIN = 8*N
NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 )
NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, -1 ) )
LWKOPT = MAX( LWKMIN, ( NB + 3 )*N )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
$ INFO = -17
@ -542,7 +542,7 @@
*
* Set WORK(1) to optimal workspace size.
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

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

@ -177,12 +177,13 @@
*
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS
INTEGER LWKMIN, LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, SSYTRS_AA, SSYTRF_AA
@ -196,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
@ -206,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 SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
LWKOPT_SYTRF = INT( WORK(1) )
LWKOPT_SYTRF = INT( WORK( 1 ) )
CALL SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
$ -1, INFO )
LWKOPT_SYTRS = INT( WORK(1) )
LWKOPT = MAX( LWKOPT_SYTRF, LWKOPT_SYTRS )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
LWKOPT_SYTRS = INT( WORK( 1 ) )
LWKOPT = MAX( LWKMIN, LWKOPT_SYTRF, LWKOPT_SYTRS )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
*
IF( INFO.NE.0 ) THEN
@ -239,7 +241,7 @@
*
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

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

@ -100,14 +100,14 @@
*>
*> \param[out] TB
*> \verbatim
*> TB is REAL array, dimension (LTB)
*> TB is REAL 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
@ -147,14 +147,15 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is REAL workspace of size LWORK
*> WORK is REAL 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,
@ -204,12 +205,13 @@
* ..
* .. Local Scalars ..
LOGICAL UPPER, TQUERY, WQUERY
INTEGER LWKOPT
INTEGER LWKMIN, LWKOPT
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL SSYTRF_AA_2STAGE, SSYTRS_AA_2STAGE,
@ -226,6 +228,7 @@
UPPER = LSAME( UPLO, 'U' )
WQUERY = ( LWORK.EQ.-1 )
TQUERY = ( LTB.EQ.-1 )
LWKMIN = MAX( 1, N )
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@ -234,18 +237,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 SSYTRF_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
@ -255,7 +259,6 @@
RETURN
END IF
*
*
* Compute the factorization A = U**T*T*U or A = L*T*L**T.
*
CALL SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,
@ -269,7 +272,7 @@
*
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

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

@ -305,7 +305,7 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY, NOFACT
INTEGER LWKOPT, NB
INTEGER LWKMIN, LWKOPT, NB
REAL ANORM
* ..
* .. External Functions ..
@ -327,6 +327,7 @@
INFO = 0
NOFACT = LSAME( FACT, 'N' )
LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 3*N )
IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
INFO = -1
ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
@ -344,12 +345,12 @@
INFO = -11
ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
INFO = -13
ELSE IF( LWORK.LT.MAX( 1, 3*N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -18
END IF
*
IF( INFO.EQ.0 ) THEN
LWKOPT = MAX( 1, 3*N )
LWKOPT = LWKMIN
IF( NOFACT ) THEN
NB = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 )
LWKOPT = MAX( LWKOPT, N*NB )

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

@ -123,7 +123,7 @@
*>
*> \param[out] HOUS2
*> \verbatim
*> HOUS2 is REAL array, dimension (LHOUS2)
*> HOUS2 is REAL 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
@ -149,8 +151,10 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK = MAX(1, dimension)
*> If LWORK = -1, or LHOUS2=-1,
*> The dimension of the array WORK.
*> If N = 0, LWORK >= 1, else LWORK = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS2 = -1,
*> then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
@ -182,7 +186,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup realSYcomputational
*> \ingroup hetrd_2stage
*
*> \par Further Details:
* =====================
@ -265,10 +269,13 @@
*
KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', VECT, N, -1, -1, -1 )
IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', VECT, N, KD, -1, -1 )
IF( N.EQ.0 ) THEN
LHMIN = 1
LWMIN = 1
ELSE
LHMIN = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 )
* WRITE(*,*),'SSYTRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO,
* $ LHMIN, LWMIN
END IF
*
IF( .NOT.LSAME( VECT, 'N' ) ) THEN
INFO = -1
@ -324,7 +331,6 @@
END IF
*
*
HOUS2( 1 ) = LHMIN
WORK( 1 ) = LWMIN
RETURN
*

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

@ -124,7 +124,7 @@
*> \param[out] WORK
*> \verbatim
*> WORK is REAL array, dimension (LWORK)
*> On exit, if INFO = 0, or if LWORK=-1,
*> On exit, if INFO = 0, or if LWORK = -1,
*> WORK(1) returns the size of LWORK.
*> \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 )
IF( N.LE.KD+1 ) THEN
LWMIN = 1
ELSE
LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SY2SB', '', 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( 'SSYTRD_SY2SB', -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 SSYTRD_SY2SB

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

@ -234,7 +234,7 @@
*
NB = ILAENV( 1, 'SSYTRF', 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
@ -353,7 +353,8 @@
END IF
*
40 CONTINUE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
*
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
*
* End of SSYTRF

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

@ -101,8 +101,10 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >= MAX(1,2*N). For optimum performance
*> LWORK >= N*(1+NB), where NB is the optimal blocksize.
*> The length of WORK.
*> LWORK >= 1, if N <= 1, and LWORK >= 2*N, otherwise.
*> For optimum performance LWORK >= N*(1+NB), where NB is
*> the optimal blocksize, returned by ILAENV.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@ -128,7 +130,7 @@
*> \ingroup hetrf_aa
*
* =====================================================================
SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SUBROUTINE SSYTRF_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
REAL ALPHA
* ..
@ -180,19 +182,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.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -7
END IF
*
IF( INFO.EQ.0 ) THEN
LWKOPT = (NB+1)*N
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF
*
IF( INFO.NE.0 ) THEN
@ -204,11 +213,11 @@
*
* Quick return
*
IF ( N.EQ.0 ) THEN
IF( N.EQ.0 ) THEN
RETURN
ENDIF
IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN
IF( N.EQ.1 ) THEN
RETURN
END IF
*
@ -458,7 +467,8 @@
END IF
*
20 CONTINUE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
*
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
*
* End of SSYTRF_AA

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

@ -94,7 +94,7 @@
*> \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 REAL workspace of size LWORK
*> WORK is REAL 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,
@ -212,9 +212,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
*
@ -228,10 +228,10 @@
NB = ILAENV( 1, 'SSYTRF_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 ) = SROUNDUP_LWORK(N*NB)
WORK( 1 ) = SROUNDUP_LWORK( MAX( 1, N*NB ) )
END IF
END IF
IF( TQUERY .OR. WQUERY ) THEN
@ -240,7 +240,7 @@
*
* Quick return
*
IF ( N.EQ.0 ) THEN
IF( N.EQ.0 ) THEN
RETURN
ENDIF
*

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

@ -177,14 +177,14 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is REAL array, dimension ( MAX(1,LWORK) ).
*> WORK is REAL 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.
*>
@ -312,7 +312,7 @@
*
NB = ILAENV( 1, 'SSYTRF_RK', 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
@ -488,7 +488,7 @@
*
END IF
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
*
* End of SSYTRF_RK

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

@ -118,7 +118,7 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >=1. For best performance
*> The length of WORK. LWORK >= 1. For best performance
*> LWORK >= N*NB, where NB is the block size returned by ILAENV.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
@ -260,7 +260,7 @@
*
NB = ILAENV( 1, 'SSYTRF_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
@ -383,7 +383,8 @@
END IF
*
40 CONTINUE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
*
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN
*
* End of SSYTRF_ROOK

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

@ -88,14 +88,14 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is REAL array, dimension (N+NB+1)*(NB+3)
*> WORK is REAL 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:
*> - the optimal size of the WORK array, returns
@ -120,7 +120,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup realSYcomputational
*> \ingroup hetri2
*
* =====================================================================
SUBROUTINE SSYTRI2( 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 SSYTRI, SSYTRI2X, XERBLA
@ -159,9 +160,13 @@
INFO = 0
UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 )
*
* Get blocksize
*
NBMAX = ILAENV( 1, 'SSYTRF', 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( 'SSYTRI2', -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 SSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
ELSE
CALL SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
END IF
*
RETURN
*
* End of SSYTRI2

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

@ -119,16 +119,17 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is REAL array, dimension (N+NB+1)*(NB+3).
*> WORK is REAL 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
*
IF( N.EQ.0 ) THEN
LWKOPT = 1
ELSE
NB = MAX( 1, ILAENV( 1, 'SSYTRI_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( 'SSYTRI_3', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
RETURN
END IF
*
@ -237,7 +242,7 @@
*
CALL SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
*
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
RETURN
*

28
lapack-netlib/SRC/ssytrs_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,31 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY, UPPER
INTEGER K, KP, LWKOPT
INTEGER K, KP, LWKMIN
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines ..
EXTERNAL SGTSV, SSWAP, SLACPY, STRSM, 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 +192,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( 'SSYTRS_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