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 )**2
311 $ + scnrm2( m-p-i, x21(i+1,i+1), 1 )**2 )
312 phi(i) = atan2( s, c )
313 CALL cunbdb5( p-i, m-p-i, q-i-1, x11(i+1,i+1), 1,
314 $ x21(i+1,i+1), 1, x11(i+1,i+2), ldx11,
315 $ x21(i+1,i+2), ldx21, work(iorbdb5), lorbdb5,
subroutine cunbdb1(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
CUNBDB1
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine csrot(N, CX, INCX, CY, INCY, C, S)
CSROT
subroutine clarfgp(N, ALPHA, X, INCX, TAU)
CLARFGP generates an elementary reflector (Householder matrix) with non-negative beta.
subroutine clarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
CLARF applies an elementary reflector to a general rectangular matrix.
subroutine cunbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
CUNBDB5