Skip to content

Fix too small workspace queried in SGGEV3 (Reference-LAPACK PR 1274) #5853

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
+32 −16
Open

Fix too small workspace queried in SGGEV3 (Reference-LAPACK PR 1274) #5853

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
48 changes: 32 additions & 16 deletions lapack-netlib/SRC/sggev3.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 SGGEV3 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggev3.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggev3.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggev3.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
Expand Down Expand Up @@ -225,6 +223,7 @@
SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR,
$ ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK,
$ INFO )
IMPLICIT NONE
*
* -- LAPACK driver routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
Expand Down Expand Up @@ -259,13 +258,16 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR,
LOGICAL LDUMMA( 1 )
* ..
* .. External Subroutines ..
EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, SLACPY,
$ SLASCL, SLASET, SORGQR, SORMQR, STGEVC
EXTERNAL SGEQRF, SGGBAK, SGGBAL,
$ SGGHD3, SLAQZ0, SLACPY,
$ SLASCL, SLASET, SORGQR,
$ SORMQR, STGEVC
* ..
* .. External Functions ..
LOGICAL LSAME
REAL SLAMCH, SLANGE, SROUNDUP_LWORK
EXTERNAL LSAME, SLAMCH, SLANGE, SROUNDUP_LWORK
EXTERNAL LSAME, SLAMCH, SLANGE,
$ SROUNDUP_LWORK
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, SQRT
Expand Down Expand Up @@ -327,18 +329,23 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR,
LWKOPT = MAX( LWKMIN, 3*N+INT( WORK( 1 ) ) )
CALL SORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK,
$ -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
CALL SGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL, LDVL,
$ VR, LDVR, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
IF( ILVL ) THEN
CALL SORGQR( N, N, N, VL, LDVL, WORK, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
END IF
IF( ILV ) THEN
CALL SGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL,
$ LDVL, VR, LDVR, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
CALL SLAQZ0( 'S', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
$ WORK, -1, 0, IERR )
LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) )
ELSE
CALL SGGHD3( 'N', 'N', N, 1, N, A, LDA, B, LDB, VL, LDVL,
$ VR, LDVR, WORK, -1, IERR )
LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) )
CALL SLAQZ0( 'E', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB,
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
$ WORK, -1, 0, IERR )
Expand Down Expand Up @@ -431,7 +438,8 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR,
IF( ILVL ) THEN
CALL SLASET( 'Full', N, N, ZERO, ONE, VL, LDVL )
IF( IROWS.GT.1 ) THEN
CALL SLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
CALL SLACPY( 'L', IROWS-1, IROWS-1,
$ B( ILO+1, ILO ), LDB,
$ VL( ILO+1, ILO ), LDVL )
END IF
CALL SORGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
Expand All @@ -449,11 +457,16 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR,
*
* Eigenvectors requested -- work on whole matrix.
*
CALL SGGHD3( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
$ LDVL, VR, LDVR, WORK( IWRK ), LWORK+1-IWRK, IERR )
CALL SGGHD3( JOBVL, JOBVR, N, ILO, IHI,
$ A, LDA,
$ B, LDB, VL,
$ LDVL, VR, LDVR,
$ WORK( IWRK ), LWORK+1-IWRK, IERR )
ELSE
CALL SGGHD3( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR,
CALL SGGHD3( 'N', 'N', IROWS, 1, IROWS,
$ A( ILO, ILO ), LDA,
$ B( ILO, ILO ), LDB, VL,
$ LDVL, VR, LDVR,
$ WORK( IWRK ), LWORK+1-IWRK, IERR )
END IF
*
Expand Down Expand Up @@ -492,7 +505,8 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR,
ELSE
CHTEMP = 'R'
END IF
CALL STGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL,
CALL STGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL,
$ LDVL,
$ VR, LDVR, N, IN, WORK( IWRK ), IERR )
IF( IERR.NE.0 ) THEN
INFO = N + 2
Expand Down Expand Up @@ -575,8 +589,10 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR,
110 CONTINUE
*
IF( ILASCL ) THEN
CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N,
$ IERR )
CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N,
$ IERR )
END IF
*
IF( ILBSCL ) THEN
Expand Down
Loading