Skip to content

Commit 9cd55e4

Browse files
weslleyspereiraweslleyspereira
committed
Fix out-of-bounds references in xORBDB(2,3)
1 parent 2dafa3d commit 9cd55e4

File tree

4 files changed

+82
-62
lines changed

4 files changed

+82
-62
lines changed

‎SRC/dorbdb2.f

Lines changed: 20 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -278,48 +278,53 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
278278
* Reduce rows 1, ..., P of X11 and X21
279279
*
280280
DO I = 1, P
281+
I1 = MIN(I+1,P)
282+
I2 = MIN(I+1,Q)
281283
*
282284
IF( I .GT. 1 ) THEN
283285
CALL DROT( Q-I+1, X11(I,I), LDX11, X21(I-1,I), LDX21, C, S )
284286
END IF
285-
CALL DLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) )
287+
CALL DLARFGP( Q-I+1, X11(I,I), X11(I,I2), LDX11, TAUQ1(I) )
286288
C = X11(I,I)
287289
X11(I,I) = ONE
288290
CALL DLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
289-
$ X11(I+1,I), LDX11, WORK(ILARF) )
291+
$ X11(I1,I), LDX11, WORK(ILARF) )
290292
CALL DLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
291293
$ X21(I,I), LDX21, WORK(ILARF) )
292-
S = SQRT( DNRM2( P-I, X11(I+1,I), 1 )**2
294+
S = SQRT( DNRM2( P-I, X11(I1,I), 1 )**2
293295
$ + DNRM2( M-P-I+1, X21(I,I), 1 )**2 )
294296
THETA(I) = ATAN2( S, C )
295297
*
296-
CALL DORBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1,
297-
$ X11(I+1,I+1), LDX11, X21(I,I+1), LDX21,
298+
CALL DORBDB5( P-I, M-P-I+1, Q-I, X11(I1,I), 1, X21(I,I), 1,
299+
$ X11(I1,I2), LDX11, X21(I,I2), LDX21,
298300
$ WORK(IORBDB5), LORBDB5, CHILDINFO )
299-
CALL DSCAL( P-I, NEGONE, X11(I+1,I), 1 )
300-
CALL DLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
301+
CALL DSCAL( P-I, NEGONE, X11(I1,I), 1 )
302+
CALL DLARFGP( M-P-I+1, X21(I,I), X21( MIN(I+1,M-P) ,I), 1,
303+
$ TAUP2(I) )
301304
IF( I .LT. P ) THEN
302-
CALL DLARFGP( P-I, X11(I+1,I), X11(I+2,I), 1, TAUP1(I) )
303-
PHI(I) = ATAN2( X11(I+1,I), X21(I,I) )
305+
CALL DLARFGP( P-I, X11(I1,I), X11( MIN(I+2,P) ,I), 1,
306+
$ TAUP1(I) )
307+
PHI(I) = ATAN2( X11(I1,I), X21(I,I) )
304308
C = COS( PHI(I) )
305309
S = SIN( PHI(I) )
306-
X11(I+1,I) = ONE
307-
CALL DLARF( 'L', P-I, Q-I, X11(I+1,I), 1, TAUP1(I),
308-
$ X11(I+1,I+1), LDX11, WORK(ILARF) )
310+
X11(I1,I) = ONE
311+
CALL DLARF( 'L', P-I, Q-I, X11(I1,I), 1, TAUP1(I),
312+
$ X11(I1,I2), LDX11, WORK(ILARF) )
309313
END IF
310314
X21(I,I) = ONE
311315
CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
312-
$ X21(I,I+1), LDX21, WORK(ILARF) )
316+
$ X21(I,I2), LDX21, WORK(ILARF) )
313317
*
314318
END DO
315319
*
316320
* Reduce the bottom-right portion of X21 to the identity matrix
317321
*
318322
DO I = P + 1, Q
319-
CALL DLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
323+
CALL DLARFGP( M-P-I+1, X21(I,I), X21( MIN(I+1,M-P) ,I), 1,
324+
$ TAUP2(I) )
320325
X21(I,I) = ONE
321326
CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
322-
$ X21(I,I+1), LDX21, WORK(ILARF) )
327+
$ X21(I, MIN(I+1,Q) ), LDX21, WORK(ILARF) )
323328
END DO
324329
*
325330
RETURN

‎SRC/dorbdb3.f

Lines changed: 20 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -277,48 +277,53 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
277277
* Reduce rows 1, ..., M-P of X11 and X21
278278
*
279279
DO I = 1, M-P
280+
I1 = MIN(I+1,M-P)
281+
I2 = MIN(I+1,Q)
280282
*
281283
IF( I .GT. 1 ) THEN
282284
CALL DROT( Q-I+1, X11(I-1,I), LDX11, X21(I,I), LDX11, C, S )
283285
END IF
284286
*
285-
CALL DLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) )
287+
CALL DLARFGP( Q-I+1, X21(I,I), X21(I,I2), LDX21, TAUQ1(I) )
286288
S = X21(I,I)
287289
X21(I,I) = ONE
288290
CALL DLARF( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I),
289291
$ X11(I,I), LDX11, WORK(ILARF) )
290292
CALL DLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I),
291-
$ X21(I+1,I), LDX21, WORK(ILARF) )
293+
$ X21(I1,I), LDX21, WORK(ILARF) )
292294
C = SQRT( DNRM2( P-I+1, X11(I,I), 1 )**2
293-
$ + DNRM2( M-P-I, X21(I+1,I), 1 )**2 )
295+
$ + DNRM2( M-P-I, X21(I1,I), 1 )**2 )
294296
THETA(I) = ATAN2( S, C )
295297
*
296-
CALL DORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1,
297-
$ X11(I,I+1), LDX11, X21(I+1,I+1), LDX21,
298+
CALL DORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I1,I), 1,
299+
$ X11(I,I2), LDX11, X21(I1,I2), LDX21,
298300
$ WORK(IORBDB5), LORBDB5, CHILDINFO )
299-
CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
301+
CALL DLARFGP( P-I+1, X11(I,I), X11( MIN(I+1,P) ,I), 1,
302+
$ TAUP1(I) )
300303
IF( I .LT. M-P ) THEN
301-
CALL DLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, TAUP2(I) )
302-
PHI(I) = ATAN2( X21(I+1,I), X11(I,I) )
304+
CALL DLARFGP( M-P-I, X21(I1,I), X21( MIN(I+2,M-P) ,I), 1,
305+
$ TAUP2(I) )
306+
PHI(I) = ATAN2( X21(I1,I), X11(I,I) )
303307
C = COS( PHI(I) )
304308
S = SIN( PHI(I) )
305-
X21(I+1,I) = ONE
306-
CALL DLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1, TAUP2(I),
307-
$ X21(I+1,I+1), LDX21, WORK(ILARF) )
309+
X21(I1,I) = ONE
310+
CALL DLARF( 'L', M-P-I, Q-I, X21(I1,I), 1, TAUP2(I),
311+
$ X21(I1,I2), LDX21, WORK(ILARF) )
308312
END IF
309313
X11(I,I) = ONE
310-
CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1),
314+
CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I2),
311315
$ LDX11, WORK(ILARF) )
312316
*
313317
END DO
314318
*
315319
* Reduce the bottom-right portion of X11 to the identity matrix
316320
*
317321
DO I = M-P + 1, Q
318-
CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
322+
CALL DLARFGP( P-I+1, X11(I,I), X11( MIN(I+1,P) ,I), 1,
323+
$ TAUP1(I) )
319324
X11(I,I) = ONE
320-
CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1),
321-
$ LDX11, WORK(ILARF) )
325+
CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I),
326+
$ X11(I, MIN(I+1,Q) ), LDX11, WORK(ILARF) )
322327
END DO
323328
*
324329
RETURN

‎SRC/sorbdb2.f

Lines changed: 21 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -221,7 +221,7 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
221221
* .. Local Scalars ..
222222
REAL C, S
223223
INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
224-
$ LWORKMIN, LWORKOPT
224+
$ LWORKMIN, LWORKOPT, I1, I2
225225
LOGICAL LQUERY
226226
* ..
227227
* .. External Subroutines ..
@@ -277,48 +277,53 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
277277
* Reduce rows 1, ..., P of X11 and X21
278278
*
279279
DO I = 1, P
280+
I1 = MIN(I+1,P)
281+
I2 = MIN(I+1,Q)
280282
*
281283
IF( I .GT. 1 ) THEN
282284
CALL SROT( Q-I+1, X11(I,I), LDX11, X21(I-1,I), LDX21, C, S )
283285
END IF
284-
CALL SLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) )
286+
CALL SLARFGP( Q-I+1, X11(I,I), X11(I,I2), LDX11, TAUQ1(I) )
285287
C = X11(I,I)
286288
X11(I,I) = ONE
287289
CALL SLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
288-
$ X11(I+1,I), LDX11, WORK(ILARF) )
290+
$ X11(I1,I), LDX11, WORK(ILARF) )
289291
CALL SLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
290292
$ X21(I,I), LDX21, WORK(ILARF) )
291-
S = SQRT( SNRM2( P-I, X11(I+1,I), 1 )**2
293+
S = SQRT( SNRM2( P-I, X11(I1,I), 1 )**2
292294
$ + SNRM2( M-P-I+1, X21(I,I), 1 )**2 )
293295
THETA(I) = ATAN2( S, C )
294296
*
295-
CALL SORBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1,
296-
$ X11(I+1,I+1), LDX11, X21(I,I+1), LDX21,
297+
CALL SORBDB5( P-I, M-P-I+1, Q-I, X11(I1,I), 1, X21(I,I), 1,
298+
$ X11(I1,I2), LDX11, X21(I,I2), LDX21,
297299
$ WORK(IORBDB5), LORBDB5, CHILDINFO )
298-
CALL SSCAL( P-I, NEGONE, X11(I+1,I), 1 )
299-
CALL SLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
300+
CALL SSCAL( P-I, NEGONE, X11(I1,I), 1 )
301+
CALL SLARFGP( M-P-I+1, X21(I,I), X21( MIN(I+1,M-P) ,I), 1,
302+
$ TAUP2(I) )
300303
IF( I .LT. P ) THEN
301-
CALL SLARFGP( P-I, X11(I+1,I), X11(I+2,I), 1, TAUP1(I) )
302-
PHI(I) = ATAN2( X11(I+1,I), X21(I,I) )
304+
CALL SLARFGP( P-I, X11(I1,I), X11( MIN(I+2,P) ,I), 1,
305+
$ TAUP1(I) )
306+
PHI(I) = ATAN2( X11(I1,I), X21(I,I) )
303307
C = COS( PHI(I) )
304308
S = SIN( PHI(I) )
305-
X11(I+1,I) = ONE
306-
CALL SLARF( 'L', P-I, Q-I, X11(I+1,I), 1, TAUP1(I),
307-
$ X11(I+1,I+1), LDX11, WORK(ILARF) )
309+
X11(I1,I) = ONE
310+
CALL SLARF( 'L', P-I, Q-I, X11(I1,I), 1, TAUP1(I),
311+
$ X11(I1,I2), LDX11, WORK(ILARF) )
308312
END IF
309313
X21(I,I) = ONE
310314
CALL SLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
311-
$ X21(I,I+1), LDX21, WORK(ILARF) )
315+
$ X21(I,I2), LDX21, WORK(ILARF) )
312316
*
313317
END DO
314318
*
315319
* Reduce the bottom-right portion of X21 to the identity matrix
316320
*
317321
DO I = P + 1, Q
318-
CALL SLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
322+
CALL SLARFGP( M-P-I+1, X21(I,I), X21( MIN(I+1,M-P) ,I), 1,
323+
$ TAUP2(I) )
319324
X21(I,I) = ONE
320325
CALL SLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
321-
$ X21(I,I+1), LDX21, WORK(ILARF) )
326+
$ X21(I, MIN(I+1,Q) ), LDX21, WORK(ILARF) )
322327
END DO
323328
*
324329
RETURN

‎SRC/sorbdb3.f

Lines changed: 21 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -222,7 +222,7 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
222222
* .. Local Scalars ..
223223
REAL C, S
224224
INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
225-
$ LWORKMIN, LWORKOPT
225+
$ LWORKMIN, LWORKOPT, I1, I2
226226
LOGICAL LQUERY
227227
* ..
228228
* .. External Subroutines ..
@@ -278,48 +278,53 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
278278
* Reduce rows 1, ..., M-P of X11 and X21
279279
*
280280
DO I = 1, M-P
281+
I1 = MIN(I+1,M-P)
282+
I2 = MIN(I+1,Q)
281283
*
282284
IF( I .GT. 1 ) THEN
283285
CALL SROT( Q-I+1, X11(I-1,I), LDX11, X21(I,I), LDX11, C, S )
284286
END IF
285287
*
286-
CALL SLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) )
288+
CALL SLARFGP( Q-I+1, X21(I,I), X21(I,I2), LDX21, TAUQ1(I) )
287289
S = X21(I,I)
288290
X21(I,I) = ONE
289291
CALL SLARF( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I),
290292
$ X11(I,I), LDX11, WORK(ILARF) )
291293
CALL SLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I),
292-
$ X21(I+1,I), LDX21, WORK(ILARF) )
294+
$ X21(I1,I), LDX21, WORK(ILARF) )
293295
C = SQRT( SNRM2( P-I+1, X11(I,I), 1 )**2
294-
$ + SNRM2( M-P-I, X21(I+1,I), 1 )**2 )
296+
$ + SNRM2( M-P-I, X21(I1,I), 1 )**2 )
295297
THETA(I) = ATAN2( S, C )
296298
*
297-
CALL SORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1,
298-
$ X11(I,I+1), LDX11, X21(I+1,I+1), LDX21,
299+
CALL SORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I1,I), 1,
300+
$ X11(I,I2), LDX11, X21(I1,I2), LDX21,
299301
$ WORK(IORBDB5), LORBDB5, CHILDINFO )
300-
CALL SLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
302+
CALL SLARFGP( P-I+1, X11(I,I), X11( MIN(I+1,P) ,I), 1,
303+
$ TAUP1(I) )
301304
IF( I .LT. M-P ) THEN
302-
CALL SLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, TAUP2(I) )
303-
PHI(I) = ATAN2( X21(I+1,I), X11(I,I) )
305+
CALL SLARFGP( M-P-I, X21(I1,I), X21( MIN(I+2,M-P) ,I), 1,
306+
$ TAUP2(I) )
307+
PHI(I) = ATAN2( X21(I1,I), X11(I,I) )
304308
C = COS( PHI(I) )
305309
S = SIN( PHI(I) )
306-
X21(I+1,I) = ONE
307-
CALL SLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1, TAUP2(I),
308-
$ X21(I+1,I+1), LDX21, WORK(ILARF) )
310+
X21(I1,I) = ONE
311+
CALL SLARF( 'L', M-P-I, Q-I, X21(I1,I), 1, TAUP2(I),
312+
$ X21(I1,I2), LDX21, WORK(ILARF) )
309313
END IF
310314
X11(I,I) = ONE
311-
CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1),
315+
CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I2),
312316
$ LDX11, WORK(ILARF) )
313317
*
314318
END DO
315319
*
316320
* Reduce the bottom-right portion of X11 to the identity matrix
317321
*
318322
DO I = M-P + 1, Q
319-
CALL SLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
323+
CALL SLARFGP( P-I+1, X11(I,I), X11( MIN(I+1,P) ,I), 1,
324+
$ TAUP1(I) )
320325
X11(I,I) = ONE
321-
CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1),
322-
$ LDX11, WORK(ILARF) )
326+
CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I),
327+
$ X11(I, MIN(I+1,Q) ), LDX11, WORK(ILARF) )
323328
END DO
324329
*
325330
RETURN

0 commit comments

Comments
 (0)