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) )