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, x11(i+1,i+1),
308 $ 1 )**2 +
dnrm2( m-p-i, x21(i+1,i+1), 1, x21(i+1,i+1),
310 phi(i) = atan2( s, c )
311 CALL
dorbdb5( p-i, m-p-i, q-i-1, x11(i+1,i+1), 1,
312 $ x21(i+1,i+1), 1, x11(i+1,i+2), ldx11,
313 $ x21(i+1,i+2), ldx21, work(iorbdb5), lorbdb5,
subroutine dlarfgp(N, ALPHA, X, INCX, TAU)
DLARFGP generates an elementary reflector (Householder matrix) with non-negatibe beta.
subroutine dorbdb1(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
DORBDB1
subroutine xerbla(SRNAME, INFO)
XERBLA
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
double precision function dnrm2(N, X, INCX)
DNRM2
subroutine dorbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
DORBDB5