LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sorbdb5.f
Go to the documentation of this file.
1*> \brief \b SORBDB5
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SORBDB5 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorbdb5.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorbdb5.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorbdb5.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SORBDB5( 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* REAL Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*>\verbatim
37*>
38*> SORBDB5 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 REAL 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 REAL 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 REAL 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 REAL 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 REAL 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 realOTHERcomputational
152*
153* =====================================================================
154 SUBROUTINE sorbdb5( 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 REAL Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
167* ..
168*
169* =====================================================================
170*
171* .. Parameters ..
172 REAL ONE, ZERO
173 parameter( one = 1.0e0, zero = 0.0e0 )
174* ..
175* .. Local Scalars ..
176 INTEGER CHILDINFO, I, J
177* ..
178* .. External Subroutines ..
179 EXTERNAL sorbdb6, xerbla
180* ..
181* .. External Functions ..
182 REAL SNRM2
183 EXTERNAL snrm2
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( 'SORBDB5', -info )
213 RETURN
214 END IF
215*
216* Project X onto the orthogonal complement of Q
217*
218 CALL sorbdb6( 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( snrm2(m1,x1,incx1) .NE. zero
224 $ .OR. snrm2(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 sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
240 $ ldq2, work, lwork, childinfo )
241 IF( snrm2(m1,x1,incx1) .NE. zero
242 $ .OR. snrm2(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 sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
259 $ ldq2, work, lwork, childinfo )
260 IF( snrm2(m1,x1,incx1) .NE. zero
261 $ .OR. snrm2(m2,x2,incx2) .NE. zero ) THEN
262 RETURN
263 END IF
264 END DO
265*
266 RETURN
267*
268* End of SORBDB5
269*
270 END
271
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine sorbdb6(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
SORBDB6
Definition: sorbdb6.f:160
subroutine sorbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
SORBDB5
Definition: sorbdb5.f:156