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,
234 DOUBLE PRECISION DZNRM2
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 )**2
299 $ + dznrm2( m-p-i, 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 zunbdb3(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
ZUNBDB3
subroutine zlarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
ZLARF applies an elementary reflector to a general rectangular matrix.
subroutine zdrot(N, CX, INCX, CY, INCY, C, S)
ZDROT
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zlarfgp(N, ALPHA, X, INCX, TAU)
ZLARFGP generates an elementary reflector (Householder matrix) with non-negative beta.
subroutine zunbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
ZUNBDB5