202 SUBROUTINE cunbdb2( 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( negone = (-1.0e0,0.0e0),
224 $ one = (1.0e0,0.0e0) )
228 INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
240 INTRINSIC atan2, cos, max, sin, sqrt
247 lquery = lwork .EQ. -1
251 ELSE IF( p .LT. 0 .OR. p .GT. m-p )
THEN
253 ELSE IF( q .LT. 0 .OR. q .LT. p .OR. m-q .LT. p )
THEN
255 ELSE IF( ldx11 .LT. max( 1, p ) )
THEN
257 ELSE IF( ldx21 .LT. max( 1, m-p ) )
THEN
263 IF( info .EQ. 0 )
THEN
265 llarf = max( p-1, m-p, q-1 )
268 lworkopt = max( ilarf+llarf-1, iorbdb5+lorbdb5-1 )
271 IF( lwork .LT. lworkmin .AND. .NOT.lquery )
THEN
275 IF( info .NE. 0 )
THEN
276 CALL
xerbla(
'CUNBDB2', -info )
278 ELSE IF( lquery )
THEN
287 CALL
csrot( q-i+1, x11(i,i), ldx11, x21(i-1,i), ldx21, c,
290 CALL
clacgv( q-i+1, x11(i,i), ldx11 )
291 CALL
clarfgp( q-i+1, x11(i,i), x11(i,i+1), ldx11, tauq1(i) )
294 CALL
clarf(
'R', p-i, q-i+1, x11(i,i), ldx11, tauq1(i),
295 $ x11(i+1,i), ldx11, work(ilarf) )
296 CALL
clarf(
'R', m-p-i+1, q-i+1, x11(i,i), ldx11, tauq1(i),
297 $ x21(i,i), ldx21, work(ilarf) )
298 CALL
clacgv( q-i+1, x11(i,i), ldx11 )
299 s = sqrt( scnrm2( p-i, x11(i+1,i), 1, x11(i+1,i),
300 $ 1 )**2 + scnrm2( m-p-i+1, x21(i,i), 1, x21(i,i), 1 )**2 )
301 theta(i) = atan2( s, c )
303 CALL
cunbdb5( p-i, m-p-i+1, q-i, x11(i+1,i), 1, x21(i,i), 1,
304 $ x11(i+1,i+1), ldx11, x21(i,i+1), ldx21,
305 $ work(iorbdb5), lorbdb5, childinfo )
306 CALL
cscal( p-i, negone, x11(i+1,i), 1 )
307 CALL
clarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
309 CALL
clarfgp( p-i, x11(i+1,i), x11(i+2,i), 1, taup1(i) )
310 phi(i) = atan2(
REAL( X11(I+1,I) ),
REAL( X21(I,I) ) )
314 CALL
clarf(
'L', p-i, q-i, x11(i+1,i), 1, conjg(taup1(i)),
315 $ x11(i+1,i+1), ldx11, work(ilarf) )
318 CALL
clarf(
'L', m-p-i+1, q-i, x21(i,i), 1, conjg(taup2(i)),
319 $ x21(i,i+1), ldx21, work(ilarf) )
326 CALL
clarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
328 CALL
clarf(
'L', m-p-i+1, q-i, x21(i,i), 1, conjg(taup2(i)),
329 $ x21(i,i+1), ldx21, work(ilarf) )
subroutine cscal(N, CA, CX, INCX)
CSCAL
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.
subroutine cunbdb2(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
CUNBDB2
subroutine clarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
CLARF applies an elementary reflector to a general rectangular matrix.