Skip to content

Commit bc2b374

Browse files
xORBDB6/xUNBDB6: do not require unit-norm vector
Do not assume that the vector x passed to these subroutines has Euclidean norm one (the norm is almost surely smaller than one when xORBDB5/xUNBDB5 calls this subroutine for the first time). This commit fixes the occasional inaccurate results computed by xORCSD2BY1/xUNCSD2BY1.
1 parent 8ecaaf9 commit bc2b374

File tree

4 files changed

+40
-36
lines changed

4 files changed

+40
-36
lines changed

SRC/cunbdb6.f

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -41,9 +41,8 @@
4141
*> with respect to the columns of
4242
*> Q = [ Q1 ] .
4343
*> [ Q2 ]
44-
*> The Euclidean norm of X must be one and the columns of Q must be
45-
*> orthonormal. The orthogonalized vector will be zero if and only if it
46-
*> lies entirely in the range of Q.
44+
*> The columns of Q must be orthonormal. The orthogonalized vector will
45+
*> be zero if and only if it lies entirely in the range of Q.
4746
*>
4847
*> The projection is computed with at most two iterations of the
4948
*> classical Gram-Schmidt algorithm, see
@@ -223,14 +222,16 @@ SUBROUTINE CUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
223222
*
224223
EPS = SLAMCH( 'Precision' )
225224
*
225+
* Compute the Euclidean norm of X
226+
*
227+
SCL = REALZERO
228+
SSQ = REALZERO
229+
CALL CLASSQ( M1, X1, INCX1, SCL, SSQ )
230+
CALL CLASSQ( M2, X2, INCX2, SCL, SSQ )
231+
NORM = SCL * SQRT( SSQ )
232+
*
226233
* First, project X onto the orthogonal complement of Q's column
227234
* space
228-
*
229-
* Christoph Conrads: In debugging mode the norm should be computed
230-
* and an assertion added comparing the norm with one. Alas, Fortran
231-
* never made it into 1989 when assert() was introduced into the C
232-
* programming language.
233-
NORM = REALONE
234235
*
235236
IF( M1 .EQ. 0 ) THEN
236237
DO I = 1, N

SRC/dorbdb6.f

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -41,9 +41,8 @@
4141
*> with respect to the columns of
4242
*> Q = [ Q1 ] .
4343
*> [ Q2 ]
44-
*> The Euclidean norm of X must be one and the columns of Q must be
45-
*> orthonormal. The orthogonalized vector will be zero if and only if it
46-
*> lies entirely in the range of Q.
44+
*> The columns of Q must be orthonormal. The orthogonalized vector will
45+
*> be zero if and only if it lies entirely in the range of Q.
4746
*>
4847
*> The projection is computed with at most two iterations of the
4948
*> classical Gram-Schmidt algorithm, see
@@ -222,14 +221,16 @@ SUBROUTINE DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
222221
*
223222
EPS = DLAMCH( 'Precision' )
224223
*
224+
* Compute the Euclidean norm of X
225+
*
226+
SCL = REALZERO
227+
SSQ = REALZERO
228+
CALL DLASSQ( M1, X1, INCX1, SCL, SSQ )
229+
CALL DLASSQ( M2, X2, INCX2, SCL, SSQ )
230+
NORM = SCL * SQRT( SSQ )
231+
*
225232
* First, project X onto the orthogonal complement of Q's column
226233
* space
227-
*
228-
* Christoph Conrads: In debugging mode the norm should be computed
229-
* and an assertion added comparing the norm with one. Alas, Fortran
230-
* never made it into 1989 when assert() was introduced into the C
231-
* programming language.
232-
NORM = REALONE
233234
*
234235
IF( M1 .EQ. 0 ) THEN
235236
DO I = 1, N

SRC/sorbdb6.f

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -41,9 +41,8 @@
4141
*> with respect to the columns of
4242
*> Q = [ Q1 ] .
4343
*> [ Q2 ]
44-
*> The Euclidean norm of X must be one and the columns of Q must be
45-
*> orthonormal. The orthogonalized vector will be zero if and only if it
46-
*> lies entirely in the range of Q.
44+
*> The columns of Q must be orthonormal. The orthogonalized vector will
45+
*> be zero if and only if it lies entirely in the range of Q.
4746
*>
4847
*> The projection is computed with at most two iterations of the
4948
*> classical Gram-Schmidt algorithm, see
@@ -222,14 +221,16 @@ SUBROUTINE SORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
222221
*
223222
EPS = SLAMCH( 'Precision' )
224223
*
224+
* Compute the Euclidean norm of X
225+
*
226+
SCL = REALZERO
227+
SSQ = REALZERO
228+
CALL SLASSQ( M1, X1, INCX1, SCL, SSQ )
229+
CALL SLASSQ( M2, X2, INCX2, SCL, SSQ )
230+
NORM = SCL * SQRT( SSQ )
231+
*
225232
* First, project X onto the orthogonal complement of Q's column
226233
* space
227-
*
228-
* Christoph Conrads: In debugging mode the norm should be computed
229-
* and an assertion added comparing the norm with one. Alas, Fortran
230-
* never made it into 1989 when assert() was introduced into the C
231-
* programming language.
232-
NORM = REALONE
233234
*
234235
IF( M1 .EQ. 0 ) THEN
235236
DO I = 1, N

SRC/zunbdb6.f

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -41,9 +41,8 @@
4141
*> with respect to the columns of
4242
*> Q = [ Q1 ] .
4343
*> [ Q2 ]
44-
*> The Euclidean norm of X must be one and the columns of Q must be
45-
*> orthonormal. The orthogonalized vector will be zero if and only if it
46-
*> lies entirely in the range of Q.
44+
*> The columns of Q must be orthonormal. The orthogonalized vector will
45+
*> be zero if and only if it lies entirely in the range of Q.
4746
*>
4847
*> The projection is computed with at most two iterations of the
4948
*> classical Gram-Schmidt algorithm, see
@@ -223,14 +222,16 @@ SUBROUTINE ZUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
223222
*
224223
EPS = DLAMCH( 'Precision' )
225224
*
225+
* Compute the Euclidean norm of X
226+
*
227+
SCL = REALZERO
228+
SSQ = REALZERO
229+
CALL ZLASSQ( M1, X1, INCX1, SCL, SSQ )
230+
CALL ZLASSQ( M2, X2, INCX2, SCL, SSQ )
231+
NORM = SCL * SQRT( SSQ )
232+
*
226233
* First, project X onto the orthogonal complement of Q's column
227234
* space
228-
*
229-
* Christoph Conrads: In debugging mode the norm should be computed
230-
* and an assertion added comparing the norm with one. Alas, Fortran
231-
* never made it into 1989 when assert() was introduced into the C
232-
* programming language.
233-
NORM = REALONE
234235
*
235236
IF( M1 .EQ. 0 ) THEN
236237
DO I = 1, N

0 commit comments

Comments
 (0)