Skip to content

Commit 3ea9f5a

Browse files
langoulangou
authored
Merge pull request #405 from christoph-conrads/csd2by1-fixes-20200422
2-by-1 CS decomposition fixes
2 parents edb5fc4 + 0c32d4b commit 3ea9f5a

File tree

4 files changed

+43
-24
lines changed

4 files changed

+43
-24
lines changed

‎SRC/cuncsd2by1.f

Lines changed: 19 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -190,9 +190,10 @@
190190
*> The dimension of the array WORK.
191191
*>
192192
*> If LWORK = -1, then a workspace query is assumed; the routine
193-
*> only calculates the optimal size of the WORK array, returns
194-
*> this value as the first entry of the work array, and no error
195-
*> message related to LWORK is issued by XERBLA.
193+
*> only calculates the optimal size of the WORK and RWORK
194+
*> arrays, returns this value as the first entry of the WORK
195+
*> and RWORK array, respectively, and no error message related
196+
*> to LWORK or LRWORK is issued by XERBLA.
196197
*> \endverbatim
197198
*>
198199
*> \param[out] RWORK
@@ -211,10 +212,11 @@
211212
*> LRWORK is INTEGER
212213
*> The dimension of the array RWORK.
213214
*>
214-
*> If LRWORK = -1, then a workspace query is assumed; the routine
215-
*> only calculates the optimal size of the RWORK array, returns
216-
*> this value as the first entry of the work array, and no error
217-
*> message related to LRWORK is issued by XERBLA.
215+
*> If LRWORK=-1, then a workspace query is assumed; the routine
216+
*> only calculates the optimal size of the WORK and RWORK
217+
*> arrays, returns this value as the first entry of the WORK
218+
*> and RWORK array, respectively, and no error message related
219+
*> to LWORK or LRWORK is issued by XERBLA.
218220
*> \endverbatim
219221
*
220222
*> \param[out] IWORK
@@ -313,7 +315,7 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
313315
WANTU1 = LSAME( JOBU1, 'Y' )
314316
WANTU2 = LSAME( JOBU2, 'Y' )
315317
WANTV1T = LSAME( JOBV1T, 'Y' )
316-
LQUERY = LWORK .EQ. -1
318+
LQUERY = ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 )
317319
*
318320
IF( M .LT. 0 ) THEN
319321
INFO = -4
@@ -513,6 +515,9 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
513515
IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN
514516
INFO = -19
515517
END IF
518+
IF( LRWORK .LT. LRWORKMIN .AND. .NOT.LQUERY ) THEN
519+
INFO = -21
520+
END IF
516521
END IF
517522
IF( INFO .NE. 0 ) THEN
518523
CALL XERBLA( 'CUNCSD2BY1', -INFO )
@@ -566,8 +571,8 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
566571
$ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM,
567572
$ 1, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D),
568573
$ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E),
569-
$ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD,
570-
$ CHILDINFO )
574+
$ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD),
575+
$ LRWORK-IBBCSD+1, CHILDINFO )
571576
*
572577
* Permute rows and columns to place zero submatrices in
573578
* preferred positions
@@ -708,6 +713,10 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
708713
*
709714
* Accumulate Householder reflectors
710715
*
716+
717+
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
718+
CALL CCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
719+
END IF
711720
IF( WANTU1 .AND. P .GT. 0 ) THEN
712721
CALL CCOPY( P, WORK(IORBDB), 1, U1, 1 )
713722
DO J = 2, P
@@ -719,7 +728,6 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
719728
$ WORK(IORGQR), LORGQR, CHILDINFO )
720729
END IF
721730
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
722-
CALL CCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
723731
DO J = 2, M-P
724732
U2(1,J) = ZERO
725733
END DO

‎SRC/dorcsd2by1.f

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -674,6 +674,9 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
674674
*
675675
* Accumulate Householder reflectors
676676
*
677+
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
678+
CALL DCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
679+
END IF
677680
IF( WANTU1 .AND. P .GT. 0 ) THEN
678681
CALL DCOPY( P, WORK(IORBDB), 1, U1, 1 )
679682
DO J = 2, P
@@ -685,7 +688,6 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
685688
$ WORK(IORGQR), LORGQR, CHILDINFO )
686689
END IF
687690
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
688-
CALL DCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
689691
DO J = 2, M-P
690692
U2(1,J) = ZERO
691693
END DO

‎SRC/sorcsd2by1.f

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -674,6 +674,9 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
674674
*
675675
* Accumulate Householder reflectors
676676
*
677+
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
678+
CALL SCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
679+
END IF
677680
IF( WANTU1 .AND. P .GT. 0 ) THEN
678681
CALL SCOPY( P, WORK(IORBDB), 1, U1, 1 )
679682
DO J = 2, P
@@ -685,7 +688,6 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
685688
$ WORK(IORGQR), LORGQR, CHILDINFO )
686689
END IF
687690
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
688-
CALL SCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
689691
DO J = 2, M-P
690692
U2(1,J) = ZERO
691693
END DO

‎SRC/zuncsd2by1.f

Lines changed: 18 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -189,9 +189,10 @@
189189
*> The dimension of the array WORK.
190190
*>
191191
*> If LWORK = -1, then a workspace query is assumed; the routine
192-
*> only calculates the optimal size of the WORK array, returns
193-
*> this value as the first entry of the work array, and no error
194-
*> message related to LWORK is issued by XERBLA.
192+
*> only calculates the optimal size of the WORK and RWORK
193+
*> arrays, returns this value as the first entry of the WORK
194+
*> and RWORK array, respectively, and no error message related
195+
*> to LWORK or LRWORK is issued by XERBLA.
195196
*> \endverbatim
196197
*>
197198
*> \param[out] RWORK
@@ -210,10 +211,11 @@
210211
*> LRWORK is INTEGER
211212
*> The dimension of the array RWORK.
212213
*>
213-
*> If LRWORK = -1, then a workspace query is assumed; the routine
214-
*> only calculates the optimal size of the RWORK array, returns
215-
*> this value as the first entry of the work array, and no error
216-
*> message related to LRWORK is issued by XERBLA.
214+
*> If LRWORK=-1, then a workspace query is assumed; the routine
215+
*> only calculates the optimal size of the WORK and RWORK
216+
*> arrays, returns this value as the first entry of the WORK
217+
*> and RWORK array, respectively, and no error message related
218+
*> to LWORK or LRWORK is issued by XERBLA.
217219
*> \endverbatim
218220
*
219221
*> \param[out] IWORK
@@ -312,7 +314,7 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
312314
WANTU1 = LSAME( JOBU1, 'Y' )
313315
WANTU2 = LSAME( JOBU2, 'Y' )
314316
WANTV1T = LSAME( JOBV1T, 'Y' )
315-
LQUERY = LWORK .EQ. -1
317+
LQUERY = ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 )
316318
*
317319
IF( M .LT. 0 ) THEN
318320
INFO = -4
@@ -511,6 +513,9 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
511513
IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN
512514
INFO = -19
513515
END IF
516+
IF( LRWORK .LT. LRWORKMIN .AND. .NOT.LQUERY ) THEN
517+
INFO = -21
518+
END IF
514519
END IF
515520
IF( INFO .NE. 0 ) THEN
516521
CALL XERBLA( 'ZUNCSD2BY1', -INFO )
@@ -564,8 +569,8 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
564569
$ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM,
565570
$ 1, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D),
566571
$ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E),
567-
$ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD,
568-
$ CHILDINFO )
572+
$ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD),
573+
$ LRWORK-IBBCSD+1, CHILDINFO )
569574
*
570575
* Permute rows and columns to place zero submatrices in
571576
* preferred positions
@@ -706,6 +711,9 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
706711
*
707712
* Accumulate Householder reflectors
708713
*
714+
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
715+
CALL ZCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
716+
END IF
709717
IF( WANTU1 .AND. P .GT. 0 ) THEN
710718
CALL ZCOPY( P, WORK(IORBDB), 1, U1, 1 )
711719
DO J = 2, P
@@ -717,7 +725,6 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11,
717725
$ WORK(IORGQR), LORGQR, CHILDINFO )
718726
END IF
719727
IF( WANTU2 .AND. M-P .GT. 0 ) THEN
720-
CALL ZCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 )
721728
DO J = 2, M-P
722729
U2(1,J) = ZERO
723730
END DO

0 commit comments

Comments
 (0)