202 SUBROUTINE cunbdb2( 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 ( negone = (-1.0e0,0.0e0),
224 $ one = (1.0e0,0.0e0) )
228 INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
240 INTRINSIC atan2, cos, max, sin, sqrt
247 lquery = lwork .EQ. -1
251 ELSE IF( p .LT. 0 .OR. p .GT. m-p )
THEN
253 ELSE IF( q .LT. 0 .OR. q .LT. p .OR. m-q .LT. p )
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, 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(
'CUNBDB2', -info )
278 ELSE IF( lquery )
THEN
287 CALL csrot( q-i+1, x11(i,i), ldx11, x21(i-1,i), ldx21, c,
290 CALL clacgv( q-i+1, x11(i,i), ldx11 )
291 CALL clarfgp( q-i+1, x11(i,i), x11(i,i+1), ldx11, tauq1(i) )
294 CALL clarf(
'R', p-i, q-i+1, x11(i,i), ldx11, tauq1(i),
295 $ x11(i+1,i), ldx11, work(ilarf) )
296 CALL clarf(
'R', m-p-i+1, q-i+1, x11(i,i), ldx11, tauq1(i),
297 $ x21(i,i), ldx21, work(ilarf) )
298 CALL clacgv( q-i+1, x11(i,i), ldx11 )
299 s = sqrt( scnrm2( p-i, x11(i+1,i), 1 )**2
300 $ + scnrm2( m-p-i+1, x21(i,i), 1 )**2 )
301 theta(i) = atan2( s, c )
303 CALL cunbdb5( p-i, m-p-i+1, q-i, x11(i+1,i), 1, x21(i,i), 1,
304 $ x11(i+1,i+1), ldx11, x21(i,i+1), ldx21,
305 $ work(iorbdb5), lorbdb5, childinfo )
306 CALL cscal( p-i, negone, x11(i+1,i), 1 )
307 CALL clarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
309 CALL clarfgp( p-i, x11(i+1,i), x11(i+2,i), 1, taup1(i) )
310 phi(i) = atan2(
REAL( X11(I+1,I) ),
REAL( X21(I,I) ) )
314 CALL clarf(
'L', p-i, q-i, x11(i+1,i), 1, conjg(taup1(i)),
315 $ x11(i+1,i+1), ldx11, work(ilarf) )
318 CALL clarf(
'L', m-p-i+1, q-i, x21(i,i), 1, conjg(taup2(i)),
319 $ x21(i,i+1), ldx21, work(ilarf) )
326 CALL clarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
328 CALL clarf(
'L', m-p-i+1, q-i, x21(i,i), 1, conjg(taup2(i)),
329 $ x21(i,i+1), ldx21, work(ilarf) )
subroutine cscal(N, CA, CX, INCX)
CSCAL
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 cunbdb2(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
CUNBDB2
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