cunbdb5()

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

CUNBDB5

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

Purpose:

!>
!> CUNBDB5 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 
!> 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 COMPLEX 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 COMPLEX 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 COMPLEX 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 COMPLEX 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 COMPLEX 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 152 of file cunbdb5.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 ..
      COMPLEX            Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               REALZERO
      parameter( realzero = 0.0e0 )
      COMPLEX            ONE, ZERO
      parameter( one = (1.0e0,0.0e0), zero = (0.0e0,0.0e0) )
*     ..
*     .. Local Scalars ..
      INTEGER            CHILDINFO, I, J
      REAL               EPS, NORM, SCL, SSQ
*     ..
*     .. External Subroutines ..
      EXTERNAL           classq, cunbdb6, cscal, xerbla
*     ..
*     .. External Functions ..
      REAL               SLAMCH, SCNRM2
      EXTERNAL           slamch, scnrm2
*     ..
*     .. 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( 'CUNBDB5', -info )
         RETURN
      END IF
*
      eps = slamch( 'Precision' )
*
*     Project X onto the orthogonal complement of Q if X is nonzero
*
      scl = realzero
      ssq = realzero
      CALL classq( m1, x1, incx1, scl, ssq )
      CALL classq( m2, x2, incx2, scl, ssq )
      norm = scl * sqrt( ssq )
*
      IF( norm .GT. real( 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 cscal( m1, one / norm, x1, incx1 )
         CALL cscal( m2, one / norm, x2, incx2 )
         CALL cunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
     $              ldq2, work, lwork, childinfo )
*
*        If the projection is nonzero, then return
*
         IF( scnrm2(m1,x1,incx1) .NE. realzero
     $       .OR. scnrm2(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 cunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
     $                 ldq2, work, lwork, childinfo )
         IF( scnrm2(m1,x1,incx1) .NE. realzero
     $       .OR. scnrm2(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 cunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
     $                 ldq2, work, lwork, childinfo )
         IF( scnrm2(m1,x1,incx1) .NE. realzero
     $       .OR. scnrm2(m2,x2,incx2) .NE. realzero ) THEN
            RETURN
         END IF
      END DO
*
      RETURN
*
*     End of CUNBDB5
*

Here is the call graph for this function:

Here is the caller graph for this function: