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 )**2
295 $ + snrm2( m-p-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 srot(N, SX, INCX, SY, INCY, C, S)
SROT
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine slarfgp(N, ALPHA, X, INCX, TAU)
SLARFGP generates an elementary reflector (Householder matrix) with non-negative beta.
subroutine sorbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
SORBDB5
subroutine sorbdb2(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
SORBDB2
subroutine slarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
SLARF applies an elementary reflector to a general rectangular matrix.