154 SUBROUTINE cunbdb6( 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 COMPLEX q1(ldq1,*), q2(ldq2,*), work(*), x1(*), x2(*)
173 REAL alphasq, realone, realzero
174 parameter( alphasq = 0.01e0, realone = 1.0e0,
176 COMPLEX negone, one, zero
177 parameter( negone = (-1.0e0,0.0e0), one = (1.0e0,0.0e0),
178 $ zero = (0.0e0,0.0e0) )
182 REAL normsq1, normsq2, scl1, scl2, ssq1, ssq2
197 ELSE IF( m2 .LT. 0 )
THEN
199 ELSE IF( n .LT. 0 )
THEN
201 ELSE IF( incx1 .LT. 1 )
THEN
203 ELSE IF( incx2 .LT. 1 )
THEN
205 ELSE IF( ldq1 .LT. max( 1, m1 ) )
THEN
207 ELSE IF( ldq2 .LT. max( 1, m2 ) )
THEN
209 ELSE IF( lwork .LT. n )
THEN
213 IF( info .NE. 0 )
THEN
214 CALL
xerbla(
'CUNBDB6', -info )
223 CALL
classq( m1, x1, incx1, scl1, ssq1 )
226 CALL
classq( m2, x2, incx2, scl2, ssq2 )
227 normsq1 = scl1**2*ssq1 + scl2**2*ssq2
234 CALL
cgemv(
'C', m1, n, one, q1, ldq1, x1, incx1, zero, work,
238 CALL
cgemv(
'C', m2, n, one, q2, ldq2, x2, incx2, one, work, 1 )
240 CALL
cgemv(
'N', m1, n, negone, q1, ldq1, work, 1, one, x1,
242 CALL
cgemv(
'N', m2, n, negone, q2, ldq2, work, 1, one, x2,
247 CALL
classq( m1, x1, incx1, scl1, ssq1 )
250 CALL
classq( m2, x2, incx2, scl2, ssq2 )
251 normsq2 = scl1**2*ssq1 + scl2**2*ssq2
257 IF( normsq2 .GE. alphasq*normsq1 )
THEN
261 IF( normsq2 .EQ. zero )
THEN
276 CALL
cgemv(
'C', m1, n, one, q1, ldq1, x1, incx1, zero, work,
280 CALL
cgemv(
'C', m2, n, one, q2, ldq2, x2, incx2, one, work, 1 )
282 CALL
cgemv(
'N', m1, n, negone, q1, ldq1, work, 1, one, x1,
284 CALL
cgemv(
'N', m2, n, negone, q2, ldq2, work, 1, one, x2,
289 CALL
classq( m1, x1, incx1, scl1, ssq1 )
292 CALL
classq( m1, x1, incx1, scl1, ssq1 )
293 normsq2 = scl1**2*ssq1 + scl2**2*ssq2
299 IF( normsq2 .LT. alphasq*normsq1 )
THEN