From fb4e77d379b20fa00dff4614d42ad1089490cdfd Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 24 Jun 2026 13:27:17 +0200 Subject: [PATCH] Query correct (larger) workspace for VL=N,VR=V (Reference-LAPACK PR 1274) --- lapack-netlib/SRC/sggev3.f | 48 +++++++++++++++++++++++++------------- 1 file changed, 32 insertions(+), 16 deletions(-) diff --git a/lapack-netlib/SRC/sggev3.f b/lapack-netlib/SRC/sggev3.f index d788d11472..9fbe6bafef 100644 --- a/lapack-netlib/SRC/sggev3.f +++ b/lapack-netlib/SRC/sggev3.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download SGGEV3 + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -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, -- @@ -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 @@ -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 ) @@ -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, @@ -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 * @@ -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 @@ -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