202 SUBROUTINE dorbdb2( 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 DOUBLE PRECISION phi(*), theta(*)
215 DOUBLE PRECISION taup1(*), taup2(*), tauq1(*), work(*),
216 $ x11(ldx11,*), x21(ldx21,*)
222 DOUBLE PRECISION negone, one
223 parameter( negone = -1.0d0, one = 1.0d0 )
226 DOUBLE PRECISION c, s
227 INTEGER childinfo, i, ilarf, iorbdb5, llarf, lorbdb5,
235 DOUBLE PRECISION dnrm2
239 INTRINSIC atan2, cos, max, sin, sqrt
246 lquery = lwork .EQ. -1
250 ELSE IF( p .LT. 0 .OR. p .GT. m-p )
THEN
252 ELSE IF( q .LT. 0 .OR. q .LT. p .OR. m-q .LT. p )
THEN
254 ELSE IF( ldx11 .LT. max( 1, p ) )
THEN
256 ELSE IF( ldx21 .LT. max( 1, m-p ) )
THEN
262 IF( info .EQ. 0 )
THEN
264 llarf = max( p-1, m-p, q-1 )
267 lworkopt = max( ilarf+llarf-1, iorbdb5+lorbdb5-1 )
270 IF( lwork .LT. lworkmin .AND. .NOT.lquery )
THEN
274 IF( info .NE. 0 )
THEN
275 CALL
xerbla(
'DORBDB2', -info )
277 ELSE IF( lquery )
THEN
286 CALL
drot( q-i+1, x11(i,i), ldx11, x21(i-1,i), ldx21, c, s )
288 CALL
dlarfgp( q-i+1, x11(i,i), x11(i,i+1), ldx11, tauq1(i) )
291 CALL
dlarf(
'R', p-i, q-i+1, x11(i,i), ldx11, tauq1(i),
292 $ x11(i+1,i), ldx11, work(ilarf) )
293 CALL
dlarf(
'R', m-p-i+1, q-i+1, x11(i,i), ldx11, tauq1(i),
294 $ x21(i,i), ldx21, work(ilarf) )
295 s = sqrt(
dnrm2( p-i, x11(i+1,i), 1, x11(i+1,i),
296 $ 1 )**2 +
dnrm2( m-p-i+1, x21(i,i), 1, x21(i,i), 1 )**2 )
297 theta(i) = atan2( s, c )
299 CALL
dorbdb5( p-i, m-p-i+1, q-i, x11(i+1,i), 1, x21(i,i), 1,
300 $ x11(i+1,i+1), ldx11, x21(i,i+1), ldx21,
301 $ work(iorbdb5), lorbdb5, childinfo )
302 CALL
dscal( p-i, negone, x11(i+1,i), 1 )
303 CALL
dlarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
305 CALL
dlarfgp( p-i, x11(i+1,i), x11(i+2,i), 1, taup1(i) )
306 phi(i) = atan2( x11(i+1,i), x21(i,i) )
310 CALL
dlarf(
'L', p-i, q-i, x11(i+1,i), 1, taup1(i),
311 $ x11(i+1,i+1), ldx11, work(ilarf) )
314 CALL
dlarf(
'L', m-p-i+1, q-i, x21(i,i), 1, taup2(i),
315 $ x21(i,i+1), ldx21, work(ilarf) )
322 CALL
dlarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
324 CALL
dlarf(
'L', m-p-i+1, q-i, x21(i,i), 1, taup2(i),
325 $ x21(i,i+1), ldx21, work(ilarf) )
subroutine dlarfgp(N, ALPHA, X, INCX, TAU)
DLARFGP generates an elementary reflector (Householder matrix) with non-negatibe beta.
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 dorbdb2(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
DORBDB2
subroutine dscal(N, DA, DX, INCX)
DSCAL
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