1*> \brief \b DORBDB5
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DORBDB5 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorbdb5.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorbdb5.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorbdb5.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE DORBDB5( 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*       DOUBLE PRECISION   Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
30*       ..
31*
32*
33*> \par Purpose:
34*  =============
35*>
36*>\verbatim
37*>
38*> DORBDB5 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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*> \ingroup doubleOTHERcomputational
152*
153*  =====================================================================
154      SUBROUTINE DORBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
155     $                    LDQ2, WORK, LWORK, INFO )
156*
157*  -- LAPACK computational routine --
158*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
159*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
160*
161*     .. Scalar Arguments ..
162      INTEGER            INCX1, INCX2, INFO, LDQ1, LDQ2, LWORK, M1, M2,
163     $                   N
164*     ..
165*     .. Array Arguments ..
166      DOUBLE PRECISION   Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
167*     ..
168*
169*  =====================================================================
170*
171*     .. Parameters ..
172      DOUBLE PRECISION   ONE, ZERO
173      PARAMETER          ( ONE = 1.0D0, ZERO = 0.0D0 )
174*     ..
175*     .. Local Scalars ..
176      INTEGER            CHILDINFO, I, J
177*     ..
178*     .. External Subroutines ..
179      EXTERNAL           DORBDB6, XERBLA
180*     ..
181*     .. External Functions ..
182      DOUBLE PRECISION   DNRM2
183      EXTERNAL           DNRM2
184*     ..
185*     .. Intrinsic Function ..
186      INTRINSIC          MAX
187*     ..
188*     .. Executable Statements ..
189*
190*     Test input arguments
191*
192      INFO = 0
193      IF( M1 .LT. 0 ) THEN
194         INFO = -1
195      ELSE IF( M2 .LT. 0 ) THEN
196         INFO = -2
197      ELSE IF( N .LT. 0 ) THEN
198         INFO = -3
199      ELSE IF( INCX1 .LT. 1 ) THEN
200         INFO = -5
201      ELSE IF( INCX2 .LT. 1 ) THEN
202         INFO = -7
203      ELSE IF( LDQ1 .LT. MAX( 1, M1 ) ) THEN
204         INFO = -9
205      ELSE IF( LDQ2 .LT. MAX( 1, M2 ) ) THEN
206         INFO = -11
207      ELSE IF( LWORK .LT. N ) THEN
208         INFO = -13
209      END IF
210*
211      IF( INFO .NE. 0 ) THEN
212         CALL XERBLA( 'DORBDB5', -INFO )
213         RETURN
214      END IF
215*
216*     Project X onto the orthogonal complement of Q
217*
218      CALL DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2,
219     $              WORK, LWORK, CHILDINFO )
220*
221*     If the projection is nonzero, then return
222*
223      IF( DNRM2(M1,X1,INCX1) .NE. ZERO
224     $    .OR. DNRM2(M2,X2,INCX2) .NE. ZERO ) THEN
225         RETURN
226      END IF
227*
228*     Project each standard basis vector e_1,...,e_M1 in turn, stopping
229*     when a nonzero projection is found
230*
231      DO I = 1, M1
232         DO J = 1, M1
233            X1(J) = ZERO
234         END DO
235         X1(I) = ONE
236         DO J = 1, M2
237            X2(J) = ZERO
238         END DO
239         CALL DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
240     $                 LDQ2, WORK, LWORK, CHILDINFO )
241         IF( DNRM2(M1,X1,INCX1) .NE. ZERO
242     $       .OR. DNRM2(M2,X2,INCX2) .NE. ZERO ) THEN
243            RETURN
244         END IF
245      END DO
246*
247*     Project each standard basis vector e_(M1+1),...,e_(M1+M2) in turn,
248*     stopping when a nonzero projection is found
249*
250      DO I = 1, M2
251         DO J = 1, M1
252            X1(J) = ZERO
253         END DO
254         DO J = 1, M2
255            X2(J) = ZERO
256         END DO
257         X2(I) = ONE
258         CALL DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
259     $                 LDQ2, WORK, LWORK, CHILDINFO )
260         IF( DNRM2(M1,X1,INCX1) .NE. ZERO
261     $       .OR. DNRM2(M2,X2,INCX2) .NE. ZERO ) THEN
262            RETURN
263         END IF
264      END DO
265*
266      RETURN
267*
268*     End of DORBDB5
269*
270      END
271
272