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:
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dorbdb5.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack