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: *> \date July 2012
152: *
153: *> \ingroup doubleOTHERcomputational
154: *
155: * =====================================================================
156: SUBROUTINE DORBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
157: $ LDQ2, WORK, LWORK, INFO )
158: *
159: * -- LAPACK computational routine (version 3.7.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: DOUBLE PRECISION Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
170: * ..
171: *
172: * =====================================================================
173: *
174: * .. Parameters ..
175: DOUBLE PRECISION ONE, ZERO
176: PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 )
177: * ..
178: * .. Local Scalars ..
179: INTEGER CHILDINFO, I, J
180: * ..
181: * .. External Subroutines ..
182: EXTERNAL DORBDB6, XERBLA
183: * ..
184: * .. External Functions ..
185: DOUBLE PRECISION DNRM2
186: EXTERNAL DNRM2
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( 'DORBDB5', -INFO )
216: RETURN
217: END IF
218: *
219: * Project X onto the orthogonal complement of Q
220: *
221: CALL DORBDB6( 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( DNRM2(M1,X1,INCX1) .NE. ZERO
227: $ .OR. DNRM2(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 DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
243: $ LDQ2, WORK, LWORK, CHILDINFO )
244: IF( DNRM2(M1,X1,INCX1) .NE. ZERO
245: $ .OR. DNRM2(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 DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
262: $ LDQ2, WORK, LWORK, CHILDINFO )
263: IF( DNRM2(M1,X1,INCX1) .NE. ZERO
264: $ .OR. DNRM2(M2,X2,INCX2) .NE. ZERO ) THEN
265: RETURN
266: END IF
267: END DO
268: *
269: RETURN
270: *
271: * End of DORBDB5
272: *
273: END
274:
CVSweb interface <joel.bertrand@systella.fr>