203 SUBROUTINE dorbdb1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
204 $ taup1, taup2, tauq1, work, lwork, info )
212 INTEGER INFO, LWORK, M, P, Q, LDX11, LDX21
215 DOUBLE PRECISION PHI(*), THETA(*)
216 DOUBLE PRECISION TAUP1(*), TAUP2(*), TAUQ1(*), WORK(*),
217 $ x11(ldx11,*), x21(ldx21,*)
224 parameter ( one = 1.0d0 )
227 DOUBLE PRECISION C, S
228 INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
236 DOUBLE PRECISION DNRM2
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(
'DORBDB1', -info )
278 ELSE IF( lquery )
THEN
286 CALL dlarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
287 CALL dlarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
288 theta(i) = atan2( x21(i,i), x11(i,i) )
293 CALL dlarf(
'L', p-i+1, q-i, x11(i,i), 1, taup1(i), x11(i,i+1),
294 $ ldx11, work(ilarf) )
295 CALL dlarf(
'L', m-p-i+1, q-i, x21(i,i), 1, taup2(i),
296 $ x21(i,i+1), ldx21, work(ilarf) )
299 CALL drot( q-i, x11(i,i+1), ldx11, x21(i,i+1), ldx21, c, s )
300 CALL dlarfgp( q-i, x21(i,i+1), x21(i,i+2), ldx21, tauq1(i) )
303 CALL dlarf(
'R', p-i, q-i, x21(i,i+1), ldx21, tauq1(i),
304 $ x11(i+1,i+1), ldx11, work(ilarf) )
305 CALL dlarf(
'R', m-p-i, q-i, x21(i,i+1), ldx21, tauq1(i),
306 $ x21(i+1,i+1), ldx21, work(ilarf) )
307 c = sqrt( dnrm2( p-i, x11(i+1,i+1), 1 )**2
308 $ + dnrm2( m-p-i, x21(i+1,i+1), 1 )**2 )
309 phi(i) = atan2( s, c )
310 CALL dorbdb5( p-i, m-p-i, q-i-1, x11(i+1,i+1), 1,
311 $ x21(i+1,i+1), 1, x11(i+1,i+2), ldx11,
312 $ x21(i+1,i+2), ldx21, work(iorbdb5), lorbdb5,
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 dorbdb1(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
DORBDB1
subroutine xerbla(SRNAME, INFO)
XERBLA