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) )