197 SUBROUTINE sorbdb2( M, P, Q, X11, LDX11, X21, LDX21, THETA,
199 $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
206 INTEGER INFO, LWORK, M, P, Q, LDX11, LDX21
209 REAL PHI(*), THETA(*)
210 REAL TAUP1(*), TAUP2(*), TAUQ1(*), WORK(*),
211 $ x11(ldx11,*), x21(ldx21,*)
218 PARAMETER ( NEGONE = -1.0e0 )
222 INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
235 INTRINSIC atan2, cos, max, sin, sqrt
242 lquery = lwork .EQ. -1
246 ELSE IF( p .LT. 0 .OR. p .GT. m-p )
THEN
248 ELSE IF( q .LT. 0 .OR. q .LT. p .OR. m-q .LT. p )
THEN
250 ELSE IF( ldx11 .LT. max( 1, p ) )
THEN
252 ELSE IF( ldx21 .LT. max( 1, m-p ) )
THEN
258 IF( info .EQ. 0 )
THEN
260 llarf = max( p-1, m-p, q-1 )
263 lworkopt = max( ilarf+llarf-1, iorbdb5+lorbdb5-1 )
265 work(1) = real( lworkopt )
266 IF( lwork .LT. lworkmin .AND. .NOT.lquery )
THEN
270 IF( info .NE. 0 )
THEN
271 CALL xerbla(
'SORBDB2', -info )
273 ELSE IF( lquery )
THEN
282 CALL srot( q-i+1, x11(i,i), ldx11, x21(i-1,i), ldx21, c,
285 CALL slarfgp( q-i+1, x11(i,i), x11(i,i+1), ldx11, tauq1(i) )
287 CALL slarf1f(
'R', p-i, q-i+1, x11(i,i), ldx11, tauq1(i),
288 $ x11(i+1,i), ldx11, work(ilarf) )
289 CALL slarf1f(
'R', m-p-i+1, q-i+1, x11(i,i), ldx11,
290 $ tauq1(i), x21(i,i), ldx21, work(ilarf) )
291 s = sqrt( snrm2( p-i, x11(i+1,i), 1 )**2
292 $ + snrm2( m-p-i+1, x21(i,i), 1 )**2 )
293 theta(i) = atan2( s, c )
295 CALL sorbdb5( p-i, m-p-i+1, q-i, x11(i+1,i), 1, x21(i,i), 1,
296 $ x11(i+1,i+1), ldx11, x21(i,i+1), ldx21,
297 $ work(iorbdb5), lorbdb5, childinfo )
298 CALL sscal( p-i, negone, x11(i+1,i), 1 )
299 CALL slarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
301 CALL slarfgp( p-i, x11(i+1,i), x11(i+2,i), 1, taup1(i) )
302 phi(i) = atan2( x11(i+1,i), x21(i,i) )
305 CALL slarf1f(
'L', p-i, q-i, x11(i+1,i), 1, taup1(i),
306 $ x11(i+1,i+1), ldx11, work(ilarf) )
308 CALL slarf1f(
'L', m-p-i+1, q-i, x21(i,i), 1, taup2(i),
309 $ x21(i,i+1), ldx21, work(ilarf) )
316 CALL slarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
317 CALL slarf1f(
'L', m-p-i+1, q-i, x21(i,i), 1, taup2(i),
318 $ x21(i,i+1), ldx21, work(ilarf) )