Skip to content

Commit 8b3e60f

Browse files
weslleyspereiraweslleyspereira
committed
Merge branch 'master' into fix-segfault-xeigtstz-335
2 parents b3e5991 + 8960228 commit 8b3e60f

File tree

16 files changed

+61
-42
lines changed

16 files changed

+61
-42
lines changed

‎SRC/clargv.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -200,7 +200,7 @@ SUBROUTINE CLARGV( N, X, INCX, Y, INCY, C, INCC )
200200
FS = FS*SAFMN2
201201
GS = GS*SAFMN2
202202
SCALE = SCALE*SAFMN2
203-
IF( SCALE.GE.SAFMX2 )
203+
IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20 )
204204
$ GO TO 10
205205
ELSE IF( SCALE.LE.SAFMN2 ) THEN
206206
IF( G.EQ.CZERO ) THEN

‎SRC/clartg.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -161,7 +161,7 @@ SUBROUTINE CLARTG( F, G, CS, SN, R )
161161
FS = FS*SAFMN2
162162
GS = GS*SAFMN2
163163
SCALE = SCALE*SAFMN2
164-
IF( SCALE.GE.SAFMX2 )
164+
IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20)
165165
$ GO TO 10
166166
ELSE IF( SCALE.LE.SAFMN2 ) THEN
167167
IF( G.EQ.CZERO.OR.SISNAN( ABS( G ) ) ) THEN

‎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/cungbr.f

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -222,17 +222,17 @@ SUBROUTINE CUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
222222
CALL CUNGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
223223
ELSE
224224
IF( M.GT.1 ) THEN
225-
CALL CUNGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
226-
$ -1, IINFO )
225+
CALL CUNGQR( M-1, M-1, M-1, A, LDA, TAU, WORK, -1,
226+
$ IINFO )
227227
END IF
228228
END IF
229229
ELSE
230230
IF( K.LT.N ) THEN
231231
CALL CUNGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
232232
ELSE
233233
IF( N.GT.1 ) THEN
234-
CALL CUNGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
235-
$ -1, IINFO )
234+
CALL CUNGLQ( N-1, N-1, N-1, A, LDA, TAU, WORK, -1,
235+
$ IINFO )
236236
END IF
237237
END IF
238238
END IF

‎SRC/dlartg.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -163,7 +163,7 @@ SUBROUTINE DLARTG( F, G, CS, SN, R )
163163
F1 = F1*SAFMN2
164164
G1 = G1*SAFMN2
165165
SCALE = MAX( ABS( F1 ), ABS( G1 ) )
166-
IF( SCALE.GE.SAFMX2 )
166+
IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20)
167167
$ GO TO 10
168168
R = SQRT( F1**2+G1**2 )
169169
CS = F1 / R

‎SRC/dlartgp.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -161,7 +161,7 @@ SUBROUTINE DLARTGP( F, G, CS, SN, R )
161161
F1 = F1*SAFMN2
162162
G1 = G1*SAFMN2
163163
SCALE = MAX( ABS( F1 ), ABS( G1 ) )
164-
IF( SCALE.GE.SAFMX2 )
164+
IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20 )
165165
$ GO TO 10
166166
R = SQRT( F1**2+G1**2 )
167167
CS = F1 / R

‎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/slartg.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -163,7 +163,7 @@ SUBROUTINE SLARTG( F, G, CS, SN, R )
163163
F1 = F1*SAFMN2
164164
G1 = G1*SAFMN2
165165
SCALE = MAX( ABS( F1 ), ABS( G1 ) )
166-
IF( SCALE.GE.SAFMX2 )
166+
IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20)
167167
$ GO TO 10
168168
R = SQRT( F1**2+G1**2 )
169169
CS = F1 / R

‎SRC/slartgp.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -161,7 +161,7 @@ SUBROUTINE SLARTGP( F, G, CS, SN, R )
161161
F1 = F1*SAFMN2
162162
G1 = G1*SAFMN2
163163
SCALE = MAX( ABS( F1 ), ABS( G1 ) )
164-
IF( SCALE.GE.SAFMX2 )
164+
IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20)
165165
$ GO TO 10
166166
R = SQRT( F1**2+G1**2 )
167167
CS = F1 / R

‎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

0 commit comments

Comments
 (0)