152 SUBROUTINE cunbdb6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
153 $ LDQ2, WORK, LWORK, INFO )
160 INTEGER INCX1, INCX2, INFO, LDQ1, LDQ2, LWORK, M1, M2,
164 COMPLEX Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
170 REAL ALPHASQ, REALONE, REALZERO
171 parameter( alphasq = 0.01e0, realone = 1.0e0,
173 COMPLEX NEGONE, ONE, ZERO
174 parameter( negone = (-1.0e0,0.0e0), one = (1.0e0,0.0e0),
175 $ zero = (0.0e0,0.0e0) )
179 REAL NORMSQ1, NORMSQ2, SCL1, SCL2, SSQ1, SSQ2
194 ELSE IF( m2 .LT. 0 )
THEN
196 ELSE IF( n .LT. 0 )
THEN
198 ELSE IF( incx1 .LT. 1 )
THEN
200 ELSE IF( incx2 .LT. 1 )
THEN
202 ELSE IF( ldq1 .LT. max( 1, m1 ) )
THEN
204 ELSE IF( ldq2 .LT. max( 1, m2 ) )
THEN
206 ELSE IF( lwork .LT. n )
THEN
210 IF( info .NE. 0 )
THEN
211 CALL xerbla(
'CUNBDB6', -info )
220 CALL classq( m1, x1, incx1, scl1, ssq1 )
223 CALL classq( m2, x2, incx2, scl2, ssq2 )
224 normsq1 = scl1**2*ssq1 + scl2**2*ssq2
231 CALL cgemv(
'C', m1, n, one, q1, ldq1, x1, incx1, zero, work,
235 CALL cgemv(
'C', m2, n, one, q2, ldq2, x2, incx2, one, work, 1 )
237 CALL cgemv(
'N', m1, n, negone, q1, ldq1, work, 1, one, x1,
239 CALL cgemv(
'N', m2, n, negone, q2, ldq2, work, 1, one, x2,
244 CALL classq( m1, x1, incx1, scl1, ssq1 )
247 CALL classq( m2, x2, incx2, scl2, ssq2 )
248 normsq2 = scl1**2*ssq1 + scl2**2*ssq2
254 IF( normsq2 .GE. alphasq*normsq1 )
THEN
258 IF( normsq2 .EQ. zero )
THEN
273 CALL cgemv(
'C', m1, n, one, q1, ldq1, x1, incx1, zero, work,
277 CALL cgemv(
'C', m2, n, one, q2, ldq2, x2, incx2, one, work, 1 )
279 CALL cgemv(
'N', m1, n, negone, q1, ldq1, work, 1, one, x1,
281 CALL cgemv(
'N', m2, n, negone, q2, ldq2, work, 1, one, x2,
286 CALL classq( m1, x1, incx1, scl1, ssq1 )
289 CALL classq( m1, x1, incx1, scl1, ssq1 )
290 normsq2 = scl1**2*ssq1 + scl2**2*ssq2
296 IF( normsq2 .LT. alphasq*normsq1 )
THEN
subroutine classq(n, x, incx, scl, sumsq)
CLASSQ updates a sum of squares represented in scaled form.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine cunbdb6(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
CUNBDB6