154 SUBROUTINE sorbdb6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
155 $ ldq2, work, lwork, info )
163 INTEGER incx1, incx2, info, ldq1, ldq2, lwork, m1, m2,
167 REAL q1(ldq1,*), q2(ldq2,*), work(*), x1(*), x2(*)
173 REAL alphasq, realone, realzero
174 parameter( alphasq = 0.01e0, realone = 1.0e0,
176 REAL negone, one, zero
177 parameter( negone = -1.0e0, one = 1.0e0, zero = 0.0e0 )
181 REAL normsq1, normsq2, scl1, scl2, ssq1, ssq2
196 ELSE IF( m2 .LT. 0 )
THEN
198 ELSE IF( n .LT. 0 )
THEN
200 ELSE IF( incx1 .LT. 1 )
THEN
202 ELSE IF( incx2 .LT. 1 )
THEN
204 ELSE IF( ldq1 .LT. max( 1, m1 ) )
THEN
206 ELSE IF( ldq2 .LT. max( 1, m2 ) )
THEN
208 ELSE IF( lwork .LT. n )
THEN
212 IF( info .NE. 0 )
THEN
213 CALL
xerbla(
'SORBDB6', -info )
222 CALL
slassq( m1, x1, incx1, scl1, ssq1 )
225 CALL
slassq( m2, x2, incx2, scl2, ssq2 )
226 normsq1 = scl1**2*ssq1 + scl2**2*ssq2
233 CALL
sgemv(
'C', m1, n, one, q1, ldq1, x1, incx1, zero, work,
237 CALL
sgemv(
'C', m2, n, one, q2, ldq2, x2, incx2, one, work, 1 )
239 CALL
sgemv(
'N', m1, n, negone, q1, ldq1, work, 1, one, x1,
241 CALL
sgemv(
'N', m2, n, negone, q2, ldq2, work, 1, one, x2,
246 CALL
slassq( m1, x1, incx1, scl1, ssq1 )
249 CALL
slassq( m2, x2, incx2, scl2, ssq2 )
250 normsq2 = scl1**2*ssq1 + scl2**2*ssq2
256 IF( normsq2 .GE. alphasq*normsq1 )
THEN
260 IF( normsq2 .EQ. zero )
THEN
275 CALL
sgemv(
'C', m1, n, one, q1, ldq1, x1, incx1, zero, work,
279 CALL
sgemv(
'C', m2, n, one, q2, ldq2, x2, incx2, one, work, 1 )
281 CALL
sgemv(
'N', m1, n, negone, q1, ldq1, work, 1, one, x1,
283 CALL
sgemv(
'N', m2, n, negone, q2, ldq2, work, 1, one, x2,
288 CALL
slassq( m1, x1, incx1, scl1, ssq1 )
291 CALL
slassq( m1, x1, incx1, scl1, ssq1 )
292 normsq2 = scl1**2*ssq1 + scl2**2*ssq2
298 IF( normsq2 .LT. alphasq*normsq1 )
THEN