201 SUBROUTINE sorbdb2( 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 REAL phi(*), theta(*)
214 REAL taup1(*), taup2(*), tauq1(*), work(*),
215 $ x11(ldx11,*), x21(ldx21,*)
222 parameter( negone = -1.0e0, one = 1.0e0 )
226 INTEGER childinfo, i, ilarf, iorbdb5, llarf, lorbdb5,
238 INTRINSIC atan2, cos, max, sin, sqrt
245 lquery = lwork .EQ. -1
249 ELSE IF( p .LT. 0 .OR. p .GT. m-p )
THEN
251 ELSE IF( q .LT. 0 .OR. q .LT. p .OR. m-q .LT. 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-1, m-p, 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(
'SORBDB2', -info )
276 ELSE IF( lquery )
THEN
285 CALL
srot( q-i+1, x11(i,i), ldx11, x21(i-1,i), ldx21, c, s )
287 CALL
slarfgp( q-i+1, x11(i,i), x11(i,i+1), ldx11, tauq1(i) )
290 CALL
slarf(
'R', p-i, q-i+1, x11(i,i), ldx11, tauq1(i),
291 $ x11(i+1,i), ldx11, work(ilarf) )
292 CALL
slarf(
'R', m-p-i+1, q-i+1, x11(i,i), ldx11, tauq1(i),
293 $ x21(i,i), ldx21, work(ilarf) )
294 s = sqrt(
snrm2( p-i, x11(i+1,i), 1, x11(i+1,i),
295 $ 1 )**2 +
snrm2( m-p-i+1, x21(i,i), 1, x21(i,i), 1 )**2 )
296 theta(i) = atan2( s, c )
298 CALL
sorbdb5( p-i, m-p-i+1, q-i, x11(i+1,i), 1, x21(i,i), 1,
299 $ x11(i+1,i+1), ldx11, x21(i,i+1), ldx21,
300 $ work(iorbdb5), lorbdb5, childinfo )
301 CALL
sscal( p-i, negone, x11(i+1,i), 1 )
302 CALL
slarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
304 CALL
slarfgp( p-i, x11(i+1,i), x11(i+2,i), 1, taup1(i) )
305 phi(i) = atan2( x11(i+1,i), x21(i,i) )
309 CALL
slarf(
'L', p-i, q-i, x11(i+1,i), 1, taup1(i),
310 $ x11(i+1,i+1), ldx11, work(ilarf) )
313 CALL
slarf(
'L', m-p-i+1, q-i, x21(i,i), 1, taup2(i),
314 $ x21(i,i+1), ldx21, work(ilarf) )
321 CALL
slarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
323 CALL
slarf(
'L', m-p-i+1, q-i, x21(i,i), 1, taup2(i),
324 $ x21(i,i+1), ldx21, 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 sorbdb2(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
SORBDB2
real function snrm2(N, X, INCX)
SNRM2
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine srot(N, SX, INCX, SY, INCY, C, S)
SROT