LAPACK  3.8.0
LAPACK: Linear Algebra PACKage
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 *> \date July 2012
152 *
153 *> \ingroup realOTHERcomputational
154 *
155 * =====================================================================
156  SUBROUTINE sorbdb5( 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  REAL Q1(ldq1,*), Q2(ldq2,*), WORK(*), X1(*), X2(*)
170 * ..
171 *
172 * =====================================================================
173 *
174 * .. Parameters ..
175  REAL ONE, ZERO
176  parameter( one = 1.0e0, zero = 0.0e0 )
177 * ..
178 * .. Local Scalars ..
179  INTEGER CHILDINFO, I, J
180 * ..
181 * .. External Subroutines ..
182  EXTERNAL sorbdb6, xerbla
183 * ..
184 * .. External Functions ..
185  REAL SNRM2
186  EXTERNAL snrm2
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( 'SORBDB5', -info )
216  RETURN
217  END IF
218 *
219 * Project X onto the orthogonal complement of Q
220 *
221  CALL sorbdb6( 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( snrm2(m1,x1,incx1) .NE. zero
227  $ .OR. snrm2(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 sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
243  $ ldq2, work, lwork, childinfo )
244  IF( snrm2(m1,x1,incx1) .NE. zero
245  $ .OR. snrm2(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 sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
262  $ ldq2, work, lwork, childinfo )
263  IF( snrm2(m1,x1,incx1) .NE. zero
264  $ .OR. snrm2(m2,x2,incx2) .NE. zero ) THEN
265  RETURN
266  END IF
267  END DO
268 *
269  RETURN
270 *
271 * End of SORBDB5
272 *
273  END
274 
subroutine sorbdb6(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
SORBDB6
Definition: sorbdb6.f:156
subroutine sorbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
SORBDB5
Definition: sorbdb5.f:158
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62