Skip to content

Commit

Permalink
Fix out-of-bounds references in xORBDB(2,3)
Browse files Browse the repository at this point in the history
  • Loading branch information
@weslleyspereira
weslleyspereira committed May 14, 2021
1 parent 2dafa3d commit 9cd55e4
Show file tree
Hide file tree
Showing 4 changed files with 82 additions and 62 deletions.
35 changes: 20 additions & 15 deletions SRC/dorbdb2.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -278,48 +278,53 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
* Reduce rows 1, ..., P of X11 and X21
*
DO I = 1, P
I1 = MIN(I+1,P)
I2 = MIN(I+1,Q)
*
IF( I .GT. 1 ) THEN
CALL DROT( Q-I+1, X11(I,I), LDX11, X21(I-1,I), LDX21, C, S )
END IF
CALL DLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) )
CALL DLARFGP( Q-I+1, X11(I,I), X11(I,I2), LDX11, TAUQ1(I) )
C = X11(I,I)
X11(I,I) = ONE
CALL DLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
$ X11(I+1,I), LDX11, WORK(ILARF) )
$ X11(I1,I), LDX11, WORK(ILARF) )
CALL DLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
$ X21(I,I), LDX21, WORK(ILARF) )
S = SQRT( DNRM2( P-I, X11(I+1,I), 1 )**2
S = SQRT( DNRM2( P-I, X11(I1,I), 1 )**2
$ + DNRM2( M-P-I+1, X21(I,I), 1 )**2 )
THETA(I) = ATAN2( S, C )
*
CALL DORBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1,
$ X11(I+1,I+1), LDX11, X21(I,I+1), LDX21,
CALL DORBDB5( P-I, M-P-I+1, Q-I, X11(I1,I), 1, X21(I,I), 1,
$ X11(I1,I2), LDX11, X21(I,I2), LDX21,
$ WORK(IORBDB5), LORBDB5, CHILDINFO )
CALL DSCAL( P-I, NEGONE, X11(I+1,I), 1 )
CALL DLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
CALL DSCAL( P-I, NEGONE, X11(I1,I), 1 )
CALL DLARFGP( M-P-I+1, X21(I,I), X21( MIN(I+1,M-P) ,I), 1,
$ TAUP2(I) )
IF( I .LT. P ) THEN
CALL DLARFGP( P-I, X11(I+1,I), X11(I+2,I), 1, TAUP1(I) )
PHI(I) = ATAN2( X11(I+1,I), X21(I,I) )
CALL DLARFGP( P-I, X11(I1,I), X11( MIN(I+2,P) ,I), 1,
$ TAUP1(I) )
PHI(I) = ATAN2( X11(I1,I), X21(I,I) )
C = COS( PHI(I) )
S = SIN( PHI(I) )
X11(I+1,I) = ONE
CALL DLARF( 'L', P-I, Q-I, X11(I+1,I), 1, TAUP1(I),
$ X11(I+1,I+1), LDX11, WORK(ILARF) )
X11(I1,I) = ONE
CALL DLARF( 'L', P-I, Q-I, X11(I1,I), 1, TAUP1(I),
$ X11(I1,I2), LDX11, WORK(ILARF) )
END IF
X21(I,I) = ONE
CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
$ X21(I,I+1), LDX21, WORK(ILARF) )
$ X21(I,I2), LDX21, WORK(ILARF) )
*
END DO
*
* Reduce the bottom-right portion of X21 to the identity matrix
*
DO I = P + 1, Q
CALL DLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
CALL DLARFGP( M-P-I+1, X21(I,I), X21( MIN(I+1,M-P) ,I), 1,
$ TAUP2(I) )
X21(I,I) = ONE
CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
$ X21(I,I+1), LDX21, WORK(ILARF) )
$ X21(I, MIN(I+1,Q) ), LDX21, WORK(ILARF) )
END DO
*
RETURN
Expand Down
35 changes: 20 additions & 15 deletions SRC/dorbdb3.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -277,48 +277,53 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
* Reduce rows 1, ..., M-P of X11 and X21
*
DO I = 1, M-P
I1 = MIN(I+1,M-P)
I2 = MIN(I+1,Q)
*
IF( I .GT. 1 ) THEN
CALL DROT( Q-I+1, X11(I-1,I), LDX11, X21(I,I), LDX11, C, S )
END IF
*
CALL DLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) )
CALL DLARFGP( Q-I+1, X21(I,I), X21(I,I2), LDX21, TAUQ1(I) )
S = X21(I,I)
X21(I,I) = ONE
CALL DLARF( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I),
$ X11(I,I), LDX11, WORK(ILARF) )
CALL DLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I),
$ X21(I+1,I), LDX21, WORK(ILARF) )
$ X21(I1,I), LDX21, WORK(ILARF) )
C = SQRT( DNRM2( P-I+1, X11(I,I), 1 )**2
$ + DNRM2( M-P-I, X21(I+1,I), 1 )**2 )
$ + DNRM2( M-P-I, X21(I1,I), 1 )**2 )
THETA(I) = ATAN2( S, C )
*
CALL DORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1,
$ X11(I,I+1), LDX11, X21(I+1,I+1), LDX21,
CALL DORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I1,I), 1,
$ X11(I,I2), LDX11, X21(I1,I2), LDX21,
$ WORK(IORBDB5), LORBDB5, CHILDINFO )
CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
CALL DLARFGP( P-I+1, X11(I,I), X11( MIN(I+1,P) ,I), 1,
$ TAUP1(I) )
IF( I .LT. M-P ) THEN
CALL DLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, TAUP2(I) )
PHI(I) = ATAN2( X21(I+1,I), X11(I,I) )
CALL DLARFGP( M-P-I, X21(I1,I), X21( MIN(I+2,M-P) ,I), 1,
$ TAUP2(I) )
PHI(I) = ATAN2( X21(I1,I), X11(I,I) )
C = COS( PHI(I) )
S = SIN( PHI(I) )
X21(I+1,I) = ONE
CALL DLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1, TAUP2(I),
$ X21(I+1,I+1), LDX21, WORK(ILARF) )
X21(I1,I) = ONE
CALL DLARF( 'L', M-P-I, Q-I, X21(I1,I), 1, TAUP2(I),
$ X21(I1,I2), LDX21, WORK(ILARF) )
END IF
X11(I,I) = ONE
CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1),
CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I2),
$ LDX11, WORK(ILARF) )
*
END DO
*
* Reduce the bottom-right portion of X11 to the identity matrix
*
DO I = M-P + 1, Q
CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
CALL DLARFGP( P-I+1, X11(I,I), X11( MIN(I+1,P) ,I), 1,
$ TAUP1(I) )
X11(I,I) = ONE
CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1),
$ LDX11, WORK(ILARF) )
CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I),
$ X11(I, MIN(I+1,Q) ), LDX11, WORK(ILARF) )
END DO
*
RETURN
Expand Down
37 changes: 21 additions & 16 deletions SRC/sorbdb2.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -221,7 +221,7 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
* .. Local Scalars ..
REAL C, S
INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
$ LWORKMIN, LWORKOPT
$ LWORKMIN, LWORKOPT, I1, I2
LOGICAL LQUERY
* ..
* .. External Subroutines ..
Expand Down Expand Up @@ -277,48 +277,53 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
* Reduce rows 1, ..., P of X11 and X21
*
DO I = 1, P
I1 = MIN(I+1,P)
I2 = MIN(I+1,Q)
*
IF( I .GT. 1 ) THEN
CALL SROT( Q-I+1, X11(I,I), LDX11, X21(I-1,I), LDX21, C, S )
END IF
CALL SLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) )
CALL SLARFGP( Q-I+1, X11(I,I), X11(I,I2), LDX11, TAUQ1(I) )
C = X11(I,I)
X11(I,I) = ONE
CALL SLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
$ X11(I+1,I), LDX11, WORK(ILARF) )
$ X11(I1,I), LDX11, WORK(ILARF) )
CALL SLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
$ X21(I,I), LDX21, WORK(ILARF) )
S = SQRT( SNRM2( P-I, X11(I+1,I), 1 )**2
S = SQRT( SNRM2( P-I, X11(I1,I), 1 )**2
$ + SNRM2( M-P-I+1, X21(I,I), 1 )**2 )
THETA(I) = ATAN2( S, C )
*
CALL SORBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1,
$ X11(I+1,I+1), LDX11, X21(I,I+1), LDX21,
CALL SORBDB5( P-I, M-P-I+1, Q-I, X11(I1,I), 1, X21(I,I), 1,
$ X11(I1,I2), LDX11, X21(I,I2), LDX21,
$ WORK(IORBDB5), LORBDB5, CHILDINFO )
CALL SSCAL( P-I, NEGONE, X11(I+1,I), 1 )
CALL SLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
CALL SSCAL( P-I, NEGONE, X11(I1,I), 1 )
CALL SLARFGP( M-P-I+1, X21(I,I), X21( MIN(I+1,M-P) ,I), 1,
$ TAUP2(I) )
IF( I .LT. P ) THEN
CALL SLARFGP( P-I, X11(I+1,I), X11(I+2,I), 1, TAUP1(I) )
PHI(I) = ATAN2( X11(I+1,I), X21(I,I) )
CALL SLARFGP( P-I, X11(I1,I), X11( MIN(I+2,P) ,I), 1,
$ TAUP1(I) )
PHI(I) = ATAN2( X11(I1,I), X21(I,I) )
C = COS( PHI(I) )
S = SIN( PHI(I) )
X11(I+1,I) = ONE
CALL SLARF( 'L', P-I, Q-I, X11(I+1,I), 1, TAUP1(I),
$ X11(I+1,I+1), LDX11, WORK(ILARF) )
X11(I1,I) = ONE
CALL SLARF( 'L', P-I, Q-I, X11(I1,I), 1, TAUP1(I),
$ X11(I1,I2), LDX11, WORK(ILARF) )
END IF
X21(I,I) = ONE
CALL SLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
$ X21(I,I+1), LDX21, WORK(ILARF) )
$ X21(I,I2), LDX21, WORK(ILARF) )
*
END DO
*
* Reduce the bottom-right portion of X21 to the identity matrix
*
DO I = P + 1, Q
CALL SLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
CALL SLARFGP( M-P-I+1, X21(I,I), X21( MIN(I+1,M-P) ,I), 1,
$ TAUP2(I) )
X21(I,I) = ONE
CALL SLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
$ X21(I,I+1), LDX21, WORK(ILARF) )
$ X21(I, MIN(I+1,Q) ), LDX21, WORK(ILARF) )
END DO
*
RETURN
Expand Down
37 changes: 21 additions & 16 deletions SRC/sorbdb3.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -222,7 +222,7 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
* .. Local Scalars ..
REAL C, S
INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
$ LWORKMIN, LWORKOPT
$ LWORKMIN, LWORKOPT, I1, I2
LOGICAL LQUERY
* ..
* .. External Subroutines ..
Expand Down Expand Up @@ -278,48 +278,53 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
* Reduce rows 1, ..., M-P of X11 and X21
*
DO I = 1, M-P
I1 = MIN(I+1,M-P)
I2 = MIN(I+1,Q)
*
IF( I .GT. 1 ) THEN
CALL SROT( Q-I+1, X11(I-1,I), LDX11, X21(I,I), LDX11, C, S )
END IF
*
CALL SLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) )
CALL SLARFGP( Q-I+1, X21(I,I), X21(I,I2), LDX21, TAUQ1(I) )
S = X21(I,I)
X21(I,I) = ONE
CALL SLARF( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I),
$ X11(I,I), LDX11, WORK(ILARF) )
CALL SLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I),
$ X21(I+1,I), LDX21, WORK(ILARF) )
$ X21(I1,I), LDX21, WORK(ILARF) )
C = SQRT( SNRM2( P-I+1, X11(I,I), 1 )**2
$ + SNRM2( M-P-I, X21(I+1,I), 1 )**2 )
$ + SNRM2( M-P-I, X21(I1,I), 1 )**2 )
THETA(I) = ATAN2( S, C )
*
CALL SORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1,
$ X11(I,I+1), LDX11, X21(I+1,I+1), LDX21,
CALL SORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I1,I), 1,
$ X11(I,I2), LDX11, X21(I1,I2), LDX21,
$ WORK(IORBDB5), LORBDB5, CHILDINFO )
CALL SLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
CALL SLARFGP( P-I+1, X11(I,I), X11( MIN(I+1,P) ,I), 1,
$ TAUP1(I) )
IF( I .LT. M-P ) THEN
CALL SLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, TAUP2(I) )
PHI(I) = ATAN2( X21(I+1,I), X11(I,I) )
CALL SLARFGP( M-P-I, X21(I1,I), X21( MIN(I+2,M-P) ,I), 1,
$ TAUP2(I) )
PHI(I) = ATAN2( X21(I1,I), X11(I,I) )
C = COS( PHI(I) )
S = SIN( PHI(I) )
X21(I+1,I) = ONE
CALL SLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1, TAUP2(I),
$ X21(I+1,I+1), LDX21, WORK(ILARF) )
X21(I1,I) = ONE
CALL SLARF( 'L', M-P-I, Q-I, X21(I1,I), 1, TAUP2(I),
$ X21(I1,I2), LDX21, WORK(ILARF) )
END IF
X11(I,I) = ONE
CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1),
CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I2),
$ LDX11, WORK(ILARF) )
*
END DO
*
* Reduce the bottom-right portion of X11 to the identity matrix
*
DO I = M-P + 1, Q
CALL SLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
CALL SLARFGP( P-I+1, X11(I,I), X11( MIN(I+1,P) ,I), 1,
$ TAUP1(I) )
X11(I,I) = ONE
CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1),
$ LDX11, WORK(ILARF) )
CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I),
$ X11(I, MIN(I+1,Q) ), LDX11, WORK(ILARF) )
END DO
*
RETURN
Expand Down

0 comments on commit 9cd55e4

Please sign in to comment.