OSchip
/
OpenBLAS
Not watched
1
0
Fork 0
Code
Releases 66 Wiki evaluate Activity
Issues 0 Pull Requests 0 Datasets Model Cloudbrain HPC
Browse Source

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

tags/v0.3.26
Martin Kroeker GitHub 2 years ago
parent
c082669ad4
commit
45ef0d7361
No known key found for this signature in database GPG Key ID: 4AEE18F83AFDEB23
42 changed files with 733 additions and 504 deletions
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +17
    -9
      lapack-netlib/SRC/zgebrd.f
  2. +14
    -9
      lapack-netlib/SRC/zgehrd.f
  3. +3
    -1
      lapack-netlib/SRC/zgelq.f
  4. +13
    -7
      lapack-netlib/SRC/zgelqf.f
  5. +19
    -9
      lapack-netlib/SRC/zgemlq.f
  6. +20
    -10
      lapack-netlib/SRC/zgemqr.f
  7. +6
    -4
      lapack-netlib/SRC/zgeqlf.f
  8. +2
    -1
      lapack-netlib/SRC/zgeqp3rk.f
  9. +12
    -8
      lapack-netlib/SRC/zgeqr.f
  10. +16
    -8
      lapack-netlib/SRC/zgeqrfp.f
  11. +49
    -34
      lapack-netlib/SRC/zgesvj.f
  12. +2
    -2
      lapack-netlib/SRC/zgetri.f
  13. +7
    -5
      lapack-netlib/SRC/zgetsls.f
  14. +9
    -6
      lapack-netlib/SRC/zgetsqrhrt.f
  15. +20
    -14
      lapack-netlib/SRC/zgges3.f
  16. +14
    -10
      lapack-netlib/SRC/zggev3.f
  17. +10
    -5
      lapack-netlib/SRC/zgghd3.f
  18. +2
    -2
      lapack-netlib/SRC/zggqrf.f
  19. +2
    -2
      lapack-netlib/SRC/zggrqf.f
  20. +2
    -2
      lapack-netlib/SRC/zggsvd3.f
  21. +2
    -2
      lapack-netlib/SRC/zggsvp3.f
  22. +2
    -3
      lapack-netlib/SRC/zheevd.f
  23. +19
    -10
      lapack-netlib/SRC/zheevr.f
  24. +26
    -16
      lapack-netlib/SRC/zheevr_2stage.f
  25. +8
    -7
      lapack-netlib/SRC/zhesv_aa.f
  26. +13
    -10
      lapack-netlib/SRC/zhesv_aa_2stage.f
  27. +7
    -6
      lapack-netlib/SRC/zhesvx.f
  28. +47
    -40
      lapack-netlib/SRC/zhetrd_2stage.f
  29. +71
    -63
      lapack-netlib/SRC/zhetrd_hb2st.F
  30. +12
    -6
      lapack-netlib/SRC/zhetrd_he2hb.f
  31. +4
    -3
      lapack-netlib/SRC/zhetrf.f
  32. +18
    -9
      lapack-netlib/SRC/zhetrf_aa.f
  33. +14
    -14
      lapack-netlib/SRC/zhetrf_aa_2stage.f
  34. +4
    -4
      lapack-netlib/SRC/zhetrf_rk.f
  35. +2
    -2
      lapack-netlib/SRC/zhetrf_rook.f
  36. +16
    -11
      lapack-netlib/SRC/zhetri2.f
  37. +19
    -8
      lapack-netlib/SRC/zhetrs_aa.f
  38. +41
    -27
      lapack-netlib/SRC/zlamswlq.f
  39. +44
    -32
      lapack-netlib/SRC/zlamtsqr.f
  40. +52
    -39
      lapack-netlib/SRC/zlaswlq.f
  41. +18
    -4
      lapack-netlib/SRC/zlatrs3.f
  42. +55
    -40
      lapack-netlib/SRC/zlatsqr.f

+ 17
- 9
lapack-netlib/SRC/zgebrd.f View File

@@ -122,7 +122,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of the array WORK. LWORK >= max(1,M,N).
*> The length of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(M,N), otherwise.
*> For optimum performance LWORK >= (M+N)*NB, where NB
*> is the optimal blocksize.
*>
@@ -147,7 +148,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16GEcomputational
*> \ingroup gebrd
*
*> \par Further Details:
* =====================
@@ -223,8 +224,8 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
$ NBMIN, NX, WS
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT,
$ MINMN, NB, NBMIN, NX, WS
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, ZGEBD2, ZGEMM, ZLABRD
@@ -241,9 +242,17 @@
* Test the input parameters
*
INFO = 0
NB = MAX( 1, ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) )
LWKOPT = ( M+N )*NB
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = MAX( M, N )
NB = MAX( 1, ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) )
LWKOPT = ( M+N )*NB
END IF
WORK( 1 ) = DBLE( LWKOPT )
*
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
@@ -251,7 +260,7 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
IF( INFO.LT.0 ) THEN
@@ -263,7 +272,6 @@
*
* Quick return if possible
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
WORK( 1 ) = 1
RETURN
@@ -282,7 +290,7 @@
* Determine when to switch from blocked to unblocked code.
*
IF( NX.LT.MINMN ) THEN
WS = ( M+N )*NB
WS = LWKOPT
IF( LWORK.LT.WS ) THEN
*
* Not enough work space for the optimal NB, consider using


+ 14
- 9
lapack-netlib/SRC/zgehrd.f View File

@@ -89,7 +89,7 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX*16 array, dimension (LWORK)
*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim
*>
@@ -120,7 +120,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16GEcomputational
*> \ingroup gehrd
*
*> \par Further Details:
* =====================
@@ -173,7 +173,7 @@
INTEGER IHI, ILO, INFO, LDA, LWORK, N
* ..
* .. Array Arguments ..
COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
* ..
*
* =====================================================================
@@ -182,7 +182,7 @@
INTEGER NBMAX, LDT, TSIZE
PARAMETER ( NBMAX = 64, LDT = NBMAX+1,
$ TSIZE = LDT*NBMAX )
COMPLEX*16 ZERO, ONE
COMPLEX*16 ZERO, ONE
PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
$ ONE = ( 1.0D+0, 0.0D+0 ) )
* ..
@@ -190,7 +190,7 @@
LOGICAL LQUERY
INTEGER I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB,
$ NBMIN, NH, NX
COMPLEX*16 EI
COMPLEX*16 EI
* ..
* .. External Subroutines ..
EXTERNAL ZAXPY, ZGEHD2, ZGEMM, ZLAHR2, ZLARFB, ZTRMM,
@@ -221,12 +221,18 @@
INFO = -8
END IF
*
NH = IHI - ILO + 1
IF( INFO.EQ.0 ) THEN
*
* Compute the workspace requirements
*
NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
LWKOPT = N*NB + TSIZE
IF( NH.LE.1 ) THEN
LWKOPT = 1
ELSE
NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI,
$ -1 ) )
LWKOPT = N*NB + TSIZE
END IF
WORK( 1 ) = LWKOPT
ENDIF
*
@@ -248,7 +254,6 @@
*
* Quick return if possible
*
NH = IHI - ILO + 1
IF( NH.LE.1 ) THEN
WORK( 1 ) = 1
RETURN
@@ -268,7 +273,7 @@
*
* Determine if workspace is large enough for blocked code
*
IF( LWORK.LT.N*NB+TSIZE ) THEN
IF( LWORK.LT.LWKOPT ) THEN
*
* Not enough workspace to use optimal NB: determine the
* minimum value of NB, and reduce NB or force use of


+ 3
- 1
lapack-netlib/SRC/zgelq.f View File

@@ -98,7 +98,7 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
*> only calculates the sizes of the T and WORK arrays, returns these
*> values as the first entries of the T and WORK arrays, and no error
@@ -166,6 +166,8 @@
*> the LQ factorization.
*> \endverbatim
*>
*> \ingroup gelq
*>
* =====================================================================
SUBROUTINE ZGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
$ INFO )


+ 13
- 7
lapack-netlib/SRC/zgelqf.f View File

@@ -93,7 +93,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,M).
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M, otherwise.
*> For optimum performance LWORK >= M*NB, where NB is the
*> optimal blocksize.
*>
@@ -118,7 +119,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16GEcomputational
*> \ingroup gelqf
*
*> \par Further Details:
* =====================
@@ -174,9 +175,8 @@
* Test the input arguments
*
INFO = 0
K = MIN( M, N )
NB = ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
LWKOPT = M*NB
WORK( 1 ) = LWKOPT
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
@@ -184,19 +184,25 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
INFO = -7
ELSE IF( .NOT.LQUERY ) THEN
IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) )
$ INFO = -7
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGELQF', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
IF( K.EQ.0 ) THEN
LWKOPT = 1
ELSE
LWKOPT = M*NB
END IF
WORK( 1 ) = LWKOPT
RETURN
END IF
*
* Quick return if possible
*
K = MIN( M, N )
IF( K.EQ.0 ) THEN
WORK( 1 ) = 1
RETURN


+ 19
- 9
lapack-netlib/SRC/zgemlq.f View File

@@ -109,16 +109,17 @@
*>
*> \param[out] WORK
*> \verbatim
*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1, then a workspace query is assumed. The routine
*> only calculates the size of the WORK array, returns this
*> value as WORK(1), and no error message related to WORK
*> value as WORK(1), and no error message related to WORK
*> is issued by XERBLA.
*> \endverbatim
*>
@@ -142,7 +143,7 @@
*>
*> \verbatim
*>
*> These details are particular for this LAPACK implementation. Users should not
*> These details are particular for this LAPACK implementation. Users should not
*> take them for granted. These details may change in the future, and are not likely
*> true for another LAPACK implementation. These details are relevant if one wants
*> to try to understand the code. They are not part of the interface.
@@ -158,11 +159,13 @@
*> block sizes MB and NB returned by ILAENV, ZGELQ will use either
*> ZLASWLQ (if the matrix is wide-and-short) or ZGELQT to compute
*> the LQ factorization.
*> This version of ZGEMLQ will use either ZLAMSWLQ or ZGEMLQT to
*> This version of ZGEMLQ will use either ZLAMSWLQ or ZGEMLQT to
*> multiply matrix Q by another matrix.
*> Further Details in ZLAMSWLQ or ZGEMLQT.
*> \endverbatim
*>
*> \ingroup gemlq
*>
* =====================================================================
SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
$ C, LDC, WORK, LWORK, INFO )
@@ -184,7 +187,7 @@
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER MB, NB, LW, NBLCKS, MN
INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -200,7 +203,7 @@
*
* Test the input arguments
*
LQUERY = LWORK.EQ.-1
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' )
@@ -215,6 +218,13 @@
LW = M * MB
MN = N
END IF
*
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
*
IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
@@ -243,7 +253,7 @@
INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -11
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
ELSE IF( ( LWORK.LT.LWMIN ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
END IF
*
@@ -260,7 +270,7 @@
*
* Quick return if possible
*
IF( MIN( M, N, K ).EQ.0 ) THEN
IF( MINMNK.EQ.0 ) THEN
RETURN
END IF
*


+ 20
- 10
lapack-netlib/SRC/zgemqr.f View File

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


+ 6
- 4
lapack-netlib/SRC/zgeqlf.f View File

@@ -88,7 +88,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,N).
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise.
*> For optimum performance LWORK >= N*NB, where NB is
*> the optimal blocksize.
*>
@@ -113,7 +114,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16GEcomputational
*> \ingroup geqlf
*
*> \par Further Details:
* =====================
@@ -188,8 +189,9 @@
END IF
WORK( 1 ) = LWKOPT
*
IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
INFO = -7
IF( .NOT.LQUERY ) THEN
IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) )
$ INFO = -7
END IF
END IF
*


+ 2
- 1
lapack-netlib/SRC/zgeqp3rk.f View File

@@ -428,7 +428,8 @@
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*. LWORK >= N+NRHS-1
*> LWORK >= 1, if MIN(M,N) = 0, and
*> LWORK >= N+NRHS-1, otherwise.
*> For optimal performance LWORK >= NB*( N+NRHS+1 ),
*> where NB is the optimal block size for ZGEQP3RK returned
*> by ILAENV. Minimal block size MINNB=2.


+ 12
- 8
lapack-netlib/SRC/zgeqr.f View File

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


+ 16
- 8
lapack-netlib/SRC/zgeqrfp.f View File

@@ -97,7 +97,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,N).
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise.
*> For optimum performance LWORK >= N*NB, where NB is
*> the optimal blocksize.
*>
@@ -122,7 +123,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16GEcomputational
*> \ingroup geqrfp
*
*> \par Further Details:
* =====================
@@ -162,8 +163,8 @@
*
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
$ NBMIN, NX
INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKMIN, LWKOPT,
$ NB, NBMIN, NX
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, ZGEQR2P, ZLARFB, ZLARFT
@@ -181,8 +182,16 @@
*
INFO = 0
NB = ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
LWKOPT = N*NB
K = MIN( M, N )
IF( K.EQ.0 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = N
LWKOPT = N*NB
END IF
WORK( 1 ) = LWKOPT
*
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
@@ -190,7 +199,7 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -7
END IF
IF( INFO.NE.0 ) THEN
@@ -202,7 +211,6 @@
*
* Quick return if possible
*
K = MIN( M, N )
IF( K.EQ.0 ) THEN
WORK( 1 ) = 1
RETURN
@@ -210,7 +218,7 @@
*
NBMIN = 2
NX = 0
IWS = N
IWS = LWKMIN
IF( NB.GT.1 .AND. NB.LT.K ) THEN
*
* Determine when to cross over from blocked to unblocked code.


+ 49
- 34
lapack-netlib/SRC/zgesvj.f View File

@@ -200,23 +200,25 @@
*> \verbatim
*> LDV is INTEGER
*> The leading dimension of the array V, LDV >= 1.
*> If JOBV = 'V', then LDV >= max(1,N).
*> If JOBV = 'A', then LDV >= max(1,MV) .
*> If JOBV = 'V', then LDV >= MAX(1,N).
*> If JOBV = 'A', then LDV >= MAX(1,MV) .
*> \endverbatim
*>
*> \param[in,out] CWORK
*> \verbatim
*> CWORK is COMPLEX*16 array, dimension (max(1,LWORK))
*> CWORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
*> Used as workspace.
*> If on entry LWORK = -1, then a workspace query is assumed and
*> no computation is done; CWORK(1) is set to the minial (and optimal)
*> length of CWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER.
*> Length of CWORK, LWORK >= M+N.
*> Length of CWORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M+N, otherwise.
*>
*> If on entry LWORK = -1, then a workspace query is assumed and
*> no computation is done; CWORK(1) is set to the minial (and optimal)
*> length of CWORK.
*> \endverbatim
*>
*> \param[in,out] RWORK
@@ -247,15 +249,17 @@
*> RWORK(6) = the largest absolute value over all sines of the
*> Jacobi rotation angles in the last sweep. It can be
*> useful for a post festum analysis.
*> If on entry LRWORK = -1, then a workspace query is assumed and
*> no computation is done; RWORK(1) is set to the minial (and optimal)
*> length of RWORK.
*> \endverbatim
*>
*> \param[in] LRWORK
*> \verbatim
*> LRWORK is INTEGER
*> Length of RWORK, LRWORK >= MAX(6,N).
*> Length of RWORK.
*> LRWORK >= 1, if MIN(M,N) = 0, and LRWORK >= MAX(6,N), otherwise.
*>
*> If on entry LRWORK = -1, then a workspace query is assumed and
*> no computation is done; RWORK(1) is set to the minial (and optimal)
*> length of RWORK.
*> \endverbatim
*>
*> \param[out] INFO
@@ -276,7 +280,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16GEcomputational
*> \ingroup gesvj
*
*> \par Further Details:
* =====================
@@ -367,23 +371,25 @@
*
* .. Local Parameters ..
DOUBLE PRECISION ZERO, HALF, ONE
PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0)
COMPLEX*16 CZERO, CONE
PARAMETER ( CZERO = (0.0D0, 0.0D0), CONE = (1.0D0, 0.0D0) )
INTEGER NSWEEP
PARAMETER ( NSWEEP = 30 )
PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0)
COMPLEX*16 CZERO, CONE
PARAMETER ( CZERO = (0.0D0, 0.0D0), CONE = (1.0D0, 0.0D0) )
INTEGER NSWEEP
PARAMETER ( NSWEEP = 30 )
* ..
* .. Local Scalars ..
COMPLEX*16 AAPQ, OMPQ
DOUBLE PRECISION AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG,
$ BIGTHETA, CS, CTOL, EPSLN, MXAAPQ,
$ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL,
$ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN, TOL
INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
$ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34,
$ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, SWBAND
LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, ROTOK,
$ RSVEC, UCTOL, UPPER
COMPLEX*16 AAPQ, OMPQ
DOUBLE PRECISION AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG,
$ BIGTHETA, CS, CTOL, EPSLN, MXAAPQ,
$ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL,
$ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN,
$ TOL
INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
$ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34,
$ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP,
$ SWBAND, MINMN, LWMIN, LRWMIN
LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE,
$ ROTOK, RSVEC, UCTOL, UPPER
* ..
* ..
* .. Intrinsic Functions ..
@@ -422,7 +428,16 @@
UPPER = LSAME( JOBA, 'U' )
LOWER = LSAME( JOBA, 'L' )
*
LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 )
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
LRWMIN = 1
ELSE
LWMIN = M+N
LRWMIN = MAX( 6, N )
END IF
*
LQUERY = ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 )
IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN
INFO = -1
ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN
@@ -442,9 +457,9 @@
INFO = -11
ELSE IF( UCTOL .AND. ( RWORK( 1 ).LE.ONE ) ) THEN
INFO = -12
ELSE IF( ( LWORK.LT.( M+N ) ) .AND. ( .NOT.LQUERY ) ) THEN
ELSE IF( LWORK.LT.LWMIN .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
ELSE IF( ( LRWORK.LT.MAX( N, 6 ) ) .AND. ( .NOT.LQUERY ) ) THEN
ELSE IF( LRWORK.LT.LRWMIN .AND. ( .NOT.LQUERY ) ) THEN
INFO = -15
ELSE
INFO = 0
@@ -454,15 +469,15 @@
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGESVJ', -INFO )
RETURN
ELSE IF ( LQUERY ) THEN
CWORK(1) = M + N
RWORK(1) = MAX( N, 6 )
ELSE IF( LQUERY ) THEN
CWORK( 1 ) = LWMIN
RWORK( 1 ) = LRWMIN
RETURN
END IF
*
* #:) Quick return for void matrix
*
IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN
IF( MINMN.EQ.0 ) RETURN
*
* Set numerical parameters
* The stopping criterion for Jacobi rotations is


+ 2
- 2
lapack-netlib/SRC/zgetri.f View File

@@ -107,7 +107,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16GEcomputational
*> \ingroup getri
*
* =====================================================================
SUBROUTINE ZGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
@@ -152,7 +152,7 @@
*
INFO = 0
NB = ILAENV( 1, 'ZGETRI', ' ', N, -1, -1, -1 )
LWKOPT = N*NB
LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = LWKOPT
LQUERY = ( LWORK.EQ.-1 )
IF( N.LT.0 ) THEN


+ 7
- 5
lapack-netlib/SRC/zgetsls.f View File

@@ -127,7 +127,7 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK. LWORK >= 1.
*> If LWORK = -1 or -2, then a workspace query is assumed.
*> If LWORK = -1, the routine calculates optimal size of WORK for the
*> optimal performance and returns this value in WORK(1).
@@ -154,7 +154,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16GEsolve
*> \ingroup getsls
*
* =====================================================================
SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
@@ -192,7 +192,7 @@
* .. External Functions ..
LOGICAL LSAME
DOUBLE PRECISION DLAMCH, ZLANGE
EXTERNAL LSAME, DLABAD, DLAMCH, ZLANGE
EXTERNAL LSAME, DLAMCH, ZLANGE
* ..
* .. External Subroutines ..
EXTERNAL ZGEQR, ZGEMQR, ZLASCL, ZLASET,
@@ -229,7 +229,10 @@
*
* Determine the optimum and minimum LWORK
*
IF( M.GE.N ) THEN
IF( MIN( M, N, NRHS ).EQ.0 ) THEN
WSIZEO = 1
WSIZEM = 1
ELSE IF( M.GE.N ) THEN
CALL ZGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) )
LWO = INT( WORKQ( 1 ) )
@@ -297,7 +300,6 @@
*
SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
*
* Scale A, B if max element outside range [SMLNUM,BIGNUM]
*


+ 9
- 6
lapack-netlib/SRC/zgetsqrhrt.f View File

@@ -131,13 +131,15 @@
*> \param[in] LWORK
*> \verbatim
*> The dimension of the array WORK.
*> LWORK >= MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ),
*> If MIN(M,N) = 0, LWORK >= 1, else
*> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ),
*> where
*> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)),
*> NB1LOCAL = MIN(NB1,N).
*> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL,
*> LW1 = NB1LOCAL * N,
*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ),
*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ).
*>
*> If LWORK = -1, then a workspace query is assumed.
*> The routine only calculates the optimal size of the WORK
*> array, returns this value as the first entry of the WORK
@@ -160,7 +162,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup comlpex16OTHERcomputational
*> \ingroup getsqrhrt
*
*> \par Contributors:
* ==================
@@ -212,7 +214,7 @@
* Test the input arguments
*
INFO = 0
LQUERY = LWORK.EQ.-1
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
ELSE IF( N.LT.0 .OR. M.LT.N ) THEN
@@ -225,7 +227,7 @@
INFO = -5
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -7
ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN
ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN
INFO = -9
ELSE
*
@@ -263,8 +265,9 @@
LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) )
*
LWORKOPT = MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) )
LWORKOPT = MAX( 1, LWORKOPT )
*
IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN
IF( LWORK.LT.LWORKOPT .AND. .NOT.LQUERY ) THEN
INFO = -11
END IF
*


+ 20
- 14
lapack-netlib/SRC/zgges3.f View File

@@ -215,7 +215,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK. LWORK >= MAX(1,2*N)
*> For good performance, LWORK must generally be larger.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@@ -260,7 +261,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16GEeigen
*> \ingroup gges3
*
* =====================================================================
SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B,
@@ -300,7 +301,8 @@
LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
$ LQUERY, WANTST
INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
$ ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK, LWKOPT
$ ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK, LWKOPT,
$ LWKMIN
DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL,
$ PVSR, SMLNUM
* ..
@@ -309,9 +311,8 @@
DOUBLE PRECISION DIF( 2 )
* ..
* .. External Subroutines ..
EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3,
$ ZLAQZ0, ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR,
$ ZUNMQR
EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, ZLAQZ0,
$ ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, ZUNMQR
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -353,6 +354,8 @@
*
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N )
*
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@@ -369,7 +372,7 @@
INFO = -14
ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
INFO = -16
ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -18
END IF
*
@@ -377,28 +380,32 @@
*
IF( INFO.EQ.0 ) THEN
CALL ZGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
LWKOPT = MAX( 1, N + INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKMIN, N + INT( WORK( 1 ) ) )
CALL ZUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK,
$ -1, IERR )
LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) )
IF( ILVSL ) THEN
CALL ZUNGQR( N, N, N, VSL, LDVSL, WORK, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) )
END IF
CALL ZGGHD3( JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, VSL,
$ LDVSL, VSR, LDVSR, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) )
CALL ZLAQZ0( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB,
$ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, -1,
$ RWORK, 0, IERR )
LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, INT( WORK( 1 ) ) )
IF( WANTST ) THEN
CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB,
$ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, SDIM,
$ PVSL, PVSR, DIF, WORK, -1, IDUM, 1, IERR )
LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) )
LWKOPT = MAX( LWKOPT, INT( WORK( 1 ) ) )
END IF
IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = DCMPLX( LWKOPT )
END IF
WORK( 1 ) = DCMPLX( LWKOPT )
END IF
*
IF( INFO.NE.0 ) THEN
@@ -420,7 +427,6 @@
EPS = DLAMCH( 'P' )
SMLNUM = DLAMCH( 'S' )
BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
SMLNUM = SQRT( SMLNUM ) / EPS
BIGNUM = ONE / SMLNUM
*


+ 14
- 10
lapack-netlib/SRC/zggev3.f View File

@@ -174,7 +174,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> The dimension of the array WORK. LWORK >= MAX(1,2*N).
*> For good performance, LWORK must generally be larger.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@@ -208,7 +209,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16GEeigen
*> \ingroup ggev3
*
* =====================================================================
SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
@@ -243,7 +244,7 @@
CHARACTER CHTEMP
INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
$ IN, IRIGHT, IROWS, IRWRK, ITAU, IWRK, JC, JR,
$ LWKOPT
$ LWKMIN, LWKOPT
DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
$ SMLNUM, TEMP
COMPLEX*16 X
@@ -252,9 +253,8 @@
LOGICAL LDUMMA( 1 )
* ..
* .. External Subroutines ..
EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3,
$ ZLAQZ0, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR,
$ ZUNMQR
EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, ZLAQZ0,
$ ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR, ZUNMQR
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -301,6 +301,7 @@
*
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N )
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@@ -315,7 +316,7 @@
INFO = -11
ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
INFO = -13
ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -15
END IF
*
@@ -323,7 +324,7 @@
*
IF( INFO.EQ.0 ) THEN
CALL ZGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR )
LWKOPT = MAX( 1, N+INT( WORK( 1 ) ) )
LWKOPT = MAX( LWKMIN, N+INT( WORK( 1 ) ) )
CALL ZUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK,
$ -1, IERR )
LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
@@ -348,7 +349,11 @@
$ RWORK, 0, IERR )
LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) )
END IF
WORK( 1 ) = DCMPLX( LWKOPT )
IF( N.EQ.0 ) THEN
WORK( 1 ) = 1
ELSE
WORK( 1 ) = DCMPLX( LWKOPT )
END IF
END IF
*
IF( INFO.NE.0 ) THEN
@@ -368,7 +373,6 @@
EPS = DLAMCH( 'E' )*DLAMCH( 'B' )
SMLNUM = DLAMCH( 'S' )
BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
SMLNUM = SQRT( SMLNUM ) / EPS
BIGNUM = ONE / SMLNUM
*


+ 10
- 5
lapack-netlib/SRC/zgghd3.f View File

@@ -176,14 +176,14 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX*16 array, dimension (LWORK)
*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of the array WORK. LWORK >= 1.
*> The length of the array WORK. LWORK >= 1.
*> For optimum performance LWORK >= 6*N*NB, where NB is the
*> optimal blocksize.
*>
@@ -208,7 +208,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16OTHERcomputational
*> \ingroup gghd3
*
*> \par Further Details:
* =====================
@@ -275,7 +275,12 @@
*
INFO = 0
NB = ILAENV( 1, 'ZGGHD3', ' ', 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 ) = DCMPLX( LWKOPT )
INITQ = LSAME( COMPQ, 'I' )
WANTQ = INITQ .OR. LSAME( COMPQ, 'V' )
@@ -325,7 +330,6 @@
*
* Quick return if possible
*
NH = IHI - ILO + 1
IF( NH.LE.1 ) THEN
WORK( 1 ) = CONE
RETURN
@@ -883,6 +887,7 @@
IF ( JCOL.LT.IHI )
$ CALL ZGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q,
$ LDQ, Z, LDZ, IERR )
*
WORK( 1 ) = DCMPLX( LWKOPT )
*
RETURN


+ 2
- 2
lapack-netlib/SRC/zggqrf.f View File

@@ -173,7 +173,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16OTHERcomputational
*> \ingroup ggqrf
*
*> \par Further Details:
* =====================
@@ -250,7 +250,7 @@
NB2 = ILAENV( 1, 'ZGERQF', ' ', N, P, -1, -1 )
NB3 = ILAENV( 1, 'ZUNMQR', ' ', N, M, P, -1 )
NB = MAX( NB1, NB2, NB3 )
LWKOPT = MAX( N, M, P )*NB
LWKOPT = MAX( 1, MAX( N, M, P )*NB )
WORK( 1 ) = LWKOPT
LQUERY = ( LWORK.EQ.-1 )
IF( N.LT.0 ) THEN


+ 2
- 2
lapack-netlib/SRC/zggrqf.f View File

@@ -172,7 +172,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16OTHERcomputational
*> \ingroup ggrqf
*
*> \par Further Details:
* =====================
@@ -249,7 +249,7 @@
NB2 = ILAENV( 1, 'ZGEQRF', ' ', P, N, -1, -1 )
NB3 = ILAENV( 1, 'ZUNMRQ', ' ', M, N, P, -1 )
NB = MAX( NB1, NB2, NB3 )
LWKOPT = MAX( N, M, P )*NB
LWKOPT = MAX( 1, MAX( N, M, P )*NB )
WORK( 1 ) = LWKOPT
LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN


+ 2
- 2
lapack-netlib/SRC/zggsvd3.f View File

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


+ 2
- 2
lapack-netlib/SRC/zggsvp3.f View File

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


+ 2
- 3
lapack-netlib/SRC/zheevd.f View File

@@ -116,8 +116,7 @@
*>
*> \param[out] RWORK
*> \verbatim
*> RWORK is DOUBLE PRECISION array,
*> dimension (LRWORK)
*> RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK))
*> On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
*> \endverbatim
*>
@@ -180,7 +179,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEeigen
*> \ingroup heevd
*
*> \par Further Details:
* =====================


+ 19
- 10
lapack-netlib/SRC/zheevr.f View File

@@ -272,7 +272,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of the array WORK. LWORK >= max(1,2*N).
*> The length of the array WORK.
*> If N <= 1, LWORK >= 1, else LWORK >= 2*N.
*> For optimal efficiency, LWORK >= (NB+1)*N,
*> where NB is the max of the blocksize for ZHETRD and for
*> ZUNMTR as returned by ILAENV.
@@ -294,7 +295,8 @@
*> \param[in] LRWORK
*> \verbatim
*> LRWORK is INTEGER
*> The length of the array RWORK. LRWORK >= max(1,24*N).
*> The length of the array RWORK.
*> If N <= 1, LRWORK >= 1, else LRWORK >= 24*N.
*>
*> If LRWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal sizes of the WORK, RWORK
@@ -313,7 +315,8 @@
*> \param[in] LIWORK
*> \verbatim
*> LIWORK is INTEGER
*> The dimension of the array IWORK. LIWORK >= max(1,10*N).
*> The dimension of the array IWORK.
*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N.
*>
*> If LIWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal sizes of the WORK, RWORK
@@ -338,7 +341,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEeigen
*> \ingroup heevr
*
*> \par Contributors:
* ==================
@@ -417,9 +420,15 @@
LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR.
$ ( LIWORK.EQ.-1 ) )
*
LRWMIN = MAX( 1, 24*N )
LIWMIN = MAX( 1, 10*N )
LWMIN = MAX( 1, 2*N )
IF( N.LE.1 ) THEN
LWMIN = 1
LRWMIN = 1
LIWMIN = 1
ELSE
LWMIN = 2*N
LRWMIN = 24*N
LIWMIN = 10*N
END IF
*
INFO = 0
IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
@@ -454,7 +463,7 @@
NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 )
NB = MAX( NB, ILAENV( 1, 'ZUNMTR', UPLO, N, -1, -1, -1 ) )
LWKOPT = MAX( ( NB+1 )*N, LWMIN )
WORK( 1 ) = LWKOPT
WORK( 1 ) = LWKOPT
RWORK( 1 ) = LRWMIN
IWORK( 1 ) = LIWMIN
*
@@ -483,7 +492,7 @@
END IF
*
IF( N.EQ.1 ) THEN
WORK( 1 ) = 2
WORK( 1 ) = 1
IF( ALLEIG .OR. INDEIG ) THEN
M = 1
W( 1 ) = DBLE( A( 1, 1 ) )
@@ -710,7 +719,7 @@
*
* Set WORK(1) to optimal workspace size.
*
WORK( 1 ) = LWKOPT
WORK( 1 ) = LWKOPT
RWORK( 1 ) = LRWMIN
IWORK( 1 ) = LIWMIN
*


+ 26
- 16
lapack-netlib/SRC/zheevr_2stage.f View File

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


+ 8
- 7
lapack-netlib/SRC/zhesv_aa.f View File

@@ -128,7 +128,7 @@
*> LWORK is INTEGER
*> The length of WORK. LWORK >= MAX(1,2*N,3*N-2), and for best
*> performance LWORK >= max(1,N*NB), where NB is the optimal
*> blocksize for ZHETRF.
*> blocksize for ZHETRF_AA.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@@ -154,7 +154,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEsolve
*> \ingroup hesv_aa
*
* =====================================================================
SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
@@ -177,7 +177,7 @@
*
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER LWKOPT, LWKOPT_HETRF, LWKOPT_HETRS
INTEGER LWKMIN, LWKOPT, LWKOPT_HETRF, LWKOPT_HETRS
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -196,6 +196,7 @@
*
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N, 3*N-2 )
IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@@ -206,17 +207,17 @@
INFO = -5
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -8
ELSE IF( LWORK.LT.MAX(2*N, 3*N-2) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
*
IF( INFO.EQ.0 ) THEN
CALL ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
LWKOPT_HETRF = INT( WORK(1) )
LWKOPT_HETRF = INT( WORK( 1 ) )
CALL ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
$ -1, INFO )
LWKOPT_HETRS = INT( WORK(1) )
LWKOPT = MAX( LWKOPT_HETRF, LWKOPT_HETRS )
LWKOPT_HETRS = INT( WORK( 1 ) )
LWKOPT = MAX( LWKMIN, LWKOPT_HETRF, LWKOPT_HETRS )
WORK( 1 ) = LWKOPT
END IF
*


+ 13
- 10
lapack-netlib/SRC/zhesv_aa_2stage.f View File

@@ -100,14 +100,14 @@
*>
*> \param[out] TB
*> \verbatim
*> TB is COMPLEX*16 array, dimension (LTB)
*> TB is COMPLEX*16 array, dimension (MAX(1,LTB)).
*> On exit, details of the LU factorization of the band matrix.
*> \endverbatim
*>
*> \param[in] LTB
*> \verbatim
*> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally
*> The size of the array TB. LTB >= MAX(1,4*N), internally
*> used to select NB such that LTB >= (3*NB+1)*N.
*>
*> If LTB = -1, then a workspace query is assumed; the
@@ -147,14 +147,15 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX*16 workspace of size LWORK
*> WORK is COMPLEX*16 workspace of size (MAX(1,LWORK)).
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB
*> such that LWORK >= N*NB.
*> The size of WORK. LWORK >= MAX(1,N), internally used to
*> select NB such that LWORK >= N*NB.
*>
*> If LWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the WORK array,
@@ -178,7 +179,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEsolve
*> \ingroup hesv_aa_2stage
*
* =====================================================================
SUBROUTINE ZHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
@@ -208,7 +209,7 @@
*
* .. Local Scalars ..
LOGICAL UPPER, TQUERY, WQUERY
INTEGER LWKOPT
INTEGER LWKOPT, LWKMIN
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -229,6 +230,7 @@
UPPER = LSAME( UPLO, 'U' )
WQUERY = ( LWORK.EQ.-1 )
TQUERY = ( LTB.EQ.-1 )
LWKMIN = MAX( 1, N )
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@@ -237,18 +239,19 @@
INFO = -3
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -5
ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN
ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN
INFO = -7
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -11
ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.WQUERY ) THEN
INFO = -13
END IF
*
IF( INFO.EQ.0 ) THEN
CALL ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
$ IPIV2, WORK, -1, INFO )
LWKOPT = INT( WORK(1) )
LWKOPT = MAX( LWKMIN, INT( WORK( 1 ) ) )
WORK( 1 ) = LWKOPT
END IF
*
IF( INFO.NE.0 ) THEN


+ 7
- 6
lapack-netlib/SRC/zhesvx.f View File

@@ -234,8 +234,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >= max(1,2*N), and for best
*> performance, when FACT = 'N', LWORK >= max(1,2*N,N*NB), where
*> The length of WORK. LWORK >= MAX(1,2*N), and for best
*> performance, when FACT = 'N', LWORK >= MAX(1,2*N,N*NB), where
*> NB is the optimal blocksize for ZHETRF.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
@@ -276,7 +276,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEsolve
*> \ingroup hesvx
*
* =====================================================================
SUBROUTINE ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B,
@@ -307,7 +307,7 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY, NOFACT
INTEGER LWKOPT, NB
INTEGER LWKOPT, LWKMIN, NB
DOUBLE PRECISION ANORM
* ..
* .. External Functions ..
@@ -329,6 +329,7 @@
INFO = 0
NOFACT = LSAME( FACT, 'N' )
LQUERY = ( LWORK.EQ.-1 )
LWKMIN = MAX( 1, 2*N )
IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
INFO = -1
ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
@@ -346,12 +347,12 @@
INFO = -11
ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
INFO = -13
ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -18
END IF
*
IF( INFO.EQ.0 ) THEN
LWKOPT = MAX( 1, 2*N )
LWKOPT = LWKMIN
IF( NOFACT ) THEN
NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 )
LWKOPT = MAX( LWKOPT, N*NB )


+ 47
- 40
lapack-netlib/SRC/zhetrd_2stage.f View File

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


+ 71
- 63
lapack-netlib/SRC/zhetrd_hb2st.F View File

@@ -18,7 +18,7 @@
* Definition:
* ===========
*
* SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB,
* SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB,
* D, E, HOUS, LHOUS, WORK, LWORK, INFO )
*
* #if defined(_OPENMP)
@@ -53,12 +53,12 @@
*> \param[in] STAGE1
*> \verbatim
*> STAGE1 is CHARACTER*1
*> = 'N': "No": to mention that the stage 1 of the reduction
*> = 'N': "No": to mention that the stage 1 of the reduction
*> from dense to band using the zhetrd_he2hb routine
*> was not called before this routine to reproduce AB.
*> In other term this routine is called as standalone.
*> = 'Y': "Yes": to mention that the stage 1 of the
*> reduction from dense to band using the zhetrd_he2hb
*> was not called before this routine to reproduce AB.
*> In other term this routine is called as standalone.
*> = 'Y': "Yes": to mention that the stage 1 of the
*> reduction from dense to band using the zhetrd_he2hb
*> routine has been called to produce AB (e.g., AB is
*> the output of zhetrd_he2hb.
*> \endverbatim
@@ -66,10 +66,10 @@
*> \param[in] VECT
*> \verbatim
*> VECT is CHARACTER*1
*> = 'N': No need for the Housholder representation,
*> = 'N': No need for the Housholder representation,
*> and thus LHOUS is of size max(1, 4*N);
*> = 'V': the Householder representation is needed to
*> either generate or to apply Q later on,
*> = 'V': the Householder representation is needed to
*> either generate or to apply Q later on,
*> then LHOUS is to be queried and computed.
*> (NOT AVAILABLE IN THIS RELEASE).
*> \endverbatim
@@ -132,34 +132,39 @@
*>
*> \param[out] HOUS
*> \verbatim
*> HOUS is COMPLEX*16 array, dimension LHOUS, that
*> store the Householder representation.
*> HOUS is COMPLEX*16 array, dimension (MAX(1,LHOUS))
*> Stores the Householder representation.
*> \endverbatim
*>
*> \param[in] LHOUS
*> \verbatim
*> LHOUS is INTEGER
*> The dimension of the array HOUS. LHOUS = MAX(1, dimension)
*> If LWORK = -1, or LHOUS=-1,
*> The dimension of the array HOUS.
*> If N = 0 or KD <= 1, LHOUS >= 1, else LHOUS = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS = -1,
*> then a query is assumed; the routine
*> only calculates the optimal size of the HOUS array, returns
*> this value as the first entry of the HOUS array, and no error
*> message related to LHOUS is issued by XERBLA.
*> LHOUS = MAX(1, dimension) where
*> dimension = 4*N if VECT='N'
*> not available now if VECT='H'
*> not available now if VECT='H'
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX*16 array, dimension LWORK.
*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)).
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK = MAX(1, dimension)
*> If LWORK = -1, or LHOUS=-1,
*> The dimension of the array WORK.
*> If N = 0 or KD <= 1, LWORK >= 1, else LWORK = MAX(1, dimension).
*>
*> If LWORK = -1, or LHOUS = -1,
*> then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
@@ -188,7 +193,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16OTHERcomputational
*> \ingroup hetrd_hb2st
*
*> \par Further Details:
* =====================
@@ -208,7 +213,7 @@
*> http://doi.acm.org/10.1145/2063384.2063394
*>
*> A. Haidar, J. Kurzak, P. Luszczek, 2013.
*> An improved parallel singular value algorithm and its implementation
*> An improved parallel singular value algorithm and its implementation
*> for multicore hardware, In Proceedings of 2013 International Conference
*> for High Performance Computing, Networking, Storage and Analysis (SC '13).
*> Denver, Colorado, USA, 2013.
@@ -216,16 +221,16 @@
*> http://doi.acm.org/10.1145/2503210.2503292
*>
*> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure
*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure
*> calculations based on fine-grained memory aware tasks.
*> International Journal of High Performance Computing Applications.
*> Volume 28 Issue 2, Pages 196-209, May 2014.
*> http://hpc.sagepub.com/content/28/2/196
*> http://hpc.sagepub.com/content/28/2/196
*>
*> \endverbatim
*>
* =====================================================================
SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB,
SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB,
$ D, E, HOUS, LHOUS, WORK, LWORK, INFO )
*
*
@@ -259,11 +264,11 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY, WANTQ, UPPER, AFTERS1
INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST,
INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST,
$ ED, STIND, EDIND, BLKLASTIND, COLPT, THED,
$ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID,
$ NBTILES, TTYPE, TID, NTHREADS, DEBUG,
$ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS,
$ NBTILES, TTYPE, TID, NTHREADS,
$ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS,
$ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU,
$ SIZEV, SIZETAU, LDV, LHMIN, LWMIN
DOUBLE PRECISION ABSTMP
@@ -277,7 +282,7 @@
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ILAENV2STAGE
INTEGER ILAENV2STAGE
EXTERNAL LSAME, ILAENV2STAGE
* ..
* .. Executable Statements ..
@@ -285,7 +290,6 @@
* Determine the minimal workspace size required.
* Test the input parameters
*
DEBUG = 0
INFO = 0
AFTERS1 = LSAME( STAGE1, 'Y' )
WANTQ = LSAME( VECT, 'V' )
@@ -294,9 +298,14 @@
*
* Determine the block size, the workspace size and the hous size.
*
IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', VECT, N, KD, -1, -1 )
LHMIN = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 )
IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', VECT, N, KD, -1, -1 )
IF( N.EQ.0 .OR. KD.LE.1 ) THEN
LHMIN = 1
LWMIN = 1
ELSE
LHMIN = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 )
LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 )
END IF
*
IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN
INFO = -1
@@ -358,7 +367,7 @@
ABDPOS = KD + 1
ABOFDPOS = KD
ELSE
APOS = INDA
APOS = INDA
AWPOS = INDA + KD + 1
DPOS = APOS
OFDPOS = DPOS + 1
@@ -366,11 +375,11 @@
ABOFDPOS = 2

ENDIF
*
* Case KD=0:
* The matrix is diagonal. We just copy it (convert to "real" for
* complex because D is double and the imaginary part should be 0)
* and store it in D. A sequential code here is better or
*
* Case KD=0:
* The matrix is diagonal. We just copy it (convert to "real" for
* complex because D is double and the imaginary part should be 0)
* and store it in D. A sequential code here is better or
* in a parallel environment it might need two cores for D and E
*
IF( KD.EQ.0 ) THEN
@@ -385,17 +394,17 @@
WORK( 1 ) = 1
RETURN
END IF
*
* Case KD=1:
* The matrix is already Tridiagonal. We have to make diagonal
*
* Case KD=1:
* The matrix is already Tridiagonal. We have to make diagonal
* and offdiagonal elements real, and store them in D and E.
* For that, for real precision just copy the diag and offdiag
* to D and E while for the COMPLEX case the bulge chasing is
* performed to convert the hermetian tridiagonal to symmetric
* tridiagonal. A simpler conversion formula might be used, but then
* For that, for real precision just copy the diag and offdiag
* to D and E while for the COMPLEX case the bulge chasing is
* performed to convert the hermetian tridiagonal to symmetric
* tridiagonal. A simpler conversion formula might be used, but then
* updating the Q matrix will be required and based if Q is generated
* or not this might complicate the story.
*
* or not this might complicate the story.
*
IF( KD.EQ.1 ) THEN
DO 50 I = 1, N
D( I ) = DBLE( AB( ABDPOS, I ) )
@@ -444,7 +453,7 @@ C END IF
RETURN
END IF
*
* Main code start here.
* Main code start here.
* Reduce the hermitian band of A to a tridiagonal matrix.
*
THGRSIZ = N
@@ -453,7 +462,7 @@ C END IF
NBTILES = CEILING( REAL(N)/REAL(KD) )
STEPERCOL = CEILING( REAL(SHIFT)/REAL(GRSIZ) )
THGRNB = CEILING( REAL(N-1)/REAL(THGRSIZ) )
*
*
CALL ZLACPY( "A", KD+1, N, AB, LDAB, WORK( APOS ), LDA )
CALL ZLASET( "A", KD, N, ZERO, ZERO, WORK( AWPOS ), LDA )
*
@@ -462,7 +471,7 @@ C END IF
*
#if defined(_OPENMP)
!$OMP PARALLEL PRIVATE( TID, THGRID, BLKLASTIND )
!$OMP$ PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID )
!$OMP$ PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID )
!$OMP$ PRIVATE( MYID, TTYPE, COLPT, STIND, EDIND )
!$OMP$ SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK)
!$OMP$ SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA )
@@ -471,7 +480,7 @@ C END IF
#endif
*
* main bulge chasing loop
*
*
DO 100 THGRID = 1, THGRNB
STT = (THGRID-1)*THGRSIZ+1
THED = MIN( (STT + THGRSIZ -1), (N-1))
@@ -482,7 +491,7 @@ C END IF
ST = STT
DO 130 SWEEPID = ST, ED
DO 140 K = 1, GRSIZ
MYID = (I-SWEEPID)*(STEPERCOL*GRSIZ)
MYID = (I-SWEEPID)*(STEPERCOL*GRSIZ)
$ + (M-1)*GRSIZ + K
IF ( MYID.EQ.1 ) THEN
TTYPE = 1
@@ -508,17 +517,17 @@ C END IF
ENDIF
*
* Call the kernel
*
*
#if defined(_OPENMP) && _OPENMP >= 201307

IF( TTYPE.NE.1 ) THEN
IF( TTYPE.NE.1 ) THEN
!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
!$OMP$ DEPEND(in:WORK(MYID-1))
!$OMP$ DEPEND(out:WORK(MYID))
TID = OMP_GET_THREAD_NUM()
CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE,
CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE,
$ STIND, EDIND, SWEEPID, N, KD, IB,
$ WORK ( INDA ), LDA,
$ WORK ( INDA ), LDA,
$ HOUS( INDV ), HOUS( INDTAU ), LDV,
$ WORK( INDW + TID*KD ) )
!$OMP END TASK
@@ -526,20 +535,20 @@ C END IF
!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
!$OMP$ DEPEND(out:WORK(MYID))
TID = OMP_GET_THREAD_NUM()
CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE,
CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE,
$ STIND, EDIND, SWEEPID, N, KD, IB,
$ WORK ( INDA ), LDA,
$ WORK ( INDA ), LDA,
$ HOUS( INDV ), HOUS( INDTAU ), LDV,
$ WORK( INDW + TID*KD ) )
!$OMP END TASK
ENDIF
#else
CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE,
CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE,
$ STIND, EDIND, SWEEPID, N, KD, IB,
$ WORK ( INDA ), LDA,
$ WORK ( INDA ), LDA,
$ HOUS( INDV ), HOUS( INDTAU ), LDV,
$ WORK( INDW ) )
#endif
#endif
IF ( BLKLASTIND.GE.(N-1) ) THEN
STT = STT + 1
EXIT
@@ -554,14 +563,14 @@ C END IF
!$OMP END MASTER
!$OMP END PARALLEL
#endif
*
*
* Copy the diagonal from A to D. Note that D is REAL thus only
* the Real part is needed, the imaginary part should be zero.
*
DO 150 I = 1, N
D( I ) = DBLE( WORK( DPOS+(I-1)*LDA ) )
150 CONTINUE
*
*
* Copy the off diagonal from A to E. Note that E is REAL thus only
* the Real part is needed, the imaginary part should be zero.
*
@@ -575,11 +584,10 @@ C END IF
170 CONTINUE
ENDIF
*
HOUS( 1 ) = LHMIN
WORK( 1 ) = LWMIN
RETURN
*
* End of ZHETRD_HB2ST
*
END

+ 12
- 6
lapack-netlib/SRC/zhetrd_he2hb.f View File

@@ -123,8 +123,8 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX*16 array, dimension (LWORK)
*> On exit, if INFO = 0, or if LWORK=-1,
*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, or if LWORK = -1,
*> WORK(1) returns the size of LWORK.
*> \endverbatim
*>
@@ -132,7 +132,9 @@
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK which should be calculated
*> by a workspace query. LWORK = MAX(1, LWORK_QUERY)
*> by a workspace query.
*> If N <= KD+1, LWORK >= 1, else LWORK = MAX(1, LWORK_QUERY).
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
@@ -158,7 +160,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEcomputational
*> \ingroup hetrd_he2hb
*
*> \par Further Details:
* =====================
@@ -293,8 +295,12 @@
INFO = 0
UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 )
LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HE2HB', '', N, KD, -1, -1 )
IF( N.LE.KD+1 ) THEN
LWMIN = 1
ELSE
LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HE2HB', '', N, KD, -1, -1 )
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN


+ 4
- 3
lapack-netlib/SRC/zhetrf.f View File

@@ -107,7 +107,7 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >=1. For best performance
*> The length of WORK. LWORK >= 1. For best performance
*> LWORK >= N*NB, where NB is the block size returned by ILAENV.
*> \endverbatim
*>
@@ -130,7 +130,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEcomputational
*> \ingroup hetrf
*
*> \par Further Details:
* =====================
@@ -227,7 +227,7 @@
* Determine the block size
*
NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 )
LWKOPT = N*NB
LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = LWKOPT
END IF
*
@@ -346,6 +346,7 @@
END IF
*
40 CONTINUE
*
WORK( 1 ) = LWKOPT
RETURN
*


+ 18
- 9
lapack-netlib/SRC/zhetrf_aa.f View File

@@ -101,8 +101,10 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >= MAX(1,2*N). For optimum performance
*> LWORK >= N*(1+NB), where NB is the optimal blocksize.
*> The length of WORK.
*> LWORK >= 1, if N >= 1, and LWORK >= 2*N, otherwise.
*> For optimum performance LWORK >= N*(1+NB), where NB is
*> the optimal blocksize, returned by ILAENV.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
@@ -125,10 +127,10 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEcomputational
*> \ingroup hetrf_aa
*
* =====================================================================
SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -152,7 +154,7 @@
*
* .. Local Scalars ..
LOGICAL LQUERY, UPPER
INTEGER J, LWKOPT
INTEGER J, LWKMIN, LWKOPT
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
COMPLEX*16 ALPHA
* ..
@@ -178,18 +180,25 @@
INFO = 0
UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 )
IF( N.LE.1 ) THEN
LWKMIN = 1
LWKOPT = 1
ELSE
LWKMIN = 2*N
LWKOPT = (NB+1)*N
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4
ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -7
END IF
*
IF( INFO.EQ.0 ) THEN
LWKOPT = (NB+1)*N
WORK( 1 ) = LWKOPT
END IF
*
@@ -202,11 +211,11 @@
*
* Quick return
*
IF ( N.EQ.0 ) THEN
IF( N.EQ.0 ) THEN
RETURN
ENDIF
IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN
IF( N.EQ.1 ) THEN
A( 1, 1 ) = DBLE( A( 1, 1 ) )
RETURN
END IF


+ 14
- 14
lapack-netlib/SRC/zhetrf_aa_2stage.f View File

@@ -87,14 +87,14 @@
*>
*> \param[out] TB
*> \verbatim
*> TB is COMPLEX*16 array, dimension (LTB)
*> TB is COMPLEX*16 array, dimension (MAX(1,LTB))
*> On exit, details of the LU factorization of the band matrix.
*> \endverbatim
*>
*> \param[in] LTB
*> \verbatim
*> LTB is INTEGER
*> The size of the array TB. LTB >= 4*N, internally
*> The size of the array TB. LTB >= MAX(1,4*N), internally
*> used to select NB such that LTB >= (3*NB+1)*N.
*>
*> If LTB = -1, then a workspace query is assumed; the
@@ -121,14 +121,14 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX*16 workspace of size LWORK
*> WORK is COMPLEX*16 workspace of size (MAX(1,LWORK))
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The size of WORK. LWORK >= N, internally used to select NB
*> such that LWORK >= N*NB.
*> The size of WORK. LWORK >= MAX(1,N), internally used to
*> select NB such that LWORK >= N*NB.
*>
*> If LWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal size of the WORK array,
@@ -152,7 +152,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16SYcomputational
*> \ingroup hetrf_aa_2stage
*
* =====================================================================
SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
@@ -182,7 +182,7 @@
* .. Local Scalars ..
LOGICAL UPPER, TQUERY, WQUERY
INTEGER I, J, K, I1, I2, TD
INTEGER LDTB, NB, KB, JB, NT, IINFO
INTEGER LWKOPT, LDTB, NB, KB, JB, NT, IINFO
COMPLEX*16 PIV
* ..
* .. External Functions ..
@@ -212,9 +212,9 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4
ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN
ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN
INFO = -6
ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN
ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN
INFO = -10
END IF
*
@@ -228,10 +228,10 @@
NB = ILAENV( 1, 'ZHETRF_AA_2STAGE', UPLO, N, -1, -1, -1 )
IF( INFO.EQ.0 ) THEN
IF( TQUERY ) THEN
TB( 1 ) = (3*NB+1)*N
TB( 1 ) = MAX( 1, (3*NB+1)*N )
END IF
IF( WQUERY ) THEN
WORK( 1 ) = N*NB
WORK( 1 ) = MAX( 1, N*NB )
END IF
END IF
IF( TQUERY .OR. WQUERY ) THEN
@@ -240,7 +240,7 @@
*
* Quick return
*
IF ( N.EQ.0 ) THEN
IF( N.EQ.0 ) THEN
RETURN
ENDIF
*
@@ -392,7 +392,7 @@
CALL ZGETRF( N-(J+1)*NB, NB,
$ WORK, N,
$ IPIV( (J+1)*NB+1 ), IINFO )
c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
c IF( IINFO.NE.0 .AND. INFO.EQ.0 ) THEN
c INFO = IINFO+(J+1)*NB
c END IF
*
@@ -587,7 +587,7 @@ c END IF
CALL ZGETRF( N-(J+1)*NB, NB,
$ A( (J+1)*NB+1, J*NB+1 ), LDA,
$ IPIV( (J+1)*NB+1 ), IINFO )
c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
c IF( IINFO.NE.0 .AND. INFO.EQ.0 ) THEN
c INFO = IINFO+(J+1)*NB
c END IF
*


+ 4
- 4
lapack-netlib/SRC/zhetrf_rk.f View File

@@ -177,14 +177,14 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX*16 array, dimension ( MAX(1,LWORK) ).
*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)).
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >=1. For best performance
*> The length of WORK. LWORK >= 1. For best performance
*> LWORK >= N*NB, where NB is the block size returned
*> by ILAENV.
*>
@@ -229,7 +229,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEcomputational
*> \ingroup hetrf_rk
*
*> \par Further Details:
* =====================
@@ -310,7 +310,7 @@
* Determine the block size
*
NB = ILAENV( 1, 'ZHETRF_RK', UPLO, N, -1, -1, -1 )
LWKOPT = N*NB
LWKOPT = MAX( 1, N*NB )
WORK( 1 ) = LWKOPT
END IF
*


+ 2
- 2
lapack-netlib/SRC/zhetrf_rook.f View File

@@ -122,7 +122,7 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of WORK. LWORK >=1. For best performance
*> The length of WORK. LWORK >= 1. For best performance
*> LWORK >= N*NB, where NB is the block size returned by ILAENV.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
@@ -150,7 +150,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEcomputational
*> \ingroup hetrf_rook
*
*> \par Further Details:
* =====================


+ 16
- 11
lapack-netlib/SRC/zhetri2.f View File

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

IF( NBMAX .GE. N ) THEN
IF( NBMAX.GE.N ) THEN
CALL ZHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
ELSE
CALL ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
END IF
*
RETURN
*
* End of ZHETRI2


+ 19
- 8
lapack-netlib/SRC/zhetrs_aa.f View File

@@ -106,7 +106,13 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= max(1,3*N-2).
*> The dimension of the array WORK.
*> If MIN(N,NRHS) = 0, LWORK >= 1, else LWORK >= 3*N-2.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*> \endverbatim
*>
*> \param[out] INFO
@@ -124,7 +130,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16HEcomputational
*> \ingroup hetrs_aa
*
* =====================================================================
SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
@@ -152,7 +158,7 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY, UPPER
INTEGER K, KP, LWKOPT
INTEGER K, KP, LWKMIN
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -162,13 +168,19 @@
EXTERNAL ZGTSV, ZSWAP, ZTRSM, ZLACGV, ZLACPY, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
INTRINSIC MIN, MAX
* ..
* .. Executable Statements ..
*
INFO = 0
UPPER = LSAME( UPLO, 'U' )
LQUERY = ( LWORK.EQ.-1 )
IF( MIN( N, NRHS ).EQ.0 ) THEN
LWKMIN = 1
ELSE
LWKMIN = 3*N-2
END IF
*
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@@ -179,21 +191,20 @@
INFO = -5
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -8
ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZHETRS_AA', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
LWKOPT = (3*N-2)
WORK( 1 ) = LWKOPT
WORK( 1 ) = LWKMIN
RETURN
END IF
*
* Quick return if possible
*
IF( N.EQ.0 .OR. NRHS.EQ.0 )
IF( MIN( N, NRHS ).EQ.0 )
$ RETURN
*
IF( UPPER ) THEN


+ 41
- 27
lapack-netlib/SRC/zlamswlq.f View File

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


+ 44
- 32
lapack-netlib/SRC/zlamtsqr.f View File

@@ -128,22 +128,24 @@
*>
*> \param[out] WORK
*> \verbatim
*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*>
*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> If MIN(M,N,K) = 0, LWORK >= 1.
*> If SIDE = 'L', LWORK >= max(1,N*NB).
*> If SIDE = 'R', LWORK >= max(1,MB*NB).
*>
*> If SIDE = 'L', LWORK >= max(1,N)*NB;
*> if SIDE = 'R', LWORK >= max(1,MB)*NB.
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*>
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@@ -191,46 +193,50 @@
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
*> \endverbatim
*>
*> \ingroup lamtsqr
*>
* =====================================================================
SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
$ LDT, C, LDC, WORK, LWORK, INFO )
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
CHARACTER SIDE, TRANS
INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
* ..
* .. Array Arguments ..
COMPLEX*16 A( LDA, * ), WORK( * ), C(LDC, * ),
$ T( LDT, * )
COMPLEX*16 A( LDA, * ), WORK( * ), C( LDC, * ),
$ T( LDT, * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER I, II, KK, LW, CTR, Q
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
INTEGER I, II, KK, LW, CTR, Q, MINMNK, LWMIN
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL ZGEMQRT, ZTPMQRT, XERBLA
EXTERNAL ZGEMQRT, ZTPMQRT, XERBLA
* ..
* .. Executable Statements ..
*
* Test the input arguments
*
LQUERY = LWORK.LT.0
INFO = 0
LQUERY = ( LWORK.EQ.-1 )
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
IF (LEFT) THEN
IF( LEFT ) THEN
LW = N * NB
Q = M
ELSE
@@ -238,11 +244,17 @@
Q = N
END IF
*
INFO = 0
MINMNK = MIN( M, N, K )
IF( MINMNK.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = MAX( 1, LW )
END IF
*
IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
INFO = -1
INFO = -1
ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
INFO = -2
INFO = -2
ELSE IF( M.LT.K ) THEN
INFO = -3
ELSE IF( N.LT.0 ) THEN
@@ -253,38 +265,38 @@
INFO = -7
ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN
INFO = -9
ELSE IF( LDT.LT.MAX( 1, NB) ) THEN
ELSE IF( LDT.LT.MAX( 1, NB ) ) THEN
INFO = -11
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -13
ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
INFO = -13
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -15
END IF
*
* Determine the block size if it is tall skinny or short and wide
*
IF( INFO.EQ.0) THEN
WORK(1) = LW
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZLAMTSQR', -INFO )
RETURN
ELSE IF (LQUERY) THEN
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( MIN(M,N,K).EQ.0 ) THEN
IF( MINMNK.EQ.0 ) THEN
RETURN
END IF
*
* Determine the block size if it is tall skinny or short and wide
*
IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN
CALL ZGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA,
$ T, LDT, C, LDC, WORK, INFO)
$ T, LDT, C, LDC, WORK, INFO )
RETURN
END IF
END IF
*
IF(LEFT.AND.NOTRAN) THEN
*
@@ -410,7 +422,7 @@
*
END IF
*
WORK(1) = LW
WORK( 1 ) = LWMIN
RETURN
*
* End of ZLAMTSQR


+ 52
- 39
lapack-netlib/SRC/zlaswlq.f View File

@@ -96,22 +96,23 @@
*> The leading dimension of the array T. LDT >= MB.
*> \endverbatim
*>
*>
*> \param[out] WORK
*> \verbatim
*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*>
*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= MB*M.
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MB*M, otherwise.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*>
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@@ -159,33 +160,37 @@
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
*> \endverbatim
*>
*> \ingroup laswlq
*>
* =====================================================================
SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
$ INFO)
$ INFO )
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
* ..
* .. Array Arguments ..
COMPLEX*16 A( LDA, * ), WORK( * ), T( LDT, *)
COMPLEX*16 A( LDA, * ), WORK( * ), T( LDT, * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, II, KK, CTR
LOGICAL LQUERY
INTEGER I, II, KK, CTR, MINMN, LWMIN
* ..
* .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. EXTERNAL SUBROUTINES ..
EXTERNAL ZGELQT, ZTPLQT, XERBLA
* ..
* .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD
* ..
@@ -196,12 +201,19 @@
INFO = 0
*
LQUERY = ( LWORK.EQ.-1 )
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = M*MB
END IF
*
IF( M.LT.0 ) THEN
INFO = -1
ELSE IF( N.LT.0 .OR. N.LT.M ) THEN
INFO = -2
ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN
ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 ) ) THEN
INFO = -3
ELSE IF( NB.LE.0 ) THEN
INFO = -4
@@ -209,60 +221,61 @@
INFO = -6
ELSE IF( LDT.LT.MB ) THEN
INFO = -8
ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -10
END IF
IF( INFO.EQ.0) THEN
WORK(1) = MB*M
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZLASWLQ', -INFO )
RETURN
ELSE IF (LQUERY) THEN
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( MIN(M,N).EQ.0 ) THEN
RETURN
IF( MINMN.EQ.0 ) THEN
RETURN
END IF
*
* The LQ Decomposition
*
IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
CALL ZGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO)
IF( (M.GE.N) .OR. (NB.LE.M) .OR. (NB.GE.N) ) THEN
CALL ZGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
RETURN
END IF
END IF
*
KK = MOD((N-M),(NB-M))
II=N-KK+1
KK = MOD((N-M),(NB-M))
II = N-KK+1
*
* Compute the LQ factorization of the first block A(1:M,1:NB)
* Compute the LQ factorization of the first block A(1:M,1:NB)
*
CALL ZGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO)
CTR = 1
CALL ZGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO )
CTR = 1
*
DO I = NB+1, II-NB+M , (NB-M)
DO I = NB+1, II-NB+M, (NB-M)
*
* Compute the QR factorization of the current block A(1:M,I:I+NB-M)
* Compute the QR factorization of the current block A(1:M,I:I+NB-M)
*
CALL ZTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
$ LDA, T(1, CTR * M + 1),
$ LDT, WORK, INFO )
CTR = CTR + 1
END DO
CALL ZTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
$ LDA, T(1, CTR * M + 1),
$ LDT, WORK, INFO )
CTR = CTR + 1
END DO
*
* Compute the QR factorization of the last block A(1:M,II:N)
*
IF (II.LE.N) THEN
IF( II.LE.N ) THEN
CALL ZTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ),
$ LDA, T(1, CTR * M + 1), LDT,
$ WORK, INFO )
END IF
$ LDA, T(1, CTR * M + 1), LDT,
$ WORK, INFO )
END IF
*
WORK( 1 ) = M * MB
WORK( 1 ) = LWMIN
RETURN
*
* End of ZLASWLQ


+ 18
- 4
lapack-netlib/SRC/zlatrs3.f View File

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


+ 55
- 40
lapack-netlib/SRC/zlatsqr.f View File

@@ -101,15 +101,18 @@
*>
*> \param[out] WORK
*> \verbatim
*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK. LWORK >= NB*N.
*> The dimension of the array WORK.
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> only calculates the minimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
*> \endverbatim
@@ -161,33 +164,37 @@
*> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
*> \endverbatim
*>
*> \ingroup latsqr
*>
* =====================================================================
SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK,
$ LWORK, INFO)
$ LWORK, INFO )
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK
INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK
* ..
* .. Array Arguments ..
COMPLEX*16 A( LDA, * ), WORK( * ), T(LDT, *)
COMPLEX*16 A( LDA, * ), WORK( * ), T( LDT, * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, II, KK, CTR
LOGICAL LQUERY
INTEGER I, II, KK, CTR, LWMIN, MINMN
* ..
* .. EXTERNAL FUNCTIONS ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. EXTERNAL SUBROUTINES ..
EXTERNAL ZGEQRT, ZTPQRT, XERBLA
EXTERNAL ZGEQRT, ZTPQRT, XERBLA
* ..
* .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD
* ..
@@ -198,6 +205,13 @@
INFO = 0
*
LQUERY = ( LWORK.EQ.-1 )
*
MINMN = MIN( M, N )
IF( MINMN.EQ.0 ) THEN
LWMIN = 1
ELSE
LWMIN = N*NB
END IF
*
IF( M.LT.0 ) THEN
INFO = -1
@@ -205,64 +219,65 @@
INFO = -2
ELSE IF( MB.LT.1 ) THEN
INFO = -3
ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN
ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 ) ) THEN
INFO = -4
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -6
ELSE IF( LDT.LT.NB ) THEN
INFO = -8
ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN
ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN
INFO = -10
END IF
IF( INFO.EQ.0) THEN
WORK(1) = NB*N
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZLATSQR', -INFO )
RETURN
ELSE IF (LQUERY) THEN
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( MIN(M,N).EQ.0 ) THEN
RETURN
IF( MINMN.EQ.0 ) THEN
RETURN
END IF
*
* The QR Decomposition
*
IF ((MB.LE.N).OR.(MB.GE.M)) THEN
CALL ZGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO)
RETURN
END IF
KK = MOD((M-N),(MB-N))
II=M-KK+1
IF( (MB.LE.N) .OR. (MB.GE.M) ) THEN
CALL ZGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
RETURN
END IF
KK = MOD((M-N),(MB-N))
II = M-KK+1
*
* Compute the QR factorization of the first block A(1:MB,1:N)
* Compute the QR factorization of the first block A(1:MB,1:N)
*
CALL ZGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO )
CTR = 1
CALL ZGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO )
CTR = 1
*
DO I = MB+1, II-MB+N , (MB-N)
DO I = MB+1, II-MB+N, (MB-N)
*
* Compute the QR factorization of the current block A(I:I+MB-N,1:N)
* Compute the QR factorization of the current block A(I:I+MB-N,1:N)
*
CALL ZTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA,
$ T(1, CTR * N + 1),
$ LDT, WORK, INFO )
CTR = CTR + 1
END DO
CALL ZTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA,
$ T(1, CTR * N + 1),
$ LDT, WORK, INFO )
CTR = CTR + 1
END DO
*
* Compute the QR factorization of the last block A(II:M,1:N)
* Compute the QR factorization of the last block A(II:M,1:N)
*
IF (II.LE.M) THEN
CALL ZTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
$ T(1,CTR * N + 1), LDT,
$ WORK, INFO )
END IF
IF( II.LE.M ) THEN
CALL ZTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
$ T(1,CTR * N + 1), LDT,
$ WORK, INFO )
END IF
*
work( 1 ) = N*NB
WORK( 1 ) = LWMIN
RETURN
*
* End of ZLATSQR


Write Preview
Loading…
Cancel
Save