201 SUBROUTINE zunbdb3( 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,*)
222 parameter( one = (1.0d0,0.0d0) )
225 DOUBLE PRECISION c, s
226 INTEGER childinfo, i, ilarf, iorbdb5, llarf, lorbdb5,
238 INTRINSIC atan2, cos, max, sin, sqrt
245 lquery = lwork .EQ. -1
249 ELSE IF( 2*p .LT. m .OR. p .GT. m )
THEN
251 ELSE IF( q .LT. m-p .OR. m-q .LT. m-p )
THEN
253 ELSE IF( ldx11 .LT. max( 1, p ) )
THEN
255 ELSE IF( ldx21 .LT. max( 1, m-p ) )
THEN
261 IF( info .EQ. 0 )
THEN
263 llarf = max( p, m-p-1, q-1 )
266 lworkopt = max( ilarf+llarf-1, iorbdb5+lorbdb5-1 )
269 IF( lwork .LT. lworkmin .AND. .NOT.lquery )
THEN
273 IF( info .NE. 0 )
THEN
274 CALL
xerbla(
'ZUNBDB3', -info )
276 ELSE IF( lquery )
THEN
285 CALL
zdrot( q-i+1, x11(i-1,i), ldx11, x21(i,i), ldx11, c,
289 CALL
zlacgv( q-i+1, x21(i,i), ldx21 )
290 CALL
zlarfgp( q-i+1, x21(i,i), x21(i,i+1), ldx21, tauq1(i) )
293 CALL
zlarf(
'R', p-i+1, q-i+1, x21(i,i), ldx21, tauq1(i),
294 $ x11(i,i), ldx11, work(ilarf) )
295 CALL
zlarf(
'R', m-p-i, q-i+1, x21(i,i), ldx21, tauq1(i),
296 $ x21(i+1,i), ldx21, work(ilarf) )
297 CALL
zlacgv( q-i+1, x21(i,i), ldx21 )
298 c = sqrt(
dznrm2( p-i+1, x11(i,i), 1, x11(i,i),
299 $ 1 )**2 +
dznrm2( m-p-i, x21(i+1,i), 1, x21(i+1,i), 1 )**2 )
300 theta(i) = atan2( s, c )
302 CALL
zunbdb5( p-i+1, m-p-i, q-i, x11(i,i), 1, x21(i+1,i), 1,
303 $ x11(i,i+1), ldx11, x21(i+1,i+1), ldx21,
304 $ work(iorbdb5), lorbdb5, childinfo )
305 CALL
zlarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
306 IF( i .LT. m-p )
THEN
307 CALL
zlarfgp( m-p-i, x21(i+1,i), x21(i+2,i), 1, taup2(i) )
308 phi(i) = atan2( dble( x21(i+1,i) ), dble( x11(i,i) ) )
312 CALL
zlarf(
'L', m-p-i, q-i, x21(i+1,i), 1,
313 $ dconjg(taup2(i)), x21(i+1,i+1), ldx21,
317 CALL
zlarf(
'L', p-i+1, q-i, x11(i,i), 1, dconjg(taup1(i)),
318 $ x11(i,i+1), ldx11, work(ilarf) )
325 CALL
zlarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
327 CALL
zlarf(
'L', p-i+1, q-i, x11(i,i), 1, dconjg(taup1(i)),
328 $ x11(i,i+1), ldx11, work(ilarf) )
subroutine zdrot(N, CX, INCX, CY, INCY, C, S)
ZDROT
subroutine zunbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
ZUNBDB5
subroutine zlarfgp(N, ALPHA, X, INCX, TAU)
ZLARFGP generates an elementary reflector (Householder matrix) with non-negatibe beta.
subroutine zlarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
ZLARF applies an elementary reflector to a general rectangular matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zunbdb3(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
ZUNBDB3
double precision function dznrm2(N, X, INCX)
DZNRM2