@@ -301,29 +301,30 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV,
301
301
*
302
302
* Compute T_{2,2} recursively
303
303
*
304
- CALL DLARFT(DIRECT, STOREV, N- L, K- L, V(L+1 ,L+1 ), LDV,
305
- $ TAU(L+1 ), T(L+1 ,L+1 ), LDT)
304
+ CALL DLARFT(DIRECT, STOREV, N- L, K- L, V(L+1 , L+1 ), LDV,
305
+ $ TAU(L+1 ), T(L+1 , L+1 ), LDT)
306
306
*
307
307
* Compute T_{1,2}
308
308
* T_{1,2} = V_{2,1}'
309
309
*
310
310
DO J = 1 , L
311
311
DO I = 1 , K- L
312
- T(J,L+ I) = V(L+ I,J)
312
+ T(J, L+ I) = V(L+ I, J)
313
313
END DO
314
314
END DO
315
315
*
316
316
* T_{1,2} = T_{1,2}*V_{2,2}
317
317
*
318
318
CALL DTRMM(' Right' , ' Lower' , ' No transpose' , ' Unit' , L,
319
- $ K- L, ONE, V(L+1 , L+1 ), LDV, T(1 , L+1 ), LDT)
319
+ $ K- L, ONE, V(L+1 , L+1 ), LDV, T(1 , L+1 ), LDT)
320
320
321
321
*
322
322
* T_{1,2} = V_{3,1}'*V_{3,2} + T_{1,2}
323
323
* Note: We assume K <= N, and GEMM will do nothing if N=K
324
324
*
325
325
CALL DGEMM(' Transpose' , ' No transpose' , L, K- L, N- K, ONE,
326
- $ V(K+1 , 1 ), LDV, V(K+1 ,L+1 ), LDV, ONE, T(1 , L+1 ), LDT)
326
+ $ V(K+1 , 1 ), LDV, V(K+1 , L+1 ), LDV, ONE,
327
+ $ T(1 , L+1 ), LDT)
327
328
*
328
329
* At this point, we have that T_{1,2} = V_1'*V_2
329
330
* All that is left is to pre and post multiply by -T_{1,1} and T_{2,2}
@@ -332,12 +333,12 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV,
332
333
* T_{1,2} = -T_{1,1}*T_{1,2}
333
334
*
334
335
CALL DTRMM(' Left' , ' Upper' , ' No transpose' , ' Non-unit' , L,
335
- $ K- L, NEG_ONE, T, LDT, T(1 , L+1 ), LDT)
336
+ $ K- L, NEG_ONE, T, LDT, T(1 , L+1 ), LDT)
336
337
*
337
338
* T_{1,2} = T_{1,2}*T_{2,2}
338
339
*
339
340
CALL DTRMM(' Right' , ' Upper' , ' No transpose' , ' Non-unit' , L,
340
- $ K- L, ONE, T(L+1 ,L+1 ), LDT, T(1 , L+1 ), LDT)
341
+ $ K- L, ONE, T(L+1 , L+1 ), LDT, T(1 , L+1 ), LDT)
341
342
342
343
ELSE IF (LQ) THEN
343
344
*
@@ -395,26 +396,27 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV,
395
396
*
396
397
* Compute T_{2,2} recursively
397
398
*
398
- CALL DLARFT(DIRECT, STOREV, N- L, K- L, V(L+1 ,L+1 ), LDV,
399
- $ TAU(L+1 ), T(L+1 ,L+1 ), LDT)
399
+ CALL DLARFT(DIRECT, STOREV, N- L, K- L, V(L+1 , L+1 ), LDV,
400
+ $ TAU(L+1 ), T(L+1 , L+1 ), LDT)
400
401
401
402
*
402
403
* Compute T_{1,2}
403
404
* T_{1,2} = V_{1,2}
404
405
*
405
- CALL DLACPY(' All' , L, K - L, V(1 ,L+1 ), LDV, T(1 , L+1 ), LDT)
406
+ CALL DLACPY(' All' , L, K- L, V(1 , L+1 ), LDV, T(1 , L+1 ), LDT)
406
407
*
407
408
* T_{1,2} = T_{1,2}*V_{2,2}'
408
409
*
409
410
CALL DTRMM(' Right' , ' Upper' , ' Transpose' , ' Unit' , L, K- L,
410
- $ ONE, V(L+1 , L+1 ), LDV, T(1 , L+1 ), LDT)
411
+ $ ONE, V(L+1 , L+1 ), LDV, T(1 , L+1 ), LDT)
411
412
412
413
*
413
414
* T_{1,2} = V_{1,3}*V_{2,3}' + T_{1,2}
414
415
* Note: We assume K <= N, and GEMM will do nothing if N=K
415
416
*
416
417
CALL DGEMM(' No transpose' , ' Transpose' , L, K- L, N- K, ONE,
417
- $ V(1 , K+1 ), LDV, V(L+1 , K+1 ), LDV, ONE, T(1 , L+1 ), LDT)
418
+ $ V(1 , K+1 ), LDV, V(L+1 , K+1 ), LDV, ONE,
419
+ $ T(1 , L+1 ), LDT)
418
420
*
419
421
* At this point, we have that T_{1,2} = V_1*V_2'
420
422
* All that is left is to pre and post multiply by -T_{1,1} and T_{2,2}
@@ -423,13 +425,13 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV,
423
425
* T_{1,2} = -T_{1,1}*T_{1,2}
424
426
*
425
427
CALL DTRMM(' Left' , ' Upper' , ' No transpose' , ' Non-unit' , L,
426
- $ K- L, NEG_ONE, T, LDT, T(1 , L+1 ), LDT)
428
+ $ K- L, NEG_ONE, T, LDT, T(1 , L+1 ), LDT)
427
429
428
430
*
429
431
* T_{1,2} = T_{1,2}*T_{2,2}
430
432
*
431
433
CALL DTRMM(' Right' , ' Upper' , ' No transpose' , ' Non-unit' , L,
432
- $ K- L, ONE, T(L+1 ,L+1 ), LDT, T(1 , L+1 ), LDT)
434
+ $ K- L, ONE, T(L+1 , L+1 ), LDT, T(1 , L+1 ), LDT)
433
435
ELSE IF (QL) THEN
434
436
*
435
437
* Break V apart into 6 components
@@ -487,28 +489,29 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV,
487
489
* Compute T_{2,2} recursively
488
490
*
489
491
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)
492
+ $ TAU(K- L+1 ), T(K- L+1 , K- L+1 ), LDT)
491
493
*
492
494
* Compute T_{2,1}
493
495
* T_{2,1} = V_{2,2}'
494
496
*
495
497
DO J = 1 , K- L
496
498
DO I = 1 , L
497
- T(K- L+ I,J) = V(N- K+ J, K- L+ I)
499
+ T(K- L+ I, J) = V(N- K+ J, K- L+ I)
498
500
END DO
499
501
END DO
500
502
*
501
503
* T_{2,1} = T_{2,1}*V_{2,1}
502
504
*
503
505
CALL DTRMM(' Right' , ' Upper' , ' No transpose' , ' Unit' , L,
504
- $ K- L, ONE, V(N- K+1 ,1 ), LDV, T(K- L+1 ,1 ), LDT)
506
+ $ K- L, ONE, V(N- K+1 , 1 ), LDV, T(K- L+1 , 1 ), LDT)
505
507
506
508
*
507
509
* T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1}
508
510
* Note: We assume K <= N, and GEMM will do nothing if N=K
509
511
*
510
512
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 ), LDT)
513
+ $ V(1 , K- L+1 ), LDV, V, LDV, ONE, T(K- L+1 , 1 ),
514
+ $ LDT)
512
515
*
513
516
* At this point, we have that T_{2,1} = V_2'*V_1
514
517
* All that is left is to pre and post multiply by -T_{2,2} and T_{1,1}
@@ -517,12 +520,13 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV,
517
520
* T_{2,1} = -T_{2,2}*T_{2,1}
518
521
*
519
522
CALL DTRMM(' Left' , ' Lower' , ' No transpose' , ' Non-unit' , L,
520
- $ K- L, NEG_ONE, T(K- L+1 ,K- L+1 ), LDT, T(K- L+1 ,1 ), LDT)
523
+ $ K- L, NEG_ONE, T(K- L+1 , K- L+1 ), LDT,
524
+ $ T(K- L+1 , 1 ), LDT)
521
525
*
522
526
* T_{2,1} = T_{2,1}*T_{1,1}
523
527
*
524
528
CALL DTRMM(' Right' , ' Lower' , ' No transpose' , ' Non-unit' , L,
525
- $ K- L, ONE, T, LDT, T(K- L+1 ,1 ), LDT)
529
+ $ K- L, ONE, T, LDT, T(K- L+1 , 1 ), LDT)
526
530
ELSE
527
531
*
528
532
* Else means RQ case
@@ -581,27 +585,28 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV,
581
585
*
582
586
* Compute T_{2,2} recursively
583
587
*
584
- CALL DLARFT(DIRECT, STOREV, N, L, V(K- L+1 ,1 ), LDV,
585
- $ TAU(K- L+1 ), T(K- L+1 ,K- L+1 ), LDT)
588
+ CALL DLARFT(DIRECT, STOREV, N, L, V(K- L+1 , 1 ), LDV,
589
+ $ TAU(K- L+1 ), T(K- L+1 , K- L+1 ), LDT)
586
590
*
587
591
* Compute T_{2,1}
588
592
* T_{2,1} = V_{2,2}
589
593
*
590
- CALL DLACPY(' All' , L, K- L, V(K- L+1 ,N- K+1 ), LDV, T(K - L +1 , 1 ) ,
591
- $ LDT)
594
+ CALL DLACPY(' All' , L, K- L, V(K- L+1 , N- K+1 ), LDV,
595
+ $ T(K - L +1 , 1 ), LDT)
592
596
593
597
*
594
598
* T_{2,1} = T_{2,1}*V_{1,2}'
595
599
*
596
600
CALL DTRMM(' Right' , ' Lower' , ' Transpose' , ' Unit' , L, K- L,
597
- $ ONE, V(1 , N- K+1 ), LDV, T(K- L+1 ,1 ), LDT)
601
+ $ ONE, V(1 , N- K+1 ), LDV, T(K- L+1 , 1 ), LDT)
598
602
599
603
*
600
604
* T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1}
601
605
* Note: We assume K <= N, and GEMM will do nothing if N=K
602
606
*
603
607
CALL DGEMM(' No transpose' , ' Transpose' , L, K- L, N- K, ONE,
604
- $ V(K- L+1 ,1 ), LDV, V, LDV, ONE, T(K- L+1 ,1 ), LDT)
608
+ $ V(K- L+1 , 1 ), LDV, V, LDV, ONE, T(K- L+1 , 1 ),
609
+ $ LDT)
605
610
606
611
*
607
612
* At this point, we have that T_{2,1} = V_2*V_1'
@@ -611,12 +616,13 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV,
611
616
* T_{2,1} = -T_{2,2}*T_{2,1}
612
617
*
613
618
CALL DTRMM(' Left' , ' Lower' , ' No tranpose' , ' Non-unit' , L,
614
- $ K- L, NEG_ONE, T(K- L+1 ,K- L+1 ), LDT, T(K- L+1 ,1 ), LDT)
619
+ $ K- L, NEG_ONE, T(K- L+1 , K- L+1 ), LDT,
620
+ $ T(K- L+1 , 1 ), LDT)
615
621
616
622
*
617
623
* T_{2,1} = T_{2,1}*T_{1,1}
618
624
*
619
625
CALL DTRMM(' Right' , ' Lower' , ' No tranpose' , ' Non-unit' , L,
620
- $ K- L, ONE, T, LDT, T(K- L+1 ,1 ), LDT)
626
+ $ K- L, ONE, T, LDT, T(K- L+1 , 1 ), LDT)
621
627
END IF
622
628
END SUBROUTINE
0 commit comments