158 SUBROUTINE cunbdb6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
159 $ LDQ2, WORK, LWORK, INFO )
166 INTEGER INCX1, INCX2, INFO, LDQ1, LDQ2, LWORK, M1, M2,
170 COMPLEX Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*)
176 REAL ALPHA, REALONE, REALZERO
177 parameter( alpha = 0.01e0, realone = 1.0e0,
179 COMPLEX NEGONE, ONE, ZERO
180 parameter( negone = (-1.0e0,0.0e0), one = (1.0e0,0.0e0),
181 $ zero = (0.0e0,0.0e0) )
185 REAL EPS, NORM, NORM_NEW, SCL, SSQ
203 ELSE IF( m2 .LT. 0 )
THEN
205 ELSE IF( n .LT. 0 )
THEN
207 ELSE IF( incx1 .LT. 1 )
THEN
209 ELSE IF( incx2 .LT. 1 )
THEN
211 ELSE IF( ldq1 .LT. max( 1, m1 ) )
THEN
213 ELSE IF( ldq2 .LT. max( 1, m2 ) )
THEN
215 ELSE IF( lwork .LT. n )
THEN
219 IF( info .NE. 0 )
THEN
220 CALL xerbla(
'CUNBDB6', -info )
224 eps = slamch(
'Precision' )
240 CALL cgemv(
'C', m1, n, one, q1, ldq1, x1, incx1, zero, work,
244 CALL cgemv(
'C', m2, n, one, q2, ldq2, x2, incx2, one, work, 1 )
246 CALL cgemv(
'N', m1, n, negone, q1, ldq1, work, 1, one, x1,
248 CALL cgemv(
'N', m2, n, negone, q2, ldq2, work, 1, one, x2,
253 CALL classq( m1, x1, incx1, scl, ssq )
254 CALL classq( m2, x2, incx2, scl, ssq )
255 norm_new = scl * sqrt(ssq)
261 IF( norm_new .GE. alpha * norm )
THEN
265 IF( norm_new .LE. n * eps * norm )
THEN
266 DO ix = 1, 1 + (m1-1)*incx1, incx1
269 DO ix = 1, 1 + (m2-1)*incx2, incx2
286 CALL cgemv(
'C', m1, n, one, q1, ldq1, x1, incx1, zero, work,
290 CALL cgemv(
'C', m2, n, one, q2, ldq2, x2, incx2, one, work, 1 )
292 CALL cgemv(
'N', m1, n, negone, q1, ldq1, work, 1, one, x1,
294 CALL cgemv(
'N', m2, n, negone, q2, ldq2, work, 1, one, x2,
299 CALL classq( m1, x1, incx1, scl, ssq )
300 CALL classq( m2, x2, incx2, scl, ssq )
301 norm_new = scl * sqrt(ssq)
307 IF( norm_new .LT. alpha * norm )
THEN
308 DO ix = 1, 1 + (m1-1)*incx1, incx1
311 DO ix = 1, 1 + (m2-1)*incx2, incx2
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