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,
subroutine csrot(N, CX, INCX, CY, INCY, C, S)
CSROT
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cunbdb1(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
CUNBDB1
subroutine cunbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
CUNBDB5
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine clarfgp(N, ALPHA, X, INCX, TAU)
CLARFGP generates an elementary reflector (Householder matrix) with non-negatibe beta.
REAL function scnrm2(N, X, INCX)
SCNRM2
subroutine clarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
CLARF applies an elementary reflector to a general rectangular matrix.