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

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,9 +243,16 @@
* Test the input parameters * Test the input parameters
* *
INFO = 0 INFO = 0
NB = MAX( 1, ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 ) ) MINMN = MIN( M, N )
LWKOPT = ( M+N )*NB IF( MINMN.EQ.0 ) THEN
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = MAX( M, N )
NB = MAX( 1, ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 ) )
LWKOPT = ( M+N )*NB
ENDIF
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
@ -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,7 +349,8 @@
* *
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
* *
* End of SGEBRD * End of SGEBRD

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
*> *>
@ -173,7 +173,7 @@
INTEGER IHI, ILO, INFO, LDA, LWORK, N INTEGER IHI, ILO, INFO, LDA, LWORK, N
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
REAL A( LDA, * ), TAU( * ), WORK( * ) REAL A( LDA, * ), TAU( * ), WORK( * )
* .. * ..
* *
* ===================================================================== * =====================================================================
@ -182,7 +182,7 @@
INTEGER NBMAX, LDT, TSIZE INTEGER NBMAX, LDT, TSIZE
PARAMETER ( NBMAX = 64, LDT = NBMAX+1, PARAMETER ( NBMAX = 64, LDT = NBMAX+1,
$ TSIZE = LDT*NBMAX ) $ TSIZE = LDT*NBMAX )
REAL ZERO, ONE REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E+0, PARAMETER ( ZERO = 0.0E+0,
$ ONE = 1.0E+0 ) $ ONE = 1.0E+0 )
* .. * ..
@ -190,7 +190,7 @@
LOGICAL LQUERY LOGICAL LQUERY
INTEGER I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB, INTEGER I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB,
$ NBMIN, NH, NX $ NBMIN, NH, NX
REAL EI REAL EI
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SAXPY, SGEHD2, SGEMM, SLAHR2, SLARFB, STRMM, EXTERNAL SAXPY, SGEHD2, SGEMM, SLAHR2, SLARFB, STRMM,
@ -222,13 +222,19 @@
INFO = -8 INFO = -8
END IF END IF
* *
NH = IHI - ILO + 1
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
* *
* Compute the workspace requirements * Compute the workspace requirements
* *
NB = MIN( NBMAX, ILAENV( 1, 'SGEHRD', ' ', N, ILO, IHI, -1 ) ) IF( NH.LE.1 ) THEN
LWKOPT = N*NB + TSIZE LWKOPT = 1
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) ELSE
NB = MIN( NBMAX, ILAENV( 1, 'SGEHRD', ' ', N, ILO, IHI,
$ -1 ) )
LWKOPT = N*NB + TSIZE
ENDIF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -249,7 +255,6 @@
* *
* Quick return if possible * Quick return if possible
* *
NH = IHI - ILO + 1
IF( NH.LE.1 ) THEN IF( NH.LE.1 ) THEN
WORK( 1 ) = 1 WORK( 1 ) = 1
RETURN RETURN
@ -269,7 +274,7 @@
* *
* Determine if workspace is large enough for blocked code * Determine if workspace is large enough for blocked code
* *
IF( LWORK.LT.N*NB+TSIZE ) THEN IF( LWORK.LT.LWKOPT ) THEN
* *
* Not enough workspace to use optimal NB: determine the * Not enough workspace to use optimal NB: determine the
* minimum value of NB, and reduce NB or force use of * minimum value of NB, and reduce NB or force use of
@ -345,7 +350,8 @@
* Use unblocked code to reduce the rest of the matrix * Use unblocked code to reduce the rest of the matrix
* *
CALL 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
* *

View File

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

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
@ -267,7 +273,7 @@
$ CALL SGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK, $ CALL SGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
$ IINFO ) $ IINFO )
* *
WORK( 1 ) = SROUNDUP_LWORK(IWS) WORK( 1 ) = SROUNDUP_LWORK( IWS )
RETURN RETURN
* *
* End of SGELQF * End of SGELQF

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
* *

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
* *

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
* *

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
* *

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
* *

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 )
LWKOPT = N*NB K = MIN( M, N )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) IF( K.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = N
LWKOPT = N*NB
END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
LQUERY = ( LWORK.EQ.-1 ) 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.
@ -273,7 +283,7 @@
$ CALL SGEQR2P( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK, $ CALL SGEQR2P( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
$ IINFO ) $ IINFO )
* *
WORK( 1 ) = SROUNDUP_LWORK(IWS) WORK( 1 ) = SROUNDUP_LWORK( IWS )
RETURN RETURN
* *
* End of SGEQRFP * End of SGEQRFP

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

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
@ -251,7 +253,7 @@
$ CALL SSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 ) $ CALL SSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 )
60 CONTINUE 60 CONTINUE
* *
WORK( 1 ) = SROUNDUP_LWORK(IWS) WORK( 1 ) = SROUNDUP_LWORK( IWS )
RETURN RETURN
* *
* End of SGETRI * End of SGETRI

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 ) )

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
@ -229,7 +232,7 @@
INFO = -5 INFO = -5
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -7 INFO = -7
ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN
INFO = -9 INFO = -9
ELSE ELSE
* *
@ -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
* *
@ -350,4 +354,4 @@
* *
* End of SGETSQRHRT * End of SGETSQRHRT
* *
END END

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,7 +416,11 @@
$ IERR ) $ IERR )
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
END IF 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 END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -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
* *
@ -657,7 +671,7 @@
* *
40 CONTINUE 40 CONTINUE
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

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,28 +324,31 @@
* *
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 ) ) )
CALL SGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL, LDVL, CALL SGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL, LDVL,
$ VR, LDVR, WORK, -1, IERR ) $ VR, LDVR, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT ( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
IF( ILVL ) THEN IF( ILVL ) THEN
CALL SORGQR( N, N, N, VL, LDVL, WORK, WORK, -1, IERR ) 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, CALL SLAQZ0( 'S', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
$ WORK, -1, 0, IERR ) $ WORK, -1, 0, IERR )
LWKOPT = MAX( LWKOPT, 2*N+INT ( WORK( 1 ) ) ) LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
ELSE ELSE
CALL SLAQZ0( 'E', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, CALL SLAQZ0( 'E', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
$ 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
IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
*
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN

View File

@ -179,14 +179,14 @@
*> *>
*> \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
*> *>
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The length of the array WORK. LWORK >= 1. *> The length of the array WORK. LWORK >= 1.
*> For optimum performance LWORK >= 6*N*NB, where NB is the *> For optimum performance LWORK >= 6*N*NB, where NB is the
*> optimal blocksize. *> optimal blocksize.
*> *>
@ -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

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

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

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

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,

View File

@ -127,17 +127,20 @@
*> *>
*> \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,33 +192,38 @@
*> 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 )
* *
* -- LAPACK computational routine -- * -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER SIDE, TRANS CHARACTER SIDE, TRANS
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
REAL A( LDA, * ), WORK( * ), C(LDC, * ), REAL A( LDA, * ), WORK( * ), C( LDC, * ),
$ T( LDT, * ) $ T( LDT, * )
* .. * ..
* *
* ===================================================================== * =====================================================================
* *
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER I, II, KK, LW, CTR INTEGER I, II, KK, LW, CTR, MINMNK, LWMIN
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
EXTERNAL LSAME EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL STPMLQT, SGEMLQT, XERBLA EXTERNAL STPMLQT, SGEMLQT, XERBLA
* .. * ..
@ -223,52 +231,60 @@
* *
* 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' )
RIGHT = LSAME( SIDE, 'R' ) RIGHT = LSAME( SIDE, 'R' )
IF (LEFT) THEN IF( LEFT ) THEN
LW = N * MB LW = N * MB
ELSE ELSE
LW = M * MB LW = M * MB
END IF END IF
*
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
INFO = -1 INFO = -1
ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
INFO = -2 INFO = -2
ELSE IF( K.LT.0 ) THEN ELSE IF( K.LT.0 ) THEN
INFO = -5 INFO = -5
ELSE IF( M.LT.K ) THEN ELSE IF( M.LT.K ) THEN
INFO = -3 INFO = -3
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
INFO = -4 INFO = -4
ELSE IF( K.LT.MB .OR. MB.LT.1) THEN ELSE IF( K.LT.MB .OR. MB.LT.1 ) THEN
INFO = -6 INFO = -6
ELSE IF( LDA.LT.MAX( 1, K ) ) THEN ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
INFO = -9 INFO = -9
ELSE IF( LDT.LT.MAX( 1, MB) ) THEN ELSE IF( LDT.LT.MAX( 1, MB ) ) THEN
INFO = -11 INFO = -11
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -13 INFO = -13
ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -15 INFO = -15
END IF END IF
* *
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = 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

View File

@ -128,22 +128,24 @@
*> *>
*> \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,33 +193,38 @@
*> 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 )
* *
* -- LAPACK computational routine -- * -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER SIDE, TRANS CHARACTER SIDE, TRANS
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
REAL A( LDA, * ), WORK( * ), C(LDC, * ), REAL A( LDA, * ), WORK( * ), C( LDC, * ),
$ T( LDT, * ) $ T( LDT, * )
* .. * ..
* *
* ===================================================================== * =====================================================================
* *
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER I, II, KK, LW, CTR, Q INTEGER I, II, KK, LW, CTR, Q, MINMNK, LWMIN
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
EXTERNAL LSAME EXTERNAL LSAME
REAL SROUNDUP_LWORK
EXTERNAL SROUNDUP_LWORK
* ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SGEMQRT, STPMQRT, XERBLA EXTERNAL SGEMQRT, STPMQRT, XERBLA
* .. * ..
@ -225,12 +232,13 @@
* *
* Test the input arguments * Test the input arguments
* *
LQUERY = LWORK.LT.0 INFO = 0
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' ) NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' ) TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' ) LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' ) RIGHT = LSAME( SIDE, 'R' )
IF (LEFT) THEN IF( LEFT ) THEN
LW = N * NB LW = N * NB
Q = M Q = M
ELSE ELSE
@ -238,11 +246,17 @@
Q = N Q = N
END IF END IF
* *
INFO = 0 MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
*
IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
INFO = -1 INFO = -1
ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
INFO = -2 INFO = -2
ELSE IF( M.LT.K ) THEN ELSE IF( M.LT.K ) THEN
INFO = -3 INFO = -3
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
@ -253,38 +267,38 @@
INFO = -7 INFO = -7
ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN
INFO = -9 INFO = -9
ELSE IF( LDT.LT.MAX( 1, NB) ) THEN ELSE IF( LDT.LT.MAX( 1, NB ) ) THEN
INFO = -11 INFO = -11
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -13 INFO = -13
ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN ELSE IF( LWORK.LT.LWMIN. AND. (.NOT.LQUERY) ) THEN
INFO = -15 INFO = -15
END IF END IF
* *
* Determine the block size if it is tall skinny or short and wide IF( INFO.EQ.0 ) THEN
* WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
IF( INFO.EQ.0) THEN
WORK(1) = LW
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SLAMTSQR', -INFO ) CALL XERBLA( 'SLAMTSQR', -INFO )
RETURN RETURN
ELSE IF (LQUERY) THEN ELSE IF( LQUERY ) THEN
RETURN RETURN
END IF END IF
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN(M,N,K).EQ.0 ) THEN IF( MINMNK.EQ.0 ) THEN
RETURN RETURN
END IF END IF
*
* Determine the block size if it is tall skinny or short and wide
* *
IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN
CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA,
$ T, LDT, C, LDC, WORK, INFO) $ T, LDT, C, LDC, WORK, INFO )
RETURN RETURN
END IF END IF
* *
IF(LEFT.AND.NOTRAN) THEN IF(LEFT.AND.NOTRAN) THEN
* *
@ -410,7 +424,7 @@
* *
END IF END IF
* *
WORK(1) = LW WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN RETURN
* *
* End of SLAMTSQR * End of SLAMTSQR

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
@ -163,32 +165,35 @@
*> *>
* ===================================================================== * =====================================================================
SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
$ INFO) $ INFO )
* *
* -- LAPACK computational routine -- * -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
REAL A( LDA, * ), WORK( * ), T( LDT, *) REAL A( LDA, * ), WORK( * ), T( LDT, * )
* .. * ..
* *
* ===================================================================== * =====================================================================
* *
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER I, II, KK, CTR INTEGER I, II, KK, CTR, MINMN, LWMIN
* .. * ..
* .. EXTERNAL FUNCTIONS .. * .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME LOGICAL LSAME
EXTERNAL LSAME
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,12 +204,19 @@
INFO = 0 INFO = 0
* *
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = M*MB
END IF
* *
IF( M.LT.0 ) THEN IF( M.LT.0 ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 .OR. N.LT.M ) THEN ELSE IF( N.LT.0 .OR. N.LT.M ) THEN
INFO = -2 INFO = -2
ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 ) ) THEN
INFO = -3 INFO = -3
ELSE IF( NB.LE.0 ) THEN ELSE IF( NB.LE.0 ) THEN
INFO = -4 INFO = -4
@ -212,60 +224,60 @@
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
CALL XERBLA( 'SLASWLQ', -INFO ) CALL XERBLA( 'SLASWLQ', -INFO )
RETURN RETURN
ELSE IF (LQUERY) THEN ELSE IF( LQUERY ) THEN
RETURN RETURN
END IF END IF
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN(M,N).EQ.0 ) THEN IF( MINMN.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
* The LQ Decomposition * The LQ Decomposition
* *
IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN IF( (M.GE.N) .OR. (NB.LE.M) .OR. (NB.GE.N) ) THEN
CALL SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO) CALL SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
RETURN RETURN
END IF END IF
* *
KK = MOD((N-M),(NB-M)) KK = MOD((N-M),(NB-M))
II=N-KK+1 II = N-KK+1
* *
* Compute the LQ factorization of the first block A(1:M,1:NB) * Compute the LQ factorization of the first block A(1:M,1:NB)
* *
CALL 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 CTR = 1
* *
DO I = NB+1, II-NB+M , (NB-M) DO I = NB+1, II-NB+M, (NB-M)
* *
* Compute the QR factorization of the current block A(1:M,I:I+NB-M) * Compute the QR factorization of the current block A(1:M,I:I+NB-M)
* *
CALL STPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), CALL STPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
$ LDA, T(1, CTR * M + 1), $ LDA, T(1, CTR * M + 1),
$ LDT, WORK, INFO ) $ LDT, WORK, INFO )
CTR = CTR + 1 CTR = CTR + 1
END DO END DO
* *
* Compute the QR factorization of the last block A(1:M,II:N) * Compute the QR factorization of the last block A(1:M,II:N)
* *
IF (II.LE.N) THEN IF( II.LE.N ) THEN
CALL STPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), CALL STPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ),
$ LDA, T(1, CTR * M + 1), LDT, $ LDA, T(1, CTR * M + 1), LDT,
$ WORK, INFO ) $ WORK, INFO )
END IF END IF
* *
WORK( 1 ) = SROUNDUP_LWORK(M * MB) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN RETURN
* *
* End of SLASWLQ * End of SLASWLQ

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
* *

View File

@ -101,15 +101,18 @@
*> *>
*> \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,33 +164,39 @@
*> 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 )
* *
* -- LAPACK computational routine -- * -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
REAL A( LDA, * ), WORK( * ), T(LDT, *) REAL A( LDA, * ), WORK( * ), T( LDT, * )
* .. * ..
* *
* ===================================================================== * =====================================================================
* *
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL LQUERY LOGICAL LQUERY
INTEGER I, II, KK, CTR INTEGER I, II, KK, CTR, MINMN, LWMIN
* .. * ..
* .. EXTERNAL FUNCTIONS .. * .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME LOGICAL LSAME
EXTERNAL LSAME EXTERNAL LSAME
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
@ -205,64 +221,65 @@
INFO = -2 INFO = -2
ELSE IF( MB.LT.1 ) THEN ELSE IF( MB.LT.1 ) THEN
INFO = -3 INFO = -3
ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 ) ) THEN
INFO = -4 INFO = -4
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -6 INFO = -6
ELSE IF( LDT.LT.NB ) THEN ELSE IF( LDT.LT.NB ) THEN
INFO = -8 INFO = -8
ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -10 INFO = -10
END IF END IF
IF( INFO.EQ.0) THEN *
WORK(1) = NB*N IF( INFO.EQ.0 ) THEN
WORK( 1 ) = 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 )
RETURN RETURN
ELSE IF (LQUERY) THEN ELSE IF( LQUERY ) THEN
RETURN RETURN
END IF END IF
* *
* Quick return if possible * Quick return if possible
* *
IF( MIN(M,N).EQ.0 ) THEN IF( MINMN.EQ.0 ) THEN
RETURN RETURN
END IF END IF
* *
* The QR Decomposition * The QR Decomposition
* *
IF ((MB.LE.N).OR.(MB.GE.M)) THEN IF( (MB.LE.N) .OR. (MB.GE.M) ) THEN
CALL SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) CALL SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
RETURN RETURN
END IF END IF
KK = MOD((M-N),(MB-N)) KK = MOD((M-N),(MB-N))
II=M-KK+1 II = M-KK+1
* *
* Compute the QR factorization of the first block A(1:MB,1:N) * Compute the QR factorization of the first block A(1:MB,1:N)
* *
CALL SGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) CALL SGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO )
* *
CTR = 1 CTR = 1
DO I = MB+1, II-MB+N , (MB-N) DO I = MB+1, II-MB+N, (MB-N)
* *
* Compute the QR factorization of the current block A(I:I+MB-N,1:N) * Compute the QR factorization of the current block A(I:I+MB-N,1:N)
* *
CALL STPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, CALL STPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA,
$ T(1, CTR * N + 1), $ T(1, CTR * N + 1),
$ LDT, WORK, INFO ) $ LDT, WORK, INFO )
CTR = CTR + 1 CTR = CTR + 1
END DO END DO
* *
* Compute the QR factorization of the last block A(II:M,1:N) * Compute the QR factorization of the last block A(II:M,1:N)
* *
IF (II.LE.M) THEN IF( II.LE.M ) THEN
CALL STPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, CALL STPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
$ T(1, CTR * N + 1), LDT, $ T(1, CTR * N + 1), LDT,
$ WORK, INFO ) $ WORK, INFO )
END IF END IF
* *
work( 1 ) = N*NB WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
RETURN RETURN
* *
* End of SLATSQR * End of SLATSQR

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

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
@ -428,7 +435,7 @@
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( ( NB+1 )*N, LWMIN ) LWKOPT = MAX( ( NB+1 )*N, LWMIN )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
* *
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
@ -677,7 +684,7 @@
* *
* Set WORK(1) to optimal workspace size. * Set WORK(1) to optimal workspace size.
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
* *
RETURN RETURN

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 )
LWMIN = MAX( 26*N, 5*N + LHTRD + LWTRD ) *
LIWMIN = MAX( 1, 10*N ) IF( N.LE.1 ) THEN
LWMIN = 1
LIWMIN = 1
ELSE
LWMIN = MAX( 26*N, 5*N + LHTRD + LWTRD )
LIWMIN = 10*N
END IF
* *
INFO = 0 INFO = 0
IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
@ -485,7 +493,7 @@
* 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( ( NB+1 )*N, LWMIN ) * LWKOPT = MAX( ( NB+1 )*N, LWMIN )
WORK( 1 ) = SROUNDUP_LWORK(LWMIN) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
END IF END IF
* *
@ -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 )
@ -733,7 +741,7 @@
* *
* Set WORK(1) to optimal workspace size. * Set WORK(1) to optimal workspace size.
* *
WORK( 1 ) = SROUNDUP_LWORK(LWMIN) WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
IWORK( 1 ) = LIWMIN IWORK( 1 ) = LIWMIN
* *
RETURN RETURN

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
@ -542,7 +542,7 @@
* *
* Set WORK(1) to optimal workspace size. * Set WORK(1) to optimal workspace size.
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

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,18 +208,18 @@
INFO = -5 INFO = -5
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -8 INFO = -8
ELSE IF( LWORK.LT.MAX(2*N, 3*N-2) .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10 INFO = -10
END IF END IF
* *
IF( INFO.EQ.0 ) THEN IF( INFO.EQ.0 ) THEN
CALL SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) 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, 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
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -239,7 +241,7 @@
* *
END IF END IF
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

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,
@ -269,7 +272,7 @@
* *
END IF END IF
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

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 )

View File

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

View File

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

View File

@ -234,7 +234,7 @@
* *
NB = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 ) NB = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 )
LWKOPT = MAX( 1, N*NB ) LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
END IF END IF
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -353,7 +353,8 @@
END IF END IF
* *
40 CONTINUE 40 CONTINUE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) *
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
* *
* End of SSYTRF * End of SSYTRF

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
@ -128,7 +130,7 @@
*> \ingroup hetrf_aa *> \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 computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
@ -142,19 +144,19 @@
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
INTEGER IPIV( * ) INTEGER IPIV( * )
REAL A( LDA, * ), WORK( * ) REAL A( LDA, * ), WORK( * )
* .. * ..
* *
* ===================================================================== * =====================================================================
* .. Parameters .. * .. Parameters ..
REAL ZERO, ONE REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
* *
* .. 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
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -180,19 +182,26 @@
INFO = 0 INFO = 0
UPPER = LSAME( UPLO, 'U' ) UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 ) LQUERY = ( LWORK.EQ.-1 )
IF( N.LE.1 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = 2*N
LWKOPT = (NB+1)*N
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
ELSE IF( N.LT.0 ) THEN ELSE IF( N.LT.0 ) THEN
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4 INFO = -4
ELSE IF( LWORK.LT.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
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
@ -204,11 +213,11 @@
* *
* Quick return * Quick return
* *
IF ( N.EQ.0 ) THEN IF( N.EQ.0 ) THEN
RETURN RETURN
ENDIF ENDIF
IPIV( 1 ) = 1 IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN IF( N.EQ.1 ) THEN
RETURN RETURN
END IF END IF
* *
@ -458,7 +467,8 @@
END IF END IF
* *
20 CONTINUE 20 CONTINUE
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) *
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
RETURN RETURN
* *
* End of SSYTRF_AA * End of SSYTRF_AA

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
@ -240,7 +240,7 @@
* *
* Quick return * Quick return
* *
IF ( N.EQ.0 ) THEN IF( N.EQ.0 ) THEN
RETURN RETURN
ENDIF ENDIF
* *

View File

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

View File

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

View File

@ -88,16 +88,16 @@
*> *>
*> \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
*> this value as the first entry of the WORK array, *> this value as the first entry of the WORK array,
*> - and no error message related to LWORK is issued by XERBLA. *> - and no error message related to LWORK is issued by XERBLA.
@ -120,7 +120,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \ingroup 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)
@ -173,28 +178,29 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4 INFO = -4
ELSE IF (LWORK .LT. MINSIZE .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN
INFO = -7 INFO = -7
END IF END IF
*
* Quick return if possible
*
* *
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
CALL XERBLA( '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

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
* *
NB = MAX( 1, ILAENV( 1, 'SSYTRI_3', UPLO, N, -1, -1, -1 ) ) IF( N.EQ.0 ) THEN
LWKOPT = ( N+NB+1 ) * ( NB+3 ) 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 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1 INFO = -1
@ -218,7 +224,7 @@
INFO = -2 INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4 INFO = -4
ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN
INFO = -8 INFO = -8
END IF END IF
* *
@ -226,7 +232,6 @@
CALL XERBLA( '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
* *
@ -237,7 +242,7 @@
* *
CALL SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) CALL SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
* *
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
* *
RETURN RETURN
* *

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
@ -141,7 +147,7 @@
* .. * ..
* .. Array Arguments .. * .. Array Arguments ..
INTEGER IPIV( * ) INTEGER IPIV( * )
REAL A( LDA, * ), B( LDB, * ), WORK( * ) REAL A( LDA, * ), B( LDB, * ), WORK( * )
* .. * ..
* *
* ===================================================================== * =====================================================================
@ -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