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
subroutine classq(N, X, INCX, SCALE, SUMSQ)
CLASSQ updates a sum of squares represented in scaled form.
subroutine cunbdb6(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
CUNBDB6
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA