Skip to content

Commit 694190c

Browse files
langoulangou
authored
Merge pull request Reference-LAPACK#317 from iyamazaki/aasen
Aasen
2 parents 44d5045 + bcdd799 commit 694190c

File tree

9 files changed

+150
-116
lines changed

9 files changed

+150
-116
lines changed

‎SRC/chetrf_aa_2stage.f‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -457,9 +457,9 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
457457
IF( I2.GT.(I1+1) ) THEN
458458
CALL CSWAP( I2-I1-1, A( I1, I1+1 ), LDA,
459459
$ A( I1+1, I2 ), 1 )
460-
CALL CLACGV( I2-I1, A( I1, I1+1 ), LDA )
461460
CALL CLACGV( I2-I1-1, A( I1+1, I2 ), 1 )
462461
END IF
462+
CALL CLACGV( I2-I1, A( I1, I1+1 ), LDA )
463463
* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
464464
IF( I2.LT.N )
465465
$ CALL CSWAP( N-I2, A( I1, I2+1 ), LDA,
@@ -633,13 +633,13 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
633633
* > Apply pivots to previous columns of L
634634
CALL CSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA,
635635
$ A( I2, (J+1)*NB+1 ), LDA )
636-
* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
636+
* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
637637
IF( I2.GT.(I1+1) ) THEN
638638
CALL CSWAP( I2-I1-1, A( I1+1, I1 ), 1,
639639
$ A( I2, I1+1 ), LDA )
640-
CALL CLACGV( I2-I1, A( I1+1, I1 ), 1 )
641640
CALL CLACGV( I2-I1-1, A( I2, I1+1 ), LDA )
642641
END IF
642+
CALL CLACGV( I2-I1, A( I1+1, I1 ), 1 )
643643
* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
644644
IF( I2.LT.N )
645645
$ CALL CSWAP( N-I2, A( I2+1, I1 ), 1,

‎SRC/clahef_aa.f‎

Lines changed: 24 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -288,8 +288,9 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
288288
*
289289
* Swap A(I1, I2+1:N) with A(I2, I2+1:N)
290290
*
291-
CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
292-
$ A( J1+I2-1, I2+1 ), LDA )
291+
IF( I2.LT.M )
292+
$ CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
293+
$ A( J1+I2-1, I2+1 ), LDA )
293294
*
294295
* Swap A(I1, I1) with A(I2,I2)
295296
*
@@ -329,13 +330,15 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
329330
* Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
330331
* where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
331332
*
332-
IF( A( K, J+1 ).NE.ZERO ) THEN
333-
ALPHA = ONE / A( K, J+1 )
334-
CALL CCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA )
335-
CALL CSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA )
336-
ELSE
337-
CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO,
338-
$ A( K, J+2 ), LDA)
333+
IF( J.LT.(M-1) ) THEN
334+
IF( A( K, J+1 ).NE.ZERO ) THEN
335+
ALPHA = ONE / A( K, J+1 )
336+
CALL CCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA )
337+
CALL CSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA )
338+
ELSE
339+
CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO,
340+
$ A( K, J+2 ), LDA)
341+
END IF
339342
END IF
340343
END IF
341344
J = J + 1
@@ -440,8 +443,9 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
440443
*
441444
* Swap A(I2+1:N, I1) with A(I2+1:N, I2)
442445
*
443-
CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
444-
$ A( I2+1, J1+I2-1 ), 1 )
446+
IF( I2.LT.M )
447+
$ CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
448+
$ A( I2+1, J1+I2-1 ), 1 )
445449
*
446450
* Swap A(I1, I1) with A(I2, I2)
447451
*
@@ -481,13 +485,15 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
481485
* Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
482486
* where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
483487
*
484-
IF( A( J+1, K ).NE.ZERO ) THEN
485-
ALPHA = ONE / A( J+1, K )
486-
CALL CCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 )
487-
CALL CSCAL( M-J-1, ALPHA, A( J+2, K ), 1 )
488-
ELSE
489-
CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO,
490-
$ A( J+2, K ), LDA )
488+
IF( J.LT.(M-1) ) THEN
489+
IF( A( J+1, K ).NE.ZERO ) THEN
490+
ALPHA = ONE / A( J+1, K )
491+
CALL CCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 )
492+
CALL CSCAL( M-J-1, ALPHA, A( J+2, K ), 1 )
493+
ELSE
494+
CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO,
495+
$ A( J+2, K ), LDA )
496+
END IF
491497
END IF
492498
END IF
493499
J = J + 1

‎SRC/clasyf_aa.f‎

Lines changed: 24 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -284,8 +284,9 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
284284
*
285285
* Swap A(I1, I2+1:M) with A(I2, I2+1:M)
286286
*
287-
CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
288-
$ A( J1+I2-1, I2+1 ), LDA )
287+
IF( I2.LT.M )
288+
$ CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
289+
$ A( J1+I2-1, I2+1 ), LDA )
289290
*
290291
* Swap A(I1, I1) with A(I2,I2)
291292
*
@@ -325,13 +326,15 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
325326
* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
326327
* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
327328
*
328-
IF( A( K, J+1 ).NE.ZERO ) THEN
329-
ALPHA = ONE / A( K, J+1 )
330-
CALL CCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA )
331-
CALL CSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA )
332-
ELSE
333-
CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO,
334-
$ A( K, J+2 ), LDA)
329+
IF( J.LT.(M-1) ) THEN
330+
IF( A( K, J+1 ).NE.ZERO ) THEN
331+
ALPHA = ONE / A( K, J+1 )
332+
CALL CCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA )
333+
CALL CSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA )
334+
ELSE
335+
CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO,
336+
$ A( K, J+2 ), LDA)
337+
END IF
335338
END IF
336339
END IF
337340
J = J + 1
@@ -432,8 +435,9 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
432435
*
433436
* Swap A(I2+1:M, I1) with A(I2+1:M, I2)
434437
*
435-
CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
436-
$ A( I2+1, J1+I2-1 ), 1 )
438+
IF( I2.LT.M )
439+
$ CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
440+
$ A( I2+1, J1+I2-1 ), 1 )
437441
*
438442
* Swap A(I1, I1) with A(I2, I2)
439443
*
@@ -473,13 +477,15 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
473477
* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
474478
* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
475479
*
476-
IF( A( J+1, K ).NE.ZERO ) THEN
477-
ALPHA = ONE / A( J+1, K )
478-
CALL CCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 )
479-
CALL CSCAL( M-J-1, ALPHA, A( J+2, K ), 1 )
480-
ELSE
481-
CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO,
482-
$ A( J+2, K ), LDA )
480+
IF( J.LT.(M-1) ) THEN
481+
IF( A( J+1, K ).NE.ZERO ) THEN
482+
ALPHA = ONE / A( J+1, K )
483+
CALL CCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 )
484+
CALL CSCAL( M-J-1, ALPHA, A( J+2, K ), 1 )
485+
ELSE
486+
CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO,
487+
$ A( J+2, K ), LDA )
488+
END IF
483489
END IF
484490
END IF
485491
J = J + 1

‎SRC/dlasyf_aa.f‎

Lines changed: 24 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -284,8 +284,9 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
284284
*
285285
* Swap A(I1, I2+1:M) with A(I2, I2+1:M)
286286
*
287-
CALL DSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
288-
$ A( J1+I2-1, I2+1 ), LDA )
287+
IF( I2.LT.M )
288+
$ CALL DSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
289+
$ A( J1+I2-1, I2+1 ), LDA )
289290
*
290291
* Swap A(I1, I1) with A(I2,I2)
291292
*
@@ -325,13 +326,15 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
325326
* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
326327
* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
327328
*
328-
IF( A( K, J+1 ).NE.ZERO ) THEN
329-
ALPHA = ONE / A( K, J+1 )
330-
CALL DCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA )
331-
CALL DSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA )
332-
ELSE
333-
CALL DLASET( 'Full', 1, M-J-1, ZERO, ZERO,
334-
$ A( K, J+2 ), LDA)
329+
IF( J.LT.(M-1) ) THEN
330+
IF( A( K, J+1 ).NE.ZERO ) THEN
331+
ALPHA = ONE / A( K, J+1 )
332+
CALL DCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA )
333+
CALL DSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA )
334+
ELSE
335+
CALL DLASET( 'Full', 1, M-J-1, ZERO, ZERO,
336+
$ A( K, J+2 ), LDA)
337+
END IF
335338
END IF
336339
END IF
337340
J = J + 1
@@ -432,8 +435,9 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
432435
*
433436
* Swap A(I2+1:M, I1) with A(I2+1:M, I2)
434437
*
435-
CALL DSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
436-
$ A( I2+1, J1+I2-1 ), 1 )
438+
IF( I2.LT.M )
439+
$ CALL DSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
440+
$ A( I2+1, J1+I2-1 ), 1 )
437441
*
438442
* Swap A(I1, I1) with A(I2, I2)
439443
*
@@ -473,13 +477,15 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
473477
* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
474478
* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
475479
*
476-
IF( A( J+1, K ).NE.ZERO ) THEN
477-
ALPHA = ONE / A( J+1, K )
478-
CALL DCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 )
479-
CALL DSCAL( M-J-1, ALPHA, A( J+2, K ), 1 )
480-
ELSE
481-
CALL DLASET( 'Full', M-J-1, 1, ZERO, ZERO,
482-
$ A( J+2, K ), LDA )
480+
IF( J.LT.(M-1) ) THEN
481+
IF( A( J+1, K ).NE.ZERO ) THEN
482+
ALPHA = ONE / A( J+1, K )
483+
CALL DCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 )
484+
CALL DSCAL( M-J-1, ALPHA, A( J+2, K ), 1 )
485+
ELSE
486+
CALL DLASET( 'Full', M-J-1, 1, ZERO, ZERO,
487+
$ A( J+2, K ), LDA )
488+
END IF
483489
END IF
484490
END IF
485491
J = J + 1

‎SRC/slasyf_aa.f‎

Lines changed: 24 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -284,8 +284,9 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
284284
*
285285
* Swap A(I1, I2+1:M) with A(I2, I2+1:M)
286286
*
287-
CALL SSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
288-
$ A( J1+I2-1, I2+1 ), LDA )
287+
IF( I2.LT.M )
288+
$ CALL SSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
289+
$ A( J1+I2-1, I2+1 ), LDA )
289290
*
290291
* Swap A(I1, I1) with A(I2,I2)
291292
*
@@ -325,13 +326,15 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
325326
* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
326327
* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
327328
*
328-
IF( A( K, J+1 ).NE.ZERO ) THEN
329-
ALPHA = ONE / A( K, J+1 )
330-
CALL SCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA )
331-
CALL SSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA )
332-
ELSE
333-
CALL SLASET( 'Full', 1, M-J-1, ZERO, ZERO,
334-
$ A( K, J+2 ), LDA)
329+
IF( J.LT.(M-1) ) THEN
330+
IF( A( K, J+1 ).NE.ZERO ) THEN
331+
ALPHA = ONE / A( K, J+1 )
332+
CALL SCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA )
333+
CALL SSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA )
334+
ELSE
335+
CALL SLASET( 'Full', 1, M-J-1, ZERO, ZERO,
336+
$ A( K, J+2 ), LDA)
337+
END IF
335338
END IF
336339
END IF
337340
J = J + 1
@@ -432,8 +435,9 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
432435
*
433436
* Swap A(I2+1:M, I1) with A(I2+1:M, I2)
434437
*
435-
CALL SSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
436-
$ A( I2+1, J1+I2-1 ), 1 )
438+
IF( I2.LT.M )
439+
$ CALL SSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
440+
$ A( I2+1, J1+I2-1 ), 1 )
437441
*
438442
* Swap A(I1, I1) with A(I2, I2)
439443
*
@@ -473,13 +477,15 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
473477
* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
474478
* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
475479
*
476-
IF( A( J+1, K ).NE.ZERO ) THEN
477-
ALPHA = ONE / A( J+1, K )
478-
CALL SCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 )
479-
CALL SSCAL( M-J-1, ALPHA, A( J+2, K ), 1 )
480-
ELSE
481-
CALL SLASET( 'Full', M-J-1, 1, ZERO, ZERO,
482-
$ A( J+2, K ), LDA )
480+
IF( J.LT.(M-1) ) THEN
481+
IF( A( J+1, K ).NE.ZERO ) THEN
482+
ALPHA = ONE / A( J+1, K )
483+
CALL SCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 )
484+
CALL SSCAL( M-J-1, ALPHA, A( J+2, K ), 1 )
485+
ELSE
486+
CALL SLASET( 'Full', M-J-1, 1, ZERO, ZERO,
487+
$ A( J+2, K ), LDA )
488+
END IF
483489
END IF
484490
END IF
485491
J = J + 1

‎SRC/zhesv_aa_2stage.f‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -211,9 +211,7 @@ SUBROUTINE ZHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
211211
*
212212
* .. Local Scalars ..
213213
LOGICAL UPPER, TQUERY, WQUERY
214-
INTEGER I, J, K, I1, I2, TD
215-
INTEGER LDTB, LWKOPT, NB, KB, NT, IINFO
216-
COMPLEX PIV
214+
INTEGER LWKOPT
217215
* ..
218216
* .. External Functions ..
219217
LOGICAL LSAME

‎SRC/zhetrf_aa_2stage.f‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -456,9 +456,9 @@ SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
456456
IF( I2.GT.(I1+1) ) THEN
457457
CALL ZSWAP( I2-I1-1, A( I1, I1+1 ), LDA,
458458
$ A( I1+1, I2 ), 1 )
459-
CALL ZLACGV( I2-I1, A( I1, I1+1 ), LDA )
460459
CALL ZLACGV( I2-I1-1, A( I1+1, I2 ), 1 )
461460
END IF
461+
CALL ZLACGV( I2-I1, A( I1, I1+1 ), LDA )
462462
* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
463463
IF( I2.LT.N )
464464
$ CALL ZSWAP( N-I2, A( I1, I2+1 ), LDA,
@@ -636,9 +636,9 @@ SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
636636
IF( I2.GT.(I1+1) ) THEN
637637
CALL ZSWAP( I2-I1-1, A( I1+1, I1 ), 1,
638638
$ A( I2, I1+1 ), LDA )
639-
CALL ZLACGV( I2-I1, A( I1+1, I1 ), 1 )
640639
CALL ZLACGV( I2-I1-1, A( I2, I1+1 ), LDA )
641640
END IF
641+
CALL ZLACGV( I2-I1, A( I1+1, I1 ), 1 )
642642
* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
643643
IF( I2.LT.N )
644644
$ CALL ZSWAP( N-I2, A( I2+1, I1 ), 1,

0 commit comments

Comments
 (0)