202 SUBROUTINE sorbdb3( 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 REAL taup1(*), taup2(*), tauq1(*), work(*),
216 $ x11(ldx11,*), x21(ldx21,*)
223 parameter( one = 1.0e0 )
227 INTEGER childinfo, i, ilarf, iorbdb5, llarf, lorbdb5,
239 INTRINSIC atan2, cos, max, sin, sqrt
246 lquery = lwork .EQ. -1
250 ELSE IF( 2*p .LT. m .OR. p .GT. m )
THEN
252 ELSE IF( q .LT. m-p .OR. m-q .LT. m-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, m-p-1, 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(
'SORBDB3', -info )
277 ELSE IF( lquery )
THEN
286 CALL
srot( q-i+1, x11(i-1,i), ldx11, x21(i,i), ldx11, c, s )
289 CALL
slarfgp( q-i+1, x21(i,i), x21(i,i+1), ldx21, tauq1(i) )
292 CALL
slarf(
'R', p-i+1, q-i+1, x21(i,i), ldx21, tauq1(i),
293 $ x11(i,i), ldx11, work(ilarf) )
294 CALL
slarf(
'R', m-p-i, q-i+1, x21(i,i), ldx21, tauq1(i),
295 $ x21(i+1,i), ldx21, work(ilarf) )
296 c = sqrt(
snrm2( p-i+1, x11(i,i), 1, x11(i,i),
297 $ 1 )**2 +
snrm2( m-p-i, x21(i+1,i), 1, x21(i+1,i), 1 )**2 )
298 theta(i) = atan2( s, c )
300 CALL
sorbdb5( p-i+1, m-p-i, q-i, x11(i,i), 1, x21(i+1,i), 1,
301 $ x11(i,i+1), ldx11, x21(i+1,i+1), ldx21,
302 $ work(iorbdb5), lorbdb5, childinfo )
303 CALL
slarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
304 IF( i .LT. m-p )
THEN
305 CALL
slarfgp( m-p-i, x21(i+1,i), x21(i+2,i), 1, taup2(i) )
306 phi(i) = atan2( x21(i+1,i), x11(i,i) )
310 CALL
slarf(
'L', m-p-i, q-i, x21(i+1,i), 1, taup2(i),
311 $ x21(i+1,i+1), ldx21, work(ilarf) )
314 CALL
slarf(
'L', p-i+1, q-i, x11(i,i), 1, taup1(i), x11(i,i+1),
315 $ ldx11, work(ilarf) )
322 CALL
slarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
324 CALL
slarf(
'L', p-i+1, q-i, x11(i,i), 1, taup1(i), x11(i,i+1),
325 $ ldx11, work(ilarf) )
subroutine sorbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
SORBDB5
subroutine slarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
SLARF applies an elementary reflector to a general rectangular matrix.
subroutine slarfgp(N, ALPHA, X, INCX, TAU)
SLARFGP generates an elementary reflector (Householder matrix) with non-negatibe beta.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sorbdb3(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
SORBDB3
real function snrm2(N, X, INCX)
SNRM2
subroutine srot(N, SX, INCX, SY, INCY, C, S)
SROT