SRC/cunbdb5.f

   1 *> \brief \b CUNBDB5
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download CUNBDB5 + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cunbdb5.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cunbdb5.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cunbdb5.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE CUNBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
  22 *                           LDQ2, WORK, LWORK, INFO )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       INTEGER            INCX1, INCX2, INFO, LDQ1, LDQ2, LWORK, M1, M2,
  26 *      $                   N
  27 *       ..
  28 *       .. Array Arguments ..
  29 *       COMPLEX            Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
  30 *       ..
  31 *
  32 *
  33 *> \par Purpose:
  34 *> =============
  35 *>
  36 *>\verbatim
  37 *>
  38 *> CUNBDB5 orthogonalizes the column vector
  39 *>      X = [ X1 ]
  40 *>          [ X2 ]
  41 *> with respect to the columns of
  42 *>      Q = [ Q1 ] .
  43 *>          [ Q2 ]
  44 *> The columns of Q must be orthonormal.
  45 *>
  46 *> If the projection is zero according to Kahan's "twice is enough"
  47 *> criterion, then some other vector from the orthogonal complement
  48 *> is returned. This vector is chosen in an arbitrary but deterministic
  49 *> way.
  50 *>
  51 *>\endverbatim
  52 *
  53 *  Arguments:
  54 *  ==========
  55 *
  56 *> \param[in] M1
  57 *> \verbatim
  58 *>          M1 is INTEGER
  59 *>           The dimension of X1 and the number of rows in Q1. 0 <= M1.
  60 *> \endverbatim
  61 *>
  62 *> \param[in] M2
  63 *> \verbatim
  64 *>          M2 is INTEGER
  65 *>           The dimension of X2 and the number of rows in Q2. 0 <= M2.
  66 *> \endverbatim
  67 *>
  68 *> \param[in] N
  69 *> \verbatim
  70 *>          N is INTEGER
  71 *>           The number of columns in Q1 and Q2. 0 <= N.
  72 *> \endverbatim
  73 *>
  74 *> \param[in,out] X1
  75 *> \verbatim
  76 *>          X1 is COMPLEX array, dimension (M1)
  77 *>           On entry, the top part of the vector to be orthogonalized.
  78 *>           On exit, the top part of the projected vector.
  79 *> \endverbatim
  80 *>
  81 *> \param[in] INCX1
  82 *> \verbatim
  83 *>          INCX1 is INTEGER
  84 *>           Increment for entries of X1.
  85 *> \endverbatim
  86 *>
  87 *> \param[in,out] X2
  88 *> \verbatim
  89 *>          X2 is COMPLEX array, dimension (M2)
  90 *>           On entry, the bottom part of the vector to be
  91 *>           orthogonalized. On exit, the bottom part of the projected
  92 *>           vector.
  93 *> \endverbatim
  94 *>
  95 *> \param[in] INCX2
  96 *> \verbatim
  97 *>          INCX2 is INTEGER
  98 *>           Increment for entries of X2.
  99 *> \endverbatim
 100 *>
 101 *> \param[in] Q1
 102 *> \verbatim
 103 *>          Q1 is COMPLEX array, dimension (LDQ1, N)
 104 *>           The top part of the orthonormal basis matrix.
 105 *> \endverbatim
 106 *>
 107 *> \param[in] LDQ1
 108 *> \verbatim
 109 *>          LDQ1 is INTEGER
 110 *>           The leading dimension of Q1. LDQ1 >= M1.
 111 *> \endverbatim
 112 *>
 113 *> \param[in] Q2
 114 *> \verbatim
 115 *>          Q2 is COMPLEX array, dimension (LDQ2, N)
 116 *>           The bottom part of the orthonormal basis matrix.
 117 *> \endverbatim
 118 *>
 119 *> \param[in] LDQ2
 120 *> \verbatim
 121 *>          LDQ2 is INTEGER
 122 *>           The leading dimension of Q2. LDQ2 >= M2.
 123 *> \endverbatim
 124 *>
 125 *> \param[out] WORK
 126 *> \verbatim
 127 *>          WORK is COMPLEX array, dimension (LWORK)
 128 *> \endverbatim
 129 *>
 130 *> \param[in] LWORK
 131 *> \verbatim
 132 *>          LWORK is INTEGER
 133 *>           The dimension of the array WORK. LWORK >= N.
 134 *> \endverbatim
 135 *>
 136 *> \param[out] INFO
 137 *> \verbatim
 138 *>          INFO is INTEGER
 139 *>           = 0:  successful exit.
 140 *>           < 0:  if INFO = -i, the i-th argument had an illegal value.
 141 *> \endverbatim
 142 *
 143 *  Authors:
 144 *  ========
 145 *
 146 *> \author Univ. of Tennessee
 147 *> \author Univ. of California Berkeley
 148 *> \author Univ. of Colorado Denver
 149 *> \author NAG Ltd.
 150 *
 151 *> \date July 2012
 152 *
 153 *> \ingroup complexOTHERcomputational
 154 *
 155 *  =====================================================================
 156       SUBROUTINE CUNBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
 157      $                    LDQ2, WORK, LWORK, INFO )
 158 *
 159 *  -- LAPACK computational routine (version 3.5.0) --
 160 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 161 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 162 *     July 2012
 163 *
 164 *     .. Scalar Arguments ..
 165       INTEGER            INCX1, INCX2, INFO, LDQ1, LDQ2, LWORK, M1, M2,
 166      $                   N
 167 *     ..
 168 *     .. Array Arguments ..
 169       COMPLEX            Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
 170 *     ..
 171 *
 172 *  =====================================================================
 173 *
 174 *     .. Parameters ..
 175       COMPLEX            ONE, ZERO
 176       PARAMETER          ( ONE = (1.0E0,0.0E0), ZERO = (0.0E0,0.0E0) )
 177 *     ..
 178 *     .. Local Scalars ..
 179       INTEGER            CHILDINFO, I, J
 180 *     ..
 181 *     .. External Subroutines ..
 182       EXTERNAL           CUNBDB6, XERBLA
 183 *     ..
 184 *     .. External Functions ..
 185       REAL               SCNRM2
 186       EXTERNAL           SCNRM2
 187 *     ..
 188 *     .. Intrinsic Function ..
 189       INTRINSIC          MAX
 190 *     ..
 191 *     .. Executable Statements ..
 192 *
 193 *     Test input arguments
 194 *
 195       INFO = 0
 196       IF( M1 .LT. 0 ) THEN
 197          INFO = -1
 198       ELSE IF( M2 .LT. 0 ) THEN
 199          INFO = -2
 200       ELSE IF( N .LT. 0 ) THEN
 201          INFO = -3
 202       ELSE IF( INCX1 .LT. 1 ) THEN
 203          INFO = -5
 204       ELSE IF( INCX2 .LT. 1 ) THEN
 205          INFO = -7
 206       ELSE IF( LDQ1 .LT. MAX( 1, M1 ) ) THEN
 207          INFO = -9
 208       ELSE IF( LDQ2 .LT. MAX( 1, M2 ) ) THEN
 209          INFO = -11
 210       ELSE IF( LWORK .LT. N ) THEN
 211          INFO = -13
 212       END IF
 213 *
 214       IF( INFO .NE. 0 ) THEN
 215          CALL XERBLA( 'CUNBDB5', -INFO )
 216          RETURN
 217       END IF
 218 *
 219 *     Project X onto the orthogonal complement of Q
 220 *
 221       CALL CUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2,
 222      $              WORK, LWORK, CHILDINFO )
 223 *
 224 *     If the projection is nonzero, then return
 225 *
 226       IF( SCNRM2(M1,X1,INCX1) .NE. ZERO
 227      $    .OR. SCNRM2(M2,X2,INCX2) .NE. ZERO ) THEN
 228          RETURN
 229       END IF
 230 *
 231 *     Project each standard basis vector e_1,...,e_M1 in turn, stopping
 232 *     when a nonzero projection is found
 233 *
 234       DO I = 1, M1
 235          DO J = 1, M1
 236             X1(J) = ZERO
 237          END DO
 238          X1(I) = ONE
 239          DO J = 1, M2
 240             X2(J) = ZERO
 241          END DO
 242          CALL CUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
 243      $                 LDQ2, WORK, LWORK, CHILDINFO )
 244          IF( SCNRM2(M1,X1,INCX1) .NE. ZERO
 245      $       .OR. SCNRM2(M2,X2,INCX2) .NE. ZERO ) THEN
 246             RETURN
 247          END IF
 248       END DO
 249 *
 250 *     Project each standard basis vector e_(M1+1),...,e_(M1+M2) in turn,
 251 *     stopping when a nonzero projection is found
 252 *
 253       DO I = 1, M2
 254          DO J = 1, M1
 255             X1(J) = ZERO
 256          END DO
 257          DO J = 1, M2
 258             X2(J) = ZERO
 259          END DO
 260          X2(I) = ONE
 261          CALL CUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
 262      $                 LDQ2, WORK, LWORK, CHILDINFO )
 263          IF( SCNRM2(M1,X1,INCX1) .NE. ZERO
 264      $       .OR. SCNRM2(M2,X2,INCX2) .NE. ZERO ) THEN
 265             RETURN
 266          END IF
 267       END DO
 268 *
 269       RETURN
 270 *
 271 *     End of CUNBDB5
 272 *
 273       END
 274