From d7e4a521984fa918da550aece21ef9d4f60a8734 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 30 Oct 2026 19:32:31 +0100 Subject: [PATCH] Return workspace for D/ZSTEDC via DROUNDUP_LWORK (Reference-LAPACK PR 1455) --- lapack-netlib/SRC/dstedc.c | 5 +++-- lapack-netlib/SRC/dstedc.f | 29 +++++++++++++++++------------ lapack-netlib/SRC/zstedc.c | 5 +++-- lapack-netlib/SRC/zstedc.f | 9 +++++---- 4 files changed, 28 insertions(+), 20 deletions(-) diff --git a/lapack-netlib/SRC/dstedc.c b/lapack-netlib/SRC/dstedc.c index 342b69cd9c..bda9940b9b 100644 --- a/lapack-netlib/SRC/dstedc.c +++ b/lapack-netlib/SRC/dstedc.c @@ -485,6 +485,7 @@ f"> */ logical lquery; integer smlsiz, storez, strtrw, lgn; doublereal eps; + extern doublereal droundup_lwork__(integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ @@ -560,7 +561,7 @@ f"> */ liwmin = *n * 5 + 3; } } - work[1] = (doublereal) lwmin; + work[1] = droundup_lwork__( &lwmin ); iwork[1] = liwmin; if (*lwork < lwmin && ! lquery) { @@ -766,7 +767,7 @@ f"> */ } L50: - work[1] = (doublereal) lwmin; + work[1] = droundup_lwork__( &lwmin ); iwork[1] = liwmin; return; diff --git a/lapack-netlib/SRC/dstedc.f b/lapack-netlib/SRC/dstedc.f index 6d533664bd..bb75139f60 100644 --- a/lapack-netlib/SRC/dstedc.f +++ b/lapack-netlib/SRC/dstedc.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download DSTEDC + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -167,7 +165,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup auxOTHERcomputational +*> \ingroup stedc * *> \par Contributors: * ================== @@ -179,6 +177,7 @@ * ===================================================================== SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) + IMPLICIT NONE * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -208,11 +207,13 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, * .. External Functions .. LOGICAL LSAME INTEGER ILAENV - DOUBLE PRECISION DLAMCH, DLANST - EXTERNAL LSAME, ILAENV, DLAMCH, DLANST + DOUBLE PRECISION DLAMCH, DLANST, DROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, DLAMCH, DLANST, + $ DROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DLAED0, DLASCL, DLASET, DLASRT, + EXTERNAL DGEMM, DLACPY, DLAED0, DLASCL, DLASET, + $ DLASRT, $ DSTEQR, DSTERF, DSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -268,7 +269,7 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWMIN = 3 + 5*N END IF END IF - WORK( 1 ) = LWMIN + WORK( 1 ) = DROUNDUP_LWORK(LWMIN) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT. LQUERY ) THEN @@ -377,9 +378,11 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, * 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 ) * IF( ICOMPZ.EQ.1 ) THEN @@ -398,7 +401,8 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, * * 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 @@ -408,7 +412,8 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, * the length of D, we must solve the sub-problem in a * workspace and then multiply back into Z. * - CALL DSTEQR( 'I', M, D( START ), E( START ), WORK, M, + CALL DSTEQR( 'I', M, D( START ), E( START ), WORK, + $ M, $ WORK( M*M+1 ), INFO ) CALL DLACPY( 'A', N, M, Z( 1, START ), LDZ, $ WORK( STOREZ ), N ) @@ -463,7 +468,7 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, END IF * 50 CONTINUE - WORK( 1 ) = LWMIN + WORK( 1 ) = DROUNDUP_LWORK(LWMIN) IWORK( 1 ) = LIWMIN * RETURN diff --git a/lapack-netlib/SRC/zstedc.c b/lapack-netlib/SRC/zstedc.c index ae6eb58ff8..6de6eff059 100644 --- a/lapack-netlib/SRC/zstedc.c +++ b/lapack-netlib/SRC/zstedc.c @@ -545,6 +545,7 @@ f"> */ doublereal *, doublecomplex *, integer *, doublereal *, integer *); integer lgn; doublereal eps; + extern doublereal droundup_lwork__(integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ @@ -623,7 +624,7 @@ f"> */ lrwmin = (*n << 2) + 1 + (i__1 * i__1 << 1); liwmin = *n * 5 + 3; } - work[1].r = (doublereal) lwmin, work[1].i = 0.; + work[1].r = droundup_lwork__( &lwmin ), work[1].i = 0.; rwork[1] = (doublereal) lrwmin; iwork[1] = liwmin; @@ -815,7 +816,7 @@ f"> */ } L70: - work[1].r = (doublereal) lwmin, work[1].i = 0.; + work[1].r = droundup_lwork__( &lwmin ), work[1].i = 0.; rwork[1] = (doublereal) lrwmin; iwork[1] = liwmin; diff --git a/lapack-netlib/SRC/zstedc.f b/lapack-netlib/SRC/zstedc.f index 4a5d9fa693..6ef83b96b1 100644 --- a/lapack-netlib/SRC/zstedc.f +++ b/lapack-netlib/SRC/zstedc.f @@ -232,8 +232,9 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, * .. External Functions .. LOGICAL LSAME INTEGER ILAENV - DOUBLE PRECISION DLAMCH, DLANST - EXTERNAL LSAME, ILAENV, DLAMCH, DLANST + DOUBLE PRECISION DLAMCH, DLANST, DROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, DLAMCH, DLANST, + $ DROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL DLASCL, DLASET, DSTEDC, DSTEQR, DSTERF, @@ -295,7 +296,7 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWMIN = 1 + 4*N + 2*N**2 LIWMIN = 3 + 5*N END IF - WORK( 1 ) = LWMIN + WORK( 1 ) = DROUNDUP_LWORK(LWMIN) RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * @@ -471,7 +472,7 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, END IF * 70 CONTINUE - WORK( 1 ) = LWMIN + WORK( 1 ) = DROUNDUP_LWORK(LWMIN) RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN *