Skip to content

Commit 77affe1

Browse files
martin-frbgmartin-frbg
authored
Revert "Use QR for bidiagonal SVD with vectors in ?BDSDC (Reference-LAPACK PR 1300)"
1 parent 6d36cf6 commit 77affe1

2 files changed

Lines changed: 18 additions & 28 deletions

File tree

‎lapack-netlib/SRC/dbdsdc.f‎

Lines changed: 9 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -5,13 +5,15 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8+
*> \htmlonly
89
*> Download DBDSDC + dependencies
910
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dbdsdc.f">
1011
*> [TGZ]</a>
1112
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dbdsdc.f">
1213
*> [ZIP]</a>
1314
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dbdsdc.f">
1415
*> [TXT]</a>
16+
*> \endhtmlonly
1517
*
1618
* Definition:
1719
* ===========
@@ -182,7 +184,7 @@
182184
*> \author Univ. of Colorado Denver
183185
*> \author NAG Ltd.
184186
*
185-
*> \ingroup bdsdc
187+
*> \ingroup auxOTHERcomputational
186188
*
187189
*> \par Contributors:
188190
* ==================
@@ -191,10 +193,8 @@
191193
*> California at Berkeley, USA
192194
*>
193195
* =====================================================================
194-
SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
195-
$ IQ,
196+
SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
196197
$ WORK, IWORK, INFO )
197-
IMPLICIT NONE
198198
*
199199
* -- LAPACK computational routine --
200200
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -233,8 +233,7 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
233233
EXTERNAL LSAME, ILAENV, DLAMCH, DLANST
234234
* ..
235235
* .. External Subroutines ..
236-
EXTERNAL DCOPY, DLARTG, DLASCL, DLASD0, DLASDA,
237-
$ DLASDQ,
236+
EXTERNAL DCOPY, DLARTG, DLASCL, DLASD0, DLASDA, DLASDQ,
238237
$ DLASET, DLASR, DSWAP, XERBLA
239238
* ..
240239
* .. Intrinsic Functions ..
@@ -341,17 +340,14 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
341340
IF( ICOMPQ.EQ.2 ) THEN
342341
CALL DLASET( 'A', N, N, ZERO, ONE, U, LDU )
343342
CALL DLASET( 'A', N, N, ZERO, ONE, VT, LDVT )
344-
CALL DLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU,
345-
$ U,
343+
CALL DLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, U,
346344
$ LDU, WORK( WSTART ), INFO )
347345
ELSE IF( ICOMPQ.EQ.1 ) THEN
348346
IU = 1
349347
IVT = IU + N
350-
CALL DLASET( 'A', N, N, ZERO, ONE,
351-
$ Q( IU+( QSTART-1 )*N ),
348+
CALL DLASET( 'A', N, N, ZERO, ONE, Q( IU+( QSTART-1 )*N ),
352349
$ N )
353-
CALL DLASET( 'A', N, N, ZERO, ONE,
354-
$ Q( IVT+( QSTART-1 )*N ),
350+
CALL DLASET( 'A', N, N, ZERO, ONE, Q( IVT+( QSTART-1 )*N ),
355351
$ N )
356352
CALL DLASDQ( 'U', 0, N, N, N, 0, D, E,
357353
$ Q( IVT+( QSTART-1 )*N ), N,
@@ -509,8 +505,7 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
509505
* which rotated B to be upper bidiagonal
510506
*
511507
IF( ( IUPLO.EQ.2 ) .AND. ( ICOMPQ.EQ.2 ) )
512-
$ CALL DLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U,
513-
$ LDU )
508+
$ CALL DLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, LDU )
514509
*
515510
RETURN
516511
*

‎lapack-netlib/SRC/sbdsdc.f‎

Lines changed: 9 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -5,13 +5,15 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8+
*> \htmlonly
89
*> Download SBDSDC + dependencies
910
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sbdsdc.f">
1011
*> [TGZ]</a>
1112
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sbdsdc.f">
1213
*> [ZIP]</a>
1314
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sbdsdc.f">
1415
*> [TXT]</a>
16+
*> \endhtmlonly
1517
*
1618
* Definition:
1719
* ===========
@@ -182,7 +184,7 @@
182184
*> \author Univ. of Colorado Denver
183185
*> \author NAG Ltd.
184186
*
185-
*> \ingroup bdsdc
187+
*> \ingroup auxOTHERcomputational
186188
*
187189
*> \par Contributors:
188190
* ==================
@@ -191,10 +193,8 @@
191193
*> California at Berkeley, USA
192194
*>
193195
* =====================================================================
194-
SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
195-
$ IQ,
196+
SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
196197
$ WORK, IWORK, INFO )
197-
IMPLICIT NONE
198198
*
199199
* -- LAPACK computational routine --
200200
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -233,8 +233,7 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
233233
EXTERNAL SLAMCH, SLANST, ILAENV, LSAME
234234
* ..
235235
* .. External Subroutines ..
236-
EXTERNAL SCOPY, SLARTG, SLASCL, SLASD0, SLASDA,
237-
$ SLASDQ,
236+
EXTERNAL SCOPY, SLARTG, SLASCL, SLASD0, SLASDA, SLASDQ,
238237
$ SLASET, SLASR, SSWAP, XERBLA
239238
* ..
240239
* .. Intrinsic Functions ..
@@ -341,17 +340,14 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
341340
IF( ICOMPQ.EQ.2 ) THEN
342341
CALL SLASET( 'A', N, N, ZERO, ONE, U, LDU )
343342
CALL SLASET( 'A', N, N, ZERO, ONE, VT, LDVT )
344-
CALL SLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU,
345-
$ U,
343+
CALL SLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, U,
346344
$ LDU, WORK( WSTART ), INFO )
347345
ELSE IF( ICOMPQ.EQ.1 ) THEN
348346
IU = 1
349347
IVT = IU + N
350-
CALL SLASET( 'A', N, N, ZERO, ONE,
351-
$ Q( IU+( QSTART-1 )*N ),
348+
CALL SLASET( 'A', N, N, ZERO, ONE, Q( IU+( QSTART-1 )*N ),
352349
$ N )
353-
CALL SLASET( 'A', N, N, ZERO, ONE,
354-
$ Q( IVT+( QSTART-1 )*N ),
350+
CALL SLASET( 'A', N, N, ZERO, ONE, Q( IVT+( QSTART-1 )*N ),
355351
$ N )
356352
CALL SLASDQ( 'U', 0, N, N, N, 0, D, E,
357353
$ Q( IVT+( QSTART-1 )*N ), N,
@@ -509,8 +505,7 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
509505
* which rotated B to be upper bidiagonal
510506
*
511507
IF( ( IUPLO.EQ.2 ) .AND. ( ICOMPQ.EQ.2 ) )
512-
$ CALL SLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U,
513-
$ LDU )
508+
$ CALL SLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, LDU )
514509
*
515510
RETURN
516511
*

0 commit comments

Comments
 (0)