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.7.1) --
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
275