mirror of https://github.com/xianyi/OpenBLAS.git
Query correct (larger) workspace for VL=N,VR=V (Reference-LAPACK PR 1274)
This commit is contained in:
Martin Kroeker
GitHub
parent
a36e22cbb2
commit
fb4e77d379
|
|
@ -5,7 +5,6 @@
|
|||
* 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>
|
||||
|
|
@ -13,7 +12,6 @@
|
|||
*> [ZIP]</a>
|
||||
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggev3.f">
|
||||
*> [TXT]</a>
|
||||
*> \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 @@
|
|||
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 @@
|
|||
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 @@
|
|||
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 @@
|
|||
*
|
||||
* 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 @@
|
|||
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 @@
|
|||
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue