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

## ◆ sorbdb5()

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

SORBDB5

Download SORBDB5 + dependencies [TGZ] [ZIP] [TXT]

Purpose:
``` SORBDB5 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 REAL 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 REAL 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 REAL 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 REAL 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 REAL 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 sorbdb5.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 REAL Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
167* ..
168*
169* =====================================================================
170*
171* .. Parameters ..
172 REAL REALZERO
173 parameter( realzero = 0.0e0 )
174 REAL ONE, ZERO
175 parameter( one = 1.0e0, zero = 0.0e0 )
176* ..
177* .. Local Scalars ..
178 INTEGER CHILDINFO, I, J
179 REAL EPS, NORM, SCL, SSQ
180* ..
181* .. External Subroutines ..
182 EXTERNAL slassq, sorbdb6, sscal, xerbla
183* ..
184* .. External Functions ..
185 REAL SLAMCH, SNRM2
186 EXTERNAL slamch, 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 eps = slamch( 'Precision' )
220*
221* Project X onto the orthogonal complement of Q if X is nonzero
222*
223 scl = realzero
224 ssq = realzero
225 CALL slassq( m1, x1, incx1, scl, ssq )
226 CALL slassq( 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 sscal( m1, one / norm, x1, incx1 )
236 CALL sscal( m2, one / norm, x2, incx2 )
237 CALL sorbdb6( 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( snrm2(m1,x1,incx1) .NE. realzero
243 \$ .OR. snrm2(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 sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
260 \$ ldq2, work, lwork, childinfo )
261 IF( snrm2(m1,x1,incx1) .NE. realzero
262 \$ .OR. snrm2(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 sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
279 \$ ldq2, work, lwork, childinfo )
280 IF( snrm2(m1,x1,incx1) .NE. realzero
281 \$ .OR. snrm2(m2,x2,incx2) .NE. realzero ) THEN
282 RETURN
283 END IF
284 END DO
285*
286 RETURN
287*
288* End of SORBDB5
289*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
subroutine slassq(n, x, incx, scale, sumsq)
SLASSQ updates a sum of squares represented in scaled form.
Definition slassq.f90:124
real(wp) function snrm2(n, x, incx)
SNRM2
Definition snrm2.f90:89
subroutine sscal(n, sa, sx, incx)
SSCAL
Definition sscal.f:79
subroutine sorbdb6(m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2, ldq2, work, lwork, info)
SORBDB6
Definition sorbdb6.f:159
Here is the call graph for this function:
Here is the caller graph for this function: