202 SUBROUTINE cunbdb1( 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,
240 INTRINSIC atan2, cos, max, sin, sqrt
247 lquery = lwork .EQ. -1
251 ELSE IF( p .LT. q .OR. m-p .LT. q )
THEN
253 ELSE IF( q .LT. 0 .OR. m-q .LT. q )
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-1, 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(
'CUNBDB1', -info )
278 ELSE IF( lquery )
THEN
286 CALL
clarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
287 CALL
clarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
288 theta(i) = atan2(
REAL( X21(I,I) ),
REAL( X11(I,I) ) )
293 CALL
clarf(
'L', p-i+1, q-i, x11(i,i), 1, conjg(taup1(i)),
294 $ x11(i,i+1), ldx11, work(ilarf) )
295 CALL
clarf(
'L', m-p-i+1, q-i, x21(i,i), 1, conjg(taup2(i)),
296 $ x21(i,i+1), ldx21, work(ilarf) )
299 CALL
csrot( q-i, x11(i,i+1), ldx11, x21(i,i+1), ldx21, c,
301 CALL
clacgv( q-i, x21(i,i+1), ldx21 )
302 CALL
clarfgp( q-i, x21(i,i+1), x21(i,i+2), ldx21, tauq1(i) )
303 s =
REAL( X21(I,I+1) )
305 CALL
clarf(
'R', p-i, q-i, x21(i,i+1), ldx21, tauq1(i),
306 $ x11(i+1,i+1), ldx11, work(ilarf) )
307 CALL
clarf(
'R', m-p-i, q-i, x21(i,i+1), ldx21, tauq1(i),
308 $ x21(i+1,i+1), ldx21, work(ilarf) )
309 CALL
clacgv( q-i, x21(i,i+1), ldx21 )
310 c = sqrt(
scnrm2( p-i, x11(i+1,i+1), 1, x11(i+1,i+1),
311 $ 1 )**2 +
scnrm2( m-p-i, x21(i+1,i+1), 1, x21(i+1,i+1),
313 phi(i) = atan2( s, c )
314 CALL
cunbdb5( p-i, m-p-i, q-i-1, x11(i+1,i+1), 1,
315 $ x21(i+1,i+1), 1, x11(i+1,i+2), ldx11,
316 $ x21(i+1,i+2), ldx21, work(iorbdb5), lorbdb5,