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

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

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

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

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

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

@ -98,7 +98,7 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1 or -2, then a workspace query is assumed. The routine *> If LWORK = -1 or -2, then a workspace query is assumed. The routine
*> only calculates the sizes of the T and WORK arrays, returns these *> only calculates the sizes of the T and WORK arrays, returns these
*> values as the first entries of the T and WORK arrays, and no error *> values as the first entries of the T and WORK arrays, and no error

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

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

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

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

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

@ -189,12 +189,13 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER MB, NB, LW, NBLCKS, MN INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK EXTERNAL SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SGEMQRT, SLAMTSQR, XERBLA EXTERNAL SGEMQRT, SLAMTSQR, XERBLA
@ -206,7 +207,7 @@
* *
* Test the input arguments * Test the input arguments
* *
LQUERY = LWORK.EQ.-1 LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' ) NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' ) TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' ) LEFT = LSAME( SIDE, 'L' )
@ -221,6 +222,13 @@
LW = MB * NB LW = MB * NB
MN = N MN = N
END IF END IF
*
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
* *
IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN
IF( MOD( MN - K, MB - K ).EQ.0 ) THEN IF( MOD( MN - K, MB - K ).EQ.0 ) THEN
@ -249,12 +257,12 @@
INFO = -9 INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -11 INFO = -11
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
INFO = -13 INFO = -13
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
WORK( 1 ) = SROUNDUP_LWORK(LW) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -266,7 +274,7 @@
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN( M, N, K ).EQ.0 ) THEN IF( MINMNK.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
@ -279,7 +287,7 @@
$ NB, C, LDC, WORK, LWORK, INFO ) $ NB, C, LDC, WORK, LWORK, INFO )
END IF END IF
* *
WORK( 1 ) = SROUNDUP_LWORK(LW) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
* *
RETURN RETURN
* *

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

@ -88,7 +88,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,N). *> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise.
*> For optimum performance LWORK >= N*NB, where NB is the *> For optimum performance LWORK >= N*NB, where NB is the
*> optimal blocksize. *> optimal blocksize.
*> *>
@ -189,8 +190,9 @@
END IF END IF
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
* *
IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN IF( .NOT.LQUERY ) THEN
INFO = -7 IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) )
$ INFO = -7
END IF END IF
END IF END IF
* *

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

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

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

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

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

@ -97,7 +97,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,N). *> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise.
*> For optimum performance LWORK >= N*NB, where NB is *> For optimum performance LWORK >= N*NB, where NB is
*> the optimal blocksize. *> the optimal blocksize.
*> *>
@ -162,8 +163,8 @@
* *
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB, INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKMIN, LWKOPT,
$ NBMIN, NX $ NB, NBMIN, NX
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SGEQR2P, SLARFB, SLARFT, XERBLA EXTERNAL SGEQR2P, SLARFB, SLARFT, XERBLA
@ -173,8 +174,9 @@
* .. * ..
* .. External Functions .. * .. External Functions ..
INTEGER ILAENV INTEGER ILAENV
EXTERNAL ILAENV
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL ILAENV, SROUNDUP_LWORK EXTERNAL SROUNDUP_LWORK
* .. * ..
* .. Executable Statements .. * .. Executable Statements ..
* *
@ -182,8 +184,16 @@
* *
INFO = 0 INFO = 0
NB = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) 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 LWKOPT = N*NB
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
@ -191,7 +201,7 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4 INFO = -4
ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -7 INFO = -7
END IF END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -211,7 +221,7 @@
* *
NBMIN = 2 NBMIN = 2
NX = 0 NX = 0
IWS = N IWS = LWKMIN
IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( NB.GT.1 .AND. NB.LT.K ) THEN
* *
* Determine when to cross over from blocked to unblocked code. * Determine when to cross over from blocked to unblocked code.

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

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

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

@ -137,8 +137,9 @@
* .. * ..
* .. External Functions .. * .. External Functions ..
INTEGER ILAENV INTEGER ILAENV
EXTERNAL ILAENV
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL ILAENV, SROUNDUP_LWORK EXTERNAL SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SGEMM, SGEMV, SSWAP, STRSM, STRTRI, XERBLA EXTERNAL SGEMM, SGEMV, SSWAP, STRSM, STRTRI, XERBLA
@ -152,8 +153,9 @@
* *
INFO = 0 INFO = 0
NB = ILAENV( 1, 'SGETRI', ' ', N, -1, -1, -1 ) NB = ILAENV( 1, 'SGETRI', ' ', N, -1, -1, -1 )
LWKOPT = N*NB LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LT.0 ) THEN IF( N.LT.0 ) THEN
INFO = -1 INFO = -1

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

@ -127,7 +127,7 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1 or -2, then a workspace query is assumed. *> If LWORK = -1 or -2, then a workspace query is assumed.
*> If LWORK = -1, the routine calculates optimal size of WORK for the *> If LWORK = -1, the routine calculates optimal size of WORK for the
*> optimal performance and returns this value in WORK(1). *> optimal performance and returns this value in WORK(1).
@ -226,7 +226,10 @@
* *
* Determine the optimum and minimum LWORK * Determine the optimum and minimum LWORK
* *
IF( M.GE.N ) THEN IF( MIN( M, N, NRHS ).EQ.0 ) THEN
WSIZEO = 1
WSIZEM = 1
ELSE IF( M.GE.N ) THEN
CALL SGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 ) CALL SGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) ) TSZO = INT( TQ( 1 ) )
LWO = INT( WORKQ( 1 ) ) LWO = INT( WORKQ( 1 ) )

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

@ -130,14 +130,17 @@
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK.
*> LWORK >= MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), *> If MIN(M,N) = 0, LWORK >= 1, else
*> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ),
*> where *> where
*> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)), *> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)),
*> NB1LOCAL = MIN(NB1,N). *> NB1LOCAL = MIN(NB1,N).
*> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL, *> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL,
*> LW1 = NB1LOCAL * N, *> LW1 = NB1LOCAL * N,
*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ), *> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ).
*>
*> If LWORK = -1, then a workspace query is assumed. *> If LWORK = -1, then a workspace query is assumed.
*> The routine only calculates the optimal size of the WORK *> The routine only calculates the optimal size of the WORK
*> array, returns this value as the first entry of the WORK *> array, returns this value as the first entry of the WORK
@ -216,7 +219,7 @@
* Test the input arguments * Test the input arguments
* *
INFO = 0 INFO = 0
LQUERY = LWORK.EQ.-1 LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 .OR. M.LT.N ) THEN ELSE IF( N.LT.0 .OR. M.LT.N ) THEN
@ -267,8 +270,9 @@
LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ) LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) )
* *
LWORKOPT = MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ) LWORKOPT = MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) )
LWORKOPT = MAX( 1, LWORKOPT )
* *
IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN IF( LWORK.LT.LWORKOPT .AND. .NOT.LQUERY ) THEN
INFO = -11 INFO = -11
END IF END IF
* *

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

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

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

@ -189,6 +189,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= MAX(1,8*N).
*> For good performance, LWORK should generally be larger.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
@ -248,7 +250,8 @@
LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
CHARACTER CHTEMP CHARACTER CHTEMP
INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO, 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, REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
$ SMLNUM, TEMP $ SMLNUM, TEMP
* .. * ..
@ -298,6 +301,7 @@
* *
INFO = 0 INFO = 0
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 8*N )
IF( IJOBVL.LE.0 ) THEN IF( IJOBVL.LE.0 ) THEN
INFO = -1 INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN ELSE IF( IJOBVR.LE.0 ) THEN
@ -312,7 +316,7 @@
INFO = -12 INFO = -12
ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
INFO = -14 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 INFO = -16
END IF END IF
* *
@ -320,7 +324,7 @@
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL SGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) 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, CALL SORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK,
$ -1, IERR ) $ -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
@ -340,8 +344,11 @@
$ WORK, -1, 0, IERR ) $ WORK, -1, 0, IERR )
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
END IF END IF
IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* END IF
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN

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

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

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

@ -236,8 +236,9 @@
* .. * ..
* .. External Functions .. * .. External Functions ..
INTEGER ILAENV INTEGER ILAENV
EXTERNAL ILAENV
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL ILAENV, SROUNDUP_LWORK EXTERNAL SROUNDUP_LWORK
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN INTRINSIC INT, MAX, MIN
@ -251,8 +252,9 @@
NB2 = ILAENV( 1, 'SGERQF', ' ', N, P, -1, -1 ) NB2 = ILAENV( 1, 'SGERQF', ' ', N, P, -1, -1 )
NB3 = ILAENV( 1, 'SORMQR', ' ', N, M, P, -1 ) NB3 = ILAENV( 1, 'SORMQR', ' ', N, M, P, -1 )
NB = MAX( NB1, NB2, NB3 ) NB = MAX( NB1, NB2, NB3 )
LWKOPT = MAX( N, M, P )*NB LWKOPT = MAX( 1, MAX( N, M, P )*NB )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LT.0 ) THEN IF( N.LT.0 ) THEN
INFO = -1 INFO = -1
@ -289,6 +291,7 @@
* *
CALL SGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO ) CALL SGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO )
LWKOPT = MAX( LOPT, INT( WORK( 1 ) ) ) LWKOPT = MAX( LOPT, INT( WORK( 1 ) ) )
*
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN

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

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

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

@ -278,7 +278,7 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK. LWORK >= 1.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns

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

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

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

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

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

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

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

@ -96,22 +96,24 @@
*> The leading dimension of the array T. LDT >= MB. *> The leading dimension of the array T. LDT >= MB.
*> \endverbatim *> \endverbatim
*> *>
*>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) REAL array, dimension (MAX(1,LWORK)) *> (workspace) REAL array, dimension (MAX(1,LWORK))
*> *> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim *> \endverbatim
*>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= MB * M. *> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MB*M, otherwise.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA. *> message related to LWORK is issued by XERBLA.
*>
*> \endverbatim *> \endverbatim
*> \param[out] INFO *> \param[out] INFO
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
@ -181,14 +183,17 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER I, II, KK, CTR INTEGER I, II, KK, CTR, MINMN, LWMIN
* .. * ..
* .. EXTERNAL FUNCTIONS .. * .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK EXTERNAL SROUNDUP_LWORK
* ..
* .. EXTERNAL SUBROUTINES .. * .. EXTERNAL SUBROUTINES ..
EXTERNAL SGELQT, SGEQRT, STPLQT, STPQRT, XERBLA EXTERNAL SGELQT, SGEQRT, STPLQT, STPQRT, XERBLA
* ..
* .. INTRINSIC FUNCTIONS .. * .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD INTRINSIC MAX, MIN, MOD
* .. * ..
@ -199,6 +204,13 @@
INFO = 0 INFO = 0
* *
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = M*MB
END IF
* *
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
@ -212,11 +224,11 @@
INFO = -6 INFO = -6
ELSE IF( LDT.LT.MB ) THEN ELSE IF( LDT.LT.MB ) THEN
INFO = -8 INFO = -8
ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -10 INFO = -10
END IF END IF
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
WORK(1) = MB*M WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -228,7 +240,7 @@
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN(M,N).EQ.0 ) THEN IF( MINMN.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
@ -265,7 +277,7 @@
$ WORK, INFO ) $ WORK, INFO )
END IF END IF
* *
WORK( 1 ) = SROUNDUP_LWORK(M * MB) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN RETURN
* *
* End of SLASWLQ * End of SLASWLQ

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

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

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

@ -102,14 +102,17 @@
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> (workspace) REAL array, dimension (MAX(1,LWORK)) *> (workspace) REAL array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= NB*N. *> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA. *> message related to LWORK is issued by XERBLA.
*> \endverbatim *> \endverbatim
@ -161,6 +164,8 @@
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012 *> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
*> \endverbatim *> \endverbatim
*> *>
*> \ingroup latsqr
*>
* ===================================================================== * =====================================================================
SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK,
$ LWORK, INFO ) $ LWORK, INFO )
@ -181,13 +186,17 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER I, II, KK, CTR INTEGER I, II, KK, CTR, MINMN, LWMIN
* .. * ..
* .. EXTERNAL FUNCTIONS .. * .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME LOGICAL LSAME
EXTERNAL LSAME EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. EXTERNAL SUBROUTINES .. * .. EXTERNAL SUBROUTINES ..
EXTERNAL SGEQRT, STPQRT, XERBLA EXTERNAL SGEQRT, STPQRT, XERBLA
* ..
* .. INTRINSIC FUNCTIONS .. * .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD INTRINSIC MAX, MIN, MOD
* .. * ..
@ -198,6 +207,13 @@
INFO = 0 INFO = 0
* *
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = N*NB
END IF
* *
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
@ -211,11 +227,12 @@
INFO = -6 INFO = -6
ELSE IF( LDT.LT.NB ) THEN ELSE IF( LDT.LT.NB ) THEN
INFO = -8 INFO = -8
ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -10 INFO = -10
END IF END IF
*
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
WORK(1) = NB*N WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
END IF END IF
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SLATSQR', -INFO ) CALL XERBLA( 'SLATSQR', -INFO )
@ -226,7 +243,7 @@
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN(M,N).EQ.0 ) THEN IF( MINMN.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
@ -262,7 +279,7 @@
$ WORK, INFO ) $ WORK, INFO )
END IF END IF
* *
work( 1 ) = N*NB WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN RETURN
* *
* End of SLATSQR * End of SLATSQR

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

@ -96,8 +96,7 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is REAL array, *> WORK is REAL array, dimension (MAX(1,LWORK))
*> dimension (LWORK)
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim *> \endverbatim
*> *>

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

@ -271,7 +271,8 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> 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, *> For optimal efficiency, LWORK >= (NB+6)*N,
*> where NB is the max of the blocksize for SSYTRD and SORMTR *> where NB is the max of the blocksize for SSYTRD and SORMTR
*> returned by ILAENV. *> returned by ILAENV.
@ -292,7 +293,8 @@
*> \param[in] LIWORK *> \param[in] LIWORK
*> \verbatim *> \verbatim
*> LIWORK is INTEGER *> LIWORK is INTEGER
*> The dimension of the array IWORK. LIWORK >= max(1,10*N). *> The dimension of the array IWORK.
*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N.
*> *>
*> If LIWORK = -1, then a workspace query is assumed; the *> If LIWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal sizes of the WORK and *> routine only calculates the optimal sizes of the WORK and
@ -392,8 +394,13 @@
* *
LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) ) LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
* *
LWMIN = MAX( 1, 26*N ) IF( N.LE.1 ) THEN
LIWMIN = MAX( 1, 10*N ) LWMIN = 1
LIWMIN = 1
ELSE
LWMIN = 26*N
LIWMIN = 10*N
END IF
* *
INFO = 0 INFO = 0
IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN

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

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

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

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

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

@ -177,12 +177,13 @@
* *
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS INTEGER LWKMIN, LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK EXTERNAL SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL XERBLA, SSYTRS_AA, SSYTRF_AA EXTERNAL XERBLA, SSYTRS_AA, SSYTRF_AA
@ -196,6 +197,7 @@
* *
INFO = 0 INFO = 0
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N, 3*N-2 )
IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
@ -206,7 +208,7 @@
INFO = -5 INFO = -5
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -8 INFO = -8
ELSE IF( LWORK.LT.MAX(2*N, 3*N-2) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10 INFO = -10
END IF END IF
* *
@ -216,7 +218,7 @@
CALL SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, CALL SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
$ -1, INFO ) $ -1, INFO )
LWKOPT_SYTRS = INT( WORK( 1 ) ) LWKOPT_SYTRS = INT( WORK( 1 ) )
LWKOPT = MAX( LWKOPT_SYTRF, LWKOPT_SYTRS ) LWKOPT = MAX( LWKMIN, LWKOPT_SYTRF, LWKOPT_SYTRS )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *

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

@ -100,14 +100,14 @@
*> *>
*> \param[out] TB *> \param[out] TB
*> \verbatim *> \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. *> On exit, details of the LU factorization of the band matrix.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LTB *> \param[in] LTB
*> \verbatim *> \verbatim
*> LTB is INTEGER *> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally *> The size of the array TB. LTB >= MAX(1,4*N), internally
*> used to select NB such that LTB >= (3*NB+1)*N. *> used to select NB such that LTB >= (3*NB+1)*N.
*> *>
*> If LTB = -1, then a workspace query is assumed; the *> If LTB = -1, then a workspace query is assumed; the
@ -147,14 +147,15 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is 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 *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB *> The size of WORK. LWORK >= MAX(1,N), internally used to
*> such that LWORK >= N*NB. *> select NB such that LWORK >= N*NB.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the *> If LWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the WORK array, *> routine only calculates the optimal size of the WORK array,
@ -204,12 +205,13 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL UPPER, TQUERY, WQUERY LOGICAL UPPER, TQUERY, WQUERY
INTEGER LWKOPT INTEGER LWKMIN, LWKOPT
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
EXTERNAL LSAME
REAL SROUNDUP_LWORK REAL SROUNDUP_LWORK
EXTERNAL LSAME, SROUNDUP_LWORK EXTERNAL SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SSYTRF_AA_2STAGE, SSYTRS_AA_2STAGE, EXTERNAL SSYTRF_AA_2STAGE, SSYTRS_AA_2STAGE,
@ -226,6 +228,7 @@
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
WQUERY = ( LWORK.EQ.-1 ) WQUERY = ( LWORK.EQ.-1 )
TQUERY = ( LTB.EQ.-1 ) TQUERY = ( LTB.EQ.-1 )
LWKMIN = MAX( 1, N )
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
@ -234,18 +237,19 @@
INFO = -3 INFO = -3
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -5 INFO = -5
ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN
INFO = -7 INFO = -7
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -11 INFO = -11
ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.WQUERY ) THEN
INFO = -13 INFO = -13
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV, CALL SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
$ IPIV2, WORK, -1, INFO ) $ IPIV2, WORK, -1, INFO )
LWKOPT = INT( WORK(1) ) LWKOPT = MAX( LWKMIN, INT( WORK( 1 ) ) )
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -255,7 +259,6 @@
RETURN RETURN
END IF END IF
* *
*
* Compute the factorization A = U**T*T*U or A = L*T*L**T. * 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, CALL SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,

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

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

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

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

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

@ -132,7 +132,9 @@
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK which should be calculated *> The dimension of the array WORK which should be calculated
*> by a workspace query. LWORK = MAX(1, LWORK_QUERY) *> by a workspace query.
*> If N <= KD+1, LWORK >= 1, else LWORK = MAX(1, LWORK_QUERY)
*>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error *> this value as the first entry of the WORK array, and no error
@ -294,8 +296,12 @@
INFO = 0 INFO = 0
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LE.KD+1 ) THEN
LWMIN = 1
ELSE
LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SY2SB', '', N, KD, -1, -1 ) LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SY2SB', '', N, KD, -1, -1 )
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN

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

@ -353,6 +353,7 @@
END IF END IF
* *
40 CONTINUE 40 CONTINUE
*
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
* *

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

@ -101,8 +101,10 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of WORK. LWORK >= MAX(1,2*N). For optimum performance *> The length of WORK.
*> LWORK >= N*(1+NB), where NB is the optimal blocksize. *> LWORK >= 1, if N <= 1, and LWORK >= 2*N, otherwise.
*> For optimum performance LWORK >= N*(1+NB), where NB is
*> the optimal blocksize, returned by ILAENV.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns *> only calculates the optimal size of the WORK array, returns
@ -152,7 +154,7 @@
* *
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY, UPPER LOGICAL LQUERY, UPPER
INTEGER J, LWKOPT INTEGER J, LWKMIN, LWKOPT
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
REAL ALPHA REAL ALPHA
* .. * ..
@ -180,18 +182,25 @@
INFO = 0 INFO = 0
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LE.1 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = 2*N
LWKOPT = (NB+1)*N
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4 INFO = -4
ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -7 INFO = -7
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
LWKOPT = (NB+1)*N
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *
@ -458,6 +467,7 @@
END IF END IF
* *
20 CONTINUE 20 CONTINUE
*
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
* *

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

@ -94,7 +94,7 @@
*> \param[in] LTB *> \param[in] LTB
*> \verbatim *> \verbatim
*> LTB is INTEGER *> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally *> The size of the array TB. LTB >= MAX(1,4*N), internally
*> used to select NB such that LTB >= (3*NB+1)*N. *> used to select NB such that LTB >= (3*NB+1)*N.
*> *>
*> If LTB = -1, then a workspace query is assumed; the *> If LTB = -1, then a workspace query is assumed; the
@ -121,14 +121,14 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is REAL workspace of size LWORK *> WORK is REAL workspace of size (MAX(1,LWORK))
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB *> The size of WORK. LWORK >= MAX(1,N), internally used to
*> such that LWORK >= N*NB. *> select NB such that LWORK >= N*NB.
*> *>
*> If LWORK = -1, then a workspace query is assumed; the *> If LWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the WORK array, *> routine only calculates the optimal size of the WORK array,
@ -212,9 +212,9 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4 INFO = -4
ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN
INFO = -6 INFO = -6
ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN
INFO = -10 INFO = -10
END IF END IF
* *
@ -228,10 +228,10 @@
NB = ILAENV( 1, 'SSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'SSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 )
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
IF( TQUERY ) THEN IF( TQUERY ) THEN
TB( 1 ) = (3*NB+1)*N TB( 1 ) = SROUNDUP_LWORK( MAX( 1, (3*NB+1)*N ) )
END IF END IF
IF( WQUERY ) THEN IF( WQUERY ) THEN
WORK( 1 ) = SROUNDUP_LWORK(N*NB) WORK( 1 ) = SROUNDUP_LWORK( MAX( 1, N*NB ) )
END IF END IF
END IF END IF
IF( TQUERY .OR. WQUERY ) THEN IF( TQUERY .OR. WQUERY ) THEN

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

@ -383,6 +383,7 @@
END IF END IF
* *
40 CONTINUE 40 CONTINUE
*
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
* *

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

@ -88,14 +88,14 @@
*> *>
*> \param[out] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is REAL array, dimension (N+NB+1)*(NB+3) *> WORK is REAL array, dimension (MAX(1,LWORK))
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. *> The dimension of the array WORK.
*> WORK is size >= (N+NB+1)*(NB+3) *> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3).
*> If LWORK = -1, then a workspace query is assumed; the routine *> If LWORK = -1, then a workspace query is assumed; the routine
*> calculates: *> calculates:
*> - the optimal size of the WORK array, returns *> - the optimal size of the WORK array, returns
@ -120,7 +120,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup realSYcomputational *> \ingroup hetri2
* *
* ===================================================================== * =====================================================================
SUBROUTINE SSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) SUBROUTINE SSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
@ -147,7 +147,8 @@
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER ILAENV INTEGER ILAENV
EXTERNAL LSAME, ILAENV REAL SROUNDUP_LWORK
EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SSYTRI, SSYTRI2X, XERBLA EXTERNAL SSYTRI, SSYTRI2X, XERBLA
@ -159,9 +160,13 @@
INFO = 0 INFO = 0
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
*
* Get blocksize * Get blocksize
*
NBMAX = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 ) 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 MINSIZE = N
ELSE ELSE
MINSIZE = (N+NBMAX+1)*(NBMAX+3) MINSIZE = (N+NBMAX+1)*(NBMAX+3)
@ -176,25 +181,26 @@
ELSE IF( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN
INFO = -7 INFO = -7
END IF END IF
*
* Quick return if possible
*
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SSYTRI2', -INFO ) CALL XERBLA( 'SSYTRI2', -INFO )
RETURN RETURN
ELSE IF( LQUERY ) THEN ELSE IF( LQUERY ) THEN
WORK(1)=MINSIZE WORK( 1 ) = SROUNDUP_LWORK( MINSIZE )
RETURN RETURN
END IF END IF
*
* Quick return if possible
*
IF( N.EQ.0 ) IF( N.EQ.0 )
$ RETURN $ RETURN
*
IF( NBMAX.GE.N ) THEN IF( NBMAX.GE.N ) THEN
CALL SSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL SSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
ELSE ELSE
CALL SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO ) CALL SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
END IF END IF
*
RETURN RETURN
* *
* End of SSYTRI2 * End of SSYTRI2

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

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

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

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