201 SUBROUTINE dorbdb3( 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 DOUBLE PRECISION TAUP1(*), TAUP2(*), TAUQ1(*), WORK(*),
215 $ x11(ldx11,*), x21(ldx21,*)
222 parameter ( one = 1.0d0 )
225 DOUBLE PRECISION C, S
226 INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
234 DOUBLE PRECISION DNRM2
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(
'DORBDB3', -info )
276 ELSE IF( lquery )
THEN
285 CALL drot( q-i+1, x11(i-1,i), ldx11, x21(i,i), ldx11, c, s )
288 CALL dlarfgp( q-i+1, x21(i,i), x21(i,i+1), ldx21, tauq1(i) )
291 CALL dlarf(
'R', p-i+1, q-i+1, x21(i,i), ldx21, tauq1(i),
292 $ x11(i,i), ldx11, work(ilarf) )
293 CALL dlarf(
'R', m-p-i, q-i+1, x21(i,i), ldx21, tauq1(i),
294 $ x21(i+1,i), ldx21, work(ilarf) )
295 c = sqrt( dnrm2( p-i+1, x11(i,i), 1 )**2
296 $ + dnrm2( m-p-i, x21(i+1,i), 1 )**2 )
297 theta(i) = atan2( s, c )
299 CALL dorbdb5( p-i+1, m-p-i, q-i, x11(i,i), 1, x21(i+1,i), 1,
300 $ x11(i,i+1), ldx11, x21(i+1,i+1), ldx21,
301 $ work(iorbdb5), lorbdb5, childinfo )
302 CALL dlarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
303 IF( i .LT. m-p )
THEN
304 CALL dlarfgp( m-p-i, x21(i+1,i), x21(i+2,i), 1, taup2(i) )
305 phi(i) = atan2( x21(i+1,i), x11(i,i) )
309 CALL dlarf(
'L', m-p-i, q-i, x21(i+1,i), 1, taup2(i),
310 $ x21(i+1,i+1), ldx21, work(ilarf) )
313 CALL dlarf(
'L', p-i+1, q-i, x11(i,i), 1, taup1(i), x11(i,i+1),
314 $ ldx11, work(ilarf) )
321 CALL dlarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
323 CALL dlarf(
'L', p-i+1, q-i, x11(i,i), 1, taup1(i), x11(i,i+1),
324 $ ldx11, work(ilarf) )
subroutine dorbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
DORBDB5
subroutine dlarfgp(N, ALPHA, X, INCX, TAU)
DLARFGP generates an elementary reflector (Householder matrix) with non-negative beta.
subroutine dlarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
DLARF applies an elementary reflector to a general rectangular matrix.
subroutine drot(N, DX, INCX, DY, INCY, C, S)
DROT
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dorbdb3(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
DORBDB3