203 SUBROUTINE zunbdb1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
204 $ taup1, taup2, tauq1, work, lwork, info )
212 INTEGER info, lwork, m, p, q, ldx11, ldx21
215 DOUBLE PRECISION phi(*), theta(*)
216 COMPLEX*16 taup1(*), taup2(*), tauq1(*), work(*),
217 $ x11(ldx11,*), x21(ldx21,*)
224 parameter( one = (1.0d0,0.0d0) )
227 DOUBLE PRECISION c, s
228 INTEGER childinfo, i, ilarf, iorbdb5, llarf, lorbdb5,
241 INTRINSIC atan2, cos, max, sin, sqrt
248 lquery = lwork .EQ. -1
252 ELSE IF( p .LT. q .OR. m-p .LT. q )
THEN
254 ELSE IF( q .LT. 0 .OR. m-q .LT. q )
THEN
256 ELSE IF( ldx11 .LT. max( 1, p ) )
THEN
258 ELSE IF( ldx21 .LT. max( 1, m-p ) )
THEN
264 IF( info .EQ. 0 )
THEN
266 llarf = max( p-1, m-p-1, q-1 )
269 lworkopt = max( ilarf+llarf-1, iorbdb5+lorbdb5-1 )
272 IF( lwork .LT. lworkmin .AND. .NOT.lquery )
THEN
276 IF( info .NE. 0 )
THEN
277 CALL
xerbla(
'ZUNBDB1', -info )
279 ELSE IF( lquery )
THEN
287 CALL
zlarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
288 CALL
zlarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
289 theta(i) = atan2( dble( x21(i,i) ), dble( x11(i,i) ) )
294 CALL
zlarf(
'L', p-i+1, q-i, x11(i,i), 1, dconjg(taup1(i)),
295 $ x11(i,i+1), ldx11, work(ilarf) )
296 CALL
zlarf(
'L', m-p-i+1, q-i, x21(i,i), 1, dconjg(taup2(i)),
297 $ x21(i,i+1), ldx21, work(ilarf) )
300 CALL
zdrot( q-i, x11(i,i+1), ldx11, x21(i,i+1), ldx21, c,
302 CALL
zlacgv( q-i, x21(i,i+1), ldx21 )
303 CALL
zlarfgp( q-i, x21(i,i+1), x21(i,i+2), ldx21, tauq1(i) )
304 s = dble( x21(i,i+1) )
306 CALL
zlarf(
'R', p-i, q-i, x21(i,i+1), ldx21, tauq1(i),
307 $ x11(i+1,i+1), ldx11, work(ilarf) )
308 CALL
zlarf(
'R', m-p-i, q-i, x21(i,i+1), ldx21, tauq1(i),
309 $ x21(i+1,i+1), ldx21, work(ilarf) )
310 CALL
zlacgv( q-i, x21(i,i+1), ldx21 )
311 c = sqrt(
dznrm2( p-i, x11(i+1,i+1), 1, x11(i+1,i+1),
312 $ 1 )**2 +
dznrm2( m-p-i, x21(i+1,i+1), 1, x21(i+1,i+1),
314 phi(i) = atan2( s, c )
315 CALL
zunbdb5( p-i, m-p-i, q-i-1, x11(i+1,i+1), 1,
316 $ x21(i+1,i+1), 1, x11(i+1,i+2), ldx11,
317 $ x21(i+1,i+2), ldx21, work(iorbdb5), lorbdb5,
subroutine zunbdb1(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
ZUNBDB1
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.
DOUBLE PRECISION function dznrm2(N, X, INCX)
DZNRM2