sorbdb5()

subroutine sorbdb5	(	integer	m1,
		integer	m2,
		integer	n,
		real, dimension(*)	x1,
		integer	incx1,
		real, dimension(*)	x2,
		integer	incx2,
		real, dimension(ldq1,*)	q1,
		integer	ldq1,
		real, dimension(ldq2,*)	q2,
		integer	ldq2,
		real, dimension(*)	work,
		integer	lwork,
		integer	info
	)

SORBDB5

Download SORBDB5 + dependencies [TGZ] [ZIP] [TXT]

Purpose:

 SORBDB5 orthogonalizes the column vector
      X = [ X1 ]
          [ X2 ]
 with respect to the columns of
      Q = [ Q1 ] .
          [ Q2 ]
 The columns of Q must be orthonormal.

 If the projection is zero according to Kahan's "twice is enough"
 criterion, then some other vector from the orthogonal complement
 is returned. This vector is chosen in an arbitrary but deterministic
 way.

Parameters

[in]	M1	M1 is INTEGER The dimension of X1 and the number of rows in Q1. 0 <= M1.
[in]	M2	M2 is INTEGER The dimension of X2 and the number of rows in Q2. 0 <= M2.
[in]	N	N is INTEGER The number of columns in Q1 and Q2. 0 <= N.
[in,out]	X1	X1 is REAL array, dimension (M1) On entry, the top part of the vector to be orthogonalized. On exit, the top part of the projected vector.
[in]	INCX1	INCX1 is INTEGER Increment for entries of X1.
[in,out]	X2	X2 is REAL array, dimension (M2) On entry, the bottom part of the vector to be orthogonalized. On exit, the bottom part of the projected vector.
[in]	INCX2	INCX2 is INTEGER Increment for entries of X2.
[in]	Q1	Q1 is REAL array, dimension (LDQ1, N) The top part of the orthonormal basis matrix.
[in]	LDQ1	LDQ1 is INTEGER The leading dimension of Q1. LDQ1 >= M1.
[in]	Q2	Q2 is REAL array, dimension (LDQ2, N) The bottom part of the orthonormal basis matrix.
[in]	LDQ2	LDQ2 is INTEGER The leading dimension of Q2. LDQ2 >= M2.
[out]	WORK	WORK is REAL array, dimension (LWORK)
[in]	LWORK	LWORK is INTEGER The dimension of the array WORK. LWORK >= N.
[out]	INFO	INFO is INTEGER = 0: successful exit. < 0: if INFO = -i, the i-th argument had an illegal value.

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 154 of file sorbdb5.f.

*
*  -- LAPACK computational routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      INTEGER            INCX1, INCX2, INFO, LDQ1, LDQ2, LWORK, M1, M2,
     $                   N
*     ..
*     .. Array Arguments ..
      REAL               Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               REALZERO
      parameter( realzero = 0.0e0 )
      REAL               ONE, ZERO
      parameter( one = 1.0e0, zero = 0.0e0 )
*     ..
*     .. Local Scalars ..
      INTEGER            CHILDINFO, I, J
      REAL               EPS, NORM, SCL, SSQ
*     ..
*     .. External Subroutines ..
      EXTERNAL           slassq, sorbdb6, sscal, xerbla
*     ..
*     .. External Functions ..
      REAL               SLAMCH, SNRM2
      EXTERNAL           slamch, snrm2
*     ..
*     .. Intrinsic Function ..
      INTRINSIC          max
*     ..
*     .. Executable Statements ..
*
*     Test input arguments
*
      info = 0
      IF( m1 .LT. 0 ) THEN
         info = -1
      ELSE IF( m2 .LT. 0 ) THEN
         info = -2
      ELSE IF( n .LT. 0 ) THEN
         info = -3
      ELSE IF( incx1 .LT. 1 ) THEN
         info = -5
      ELSE IF( incx2 .LT. 1 ) THEN
         info = -7
      ELSE IF( ldq1 .LT. max( 1, m1 ) ) THEN
         info = -9
      ELSE IF( ldq2 .LT. max( 1, m2 ) ) THEN
         info = -11
      ELSE IF( lwork .LT. n ) THEN
         info = -13
      END IF
*
      IF( info .NE. 0 ) THEN
         CALL xerbla( 'SORBDB5', -info )
         RETURN
      END IF
*
      eps = slamch( 'Precision' )
*
*     Project X onto the orthogonal complement of Q if X is nonzero
*
      scl = realzero
      ssq = realzero
      CALL slassq( m1, x1, incx1, scl, ssq )
      CALL slassq( m2, x2, incx2, scl, ssq )
      norm = scl * sqrt( ssq )
*
      IF( norm .GT. n * eps ) THEN
*        Scale vector to unit norm to avoid problems in the caller code.
*        Computing the reciprocal is undesirable but
*         * xLASCL cannot be used because of the vector increments and
*         * the round-off error has a negligible impact on
*           orthogonalization.
         CALL sscal( m1, one / norm, x1, incx1 )
         CALL sscal( m2, one / norm, x2, incx2 )
         CALL sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
     $              ldq2, work, lwork, childinfo )
*
*        If the projection is nonzero, then return
*
         IF( snrm2(m1,x1,incx1) .NE. realzero
     $       .OR. snrm2(m2,x2,incx2) .NE. realzero ) THEN
            RETURN
         END IF
      END IF
*
*     Project each standard basis vector e_1,...,e_M1 in turn, stopping
*     when a nonzero projection is found
*
      DO i = 1, m1
         DO j = 1, m1
            x1(j) = zero
         END DO
         x1(i) = one
         DO j = 1, m2
            x2(j) = zero
         END DO
         CALL sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
     $                 ldq2, work, lwork, childinfo )
         IF( snrm2(m1,x1,incx1) .NE. realzero
     $       .OR. snrm2(m2,x2,incx2) .NE. realzero ) THEN
            RETURN
         END IF
      END DO
*
*     Project each standard basis vector e_(M1+1),...,e_(M1+M2) in turn,
*     stopping when a nonzero projection is found
*
      DO i = 1, m2
         DO j = 1, m1
            x1(j) = zero
         END DO
         DO j = 1, m2
            x2(j) = zero
         END DO
         x2(i) = one
         CALL sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
     $                 ldq2, work, lwork, childinfo )
         IF( snrm2(m1,x1,incx1) .NE. realzero
     $       .OR. snrm2(m2,x2,incx2) .NE. realzero ) THEN
            RETURN
         END IF
      END DO
*
      RETURN
*
*     End of SORBDB5
*

Here is the call graph for this function:

Here is the caller graph for this function: