160 RECURSIVE SUBROUTINE dlarft( DIRECT, STOREV, N, K, V, LDV,
169 CHARACTER direct, storev
170 INTEGER k, ldt, ldv, n
174 DOUBLE PRECISION t( ldt, * ), tau( * ), v( ldv, * )
179 DOUBLE PRECISION one, neg_one, zero
180 parameter(one=1.0d+0, zero = 0.0d+0, neg_one=-1.0d+0)
185 LOGICAL qr,lq,ql,dirf,colv
205 IF(n.EQ.0.OR.k.EQ.0)
THEN
211 IF(n.EQ.1.OR.k.EQ.1)
THEN
225 dirf =
lsame(direct,
'F')
226 colv =
lsame(storev,
'C')
234 lq = dirf.AND.(.NOT.colv)
238 ql = (.NOT.dirf).AND.colv
298 CALL dlarft(direct, storev, n, l, v, ldv, tau, t, ldt)
302 CALL dlarft(direct, storev, n-l, k-l, v(l+1, l+1), ldv,
303 $ tau(l+1), t(l+1, l+1), ldt)
310 t(j, l+i) = v(l+i, j)
316 CALL dtrmm(
'Right',
'Lower',
'No transpose',
'Unit', l,
317 $ k-l, one, v(l+1, l+1), ldv, t(1, l+1), ldt)
323 CALL dgemm(
'Transpose',
'No transpose', l, k-l, n-k, one,
324 $ v(k+1, 1), ldv, v(k+1, l+1), ldv, one,
333 CALL dtrmm(
'Left',
'Upper',
'No transpose',
'Non-unit', l,
334 $ k-l, neg_one, t, ldt, t(1, l+1), ldt)
338 CALL dtrmm(
'Right',
'Upper',
'No transpose',
'Non-unit', l,
339 $ k-l, one, t(l+1, l+1), ldt, t(1, l+1), ldt)
393 CALL dlarft(direct, storev, n, l, v, ldv, tau, t, ldt)
397 CALL dlarft(direct, storev, n-l, k-l, v(l+1, l+1), ldv,
398 $ tau(l+1), t(l+1, l+1), ldt)
404 CALL dlacpy(
'All', l, k-l, v(1, l+1), ldv, t(1, l+1), ldt)
408 CALL dtrmm(
'Right',
'Upper',
'Transpose',
'Unit', l, k-l,
409 $ one, v(l+1, l+1), ldv, t(1, l+1), ldt)
415 CALL dgemm(
'No transpose',
'Transpose', l, k-l, n-k, one,
416 $ v(1, k+1), ldv, v(l+1, k+1), ldv, one,
425 CALL dtrmm(
'Left',
'Upper',
'No transpose',
'Non-unit', l,
426 $ k-l, neg_one, t, ldt, t(1, l+1), ldt)
431 CALL dtrmm(
'Right',
'Upper',
'No transpose',
'Non-unit', l,
432 $ k-l, one, t(l+1, l+1), ldt, t(1, l+1), ldt)
485 CALL dlarft(direct, storev, n-l, k-l, v, ldv, tau, t, ldt)
489 CALL dlarft(direct, storev, n, l, v(1, k-l+1), ldv,
490 $ tau(k-l+1), t(k-l+1, k-l+1), ldt)
497 t(k-l+i, j) = v(n-k+j, k-l+i)
503 CALL dtrmm(
'Right',
'Upper',
'No transpose',
'Unit', l,
504 $ k-l, one, v(n-k+1, 1), ldv, t(k-l+1, 1), ldt)
510 CALL dgemm(
'Transpose',
'No transpose', l, k-l, n-k, one,
511 $ v(1, k-l+1), ldv, v, ldv, one, t(k-l+1, 1),
520 CALL dtrmm(
'Left',
'Lower',
'No transpose',
'Non-unit', l,
521 $ k-l, neg_one, t(k-l+1, k-l+1), ldt,
526 CALL dtrmm(
'Right',
'Lower',
'No transpose',
'Non-unit', l,
527 $ k-l, one, t, ldt, t(k-l+1, 1), ldt)
582 CALL dlarft(direct, storev, n-l, k-l, v, ldv, tau, t, ldt)
586 CALL dlarft(direct, storev, n, l, v(k-l+1, 1), ldv,
587 $ tau(k-l+1), t(k-l+1, k-l+1), ldt)
592 CALL dlacpy(
'All', l, k-l, v(k-l+1, n-k+1), ldv,
598 CALL dtrmm(
'Right',
'Lower',
'Transpose',
'Unit', l, k-l,
599 $ one, v(1, n-k+1), ldv, t(k-l+1, 1), ldt)
605 CALL dgemm(
'No transpose',
'Transpose', l, k-l, n-k, one,
606 $ v(k-l+1, 1), ldv, v, ldv, one, t(k-l+1, 1),
616 CALL dtrmm(
'Left',
'Lower',
'No tranpose',
'Non-unit', l,
617 $ k-l, neg_one, t(k-l+1, k-l+1), ldt,
623 CALL dtrmm(
'Right',
'Lower',
'No tranpose',
'Non-unit', l,
624 $ k-l, one, t, ldt, t(k-l+1, 1), ldt)