Skip to content

Return workspace for D/ZSTEDC via DROUNDUP_LWORK (Reference-LAPACK PR… #6206

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
martin-frbg wants to merge 1 commit into
base: develop
Choose a base branch
from
Open

Return workspace for D/ZSTEDC via DROUNDUP_LWORK (Reference-LAPACK PR… #6206

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 3 additions & 2 deletions lapack-netlib/SRC/dstedc.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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) -- */
Expand Down Expand Up @@ -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) {
Expand Down Expand Up @@ -766,7 +767,7 @@ f"> */
}

L50:
work[1] = (doublereal) lwmin;
work[1] = droundup_lwork__( &lwmin );
iwork[1] = liwmin;

return;
Expand Down
29 changes: 17 additions & 12 deletions lapack-netlib/SRC/dstedc.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,15 +5,13 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DSTEDC + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstedc.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstedc.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstedc.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
Expand Down Expand Up @@ -167,7 +165,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup auxOTHERcomputational
*> \ingroup stedc
*
*> \par Contributors:
* ==================
Expand All @@ -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, --
Expand Down Expand Up @@ -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 ..
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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 )
Expand Down Expand Up @@ -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
Expand Down
5 changes: 3 additions & 2 deletions lapack-netlib/SRC/zstedc.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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) -- */
Expand Down Expand Up @@ -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;

Expand Down Expand Up @@ -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;

Expand Down
9 changes: 5 additions & 4 deletions lapack-netlib/SRC/zstedc.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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
*
Expand Down Expand Up @@ -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
*
Expand Down
Loading