Skip to content

Use QR for bidiagonal SVD with vectors in ?BDSDC (Reference-LAPACK PR 1300) #5936

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
+28 −18
Open

Use QR for bidiagonal SVD with vectors in ?BDSDC (Reference-LAPACK PR 1300) #5936

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
23 changes: 14 additions & 9 deletions lapack-netlib/SRC/dbdsdc.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 DBDSDC + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dbdsdc.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dbdsdc.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dbdsdc.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
Expand Down Expand Up @@ -184,7 +182,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup auxOTHERcomputational
*> \ingroup bdsdc
*
*> \par Contributors:
* ==================
Expand All @@ -193,8 +191,10 @@
*> California at Berkeley, USA
*>
* =====================================================================
SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
$ IQ,
$ WORK, IWORK, INFO )
IMPLICIT NONE
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
Expand Down Expand Up @@ -233,7 +233,8 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
EXTERNAL LSAME, ILAENV, DLAMCH, DLANST
* ..
* .. External Subroutines ..
EXTERNAL DCOPY, DLARTG, DLASCL, DLASD0, DLASDA, DLASDQ,
EXTERNAL DCOPY, DLARTG, DLASCL, DLASD0, DLASDA,
$ DLASDQ,
$ DLASET, DLASR, DSWAP, XERBLA
* ..
* .. Intrinsic Functions ..
Expand Down Expand Up @@ -340,14 +341,17 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
IF( ICOMPQ.EQ.2 ) THEN
CALL DLASET( 'A', N, N, ZERO, ONE, U, LDU )
CALL DLASET( 'A', N, N, ZERO, ONE, VT, LDVT )
CALL DLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, U,
CALL DLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU,
$ U,
$ LDU, WORK( WSTART ), INFO )
ELSE IF( ICOMPQ.EQ.1 ) THEN
IU = 1
IVT = IU + N
CALL DLASET( 'A', N, N, ZERO, ONE, Q( IU+( QSTART-1 )*N ),
CALL DLASET( 'A', N, N, ZERO, ONE,
$ Q( IU+( QSTART-1 )*N ),
$ N )
CALL DLASET( 'A', N, N, ZERO, ONE, Q( IVT+( QSTART-1 )*N ),
CALL DLASET( 'A', N, N, ZERO, ONE,
$ Q( IVT+( QSTART-1 )*N ),
$ N )
CALL DLASDQ( 'U', 0, N, N, N, 0, D, E,
$ Q( IVT+( QSTART-1 )*N ), N,
Expand Down Expand Up @@ -505,7 +509,8 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
* which rotated B to be upper bidiagonal
*
IF( ( IUPLO.EQ.2 ) .AND. ( ICOMPQ.EQ.2 ) )
$ CALL DLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, LDU )
$ CALL DLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U,
$ LDU )
*
RETURN
*
Expand Down
23 changes: 14 additions & 9 deletions lapack-netlib/SRC/sbdsdc.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 SBDSDC + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sbdsdc.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sbdsdc.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sbdsdc.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
Expand Down Expand Up @@ -184,7 +182,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup auxOTHERcomputational
*> \ingroup bdsdc
*
*> \par Contributors:
* ==================
Expand All @@ -193,8 +191,10 @@
*> California at Berkeley, USA
*>
* =====================================================================
SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
$ IQ,
$ WORK, IWORK, INFO )
IMPLICIT NONE
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
Expand Down Expand Up @@ -233,7 +233,8 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
EXTERNAL SLAMCH, SLANST, ILAENV, LSAME
* ..
* .. External Subroutines ..
EXTERNAL SCOPY, SLARTG, SLASCL, SLASD0, SLASDA, SLASDQ,
EXTERNAL SCOPY, SLARTG, SLASCL, SLASD0, SLASDA,
$ SLASDQ,
$ SLASET, SLASR, SSWAP, XERBLA
* ..
* .. Intrinsic Functions ..
Expand Down Expand Up @@ -340,14 +341,17 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
IF( ICOMPQ.EQ.2 ) THEN
CALL SLASET( 'A', N, N, ZERO, ONE, U, LDU )
CALL SLASET( 'A', N, N, ZERO, ONE, VT, LDVT )
CALL SLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, U,
CALL SLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU,
$ U,
$ LDU, WORK( WSTART ), INFO )
ELSE IF( ICOMPQ.EQ.1 ) THEN
IU = 1
IVT = IU + N
CALL SLASET( 'A', N, N, ZERO, ONE, Q( IU+( QSTART-1 )*N ),
CALL SLASET( 'A', N, N, ZERO, ONE,
$ Q( IU+( QSTART-1 )*N ),
$ N )
CALL SLASET( 'A', N, N, ZERO, ONE, Q( IVT+( QSTART-1 )*N ),
CALL SLASET( 'A', N, N, ZERO, ONE,
$ Q( IVT+( QSTART-1 )*N ),
$ N )
CALL SLASDQ( 'U', 0, N, N, N, 0, D, E,
$ Q( IVT+( QSTART-1 )*N ), N,
Expand Down Expand Up @@ -505,7 +509,8 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
* which rotated B to be upper bidiagonal
*
IF( ( IUPLO.EQ.2 ) .AND. ( ICOMPQ.EQ.2 ) )
$ CALL SLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, LDU )
$ CALL SLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U,
$ LDU )
*
RETURN
*
Expand Down
Loading