LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ dorbdb5()

 subroutine dorbdb5 ( integer m1, integer m2, integer n, double precision, dimension(*) x1, integer incx1, double precision, dimension(*) x2, integer incx2, double precision, dimension(ldq1,*) q1, integer ldq1, double precision, dimension(ldq2,*) q2, integer ldq2, double precision, dimension(*) work, integer lwork, integer info )

DORBDB5

Purpose:
DORBDB5 orthogonalizes the column vector
X = [ X1 ]
[ X2 ]
with respect to the columns of
Q = [ Q1 ] .
[ Q2 ]
The columns of Q must be orthonormal.

If the projection is zero according to Kahan's "twice is enough"
criterion, then some other vector from the orthogonal complement
is returned. This vector is chosen in an arbitrary but deterministic
way.
Parameters
 [in] M1 M1 is INTEGER The dimension of X1 and the number of rows in Q1. 0 <= M1. [in] M2 M2 is INTEGER The dimension of X2 and the number of rows in Q2. 0 <= M2. [in] N N is INTEGER The number of columns in Q1 and Q2. 0 <= N. [in,out] X1 X1 is DOUBLE PRECISION array, dimension (M1) On entry, the top part of the vector to be orthogonalized. On exit, the top part of the projected vector. [in] INCX1 INCX1 is INTEGER Increment for entries of X1. [in,out] X2 X2 is DOUBLE PRECISION array, dimension (M2) On entry, the bottom part of the vector to be orthogonalized. On exit, the bottom part of the projected vector. [in] INCX2 INCX2 is INTEGER Increment for entries of X2. [in] Q1 Q1 is DOUBLE PRECISION array, dimension (LDQ1, N) The top part of the orthonormal basis matrix. [in] LDQ1 LDQ1 is INTEGER The leading dimension of Q1. LDQ1 >= M1. [in] Q2 Q2 is DOUBLE PRECISION array, dimension (LDQ2, N) The bottom part of the orthonormal basis matrix. [in] LDQ2 LDQ2 is INTEGER The leading dimension of Q2. LDQ2 >= M2. [out] WORK WORK is DOUBLE PRECISION array, dimension (LWORK) [in] LWORK LWORK is INTEGER The dimension of the array WORK. LWORK >= N. [out] INFO INFO is INTEGER = 0: successful exit. < 0: if INFO = -i, the i-th argument had an illegal value.

Definition at line 154 of file dorbdb5.f.

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 REALZERO
173 parameter( realzero = 0.0d0 )
174 DOUBLE PRECISION ONE, ZERO
175 parameter( one = 1.0d0, zero = 0.0d0 )
176* ..
177* .. Local Scalars ..
178 INTEGER CHILDINFO, I, J
179 DOUBLE PRECISION EPS, NORM, SCL, SSQ
180* ..
181* .. External Subroutines ..
182 EXTERNAL dlassq, dorbdb6, dscal, xerbla
183* ..
184* .. External Functions ..
185 DOUBLE PRECISION DLAMCH, DNRM2
186 EXTERNAL dlamch, 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 eps = dlamch( 'Precision' )
220*
221* Project X onto the orthogonal complement of Q if X is nonzero
222*
223 scl = realzero
224 ssq = realzero
225 CALL dlassq( m1, x1, incx1, scl, ssq )
226 CALL dlassq( m2, x2, incx2, scl, ssq )
227 norm = scl * sqrt( ssq )
228*
229 IF( norm .GT. n * eps ) THEN
230* Scale vector to unit norm to avoid problems in the caller code.
231* Computing the reciprocal is undesirable but
232* * xLASCL cannot be used because of the vector increments and
233* * the round-off error has a negligible impact on
234* orthogonalization.
235 CALL dscal( m1, one / norm, x1, incx1 )
236 CALL dscal( m2, one / norm, x2, incx2 )
237 CALL dorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
238 \$ ldq2, work, lwork, childinfo )
239*
240* If the projection is nonzero, then return
241*
242 IF( dnrm2(m1,x1,incx1) .NE. realzero
243 \$ .OR. dnrm2(m2,x2,incx2) .NE. realzero ) THEN
244 RETURN
245 END IF
246 END IF
247*
248* Project each standard basis vector e_1,...,e_M1 in turn, stopping
249* when a nonzero projection is found
250*
251 DO i = 1, m1
252 DO j = 1, m1
253 x1(j) = zero
254 END DO
255 x1(i) = one
256 DO j = 1, m2
257 x2(j) = zero
258 END DO
259 CALL dorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
260 \$ ldq2, work, lwork, childinfo )
261 IF( dnrm2(m1,x1,incx1) .NE. realzero
262 \$ .OR. dnrm2(m2,x2,incx2) .NE. realzero ) THEN
263 RETURN
264 END IF
265 END DO
266*
267* Project each standard basis vector e_(M1+1),...,e_(M1+M2) in turn,
268* stopping when a nonzero projection is found
269*
270 DO i = 1, m2
271 DO j = 1, m1
272 x1(j) = zero
273 END DO
274 DO j = 1, m2
275 x2(j) = zero
276 END DO
277 x2(i) = one
278 CALL dorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
279 \$ ldq2, work, lwork, childinfo )
280 IF( dnrm2(m1,x1,incx1) .NE. realzero
281 \$ .OR. dnrm2(m2,x2,incx2) .NE. realzero ) THEN
282 RETURN
283 END IF
284 END DO
285*
286 RETURN
287*
288* End of DORBDB5
289*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
subroutine dlassq(n, x, incx, scale, sumsq)
DLASSQ updates a sum of squares represented in scaled form.
Definition dlassq.f90:124
real(wp) function dnrm2(n, x, incx)
DNRM2
Definition dnrm2.f90:89
subroutine dscal(n, da, dx, incx)
DSCAL
Definition dscal.f:79
subroutine dorbdb6(m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2, ldq2, work, lwork, info)
DORBDB6
Definition dorbdb6.f:159
Here is the call graph for this function:
Here is the caller graph for this function: