Skip to content

Commit 8c1535b

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #5936 from martin-frbg/fixup-5883
Use QR for bidiagonal SVD with vectors in ?BDSDC (Reference-LAPACK PR 1300)
2 parents efab2a2 + 1c6f5f4 commit 8c1535b

2 files changed

Lines changed: 28 additions & 18 deletions

File tree

‎lapack-netlib/SRC/dbdsdc.f‎

Lines changed: 14 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,13 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8-
*> \htmlonly
98
*> Download DBDSDC + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dbdsdc.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dbdsdc.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dbdsdc.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -184,7 +182,7 @@
184182
*> \author Univ. of Colorado Denver
185183
*> \author NAG Ltd.
186184
*
187-
*> \ingroup auxOTHERcomputational
185+
*> \ingroup bdsdc
188186
*
189187
*> \par Contributors:
190188
* ==================
@@ -193,8 +191,10 @@
193191
*> California at Berkeley, USA
194192
*>
195193
* =====================================================================
196-
SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
194+
SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
195+
$ IQ,
197196
$ WORK, IWORK, INFO )
197+
IMPLICIT NONE
198198
*
199199
* -- LAPACK computational routine --
200200
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -233,7 +233,8 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
233233
EXTERNAL LSAME, ILAENV, DLAMCH, DLANST
234234
* ..
235235
* .. External Subroutines ..
236-
EXTERNAL DCOPY, DLARTG, DLASCL, DLASD0, DLASDA, DLASDQ,
236+
EXTERNAL DCOPY, DLARTG, DLASCL, DLASD0, DLASDA,
237+
$ DLASDQ,
237238
$ DLASET, DLASR, DSWAP, XERBLA
238239
* ..
239240
* .. Intrinsic Functions ..
@@ -340,14 +341,17 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
340341
IF( ICOMPQ.EQ.2 ) THEN
341342
CALL DLASET( 'A', N, N, ZERO, ONE, U, LDU )
342343
CALL DLASET( 'A', N, N, ZERO, ONE, VT, LDVT )
343-
CALL DLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, U,
344+
CALL DLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU,
345+
$ U,
344346
$ LDU, WORK( WSTART ), INFO )
345347
ELSE IF( ICOMPQ.EQ.1 ) THEN
346348
IU = 1
347349
IVT = IU + N
348-
CALL DLASET( 'A', N, N, ZERO, ONE, Q( IU+( QSTART-1 )*N ),
350+
CALL DLASET( 'A', N, N, ZERO, ONE,
351+
$ Q( IU+( QSTART-1 )*N ),
349352
$ N )
350-
CALL DLASET( 'A', N, N, ZERO, ONE, Q( IVT+( QSTART-1 )*N ),
353+
CALL DLASET( 'A', N, N, ZERO, ONE,
354+
$ Q( IVT+( QSTART-1 )*N ),
351355
$ N )
352356
CALL DLASDQ( 'U', 0, N, N, N, 0, D, E,
353357
$ Q( IVT+( QSTART-1 )*N ), N,
@@ -505,7 +509,8 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
505509
* which rotated B to be upper bidiagonal
506510
*
507511
IF( ( IUPLO.EQ.2 ) .AND. ( ICOMPQ.EQ.2 ) )
508-
$ CALL DLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, LDU )
512+
$ CALL DLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U,
513+
$ LDU )
509514
*
510515
RETURN
511516
*

‎lapack-netlib/SRC/sbdsdc.f‎

Lines changed: 14 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,13 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8-
*> \htmlonly
98
*> Download SBDSDC + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sbdsdc.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sbdsdc.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sbdsdc.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -184,7 +182,7 @@
184182
*> \author Univ. of Colorado Denver
185183
*> \author NAG Ltd.
186184
*
187-
*> \ingroup auxOTHERcomputational
185+
*> \ingroup bdsdc
188186
*
189187
*> \par Contributors:
190188
* ==================
@@ -193,8 +191,10 @@
193191
*> California at Berkeley, USA
194192
*>
195193
* =====================================================================
196-
SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
194+
SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q,
195+
$ IQ,
197196
$ WORK, IWORK, INFO )
197+
IMPLICIT NONE
198198
*
199199
* -- LAPACK computational routine --
200200
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -233,7 +233,8 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
233233
EXTERNAL SLAMCH, SLANST, ILAENV, LSAME
234234
* ..
235235
* .. External Subroutines ..
236-
EXTERNAL SCOPY, SLARTG, SLASCL, SLASD0, SLASDA, SLASDQ,
236+
EXTERNAL SCOPY, SLARTG, SLASCL, SLASD0, SLASDA,
237+
$ SLASDQ,
237238
$ SLASET, SLASR, SSWAP, XERBLA
238239
* ..
239240
* .. Intrinsic Functions ..
@@ -340,14 +341,17 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
340341
IF( ICOMPQ.EQ.2 ) THEN
341342
CALL SLASET( 'A', N, N, ZERO, ONE, U, LDU )
342343
CALL SLASET( 'A', N, N, ZERO, ONE, VT, LDVT )
343-
CALL SLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, U,
344+
CALL SLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU,
345+
$ U,
344346
$ LDU, WORK( WSTART ), INFO )
345347
ELSE IF( ICOMPQ.EQ.1 ) THEN
346348
IU = 1
347349
IVT = IU + N
348-
CALL SLASET( 'A', N, N, ZERO, ONE, Q( IU+( QSTART-1 )*N ),
350+
CALL SLASET( 'A', N, N, ZERO, ONE,
351+
$ Q( IU+( QSTART-1 )*N ),
349352
$ N )
350-
CALL SLASET( 'A', N, N, ZERO, ONE, Q( IVT+( QSTART-1 )*N ),
353+
CALL SLASET( 'A', N, N, ZERO, ONE,
354+
$ Q( IVT+( QSTART-1 )*N ),
351355
$ N )
352356
CALL SLASDQ( 'U', 0, N, N, N, 0, D, E,
353357
$ Q( IVT+( QSTART-1 )*N ), N,
@@ -505,7 +509,8 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
505509
* which rotated B to be upper bidiagonal
506510
*
507511
IF( ( IUPLO.EQ.2 ) .AND. ( ICOMPQ.EQ.2 ) )
508-
$ CALL SLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, LDU )
512+
$ CALL SLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U,
513+
$ LDU )
509514
*
510515
RETURN
511516
*

0 commit comments

Comments
 (0)