From 37e189c85d3379179e2f50ba373cb1af206b8549 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 31 Mar 2026 10:59:07 +0200 Subject: [PATCH] Fix truncation of large workspace values (Reference-LAPACK PR 1195) --- lapack-netlib/SRC/zgesvj.f | 83 ++++++++++++++++++++----------- lapack-netlib/SRC/zhbevd.f | 24 +++++---- lapack-netlib/SRC/zhbevd_2stage.f | 46 +++++++++-------- lapack-netlib/SRC/zhbgvd.f | 18 ++++--- lapack-netlib/SRC/zheevd.f | 16 +++--- lapack-netlib/SRC/zheevd_2stage.f | 28 +++++------ lapack-netlib/SRC/zheevr.f | 36 ++++++++++---- lapack-netlib/SRC/zheevr_2stage.f | 27 ++++++---- lapack-netlib/SRC/zhpevd.f | 21 ++++---- lapack-netlib/SRC/zstedc.f | 27 ++++++---- 10 files changed, 196 insertions(+), 130 deletions(-) diff --git a/lapack-netlib/SRC/zgesvj.f b/lapack-netlib/SRC/zgesvj.f index 2be45d826e..a8b881e131 100644 --- a/lapack-netlib/SRC/zgesvj.f +++ b/lapack-netlib/SRC/zgesvj.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZGESVJ + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -101,7 +99,7 @@ *> \param[in] M *> \verbatim *> M is INTEGER -*> The number of rows of the input matrix A. 1/DLAMCH('E') > M >= 0. +*> The number of rows of the input matrix A. 1/DLAMCH('E') >= M >= 0. *> \endverbatim *> *> \param[in] N @@ -217,7 +215,7 @@ *> 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) +*> no computation is done; CWORK(1) is set to the minimal (and optimal) *> length of CWORK. *> \endverbatim *> @@ -258,7 +256,7 @@ *> 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) +*> no computation is done; RWORK(1) is set to the minimal (and optimal) *> length of RWORK. *> \endverbatim *> @@ -414,7 +412,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * from BLAS EXTERNAL ZCOPY, ZROT, ZDSCAL, ZSWAP, ZAXPY * from LAPACK - EXTERNAL DLASCL, ZLASCL, ZLASET, ZLASSQ, XERBLA + EXTERNAL DLASCL, ZLASCL, ZLASET, ZLASSQ, + $ XERBLA EXTERNAL ZGSVJ0, ZGSVJ1 * .. * .. Executable Statements .. @@ -440,9 +439,13 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, 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 + ELSE IF( .NOT.( LSVEC .OR. + $ UCTOL .OR. + $ LSAME( JOBU, 'N' ) ) ) THEN INFO = -2 - ELSE IF( .NOT.( RSVEC .OR. APPLV .OR. LSAME( JOBV, 'N' ) ) ) THEN + ELSE IF( .NOT.( RSVEC .OR. + $ APPLV .OR. + $ LSAME( JOBV, 'N' ) ) ) THEN INFO = -3 ELSE IF( M.LT.0 ) THEN INFO = -4 @@ -455,7 +458,7 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE IF( ( RSVEC .AND. ( LDV.LT.N ) ) .OR. $ ( APPLV .AND. ( LDV.LT.MV ) ) ) THEN INFO = -11 - ELSE IF( UCTOL .AND. ( RWORK( 1 ).LE.ONE ) ) THEN + ELSE IF( UCTOL .AND. ( RWORK( 1 ).LT.ONE ) ) THEN INFO = -12 ELSE IF( LWORK.LT.LWMIN .AND. ( .NOT.LQUERY ) ) THEN INFO = -13 @@ -471,7 +474,7 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, RETURN ELSE IF( LQUERY ) THEN CWORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) RETURN END IF * @@ -785,7 +788,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ V( N4*q+1, N4+1 ), LDV, EPSLN, SFMIN, TOL, 1, $ CWORK( N+1 ), LWORK-N, IERR ) * - CALL ZGSVJ0( JOBV, M, N4, A, LDA, CWORK, SVA, MVL, V, LDV, + CALL ZGSVJ0( JOBV, M, N4, A, LDA, CWORK, SVA, MVL, V, + $ LDV, $ EPSLN, SFMIN, TOL, 1, CWORK( N+1 ), LWORK-N, $ IERR ) * @@ -797,16 +801,19 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE IF( UPPER ) THEN * * - CALL ZGSVJ0( JOBV, N4, N4, A, LDA, CWORK, SVA, MVL, V, LDV, + CALL ZGSVJ0( JOBV, N4, N4, A, LDA, CWORK, SVA, MVL, V, + $ LDV, $ EPSLN, SFMIN, TOL, 2, CWORK( N+1 ), LWORK-N, $ IERR ) * - CALL ZGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, CWORK( N4+1 ), + CALL ZGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, + $ CWORK( N4+1 ), $ SVA( N4+1 ), MVL, V( N4*q+1, N4+1 ), LDV, $ EPSLN, SFMIN, TOL, 1, CWORK( N+1 ), LWORK-N, $ IERR ) * - CALL ZGSVJ1( JOBV, N2, N2, N4, A, LDA, CWORK, SVA, MVL, V, + CALL ZGSVJ1( JOBV, N2, N2, N4, A, LDA, CWORK, SVA, MVL, + $ V, $ LDV, EPSLN, SFMIN, TOL, 1, CWORK( N+1 ), $ LWORK-N, IERR ) * @@ -960,7 +967,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, T = HALF / THETA CS = ONE - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF ( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -989,7 +997,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF ( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -1002,14 +1011,17 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * .. have to use modified Gram-Schmidt like transformation CALL ZCOPY( M, A( 1, p ), 1, $ CWORK(N+1), 1 ) - CALL ZLASCL( 'G', 0, 0, AAPP, ONE, M, + CALL ZLASCL( 'G', 0, 0, AAPP, ONE, + $ M, $ 1, CWORK(N+1), LDA, $ IERR ) - CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, M, + CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, + $ M, $ 1, A( 1, q ), LDA, IERR ) CALL ZAXPY( M, -AAPQ, CWORK(N+1), 1, $ A( 1, q ), 1 ) - CALL ZLASCL( 'G', 0, 0, ONE, AAQQ, M, + CALL ZLASCL( 'G', 0, 0, ONE, AAQQ, + $ M, $ 1, A( 1, q ), LDA, IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ1*AAPQ1 ) ) @@ -1024,7 +1036,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DZNRM2( M, A( 1, q ), 1 ) + SVA( q ) = DZNRM2( M, A( 1, q ), + $ 1 ) ELSE T = ZERO AAQQ = ONE @@ -1177,7 +1190,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( ABS( THETA ).GT.BIGTHETA ) THEN T = HALF / THETA CS = ONE - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -1204,7 +1218,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -1218,15 +1233,18 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( AAPP.GT.AAQQ ) THEN CALL ZCOPY( M, A( 1, p ), 1, $ CWORK(N+1), 1 ) - CALL ZLASCL( 'G', 0, 0, AAPP, ONE, + CALL ZLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, CWORK(N+1),LDA, $ IERR ) - CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, + CALL ZLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) CALL ZAXPY( M, -AAPQ, CWORK(N+1), $ 1, A( 1, q ), 1 ) - CALL ZLASCL( 'G', 0, 0, ONE, AAQQ, + CALL ZLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, @@ -1235,15 +1253,18 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE CALL ZCOPY( M, A( 1, q ), 1, $ CWORK(N+1), 1 ) - CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, + CALL ZLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, CWORK(N+1),LDA, $ IERR ) - CALL ZLASCL( 'G', 0, 0, AAPP, ONE, + CALL ZLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) CALL ZAXPY( M, -CONJG(AAPQ), $ CWORK(N+1), 1, A( 1, p ), 1 ) - CALL ZLASCL( 'G', 0, 0, ONE, AAPP, + CALL ZLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*SQRT( MAX( ZERO, @@ -1259,7 +1280,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DZNRM2( M, A( 1, q ), 1) + SVA( q ) = DZNRM2( M, A( 1, q ), + $ 1) ELSE T = ZERO AAQQ = ONE @@ -1401,7 +1423,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( LSVEC .OR. UCTOL ) THEN DO 1998 p = 1, N4 * CALL ZDSCAL( M, ONE / SVA( p ), A( 1, p ), 1 ) - CALL ZLASCL( 'G',0,0, SVA(p), ONE, M, 1, A(1,p), M, IERR ) + CALL ZLASCL( 'G',0,0, SVA(p), ONE, M, 1, A(1,p), M, + $ IERR ) 1998 CONTINUE END IF * diff --git a/lapack-netlib/SRC/zhbevd.f b/lapack-netlib/SRC/zhbevd.f index be9f015560..94747ac3ad 100644 --- a/lapack-netlib/SRC/zhbevd.f +++ b/lapack-netlib/SRC/zhbevd.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZHBEVD + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -201,11 +199,13 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16OTHEReigen +*> \ingroup hbevd * * ===================================================================== - SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, + SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + $ WORK, $ LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -243,7 +243,8 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, EXTERNAL LSAME, DLAMCH, ZLANHB * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZGEMM, ZHBTRD, ZLACPY, + EXTERNAL DSCAL, DSTERF, XERBLA, ZGEMM, ZHBTRD, + $ ZLACPY, $ ZLASCL, ZSTEDC * .. * .. Intrinsic Functions .. @@ -289,7 +290,7 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -342,9 +343,11 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -363,7 +366,8 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, WORK( INDWK2 ), + CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, + $ WORK( INDWK2 ), $ LLWK2, RWORK( INDWRK ), LLRWK, IWORK, LIWORK, $ INFO ) CALL ZGEMM( 'N', 'N', N, N, N, CONE, Z, LDZ, WORK, N, CZERO, @@ -383,7 +387,7 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/lapack-netlib/SRC/zhbevd_2stage.f b/lapack-netlib/SRC/zhbevd_2stage.f index e32c7125ca..eda9cf8725 100644 --- a/lapack-netlib/SRC/zhbevd_2stage.f +++ b/lapack-netlib/SRC/zhbevd_2stage.f @@ -7,7 +7,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZHBEVD_2STAGE + dependencies *> *> [TGZ] @@ -15,13 +14,12 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, -* WORK, LWORK, RWORK, LRWORK, IWORK, +* WORK, LWORK, RWORK, LRWORK, IWORK, * LIWORK, INFO ) * * IMPLICIT NONE @@ -136,7 +134,7 @@ *> \verbatim *> LWORK is INTEGER *> The length of the array WORK. LWORK >= 1, when N <= 1; -*> otherwise +*> otherwise *> If JOBZ = 'N' and N > 1, LWORK must be queried. *> LWORK = MAX(1, dimension) where *> dimension = (2KD+1)*N + KD*NTHREADS @@ -213,7 +211,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16OTHEReigen +*> \ingroup hbevd_2stage * *> \par Further Details: * ===================== @@ -231,7 +229,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. @@ -239,17 +237,18 @@ *> 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 ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, - $ WORK, LWORK, RWORK, LRWORK, IWORK, + SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, + $ LDZ, + $ WORK, LWORK, RWORK, LRWORK, IWORK, $ LIWORK, INFO ) * IMPLICIT NONE @@ -292,7 +291,8 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, EXTERNAL LSAME, DLAMCH, ZLANHB, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZGEMM, ZLACPY, + EXTERNAL DSCAL, DSTERF, XERBLA, ZGEMM, + $ ZLACPY, $ ZLASCL, ZSTEDC, ZHETRD_HB2ST * .. * .. Intrinsic Functions .. @@ -312,9 +312,12 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, LRWMIN = 1 LIWMIN = 1 ELSE - IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 ) + IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, + $ -1 ) IF( WANTZ ) THEN LWMIN = 2*N**2 LRWMIN = 1 + 5*N + 2*N**2 @@ -341,7 +344,7 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -394,9 +397,11 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -412,7 +417,7 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, LLWK2 = LWORK - INDWK2 + 1 * CALL ZHETRD_HB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, W, - $ RWORK( INDE ), WORK( INDHOUS ), LHTRD, + $ RWORK( INDE ), WORK( INDHOUS ), LHTRD, $ WORK( INDWK ), LLWORK, IINFO ) * * For eigenvalues only, call DSTERF. For eigenvectors, call ZSTEDC. @@ -420,7 +425,8 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, WORK( INDWK2 ), + CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, + $ WORK( INDWK2 ), $ LLWK2, RWORK( INDRWK ), LLRWK, IWORK, LIWORK, $ INFO ) CALL ZGEMM( 'N', 'N', N, N, N, CONE, Z, LDZ, WORK, N, CZERO, @@ -440,7 +446,7 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/lapack-netlib/SRC/zhbgvd.f b/lapack-netlib/SRC/zhbgvd.f index 4bd02168d4..82d62622cc 100644 --- a/lapack-netlib/SRC/zhbgvd.f +++ b/lapack-netlib/SRC/zhbgvd.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZHBGVD + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -232,7 +230,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16OTHEReigen +*> \ingroup hbgvd * *> \par Contributors: * ================== @@ -240,9 +238,11 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA * * ===================================================================== - SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, + SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, + $ W, $ Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, $ LIWORK, INFO ) + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -278,7 +278,8 @@ SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DSTERF, XERBLA, ZGEMM, ZHBGST, ZHBTRD, ZLACPY, + EXTERNAL DSTERF, XERBLA, ZGEMM, ZHBGST, ZHBTRD, + $ ZLACPY, $ ZPBSTF, ZSTEDC * .. * .. Executable Statements .. @@ -323,7 +324,7 @@ SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -380,7 +381,8 @@ SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, WORK( INDWK2 ), + CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, + $ WORK( INDWK2 ), $ LLWK2, RWORK( INDWRK ), LLRWK, IWORK, LIWORK, $ INFO ) CALL ZGEMM( 'N', 'N', N, N, N, CONE, Z, LDZ, WORK, N, CZERO, @@ -389,7 +391,7 @@ SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/lapack-netlib/SRC/zheevd.f b/lapack-netlib/SRC/zheevd.f index 8e86b9e88a..01ad3b25c4 100644 --- a/lapack-netlib/SRC/zheevd.f +++ b/lapack-netlib/SRC/zheevd.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZHEEVD + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -193,8 +191,10 @@ *> at Berkeley, USA *> * ===================================================================== - SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, + SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + $ RWORK, $ LRWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -233,7 +233,8 @@ SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZHETRD, ZLACPY, ZLASCL, + EXTERNAL DSCAL, DSTERF, XERBLA, ZHETRD, ZLACPY, + $ ZLASCL, $ ZSTEDC, ZUNMTR * .. * .. Intrinsic Functions .. @@ -277,12 +278,13 @@ SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LIWMIN = 1 END IF LOPT = MAX( LWMIN, N + - $ N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) ) + $ N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, + $ -1 ) ) LROPT = LRWMIN LIOPT = LIWMIN END IF WORK( 1 ) = LOPT - RWORK( 1 ) = LROPT + RWORK( 1 ) = DBLE( LROPT ) IWORK( 1 ) = LIOPT * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -378,7 +380,7 @@ SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, END IF * WORK( 1 ) = LOPT - RWORK( 1 ) = LROPT + RWORK( 1 ) = DBLE( LROPT ) IWORK( 1 ) = LIOPT * RETURN diff --git a/lapack-netlib/SRC/zheevd_2stage.f b/lapack-netlib/SRC/zheevd_2stage.f index e697a98237..b73d7155e1 100644 --- a/lapack-netlib/SRC/zheevd_2stage.f +++ b/lapack-netlib/SRC/zheevd_2stage.f @@ -7,7 +7,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZHEEVD_2STAGE + dependencies *> *> [TGZ] @@ -15,7 +14,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -113,8 +111,8 @@ *> If JOBZ = 'N' and N > 1, LWORK must be queried. *> LWORK = MAX(1, dimension) where *> dimension = max(stage1,stage2) + (KD+1)*N + N+1 -*> = 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+1 *> where KD is the blocking size of the reduction, *> FACTOPTNB is the blocking used by the QR or LQ @@ -196,7 +194,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16HEeigen +*> \ingroup heevd_2stage * *> \par Further Details: * ===================== @@ -225,7 +223,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. @@ -233,16 +231,17 @@ *> 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 ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, + $ LWORK, $ RWORK, LRWORK, IWORK, LIWORK, INFO ) * IMPLICIT NONE @@ -287,11 +286,12 @@ SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, EXTERNAL LSAME, DLAMCH, ZLANHE, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZLACPY, ZLASCL, + EXTERNAL DSCAL, DSTERF, XERBLA, ZLACPY, + $ ZLASCL, $ ZSTEDC, ZUNMTR, ZHETRD_2STAGE * .. * .. Intrinsic Functions .. - INTRINSIC DBLE, MAX, SQRT + INTRINSIC DBLE, MAX, SQRT * .. * .. Executable Statements .. * @@ -337,7 +337,7 @@ SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, END IF END IF WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -404,7 +404,7 @@ SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, LLWRK2 = LWORK - INDWK2 + 1 * CALL ZHETRD_2STAGE( JOBZ, UPLO, N, A, LDA, W, RWORK( INDE ), - $ WORK( INDTAU ), WORK( INDHOUS ), LHTRD, + $ WORK( INDTAU ), WORK( INDHOUS ), LHTRD, $ WORK( INDWRK ), LLWORK, IINFO ) * * For eigenvalues only, call DSTERF. For eigenvectors, first call @@ -436,7 +436,7 @@ SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/lapack-netlib/SRC/zheevr.f b/lapack-netlib/SRC/zheevr.f index fe6e1a85f7..038738ec8b 100644 --- a/lapack-netlib/SRC/zheevr.f +++ b/lapack-netlib/SRC/zheevr.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZHEEVR + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -41,9 +39,16 @@ *> \verbatim *> *> ZHEEVR computes selected eigenvalues and, optionally, eigenvectors -*> of a complex Hermitian matrix A. Eigenvalues and eigenvectors can -*> be selected by specifying either a range of values or a range of -*> indices for the desired eigenvalues. +*> of a complex Hermitian matrix A. Eigenvalues and eigenvectors can be +*> selected by specifying either a range of values or a range of indices +*> for the desired eigenvalues. Invocations with different choices for +*> these parameters may result in the computation of slightly different +*> eigenvalues and/or eigenvectors for the same matrix. The reason for +*> this behavior is that there exists a variety of algorithms (each +*> performing best for a particular set of options) with ZHEEVR +*> attempting to select the best based on the various parameters. In all +*> cases, the computed values are accurate within the limits of finite +*> precision arithmetic. *> *> ZHEEVR first reduces the matrix A to tridiagonal form T with a call *> to ZHETRD. Then, whenever possible, ZHEEVR calls ZSTEMR to compute @@ -107,6 +112,9 @@ *> JOBZ is CHARACTER*1 *> = 'N': Compute eigenvalues only; *> = 'V': Compute eigenvalues and eigenvectors. +*> +*> This parameter influences the choice of the algorithm and +*> may alter the computed values. *> \endverbatim *> *> \param[in] RANGE @@ -118,6 +126,9 @@ *> = 'I': the IL-th through IU-th eigenvalues will be found. *> For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and *> ZSTEIN are called +*> +*> This parameter influences the choice of the algorithm and +*> may alter the computed values. *> \endverbatim *> *> \param[in] UPLO @@ -242,6 +253,7 @@ *> Note: the user must ensure that at least max(1,M) columns are *> supplied in the array Z; if RANGE = 'V', the exact value of M *> is not known in advance and an upper bound must be used. +*> Supplying N columns is always safe. *> \endverbatim *> *> \param[in] LDZ @@ -354,9 +366,11 @@ *> California at Berkeley, USA \n *> * ===================================================================== - SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, + $ IU, $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ RWORK, LRWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -399,7 +413,8 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANSY * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL, + EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, + $ ZDSCAL, $ ZHETRD, ZSTEMR, ZSTEIN, ZSWAP, ZUNMTR * .. * .. Intrinsic Functions .. @@ -464,7 +479,7 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, NB = MAX( NB, ILAENV( 1, 'ZUNMTR', UPLO, N, -1, -1, -1 ) ) LWKOPT = MAX( ( NB+1 )*N, LWMIN ) WORK( 1 ) = LWKOPT - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -676,7 +691,8 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * INDWKN = INDWK LLWRKN = LWORK - INDWKN + 1 - CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * @@ -720,7 +736,7 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * Set WORK(1) to optimal workspace size. * WORK( 1 ) = LWKOPT - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/lapack-netlib/SRC/zheevr_2stage.f b/lapack-netlib/SRC/zheevr_2stage.f index b1cc7175fa..0ba5a29533 100644 --- a/lapack-netlib/SRC/zheevr_2stage.f +++ b/lapack-netlib/SRC/zheevr_2stage.f @@ -7,7 +7,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZHEEVR_2STAGE + dependencies *> *> [TGZ] @@ -15,7 +14,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -447,10 +445,12 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, LOGICAL LSAME INTEGER ILAENV, ILAENV2STAGE DOUBLE PRECISION DLAMCH, ZLANSY - EXTERNAL LSAME, DLAMCH, ZLANSY, ILAENV, ILAENV2STAGE + EXTERNAL LSAME, DLAMCH, ZLANSY, ILAENV, + $ ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL, + EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, + $ ZDSCAL, $ ZHETRD_2STAGE, ZSTEMR, ZSTEIN, ZSWAP, ZUNMTR * .. * .. Intrinsic Functions .. @@ -471,10 +471,14 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR. $ ( LIWORK.EQ.-1 ) ) * - KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 ) - 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 ) + KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + 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 ) * IF( N.LE.1 ) THEN LWMIN = 1 @@ -517,7 +521,7 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -732,7 +736,8 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * INDWKN = INDWK LLWRKN = LWORK - INDWKN + 1 - CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * @@ -776,7 +781,7 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * Set WORK(1) to optimal workspace size. * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/lapack-netlib/SRC/zhpevd.f b/lapack-netlib/SRC/zhpevd.f index 5260aaf14a..1a033de79e 100644 --- a/lapack-netlib/SRC/zhpevd.f +++ b/lapack-netlib/SRC/zhpevd.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZHPEVD + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -186,11 +184,12 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16OTHEReigen +*> \ingroup hpevd * * ===================================================================== SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, $ RWORK, LRWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -227,7 +226,8 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, EXTERNAL LSAME, DLAMCH, ZLANHP * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZDSCAL, ZHPTRD, ZSTEDC, + EXTERNAL DSCAL, DSTERF, XERBLA, ZDSCAL, ZHPTRD, + $ ZSTEDC, $ ZUPMTR * .. * .. Intrinsic Functions .. @@ -243,7 +243,8 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. + $ LSAME( UPLO, 'U' ) ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -269,7 +270,7 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, END IF END IF WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -341,10 +342,12 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL ZSTEDC( 'I', N, W, RWORK( INDE ), Z, LDZ, WORK( INDWRK ), + CALL ZSTEDC( 'I', N, W, RWORK( INDE ), Z, LDZ, + $ WORK( INDWRK ), $ LLWRK, RWORK( INDRWK ), LLRWK, IWORK, LIWORK, $ INFO ) - CALL ZUPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, LDZ, + CALL ZUPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) END IF * @@ -360,7 +363,7 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/lapack-netlib/SRC/zstedc.f b/lapack-netlib/SRC/zstedc.f index e62063a19e..4a5d9fa693 100644 --- a/lapack-netlib/SRC/zstedc.f +++ b/lapack-netlib/SRC/zstedc.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZSTEDC + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -192,7 +190,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16OTHERcomputational +*> \ingroup stedc * *> \par Contributors: * ================== @@ -203,6 +201,7 @@ * ===================================================================== SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, $ LRWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -237,7 +236,8 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, EXTERNAL LSAME, ILAENV, DLAMCH, DLANST * .. * .. External Subroutines .. - EXTERNAL DLASCL, DLASET, DSTEDC, DSTEQR, DSTERF, XERBLA, + EXTERNAL DLASCL, DLASET, DSTEDC, DSTEQR, DSTERF, + $ XERBLA, $ ZLACPY, ZLACRM, ZLAED0, ZSTEQR, ZSWAP * .. * .. Intrinsic Functions .. @@ -296,7 +296,7 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LIWMIN = 3 + 5*N END IF WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -408,12 +408,15 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, * Scale. * ORGNRM = DLANST( 'M', M, D( START ), E( START ) ) - CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), M, + CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), + $ M, $ INFO ) - CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, E( START ), + CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, + $ E( START ), $ M-1, INFO ) * - CALL ZLAED0( N, M, D( START ), E( START ), Z( 1, START ), + CALL ZLAED0( N, M, D( START ), E( START ), Z( 1, + $ START ), $ LDZ, WORK, N, RWORK, IWORK, INFO ) IF( INFO.GT.0 ) THEN INFO = ( INFO / ( M+1 )+START-1 )*( N+1 ) + @@ -423,13 +426,15 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, * * Scale back. * - CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), M, + CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), + $ M, $ INFO ) * ELSE CALL DSTEQR( 'I', M, D( START ), E( START ), RWORK, M, $ RWORK( M*M+1 ), INFO ) - CALL ZLACRM( N, M, Z( 1, START ), LDZ, RWORK, M, WORK, N, + CALL ZLACRM( N, M, Z( 1, START ), LDZ, RWORK, M, WORK, + $ N, $ RWORK( M*M+1 ) ) CALL ZLACPY( 'A', N, M, WORK, N, Z( 1, START ), LDZ ) IF( INFO.GT.0 ) THEN @@ -467,7 +472,7 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, * 70 CONTINUE WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN