Skip to content

Commit b3eb65b

Browse files
iyamazakiiyamazaki
committed
fix for issue #141 (how to detect singularity in T).
1 parent aefe751 commit b3eb65b

6 files changed

Lines changed: 86 additions & 48 deletions

File tree

‎SRC/clahef_aa.f‎

Lines changed: 15 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -319,8 +319,8 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
319319
* Set A(J, J+1) = T(J, J+1)
320320
*
321321
A( K, J+1 ) = WORK( 2 )
322-
IF( (A( K, J ).EQ.ZERO ) .AND.
323-
$ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
322+
IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND.
323+
$ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN
324324
IF(INFO .EQ. 0) THEN
325325
INFO = J
326326
END IF
@@ -346,8 +346,11 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
346346
$ A( K, J+2 ), LDA)
347347
END IF
348348
ELSE
349-
IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
350-
INFO = J
349+
IF( (A( K, J ).EQ.ZERO) .AND.
350+
$ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN
351+
IF (INFO.EQ.0) THEN
352+
INFO = J
353+
END IF
351354
END IF
352355
END IF
353356
J = J + 1
@@ -473,8 +476,8 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
473476
* Set A(J+1, J) = T(J+1, J)
474477
*
475478
A( J+1, K ) = WORK( 2 )
476-
IF( (A( J, K ).EQ.ZERO) .AND.
477-
$ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
479+
IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND.
480+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
478481
IF (INFO .EQ. 0)
479482
$ INFO = J
480483
END IF
@@ -499,8 +502,12 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
499502
$ A( J+2, K ), LDA )
500503
END IF
501504
ELSE
502-
IF( (A( J, K ).EQ.ZERO) .AND. (J.EQ.M)
503-
$ .AND. (INFO.EQ.0) ) INFO = J
505+
IF( (A( J, K ).EQ.ZERO) .AND.
506+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
507+
IF (INFO.EQ.0) THEN
508+
INFO = J
509+
END IF
510+
END IF
504511
END IF
505512
J = J + 1
506513
GO TO 30

‎SRC/clasyf_aa.f‎

Lines changed: 14 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -315,8 +315,8 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
315315
* Set A(J, J+1) = T(J, J+1)
316316
*
317317
A( K, J+1 ) = WORK( 2 )
318-
IF( (A( K, J ).EQ.ZERO ) .AND.
319-
$ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
318+
IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND.
319+
$ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN
320320
IF(INFO .EQ. 0) THEN
321321
INFO = J
322322
ENDIF
@@ -342,8 +342,11 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
342342
$ A( K, J+2 ), LDA)
343343
END IF
344344
ELSE
345-
IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
346-
INFO = J
345+
IF( (A( K, J ).EQ.ZERO) .AND.
346+
$ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN
347+
IF (INFO.EQ.0) THEN
348+
INFO = J
349+
END IF
347350
END IF
348351
END IF
349352
J = J + 1
@@ -465,8 +468,8 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
465468
* Set A(J+1, J) = T(J+1, J)
466469
*
467470
A( J+1, K ) = WORK( 2 )
468-
IF( (A( J, K ).EQ.ZERO) .AND.
469-
$ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
471+
IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND.
472+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
470473
IF (INFO .EQ. 0)
471474
$ INFO = J
472475
END IF
@@ -491,8 +494,11 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
491494
$ A( J+2, K ), LDA )
492495
END IF
493496
ELSE
494-
IF( (A( J, K ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
495-
INFO = J
497+
IF( (A( J, K ).EQ.ZERO) .AND.
498+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
499+
IF (INFO.EQ.0) THEN
500+
INFO = J
501+
END IF
496502
END IF
497503
END IF
498504
J = J + 1

‎SRC/dlasyf_aa.f‎

Lines changed: 14 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -315,8 +315,8 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
315315
* Set A(J, J+1) = T(J, J+1)
316316
*
317317
A( K, J+1 ) = WORK( 2 )
318-
IF( (A( K, J ).EQ.ZERO ) .AND.
319-
$ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
318+
IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND.
319+
$ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN
320320
IF(INFO .EQ. 0) THEN
321321
INFO = J
322322
ENDIF
@@ -342,8 +342,11 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
342342
$ A( K, J+2 ), LDA)
343343
END IF
344344
ELSE
345-
IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
346-
INFO = J
345+
IF( (A( K, J ).EQ.ZERO) .AND.
346+
$ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN
347+
IF (INFO.EQ.0) THEN
348+
INFO = J
349+
END IF
347350
END IF
348351
END IF
349352
J = J + 1
@@ -465,8 +468,8 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
465468
* Set A(J+1, J) = T(J+1, J)
466469
*
467470
A( J+1, K ) = WORK( 2 )
468-
IF( (A( J, K ).EQ.ZERO) .AND.
469-
$ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
471+
IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND.
472+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
470473
IF (INFO .EQ. 0)
471474
$ INFO = J
472475
END IF
@@ -491,8 +494,11 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
491494
$ A( J+2, K ), LDA )
492495
END IF
493496
ELSE
494-
IF( (A( J, K ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
495-
INFO = J
497+
IF( (A( J, K ).EQ.ZERO) .AND.
498+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
499+
IF (INFO.EQ.0) THEN
500+
INFO = J
501+
END IF
496502
END IF
497503
END IF
498504
J = J + 1

‎SRC/slasyf_aa.f‎

Lines changed: 14 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -315,8 +315,8 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
315315
* Set A(J, J+1) = T(J, J+1)
316316
*
317317
A( K, J+1 ) = WORK( 2 )
318-
IF( (A( K, J ).EQ.ZERO ) .AND.
319-
$ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
318+
IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND.
319+
$ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN
320320
IF(INFO .EQ. 0) THEN
321321
INFO = J
322322
ENDIF
@@ -342,8 +342,11 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
342342
$ A( K, J+2 ), LDA)
343343
END IF
344344
ELSE
345-
IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
346-
INFO = J
345+
IF( (A( K, J ).EQ.ZERO) .AND.
346+
$ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN
347+
IF (INFO.EQ.0) THEN
348+
INFO = J
349+
END IF
347350
END IF
348351
END IF
349352
J = J + 1
@@ -465,8 +468,8 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
465468
* Set A(J+1, J) = T(J+1, J)
466469
*
467470
A( J+1, K ) = WORK( 2 )
468-
IF( (A( J, K ).EQ.ZERO) .AND.
469-
$ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
471+
IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND.
472+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
470473
IF (INFO .EQ. 0)
471474
$ INFO = J
472475
END IF
@@ -491,8 +494,11 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
491494
$ A( J+2, K ), LDA )
492495
END IF
493496
ELSE
494-
IF( (A( J, K ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
495-
INFO = J
497+
IF( (A( J, K ).EQ.ZERO) .AND.
498+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
499+
IF (INFO.EQ.0) THEN
500+
INFO = J
501+
END IF
496502
END IF
497503
END IF
498504
J = J + 1

‎SRC/zlahef_aa.f‎

Lines changed: 15 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -319,8 +319,8 @@ SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
319319
* Set A(J, J+1) = T(J, J+1)
320320
*
321321
A( K, J+1 ) = WORK( 2 )
322-
IF( (A( K, J ).EQ.ZERO ) .AND.
323-
$ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
322+
IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND.
323+
$ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN
324324
IF(INFO .EQ. 0) THEN
325325
INFO = J
326326
END IF
@@ -346,8 +346,11 @@ SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
346346
$ A( K, J+2 ), LDA)
347347
END IF
348348
ELSE
349-
IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
350-
INFO = J
349+
IF( (A( K, J ).EQ.ZERO) .AND.
350+
$ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN
351+
IF (INFO.EQ.0) THEN
352+
INFO = J
353+
END IF
351354
END IF
352355
END IF
353356
J = J + 1
@@ -473,8 +476,8 @@ SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
473476
* Set A(J+1, J) = T(J+1, J)
474477
*
475478
A( J+1, K ) = WORK( 2 )
476-
IF( (A( J, K ).EQ.ZERO) .AND.
477-
$ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
479+
IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND.
480+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
478481
IF (INFO .EQ. 0)
479482
$ INFO = J
480483
END IF
@@ -499,8 +502,12 @@ SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
499502
$ A( J+2, K ), LDA )
500503
END IF
501504
ELSE
502-
IF( (A( J, K ).EQ.ZERO) .AND. (J.EQ.M)
503-
$ .AND. (INFO.EQ.0) ) INFO = J
505+
IF( (A( J, K ).EQ.ZERO) .AND.
506+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
507+
IF (INFO.EQ.0) THEN
508+
INFO = J
509+
END IF
510+
END IF
504511
END IF
505512
J = J + 1
506513
GO TO 30

‎SRC/zlasyf_aa.f‎

Lines changed: 14 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -315,8 +315,8 @@ SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
315315
* Set A(J, J+1) = T(J, J+1)
316316
*
317317
A( K, J+1 ) = WORK( 2 )
318-
IF( (A( K, J ).EQ.ZERO ) .AND.
319-
$ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
318+
IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND.
319+
$ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN
320320
IF(INFO .EQ. 0) THEN
321321
INFO = J
322322
ENDIF
@@ -342,8 +342,11 @@ SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
342342
$ A( K, J+2 ), LDA)
343343
END IF
344344
ELSE
345-
IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
346-
INFO = J
345+
IF( (A( K, J ).EQ.ZERO) .AND.
346+
$ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN
347+
IF (INFO.EQ.0) THEN
348+
INFO = J
349+
END IF
347350
END IF
348351
END IF
349352
J = J + 1
@@ -465,8 +468,8 @@ SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
465468
* Set A(J+1, J) = T(J+1, J)
466469
*
467470
A( J+1, K ) = WORK( 2 )
468-
IF( (A( J, K ).EQ.ZERO) .AND.
469-
$ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
471+
IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND.
472+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
470473
IF (INFO .EQ. 0)
471474
$ INFO = J
472475
END IF
@@ -491,8 +494,11 @@ SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
491494
$ A( J+2, K ), LDA )
492495
END IF
493496
ELSE
494-
IF( (A( J, K ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
495-
INFO = J
497+
IF( (A( J, K ).EQ.ZERO) .AND.
498+
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
499+
IF (INFO.EQ.0) THEN
500+
INFO = J
501+
END IF
496502
END IF
497503
END IF
498504
J = J + 1

0 commit comments

Comments
 (0)