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