216 SUBROUTINE dtpmqrt( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
217 $ a, lda,
b, ldb, work, info )
225 CHARACTER side, trans
226 INTEGER info, k, ldv, lda, ldb, m, n, l, nb, ldt
229 DOUBLE PRECISION v( ldv, * ), a( lda, * ),
b( ldb, * ),
230 $ t( ldt, * ), work( * )
237 LOGICAL left, right, tran, notran
238 INTEGER i, ib, mb, lb, kf, ldaq, ldvq
255 left =
lsame( side,
'L' )
256 right =
lsame( side,
'R' )
257 tran =
lsame( trans,
'T' )
258 notran =
lsame( trans,
'N' )
263 ELSE IF ( right )
THEN
267 IF( .NOT.left .AND. .NOT.right )
THEN
269 ELSE IF( .NOT.tran .AND. .NOT.notran )
THEN
271 ELSE IF( m.LT.0 )
THEN
273 ELSE IF( n.LT.0 )
THEN
275 ELSE IF( k.LT.0 )
THEN
277 ELSE IF( l.LT.0 .OR. l.GT.k )
THEN
279 ELSE IF( nb.LT.1 .OR. (nb.GT.k .AND. k.GT.0) )
THEN
281 ELSE IF( ldv.LT.ldvq )
THEN
283 ELSE IF( ldt.LT.nb )
THEN
285 ELSE IF( lda.LT.ldaq )
THEN
287 ELSE IF( ldb.LT.max( 1, m ) )
THEN
292 CALL
xerbla(
'DTPMQRT', -info )
298 IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 )
RETURN
300 IF( left .AND. tran )
THEN
303 ib = min( nb, k-i+1 )
304 mb = min( m-l+i+ib-1, m )
310 CALL
dtprfb(
'L',
'T',
'F',
'C', mb, n, ib, lb,
311 $ v( 1, i ), ldv, t( 1, i ), ldt,
312 $ a( i, 1 ), lda,
b, ldb, work, ib )
315 ELSE IF( right .AND. notran )
THEN
318 ib = min( nb, k-i+1 )
319 mb = min( n-l+i+ib-1, n )
325 CALL
dtprfb(
'R',
'N',
'F',
'C', m, mb, ib, lb,
326 $ v( 1, i ), ldv, t( 1, i ), ldt,
327 $ a( 1, i ), lda,
b, ldb, work, m )
330 ELSE IF( left .AND. notran )
THEN
334 ib = min( nb, k-i+1 )
335 mb = min( m-l+i+ib-1, m )
341 CALL
dtprfb(
'L',
'N',
'F',
'C', mb, n, ib, lb,
342 $ v( 1, i ), ldv, t( 1, i ), ldt,
343 $ a( i, 1 ), lda,
b, ldb, work, ib )
346 ELSE IF( right .AND. tran )
THEN
350 ib = min( nb, k-i+1 )
351 mb = min( n-l+i+ib-1, n )
357 CALL
dtprfb(
'R',
'T',
'F',
'C', m, mb, ib, lb,
358 $ v( 1, i ), ldv, t( 1, i ), ldt,
359 $ a( 1, i ), lda,
b, ldb, work, m )