Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix out-of-bounds in xORBDB2 and xORBDB3 #551

Closed
wants to merge 3 commits into from
Closed

Fix out-of-bounds in xORBDB2 and xORBDB3 #551

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
9cd55e4
Fix out-of-bounds references in xORBDB(2,3)
weslleyspereira May 14, 2021
dde5927
Fix out-of-bounds references in xORBDB(1,2,3) and xUNBDB(1,2,3)
weslleyspereira May 14, 2021
5a5d229
Adds comments to explain the modifications. Avoid using I3 and I4 in …
weslleyspereira May 21, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 19 additions & 8 deletions SRC/cunbdb1.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -222,7 +222,7 @@ SUBROUTINE CUNBDB1( 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 @@ -280,23 +280,34 @@ SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
*
DO I = 1, Q
*
CALL CLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
CALL CLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
* The two lines of code below are meant to avoid an out-of-bound run-time error
* when we call subroutines like
* CLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1), LDX11, WORK(ILARF) )
* with I = Q, or
* CLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, TAUQ1(I) )
* with I = Q-1. The invalid arrays have size 0, so they are never referenced in the subroutines.
*
I1 = MIN(I+1,Q)
I2 = MIN(I+2,Q)
*
CALL CLARFGP( P-I+1, X11(I,I), X11(MIN(I+1,P),I), 1, TAUP1(I) )
CALL CLARFGP( M-P-I+1, X21(I,I), X21(MIN(I+1,M-P),I), 1,
$ TAUP2(I) )
THETA(I) = ATAN2( REAL( X21(I,I) ), REAL( X11(I,I) ) )
C = COS( THETA(I) )
S = SIN( THETA(I) )
X11(I,I) = ONE
X21(I,I) = ONE
CALL CLARF( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)),
$ X11(I,I+1), LDX11, WORK(ILARF) )
$ X11(I,I1), LDX11, WORK(ILARF) )
CALL CLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, CONJG(TAUP2(I)),
$ X21(I,I+1), LDX21, WORK(ILARF) )
$ X21(I,I1), LDX21, WORK(ILARF) )
*
IF( I .LT. Q ) THEN
CALL CSROT( Q-I, X11(I,I+1), LDX11, X21(I,I+1), LDX21, C,
$ S )
CALL CLACGV( Q-I, X21(I,I+1), LDX21 )
CALL CLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, TAUQ1(I) )
CALL CLARFGP( Q-I, X21(I,I+1), X21(I,I2), LDX21, TAUQ1(I) )
S = REAL( X21(I,I+1) )
X21(I,I+1) = ONE
CALL CLARF( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I),
Expand All @@ -308,8 +319,8 @@ SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ + SCNRM2( M-P-I, X21(I+1,I+1), 1 )**2 )
PHI(I) = ATAN2( S, C )
CALL CUNBDB5( P-I, M-P-I, Q-I-1, X11(I+1,I+1), 1,
$ X21(I+1,I+1), 1, X11(I+1,I+2), LDX11,
$ X21(I+1,I+2), LDX21, WORK(IORBDB5), LORBDB5,
$ X21(I+1,I+1), 1, X11(I+1,I2), LDX11,
$ X21(I+1,I2), LDX21, WORK(IORBDB5), LORBDB5,
$ CHILDINFO )
END IF
*
Expand Down
45 changes: 29 additions & 16 deletions SRC/cunbdb2.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -223,7 +223,7 @@ SUBROUTINE CUNBDB2( 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 @@ -280,51 +280,64 @@ SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
* Reduce rows 1, ..., P of X11 and X21
*
DO I = 1, P
*
* The two lines of code below are meant to avoid an out-of-bound run-time error
* when we call subroutines like
* CLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), X11(I+1,I), LDX11, WORK(ILARF) )
* with I = P, or
* CLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) )
* with I = Q. The invalid arrays have size 0, so they are never referenced in the subroutines.
*
I1 = MIN(I+1,P)
I2 = MIN(I+1,Q)
*
IF( I .GT. 1 ) THEN
CALL CSROT( Q-I+1, X11(I,I), LDX11, X21(I-1,I), LDX21, C,
$ S )
END IF
CALL CLACGV( Q-I+1, X11(I,I), LDX11 )
CALL CLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) )
CALL CLARFGP( Q-I+1, X11(I,I), X11(I,I2), LDX11, TAUQ1(I) )
C = REAL( X11(I,I) )
X11(I,I) = ONE
CALL CLARF( '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 CLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I),
$ X21(I,I), LDX21, WORK(ILARF) )
CALL CLACGV( Q-I+1, X11(I,I), LDX11 )
S = SQRT( SCNRM2( P-I, X11(I+1,I), 1 )**2
S = SQRT( SCNRM2( P-I, X11(I1,I), 1 )**2
$ + SCNRM2( M-P-I+1, X21(I,I), 1 )**2 )
THETA(I) = ATAN2( S, C )
*
CALL CUNBDB5( 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 CUNBDB5( 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 CSCAL( P-I, NEGONE, X11(I+1,I), 1 )
CALL CLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
CALL CSCAL( P-I, NEGONE, X11(I1,I), 1 )
CALL CLARFGP( M-P-I+1, X21(I,I), X21( MIN(I+1,M-P) ,I), 1,
$ TAUP2(I) )
IF( I .LT. P ) THEN
CALL CLARFGP( P-I, X11(I+1,I), X11(I+2,I), 1, TAUP1(I) )
PHI(I) = ATAN2( REAL( X11(I+1,I) ), REAL( X21(I,I) ) )
CALL CLARFGP( P-I, X11(I1,I), X11( MIN(I+2,P) ,I), 1,
$ TAUP1(I) )
PHI(I) = ATAN2( REAL( X11(I1,I) ), REAL( X21(I,I) ) )
C = COS( PHI(I) )
S = SIN( PHI(I) )
X11(I+1,I) = ONE
CALL CLARF( 'L', P-I, Q-I, X11(I+1,I), 1, CONJG(TAUP1(I)),
$ X11(I+1,I+1), LDX11, WORK(ILARF) )
X11(I1,I) = ONE
CALL CLARF( 'L', P-I, Q-I, X11(I1,I), 1, CONJG(TAUP1(I)),
$ X11(I1,I2), LDX11, WORK(ILARF) )
END IF
X21(I,I) = ONE
CALL CLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, CONJG(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 CLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
CALL CLARFGP( M-P-I+1, X21(I,I), X21( MIN(I+1,M-P) ,I), 1,
$ TAUP2(I) )
X21(I,I) = ONE
CALL CLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, CONJG(TAUP2(I)),
$ X21(I,I+1), LDX21, WORK(ILARF) )
$ X21(I, MIN(I+1,Q) ), LDX21, WORK(ILARF) )
END DO
*
RETURN
Expand Down
43 changes: 28 additions & 15 deletions SRC/cunbdb3.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -222,7 +222,7 @@ SUBROUTINE CUNBDB3( 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,51 +278,64 @@ SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
* Reduce rows 1, ..., M-P of X11 and X21
*
DO I = 1, M-P
*
* The two lines of code below are meant to avoid an out-of-bound run-time error
* when we call subroutines like
* CLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), X21(I+1,I), LDX21, WORK(ILARF) )
* with I = M-P, or
* CLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) )
* with I = Q. The invalid arrays have size 0, so they are never referenced in the subroutines.
*
I1 = MIN(I+1,M-P)
I2 = MIN(I+1,Q)
*
IF( I .GT. 1 ) THEN
CALL CSROT( Q-I+1, X11(I-1,I), LDX11, X21(I,I), LDX11, C,
$ S )
END IF
*
CALL CLACGV( Q-I+1, X21(I,I), LDX21 )
CALL CLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) )
CALL CLARFGP( Q-I+1, X21(I,I), X21(I,I2), LDX21, TAUQ1(I) )
S = REAL( X21(I,I) )
X21(I,I) = ONE
CALL CLARF( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I),
$ X11(I,I), LDX11, WORK(ILARF) )
CALL CLARF( '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) )
CALL CLACGV( Q-I+1, X21(I,I), LDX21 )
C = SQRT( SCNRM2( P-I+1, X11(I,I), 1 )**2
$ + SCNRM2( M-P-I, X21(I+1,I), 1 )**2 )
$ + SCNRM2( M-P-I, X21(I1,I), 1 )**2 )
THETA(I) = ATAN2( S, C )
*
CALL CUNBDB5( 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 CUNBDB5( 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 CLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
CALL CLARFGP( P-I+1, X11(I,I), X11( MIN(I+1,P) ,I), 1,
$ TAUP1(I) )
IF( I .LT. M-P ) THEN
CALL CLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, TAUP2(I) )
PHI(I) = ATAN2( REAL( X21(I+1,I) ), REAL( X11(I,I) ) )
CALL CLARFGP( M-P-I, X21(I1,I), X21( MIN(I+2,M-P) ,I), 1,
$ TAUP2(I) )
PHI(I) = ATAN2( REAL( X21(I1,I) ), REAL( X11(I,I) ) )
C = COS( PHI(I) )
S = SIN( PHI(I) )
X21(I+1,I) = ONE
CALL CLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1, CONJG(TAUP2(I)),
$ X21(I+1,I+1), LDX21, WORK(ILARF) )
X21(I1,I) = ONE
CALL CLARF( 'L', M-P-I, Q-I, X21(I1,I), 1, CONJG(TAUP2(I)),
$ X21(I1,I2), LDX21, WORK(ILARF) )
END IF
X11(I,I) = ONE
CALL CLARF( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)),
$ X11(I,I+1), LDX11, WORK(ILARF) )
$ 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 CLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
CALL CLARFGP( P-I+1, X11(I,I), X11( MIN(I+1,P) ,I), 1,
$ TAUP1(I) )
X11(I,I) = ONE
CALL CLARF( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)),
$ X11(I,I+1), LDX11, WORK(ILARF) )
$ X11(I, MIN(I+1,Q) ), LDX11, WORK(ILARF) )
END DO
*
RETURN
Expand Down
27 changes: 19 additions & 8 deletions SRC/dorbdb1.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -223,7 +223,7 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
* .. Local Scalars ..
DOUBLE PRECISION C, S
INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
$ LWORKMIN, LWORKOPT
$ LWORKMIN, LWORKOPT, I1, I2
LOGICAL LQUERY
* ..
* .. External Subroutines ..
Expand Down Expand Up @@ -280,21 +280,32 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
*
DO I = 1, Q
*
CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
CALL DLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )
* The two lines of code below are meant to avoid an out-of-bound run-time error
* when we call subroutines like
* DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1), LDX11, WORK(ILARF) )
* with I = Q, or
* DLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, TAUQ1(I) )
* with I = Q-1. The invalid arrays have size 0, so they are never referenced in the subroutines.
*
I1 = MIN(I+1,Q)
I2 = MIN(I+2,Q)
*
CALL DLARFGP( P-I+1, X11(I,I), X11(MIN(I+1,P),I), 1, TAUP1(I) )
CALL DLARFGP( M-P-I+1, X21(I,I), X21(MIN(I+1,M-P),I), 1,
$ TAUP2(I) )
THETA(I) = ATAN2( X21(I,I), X11(I,I) )
C = COS( THETA(I) )
S = SIN( THETA(I) )
X11(I,I) = ONE
X21(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,I1),
$ LDX11, WORK(ILARF) )
CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
$ X21(I,I+1), LDX21, WORK(ILARF) )
$ X21(I,I1), LDX21, WORK(ILARF) )
*
IF( I .LT. Q ) THEN
CALL DROT( Q-I, X11(I,I+1), LDX11, X21(I,I+1), LDX21, C, S )
CALL DLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, TAUQ1(I) )
CALL DLARFGP( Q-I, X21(I,I+1), X21(I,I2), LDX21, TAUQ1(I) )
S = X21(I,I+1)
X21(I,I+1) = ONE
CALL DLARF( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I),
Expand All @@ -305,8 +316,8 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ + DNRM2( M-P-I, X21(I+1,I+1), 1 )**2 )
PHI(I) = ATAN2( S, C )
CALL DORBDB5( P-I, M-P-I, Q-I-1, X11(I+1,I+1), 1,
$ X21(I+1,I+1), 1, X11(I+1,I+2), LDX11,
$ X21(I+1,I+2), LDX21, WORK(IORBDB5), LORBDB5,
$ X21(I+1,I+1), 1, X11(I+1,I2), LDX11,
$ X21(I+1,I2), LDX21, WORK(IORBDB5), LORBDB5,
$ CHILDINFO )
END IF
*
Expand Down
45 changes: 29 additions & 16 deletions SRC/dorbdb2.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -222,7 +222,7 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
* .. Local Scalars ..
DOUBLE PRECISION 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,61 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
* Reduce rows 1, ..., P of X11 and X21
*
DO I = 1, P
*
* The two lines of code below are meant to avoid an out-of-bound run-time error
* when we call subroutines like
* DLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), X11(I+1,I), LDX11, WORK(ILARF) )
* with I = P, or
* DLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) )
* with I = Q. The invalid arrays have size 0, so they are never referenced in the subroutines.
*
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
Loading