203 SUBROUTINE sorbdb1( 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 REAL PHI(*), THETA(*)
216 REAL TAUP1(*), TAUP2(*), TAUQ1(*), WORK(*),
217 $ x11(ldx11,*), x21(ldx21,*)
224 parameter( one = 1.0e0 )
228 INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
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(
'SORBDB1', -info )
278 ELSE IF( lquery )
THEN
286 CALL
slarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
287 CALL
slarfgp( 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
slarf(
'L', p-i+1, q-i, x11(i,i), 1, taup1(i), x11(i,i+1),
294 $ ldx11, work(ilarf) )
295 CALL
slarf(
'L', m-p-i+1, q-i, x21(i,i), 1, taup2(i),
296 $ x21(i,i+1), ldx21, work(ilarf) )
299 CALL
srot( q-i, x11(i,i+1), ldx11, x21(i,i+1), ldx21, c, s )
300 CALL
slarfgp( q-i, x21(i,i+1), x21(i,i+2), ldx21, tauq1(i) )
303 CALL
slarf(
'R', p-i, q-i, x21(i,i+1), ldx21, tauq1(i),
304 $ x11(i+1,i+1), ldx11, work(ilarf) )
305 CALL
slarf(
'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( snrm2( p-i, x11(i+1,i+1), 1, x11(i+1,i+1),
308 $ 1 )**2 + snrm2( m-p-i, x21(i+1,i+1), 1, x21(i+1,i+1),
310 phi(i) = atan2( s, c )
311 CALL
sorbdb5( 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 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 sorbdb1(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
SORBDB1
subroutine srot(N, SX, INCX, SY, INCY, C, S)
SROT