202 SUBROUTINE cunbdb3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
203 $ taup1, taup2, tauq1, work, lwork, info )
211 INTEGER info, lwork, m, p, q, ldx11, ldx21
214 REAL phi(*), theta(*)
215 COMPLEX taup1(*), taup2(*), tauq1(*), work(*),
216 $ x11(ldx11,*), x21(ldx21,*)
223 parameter( one = (1.0e0,0.0e0) )
227 INTEGER childinfo, i, ilarf, iorbdb5, llarf, lorbdb5,
239 INTRINSIC atan2, cos, max, sin, sqrt
246 lquery = lwork .EQ. -1
250 ELSE IF( 2*p .LT. m .OR. p .GT. m )
THEN
252 ELSE IF( q .LT. m-p .OR. m-q .LT. m-p )
THEN
254 ELSE IF( ldx11 .LT. max( 1, p ) )
THEN
256 ELSE IF( ldx21 .LT. max( 1, m-p ) )
THEN
262 IF( info .EQ. 0 )
THEN
264 llarf = max( p, m-p-1, q-1 )
267 lworkopt = max( ilarf+llarf-1, iorbdb5+lorbdb5-1 )
270 IF( lwork .LT. lworkmin .AND. .NOT.lquery )
THEN
274 IF( info .NE. 0 )
THEN
275 CALL
xerbla(
'CUNBDB3', -info )
277 ELSE IF( lquery )
THEN
286 CALL
csrot( q-i+1, x11(i-1,i), ldx11, x21(i,i), ldx11, c,
290 CALL
clacgv( q-i+1, x21(i,i), ldx21 )
291 CALL
clarfgp( q-i+1, x21(i,i), x21(i,i+1), ldx21, tauq1(i) )
294 CALL
clarf(
'R', p-i+1, q-i+1, x21(i,i), ldx21, tauq1(i),
295 $ x11(i,i), ldx11, work(ilarf) )
296 CALL
clarf(
'R', m-p-i, q-i+1, x21(i,i), ldx21, tauq1(i),
297 $ x21(i+1,i), ldx21, work(ilarf) )
298 CALL
clacgv( q-i+1, x21(i,i), ldx21 )
299 c = sqrt(
scnrm2( p-i+1, x11(i,i), 1, x11(i,i),
300 $ 1 )**2 +
scnrm2( m-p-i, x21(i+1,i), 1, x21(i+1,i), 1 )**2 )
301 theta(i) = atan2( s, c )
303 CALL
cunbdb5( p-i+1, m-p-i, q-i, x11(i,i), 1, x21(i+1,i), 1,
304 $ x11(i,i+1), ldx11, x21(i+1,i+1), ldx21,
305 $ work(iorbdb5), lorbdb5, childinfo )
306 CALL
clarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
307 IF( i .LT. m-p )
THEN
308 CALL
clarfgp( m-p-i, x21(i+1,i), x21(i+2,i), 1, taup2(i) )
309 phi(i) = atan2(
REAL( X21(I+1,I) ),
REAL( X11(I,I) ) )
313 CALL
clarf(
'L', m-p-i, q-i, x21(i+1,i), 1, conjg(taup2(i)),
314 $ x21(i+1,i+1), ldx21, work(ilarf) )
317 CALL
clarf(
'L', p-i+1, q-i, x11(i,i), 1, conjg(taup1(i)),
318 $ x11(i,i+1), ldx11, work(ilarf) )
325 CALL
clarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
327 CALL
clarf(
'L', p-i+1, q-i, x11(i,i), 1, conjg(taup1(i)),
328 $ x11(i,i+1), ldx11, work(ilarf) )
subroutine csrot(N, CX, INCX, CY, INCY, C, S)
CSROT
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cunbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
CUNBDB5
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine clarfgp(N, ALPHA, X, INCX, TAU)
CLARFGP generates an elementary reflector (Householder matrix) with non-negatibe beta.
REAL function scnrm2(N, X, INCX)
SCNRM2
subroutine clarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
CLARF applies an elementary reflector to a general rectangular matrix.
subroutine cunbdb3(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
CUNBDB3