154 SUBROUTINE dorbdb6( 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 DOUBLE PRECISION q1(ldq1,*), q2(ldq2,*), work(*), x1(*), x2(*)
173 DOUBLE PRECISION alphasq, realone, realzero
174 parameter( alphasq = 0.01d0, realone = 1.0d0,
176 DOUBLE PRECISION negone, one, zero
177 parameter( negone = -1.0d0, one = 1.0d0, zero = 0.0d0 )
181 DOUBLE PRECISION 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(
'DORBDB6', -info )
222 CALL
dlassq( m1, x1, incx1, scl1, ssq1 )
225 CALL
dlassq( m2, x2, incx2, scl2, ssq2 )
226 normsq1 = scl1**2*ssq1 + scl2**2*ssq2
233 CALL
dgemv(
'C', m1, n, one, q1, ldq1, x1, incx1, zero, work,
237 CALL
dgemv(
'C', m2, n, one, q2, ldq2, x2, incx2, one, work, 1 )
239 CALL
dgemv(
'N', m1, n, negone, q1, ldq1, work, 1, one, x1,
241 CALL
dgemv(
'N', m2, n, negone, q2, ldq2, work, 1, one, x2,
246 CALL
dlassq( m1, x1, incx1, scl1, ssq1 )
249 CALL
dlassq( 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
dgemv(
'C', m1, n, one, q1, ldq1, x1, incx1, zero, work,
279 CALL
dgemv(
'C', m2, n, one, q2, ldq2, x2, incx2, one, work, 1 )
281 CALL
dgemv(
'N', m1, n, negone, q1, ldq1, work, 1, one, x1,
283 CALL
dgemv(
'N', m2, n, negone, q2, ldq2, work, 1, one, x2,
288 CALL
dlassq( m1, x1, incx1, scl1, ssq1 )
291 CALL
dlassq( m1, x1, incx1, scl1, ssq1 )
292 normsq2 = scl1**2*ssq1 + scl2**2*ssq2
298 IF( normsq2 .LT. alphasq*normsq1 )
THEN
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlassq(N, X, INCX, SCALE, SUMSQ)
DLASSQ updates a sum of squares represented in scaled form.
subroutine dorbdb6(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
DORBDB6
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV