201 SUBROUTINE zunbdb2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
202 $ taup1, taup2, tauq1, work, lwork, info )
210 INTEGER info, lwork, m, p, q, ldx11, ldx21
213 DOUBLE PRECISION phi(*), theta(*)
214 COMPLEX*16 taup1(*), taup2(*), tauq1(*), work(*),
215 $ x11(ldx11,*), x21(ldx21,*)
221 COMPLEX*16 negone, one
222 parameter( negone = (-1.0d0,0.0d0),
223 $ one = (1.0d0,0.0d0) )
226 DOUBLE PRECISION c, s
227 INTEGER childinfo, i, ilarf, iorbdb5, llarf, lorbdb5,
239 INTRINSIC atan2, cos, max, sin, sqrt
246 lquery = lwork .EQ. -1
250 ELSE IF( p .LT. 0 .OR. p .GT. m-p )
THEN
252 ELSE IF( q .LT. 0 .OR. q .LT. p .OR. m-q .LT. 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-1, m-p, 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(
'ZUNBDB2', -info )
277 ELSE IF( lquery )
THEN
286 CALL
zdrot( q-i+1, x11(i,i), ldx11, x21(i-1,i), ldx21, c,
289 CALL
zlacgv( q-i+1, x11(i,i), ldx11 )
290 CALL
zlarfgp( q-i+1, x11(i,i), x11(i,i+1), ldx11, tauq1(i) )
293 CALL
zlarf(
'R', p-i, q-i+1, x11(i,i), ldx11, tauq1(i),
294 $ x11(i+1,i), ldx11, work(ilarf) )
295 CALL
zlarf(
'R', m-p-i+1, q-i+1, x11(i,i), ldx11, tauq1(i),
296 $ x21(i,i), ldx21, work(ilarf) )
297 CALL
zlacgv( q-i+1, x11(i,i), ldx11 )
298 s = sqrt(
dznrm2( p-i, x11(i+1,i), 1, x11(i+1,i),
299 $ 1 )**2 +
dznrm2( m-p-i+1, x21(i,i), 1, x21(i,i), 1 )**2 )
300 theta(i) = atan2( s, c )
302 CALL
zunbdb5( p-i, m-p-i+1, q-i, x11(i+1,i), 1, x21(i,i), 1,
303 $ x11(i+1,i+1), ldx11, x21(i,i+1), ldx21,
304 $ work(iorbdb5), lorbdb5, childinfo )
305 CALL
zscal( p-i, negone, x11(i+1,i), 1 )
306 CALL
zlarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
308 CALL
zlarfgp( p-i, x11(i+1,i), x11(i+2,i), 1, taup1(i) )
309 phi(i) = atan2( dble( x11(i+1,i) ), dble( x21(i,i) ) )
313 CALL
zlarf(
'L', p-i, q-i, x11(i+1,i), 1, dconjg(taup1(i)),
314 $ x11(i+1,i+1), ldx11, work(ilarf) )
317 CALL
zlarf(
'L', m-p-i+1, q-i, x21(i,i), 1, dconjg(taup2(i)),
318 $ x21(i,i+1), ldx21, work(ilarf) )
325 CALL
zlarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
327 CALL
zlarf(
'L', m-p-i+1, q-i, x21(i,i), 1, dconjg(taup2(i)),
328 $ x21(i,i+1), ldx21, work(ilarf) )