From 3ba9cdf7cf4fb924a3e7904fe396692028959c3f Mon Sep 17 00:00:00 2001 From: Ichitaro Yamazaki Date: Sat, 10 Jun 2017 23:09:52 -0400 Subject: [PATCH 1/3] remove "singularity" check in sytrf_aa --- SRC/chetrf_aa.f | 22 ++++------------------ SRC/clahef_aa.f | 44 ++++---------------------------------------- SRC/clasyf_aa.f | 44 ++++---------------------------------------- SRC/csytrf_aa.f | 22 ++++------------------ SRC/dlasyf_aa.f | 44 ++++---------------------------------------- SRC/dsytrf_aa.f | 22 ++++------------------ SRC/slasyf_aa.f | 44 ++++---------------------------------------- SRC/ssytrf_aa.f | 22 ++++------------------ SRC/zhetrf_aa.f | 16 +++------------- SRC/zlahef_aa.f | 44 ++++---------------------------------------- SRC/zlasyf_aa.f | 44 ++++---------------------------------------- SRC/zsytrf_aa.f | 16 +++------------- 12 files changed, 46 insertions(+), 338 deletions(-) diff --git a/SRC/chetrf_aa.f b/SRC/chetrf_aa.f index 153a089deb..d1357e1509 100644 --- a/SRC/chetrf_aa.f +++ b/SRC/chetrf_aa.f @@ -114,11 +114,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. +*> < 0: if INFO = -i, the i-th argument had an illegal value. *> \endverbatim * * Authors: @@ -159,7 +155,7 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER J, LWKOPT, IINFO + INTEGER J, LWKOPT INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB COMPLEX ALPHA * .. @@ -215,9 +211,6 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) IPIV( 1 ) = 1 IF ( N.EQ.1 ) THEN A( 1, 1 ) = REAL( A( 1, 1 ) ) - IF ( A( 1, 1 ).EQ.ZERO ) THEN - INFO = 1 - END IF RETURN END IF * @@ -261,11 +254,7 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL CLAHEF_AA( UPLO, 2-K1, N-J, JB, $ A( MAX(1, J), J+1 ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), - $ IINFO ) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * @@ -385,10 +374,7 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL CLAHEF_AA( UPLO, 2-K1, N-J, JB, $ A( J+1, MAX(1, J) ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * diff --git a/SRC/clahef_aa.f b/SRC/clahef_aa.f index 1fbe9a411c..bd5313644a 100644 --- a/SRC/clahef_aa.f +++ b/SRC/clahef_aa.f @@ -19,11 +19,11 @@ * =========== * * SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, -* H, LDH, WORK, INFO ) +* H, LDH, WORK ) * * .. Scalar Arguments .. * CHARACTER UPLO -* INTEGER J1, M, NB, LDA, LDH, INFO +* INTEGER J1, M, NB, LDA, LDH * .. * .. Array Arguments .. * INTEGER IPIV( * ) @@ -127,16 +127,6 @@ *> WORK is COMPLEX workspace, dimension (M). *> \endverbatim *> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. -*> \endverbatim * * Authors: * ======== @@ -152,7 +142,7 @@ * * ===================================================================== SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, - $ H, LDH, WORK, INFO ) + $ H, LDH, WORK ) * * -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -163,7 +153,7 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * * .. Scalar Arguments .. CHARACTER UPLO - INTEGER M, NB, J1, LDA, LDH, INFO + INTEGER M, NB, J1, LDA, LDH * .. * .. Array Arguments .. INTEGER IPIV( * ) @@ -192,7 +182,6 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * .. * .. Executable Statements .. * - INFO = 0 J = 1 * * K1 is the first column of the panel to be factorized @@ -319,12 +308,6 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J, J+1) = T(J, J+1) * A( K, J+1 ) = WORK( 2 ) - IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN - IF(INFO .EQ. 0) THEN - INFO = J - END IF - END IF * IF( J.LT.NB ) THEN * @@ -345,13 +328,6 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO, $ A( K, J+2 ), LDA) END IF - ELSE - IF( (A( K, J ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 10 @@ -476,11 +452,6 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J+1, J) = T(J+1, J) * A( J+1, K ) = WORK( 2 ) - IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO .EQ. 0) - $ INFO = J - END IF * IF( J.LT.NB ) THEN * @@ -501,13 +472,6 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO, $ A( J+2, K ), LDA ) END IF - ELSE - IF( (A( J, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 30 diff --git a/SRC/clasyf_aa.f b/SRC/clasyf_aa.f index c58cd85209..8d0d40a421 100644 --- a/SRC/clasyf_aa.f +++ b/SRC/clasyf_aa.f @@ -19,11 +19,11 @@ * =========== * * SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, -* H, LDH, WORK, INFO ) +* H, LDH, WORK ) * * .. Scalar Arguments .. * CHARACTER UPLO -* INTEGER J1, M, NB, LDA, LDH, INFO +* INTEGER J1, M, NB, LDA, LDH * .. * .. Array Arguments .. * INTEGER IPIV( * ) @@ -127,16 +127,6 @@ *> WORK is REAL workspace, dimension (M). *> \endverbatim *> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. -*> \endverbatim * * Authors: * ======== @@ -152,7 +142,7 @@ * * ===================================================================== SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, - $ H, LDH, WORK, INFO ) + $ H, LDH, WORK ) * * -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -163,7 +153,7 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * * .. Scalar Arguments .. CHARACTER UPLO - INTEGER M, NB, J1, LDA, LDH, INFO + INTEGER M, NB, J1, LDA, LDH * .. * .. Array Arguments .. INTEGER IPIV( * ) @@ -192,7 +182,6 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * .. * .. Executable Statements .. * - INFO = 0 J = 1 * * K1 is the first column of the panel to be factorized @@ -315,12 +304,6 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J, J+1) = T(J, J+1) * A( K, J+1 ) = WORK( 2 ) - IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN - IF(INFO .EQ. 0) THEN - INFO = J - ENDIF - END IF * IF( J.LT.NB ) THEN * @@ -341,13 +324,6 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO, $ A( K, J+2 ), LDA) END IF - ELSE - IF( (A( K, J ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 10 @@ -468,11 +444,6 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J+1, J) = T(J+1, J) * A( J+1, K ) = WORK( 2 ) - IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO .EQ. 0) - $ INFO = J - END IF * IF( J.LT.NB ) THEN * @@ -493,13 +464,6 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO, $ A( J+2, K ), LDA ) END IF - ELSE - IF( (A( J, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 30 diff --git a/SRC/csytrf_aa.f b/SRC/csytrf_aa.f index 7fcbb37811..2eb2e82270 100644 --- a/SRC/csytrf_aa.f +++ b/SRC/csytrf_aa.f @@ -114,11 +114,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. +*> < 0: if INFO = -i, the i-th argument had an illegal value. *> \endverbatim * * Authors: @@ -159,7 +155,7 @@ SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER J, LWKOPT, IINFO + INTEGER J, LWKOPT INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB COMPLEX ALPHA * .. @@ -214,9 +210,6 @@ SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) ENDIF IPIV( 1 ) = 1 IF ( N.EQ.1 ) THEN - IF ( A( 1, 1 ).EQ.ZERO ) THEN - INFO = 1 - END IF RETURN END IF * @@ -260,11 +253,7 @@ SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL CLASYF_AA( UPLO, 2-K1, N-J, JB, $ A( MAX(1, J), J+1 ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), - $ IINFO ) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * @@ -383,10 +372,7 @@ SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL CLASYF_AA( UPLO, 2-K1, N-J, JB, $ A( J+1, MAX(1, J) ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * diff --git a/SRC/dlasyf_aa.f b/SRC/dlasyf_aa.f index 08d7520d15..fa6cccb2e6 100644 --- a/SRC/dlasyf_aa.f +++ b/SRC/dlasyf_aa.f @@ -19,11 +19,11 @@ * =========== * * SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, -* H, LDH, WORK, INFO ) +* H, LDH, WORK ) * * .. Scalar Arguments .. * CHARACTER UPLO -* INTEGER J1, M, NB, LDA, LDH, INFO +* INTEGER J1, M, NB, LDA, LDH * .. * .. Array Arguments .. * INTEGER IPIV( * ) @@ -127,16 +127,6 @@ *> WORK is DOUBLE PRECISION workspace, dimension (M). *> \endverbatim *> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. -*> \endverbatim * * Authors: * ======== @@ -152,7 +142,7 @@ * * ===================================================================== SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, - $ H, LDH, WORK, INFO ) + $ H, LDH, WORK ) * * -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -163,7 +153,7 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * * .. Scalar Arguments .. CHARACTER UPLO - INTEGER M, NB, J1, LDA, LDH, INFO + INTEGER M, NB, J1, LDA, LDH * .. * .. Array Arguments .. INTEGER IPIV( * ) @@ -192,7 +182,6 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * .. * .. Executable Statements .. * - INFO = 0 J = 1 * * K1 is the first column of the panel to be factorized @@ -315,12 +304,6 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J, J+1) = T(J, J+1) * A( K, J+1 ) = WORK( 2 ) - IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN - IF(INFO .EQ. 0) THEN - INFO = J - ENDIF - END IF * IF( J.LT.NB ) THEN * @@ -341,13 +324,6 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL DLASET( 'Full', 1, M-J-1, ZERO, ZERO, $ A( K, J+2 ), LDA) END IF - ELSE - IF( (A( K, J ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 10 @@ -468,11 +444,6 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J+1, J) = T(J+1, J) * A( J+1, K ) = WORK( 2 ) - IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO .EQ. 0) - $ INFO = J - END IF * IF( J.LT.NB ) THEN * @@ -493,13 +464,6 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL DLASET( 'Full', M-J-1, 1, ZERO, ZERO, $ A( J+2, K ), LDA ) END IF - ELSE - IF( (A( J, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 30 diff --git a/SRC/dsytrf_aa.f b/SRC/dsytrf_aa.f index c3d598b28a..1fabc235ee 100644 --- a/SRC/dsytrf_aa.f +++ b/SRC/dsytrf_aa.f @@ -114,11 +114,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. +*> < 0: if INFO = -i, the i-th argument had an illegal value. *> \endverbatim * * Authors: @@ -159,7 +155,7 @@ SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER J, LWKOPT, IINFO + INTEGER J, LWKOPT INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB DOUBLE PRECISION ALPHA * .. @@ -214,9 +210,6 @@ SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) ENDIF IPIV( 1 ) = 1 IF ( N.EQ.1 ) THEN - IF ( A( 1, 1 ).EQ.ZERO ) THEN - INFO = 1 - END IF RETURN END IF * @@ -260,11 +253,7 @@ SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL DLASYF_AA( UPLO, 2-K1, N-J, JB, $ A( MAX(1, J), J+1 ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), - $ IINFO ) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * @@ -383,10 +372,7 @@ SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL DLASYF_AA( UPLO, 2-K1, N-J, JB, $ A( J+1, MAX(1, J) ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * diff --git a/SRC/slasyf_aa.f b/SRC/slasyf_aa.f index 5391cef1b6..c990386d59 100644 --- a/SRC/slasyf_aa.f +++ b/SRC/slasyf_aa.f @@ -19,11 +19,11 @@ * =========== * * SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, -* H, LDH, WORK, INFO ) +* H, LDH, WORK ) * * .. Scalar Arguments .. * CHARACTER UPLO -* INTEGER J1, M, NB, LDA, LDH, INFO +* INTEGER J1, M, NB, LDA, LDH * .. * .. Array Arguments .. * INTEGER IPIV( * ) @@ -127,16 +127,6 @@ *> WORK is REAL workspace, dimension (M). *> \endverbatim *> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. -*> \endverbatim * * Authors: * ======== @@ -152,7 +142,7 @@ * * ===================================================================== SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, - $ H, LDH, WORK, INFO ) + $ H, LDH, WORK ) * * -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -163,7 +153,7 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * * .. Scalar Arguments .. CHARACTER UPLO - INTEGER M, NB, J1, LDA, LDH, INFO + INTEGER M, NB, J1, LDA, LDH * .. * .. Array Arguments .. INTEGER IPIV( * ) @@ -192,7 +182,6 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * .. * .. Executable Statements .. * - INFO = 0 J = 1 * * K1 is the first column of the panel to be factorized @@ -315,12 +304,6 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J, J+1) = T(J, J+1) * A( K, J+1 ) = WORK( 2 ) - IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN - IF(INFO .EQ. 0) THEN - INFO = J - ENDIF - END IF * IF( J.LT.NB ) THEN * @@ -341,13 +324,6 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL SLASET( 'Full', 1, M-J-1, ZERO, ZERO, $ A( K, J+2 ), LDA) END IF - ELSE - IF( (A( K, J ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 10 @@ -468,11 +444,6 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J+1, J) = T(J+1, J) * A( J+1, K ) = WORK( 2 ) - IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO .EQ. 0) - $ INFO = J - END IF * IF( J.LT.NB ) THEN * @@ -493,13 +464,6 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL SLASET( 'Full', M-J-1, 1, ZERO, ZERO, $ A( J+2, K ), LDA ) END IF - ELSE - IF( (A( J, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 30 diff --git a/SRC/ssytrf_aa.f b/SRC/ssytrf_aa.f index 98f433afd0..d9684b0513 100644 --- a/SRC/ssytrf_aa.f +++ b/SRC/ssytrf_aa.f @@ -114,11 +114,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. +*> < 0: if INFO = -i, the i-th argument had an illegal value. *> \endverbatim * * Authors: @@ -159,7 +155,7 @@ SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER J, LWKOPT, IINFO + INTEGER J, LWKOPT INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB REAL ALPHA * .. @@ -214,9 +210,6 @@ SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) ENDIF IPIV( 1 ) = 1 IF ( N.EQ.1 ) THEN - IF ( A( 1, 1 ).EQ.ZERO ) THEN - INFO = 1 - END IF RETURN END IF * @@ -260,11 +253,7 @@ SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL SLASYF_AA( UPLO, 2-K1, N-J, JB, $ A( MAX(1, J), J+1 ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), - $ IINFO ) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * @@ -383,10 +372,7 @@ SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL SLASYF_AA( UPLO, 2-K1, N-J, JB, $ A( J+1, MAX(1, J) ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * diff --git a/SRC/zhetrf_aa.f b/SRC/zhetrf_aa.f index 05844bb528..7e1c7a5528 100644 --- a/SRC/zhetrf_aa.f +++ b/SRC/zhetrf_aa.f @@ -159,7 +159,7 @@ SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER J, LWKOPT, IINFO + INTEGER J, LWKOPT INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB COMPLEX*16 ALPHA * .. @@ -215,9 +215,6 @@ SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) IPIV( 1 ) = 1 IF ( N.EQ.1 ) THEN A( 1, 1 ) = DBLE( A( 1, 1 ) ) - IF ( A( 1, 1 ).EQ.ZERO ) THEN - INFO = 1 - END IF RETURN END IF * @@ -261,11 +258,7 @@ SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL ZLAHEF_AA( UPLO, 2-K1, N-J, JB, $ A( MAX(1, J), J+1 ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), - $ IINFO ) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * @@ -385,10 +378,7 @@ SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL ZLAHEF_AA( UPLO, 2-K1, N-J, JB, $ A( J+1, MAX(1, J) ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * diff --git a/SRC/zlahef_aa.f b/SRC/zlahef_aa.f index 4646233b65..5264518cb9 100644 --- a/SRC/zlahef_aa.f +++ b/SRC/zlahef_aa.f @@ -19,11 +19,11 @@ * =========== * * SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, -* H, LDH, WORK, INFO ) +* H, LDH, WORK ) * * .. Scalar Arguments .. * CHARACTER UPLO -* INTEGER J1, M, NB, LDA, LDH, INFO +* INTEGER J1, M, NB, LDA, LDH * .. * .. Array Arguments .. * INTEGER IPIV( * ) @@ -127,16 +127,6 @@ *> WORK is COMPLEX*16 workspace, dimension (M). *> \endverbatim *> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. -*> \endverbatim * * Authors: * ======== @@ -152,7 +142,7 @@ * * ===================================================================== SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, - $ H, LDH, WORK, INFO ) + $ H, LDH, WORK ) * * -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -163,7 +153,7 @@ SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * * .. Scalar Arguments .. CHARACTER UPLO - INTEGER M, NB, J1, LDA, LDH, INFO + INTEGER M, NB, J1, LDA, LDH * .. * .. Array Arguments .. INTEGER IPIV( * ) @@ -192,7 +182,6 @@ SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * .. * .. Executable Statements .. * - INFO = 0 J = 1 * * K1 is the first column of the panel to be factorized @@ -319,12 +308,6 @@ SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J, J+1) = T(J, J+1) * A( K, J+1 ) = WORK( 2 ) - IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN - IF(INFO .EQ. 0) THEN - INFO = J - END IF - END IF * IF( J.LT.NB ) THEN * @@ -345,13 +328,6 @@ SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL ZLASET( 'Full', 1, M-J-1, ZERO, ZERO, $ A( K, J+2 ), LDA) END IF - ELSE - IF( (A( K, J ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 10 @@ -476,11 +452,6 @@ SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J+1, J) = T(J+1, J) * A( J+1, K ) = WORK( 2 ) - IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO .EQ. 0) - $ INFO = J - END IF * IF( J.LT.NB ) THEN * @@ -501,13 +472,6 @@ SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL ZLASET( 'Full', M-J-1, 1, ZERO, ZERO, $ A( J+2, K ), LDA ) END IF - ELSE - IF( (A( J, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 30 diff --git a/SRC/zlasyf_aa.f b/SRC/zlasyf_aa.f index 8e28d4f244..c2ed36cc7e 100644 --- a/SRC/zlasyf_aa.f +++ b/SRC/zlasyf_aa.f @@ -19,11 +19,11 @@ * =========== * * SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, -* H, LDH, WORK, INFO ) +* H, LDH, WORK ) * * .. Scalar Arguments .. * CHARACTER UPLO -* INTEGER J1, M, NB, LDA, LDH, INFO +* INTEGER J1, M, NB, LDA, LDH * .. * .. Array Arguments .. * INTEGER IPIV( * ) @@ -127,16 +127,6 @@ *> WORK is COMPLEX*16 workspace, dimension (M). *> \endverbatim *> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. -*> \endverbatim * * Authors: * ======== @@ -152,7 +142,7 @@ * * ===================================================================== SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, - $ H, LDH, WORK, INFO ) + $ H, LDH, WORK ) * * -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -163,7 +153,7 @@ SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * * .. Scalar Arguments .. CHARACTER UPLO - INTEGER M, NB, J1, LDA, LDH, INFO + INTEGER M, NB, J1, LDA, LDH * .. * .. Array Arguments .. INTEGER IPIV( * ) @@ -192,7 +182,6 @@ SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * .. * .. Executable Statements .. * - INFO = 0 J = 1 * * K1 is the first column of the panel to be factorized @@ -315,12 +304,6 @@ SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J, J+1) = T(J, J+1) * A( K, J+1 ) = WORK( 2 ) - IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN - IF(INFO .EQ. 0) THEN - INFO = J - ENDIF - END IF * IF( J.LT.NB ) THEN * @@ -341,13 +324,6 @@ SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL ZLASET( 'Full', 1, M-J-1, ZERO, ZERO, $ A( K, J+2 ), LDA) END IF - ELSE - IF( (A( K, J ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 10 @@ -468,11 +444,6 @@ SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, * Set A(J+1, J) = T(J+1, J) * A( J+1, K ) = WORK( 2 ) - IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO .EQ. 0) - $ INFO = J - END IF * IF( J.LT.NB ) THEN * @@ -493,13 +464,6 @@ SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, CALL ZLASET( 'Full', M-J-1, 1, ZERO, ZERO, $ A( J+2, K ), LDA ) END IF - ELSE - IF( (A( J, K ).EQ.ZERO) .AND. - $ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN - IF (INFO.EQ.0) THEN - INFO = J - END IF - END IF END IF J = J + 1 GO TO 30 diff --git a/SRC/zsytrf_aa.f b/SRC/zsytrf_aa.f index 02f8cdda95..bb832fc4cf 100644 --- a/SRC/zsytrf_aa.f +++ b/SRC/zsytrf_aa.f @@ -159,7 +159,7 @@ SUBROUTINE ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER J, LWKOPT, IINFO + INTEGER J, LWKOPT INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB COMPLEX*16 ALPHA * .. @@ -214,9 +214,6 @@ SUBROUTINE ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) ENDIF IPIV( 1 ) = 1 IF ( N.EQ.1 ) THEN - IF ( A( 1, 1 ).EQ.ZERO ) THEN - INFO = 1 - END IF RETURN END IF * @@ -260,11 +257,7 @@ SUBROUTINE ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL ZLASYF_AA( UPLO, 2-K1, N-J, JB, $ A( MAX(1, J), J+1 ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), - $ IINFO ) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * @@ -383,10 +376,7 @@ SUBROUTINE ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * CALL ZLASYF_AA( UPLO, 2-K1, N-J, JB, $ A( J+1, MAX(1, J) ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO) - IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN - INFO = IINFO+J - ENDIF + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * From 99acde87ecf9e8edf6d2a2a074efa1b09414fb48 Mon Sep 17 00:00:00 2001 From: Ichitaro Yamazaki Date: Sat, 10 Jun 2017 23:11:11 -0400 Subject: [PATCH 2/3] skip "singularity" check in sytrf_aa tester --- TESTING/LIN/cchkhe_aa.f | 79 +++++++++++++++++++++-------------------- TESTING/LIN/cchksy_aa.f | 73 +++++++++++++++++++------------------ TESTING/LIN/dchksy_aa.f | 73 +++++++++++++++++++------------------ TESTING/LIN/schksy_aa.f | 69 ++++++++++++++++++----------------- TESTING/LIN/zchkhe_aa.f | 72 +++++++++++++++++++------------------ TESTING/LIN/zchksy_aa.f | 73 +++++++++++++++++++------------------ 6 files changed, 229 insertions(+), 210 deletions(-) diff --git a/TESTING/LIN/cchkhe_aa.f b/TESTING/LIN/cchkhe_aa.f index 8b6308c3da..78e7aa0f83 100644 --- a/TESTING/LIN/cchkhe_aa.f +++ b/TESTING/LIN/cchkhe_aa.f @@ -434,22 +434,22 @@ SUBROUTINE CCHKHE_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Adjust the expected value of INFO to account for * pivoting. * - IF( IZERO.GT.0 ) THEN - J = 1 - K = IZERO - 100 CONTINUE - IF( J.EQ.K ) THEN - K = IWORK( J ) - ELSE IF( IWORK( J ).EQ.K ) THEN - K = J - END IF - IF( J.LT.K ) THEN - J = J + 1 - GO TO 100 - END IF - ELSE +c IF( IZERO.GT.0 ) THEN +c J = 1 +c K = IZERO +c 100 CONTINUE +c IF( J.EQ.K ) THEN +c K = IWORK( J ) +c ELSE IF( IWORK( J ).EQ.K ) THEN +c K = J +c END IF +c IF( J.LT.K ) THEN +c J = J + 1 +c GO TO 100 +c END IF +c ELSE K = 0 - END IF +c END IF * * Check error code from CHETRF and handle error. * @@ -512,30 +512,33 @@ SUBROUTINE CCHKHE_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Check error code from CHETRS and handle error. * IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'CHETRS_AA', INFO, 0, - $ UPLO, N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) - END IF -* - CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) -* -* Compute the residual for the solution -* - CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, - $ LDA, RWORK, RESULT( 2 ) ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 120 K = 2, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 + IF( IZERO.EQ.0 ) THEN + CALL ALAERH( PATH, 'CHETRS_AA', INFO, 0, + $ UPLO, N, N, -1, -1, NRHS, IMAT, + $ NFAIL, NERRS, NOUT ) END IF - 120 CONTINUE + ELSE + CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA + $ ) +* +* Compute the residual for the solution +* + CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, + $ WORK, LDA, RWORK, RESULT( 2 ) ) +* +* Print information about the tests that did not pass +* the threshold. +* + DO 120 K = 2, 2 + IF( RESULT( K ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, + $ IMAT, K, RESULT( K ) + NFAIL = NFAIL + 1 + END IF + 120 CONTINUE + END IF NRUN = NRUN + 1 * * End do for each value of NRHS in NSVAL. diff --git a/TESTING/LIN/cchksy_aa.f b/TESTING/LIN/cchksy_aa.f index 0b29117bdb..f451650078 100644 --- a/TESTING/LIN/cchksy_aa.f +++ b/TESTING/LIN/cchksy_aa.f @@ -435,22 +435,22 @@ SUBROUTINE CCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Adjust the expected value of INFO to account for * pivoting. * - IF( IZERO.GT.0 ) THEN - J = 1 - K = IZERO - 100 CONTINUE - IF( J.EQ.K ) THEN - K = IWORK( J ) - ELSE IF( IWORK( J ).EQ.K ) THEN - K = J - END IF - IF( J.LT.K ) THEN - J = J + 1 - GO TO 100 - END IF - ELSE +c IF( IZERO.GT.0 ) THEN +c J = 1 +c K = IZERO +c 100 CONTINUE +c IF( J.EQ.K ) THEN +c K = IWORK( J ) +c ELSE IF( IWORK( J ).EQ.K ) THEN +c K = J +c END IF +c IF( J.LT.K ) THEN +c J = J + 1 +c GO TO 100 +c END IF +c ELSE K = 0 - END IF +c END IF * * Check error code from CSYTRF and handle error. * @@ -514,31 +514,34 @@ SUBROUTINE CCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Check error code from CSYTRS and handle error. * IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'CSYTRS_AA', INFO, 0, - $ UPLO, N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) - END IF -* - CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) + IF( IZERO.EQ.0 ) THEN + CALL ALAERH( PATH, 'CSYTRS_AA', INFO, 0, + $ UPLO, N, N, -1, -1, NRHS, IMAT, + $ NFAIL, NERRS, NOUT ) + END IF + ELSE + CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA + $ ) * -* Compute the residual for the solution +* Compute the residual for the solution * - CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, - $ LDA, RWORK, RESULT( 2 ) ) + CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, + $ WORK, LDA, RWORK, RESULT( 2 ) ) * * -* Print information about the tests that did not pass -* the threshold. +* Print information about the tests that did not pass +* the threshold. * - DO 120 K = 2, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 120 CONTINUE + DO 120 K = 2, 2 + IF( RESULT( K ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, + $ IMAT, K, RESULT( K ) + NFAIL = NFAIL + 1 + END IF + 120 CONTINUE + END IF NRUN = NRUN + 1 * * End do for each value of NRHS in NSVAL. diff --git a/TESTING/LIN/dchksy_aa.f b/TESTING/LIN/dchksy_aa.f index f30495aa9d..c9db46ad23 100644 --- a/TESTING/LIN/dchksy_aa.f +++ b/TESTING/LIN/dchksy_aa.f @@ -432,22 +432,22 @@ SUBROUTINE DCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Adjust the expected value of INFO to account for * pivoting. * - IF( IZERO.GT.0 ) THEN - J = 1 - K = IZERO - 100 CONTINUE - IF( J.EQ.K ) THEN - K = IWORK( J ) - ELSE IF( IWORK( J ).EQ.K ) THEN - K = J - END IF - IF( J.LT.K ) THEN - J = J + 1 - GO TO 100 - END IF - ELSE +c IF( IZERO.GT.0 ) THEN +c J = 1 +c K = IZERO +c 100 CONTINUE +c IF( J.EQ.K ) THEN +c K = IWORK( J ) +c ELSE IF( IWORK( J ).EQ.K ) THEN +c K = J +c END IF +c IF( J.LT.K ) THEN +c J = J + 1 +c GO TO 100 +c END IF +c ELSE K = 0 - END IF +c END IF * * Check error code from DSYTRF and handle error. * @@ -511,31 +511,34 @@ SUBROUTINE DCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Check error code from DSYTRS and handle error. * IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'DSYTRS_AA', INFO, 0, - $ UPLO, N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) - END IF -* - CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) + IF( IZERO.EQ.0 ) THEN + CALL ALAERH( PATH, 'DSYTRS_AA', INFO, 0, + $ UPLO, N, N, -1, -1, NRHS, IMAT, + $ NFAIL, NERRS, NOUT ) + END IF + ELSE + CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA + $ ) * -* Compute the residual for the solution +* Compute the residual for the solution * - CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, - $ LDA, RWORK, RESULT( 2 ) ) + CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, + $ WORK, LDA, RWORK, RESULT( 2 ) ) * * -* Print information about the tests that did not pass -* the threshold. +* Print information about the tests that did not pass +* the threshold. * - DO 120 K = 2, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 120 CONTINUE + DO 120 K = 2, 2 + IF( RESULT( K ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, + $ IMAT, K, RESULT( K ) + NFAIL = NFAIL + 1 + END IF + 120 CONTINUE + END IF NRUN = NRUN + 1 * * End do for each value of NRHS in NSVAL. diff --git a/TESTING/LIN/schksy_aa.f b/TESTING/LIN/schksy_aa.f index 304cfc4aed..4c09ca8565 100644 --- a/TESTING/LIN/schksy_aa.f +++ b/TESTING/LIN/schksy_aa.f @@ -433,22 +433,22 @@ SUBROUTINE SCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Adjust the expected value of INFO to account for * pivoting. * - IF( IZERO.GT.0 ) THEN - J = 1 - K = IZERO - 100 CONTINUE - IF( J.EQ.K ) THEN - K = IWORK( J ) - ELSE IF( IWORK( J ).EQ.K ) THEN - K = J - END IF - IF( J.LT.K ) THEN - J = J + 1 - GO TO 100 - END IF - ELSE +c IF( IZERO.GT.0 ) THEN +c J = 1 +c K = IZERO +c 100 CONTINUE +c IF( J.EQ.K ) THEN +c K = IWORK( J ) +c ELSE IF( IWORK( J ).EQ.K ) THEN +c K = J +c END IF +c IF( J.LT.K ) THEN +c J = J + 1 +c GO TO 100 +c END IF +c ELSE K = 0 - END IF +c END IF * * Check error code from SSYTRF and handle error. * @@ -512,31 +512,34 @@ SUBROUTINE SCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Check error code from SSYTRS and handle error. * IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'SSYTRS_AA', INFO, 0, - $ UPLO, N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) - END IF -* - CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) + IF( IZERO.EQ.0 ) THEN + CALL ALAERH( PATH, 'SSYTRS_AA', INFO, 0, + $ UPLO, N, N, -1, -1, NRHS, IMAT, + $ NFAIL, NERRS, NOUT ) + END IF + ELSE + CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA + $ ) * -* Compute the residual for the solution +* Compute the residual for the solution * - CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, - $ LDA, RWORK, RESULT( 2 ) ) + CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, + $ WORK, LDA, RWORK, RESULT( 2 ) ) * * * Print information about the tests that did not pass * the threshold. * - DO 120 K = 2, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 120 CONTINUE + DO 120 K = 2, 2 + IF( RESULT( K ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, + $ IMAT, K, RESULT( K ) + NFAIL = NFAIL + 1 + END IF + 120 CONTINUE + END IF NRUN = NRUN + 1 * * End do for each value of NRHS in NSVAL. diff --git a/TESTING/LIN/zchkhe_aa.f b/TESTING/LIN/zchkhe_aa.f index 85d194ab6f..6bb01442a1 100644 --- a/TESTING/LIN/zchkhe_aa.f +++ b/TESTING/LIN/zchkhe_aa.f @@ -433,22 +433,22 @@ SUBROUTINE ZCHKHE_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Adjust the expected value of INFO to account for * pivoting. * - IF( IZERO.GT.0 ) THEN - J = 1 - K = IZERO - 100 CONTINUE - IF( J.EQ.K ) THEN - K = IWORK( J ) - ELSE IF( IWORK( J ).EQ.K ) THEN - K = J - END IF - IF( J.LT.K ) THEN - J = J + 1 - GO TO 100 - END IF - ELSE +c IF( IZERO.GT.0 ) THEN +c J = 1 +c K = IZERO +c 100 CONTINUE +c IF( J.EQ.K ) THEN +c K = IWORK( J ) +c ELSE IF( IWORK( J ).EQ.K ) THEN +c K = J +c END IF +c IF( J.LT.K ) THEN +c J = J + 1 +c GO TO 100 +c END IF +c ELSE K = 0 - END IF +c END IF * * Check error code from ZHETRF and handle error. * @@ -511,30 +511,34 @@ SUBROUTINE ZCHKHE_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Check error code from ZHETRS and handle error. * IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'ZHETRS', INFO, 0, UPLO, N, - $ N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) - END IF + IF( IZERO.EQ.0 ) THEN + CALL ALAERH( PATH, 'ZHETRS_AA', INFO, 0, + $ UPLO, N, N, -1, -1, NRHS, IMAT, + $ NFAIL, NERRS, NOUT ) + END IF + ELSE * - CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) + CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA + $ ) * -* Compute the residual for the solution +* Compute the residual for the solution * - CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, - $ LDA, RWORK, RESULT( 2 ) ) + CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, + $ WORK, LDA, RWORK, RESULT( 2 ) ) * -* Print information about the tests that did not pass -* the threshold. +* Print information about the tests that did not pass +* the threshold. * - DO 120 K = 2, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 120 CONTINUE + DO 120 K = 2, 2 + IF( RESULT( K ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, + $ IMAT, K, RESULT( K ) + NFAIL = NFAIL + 1 + END IF + 120 CONTINUE + END IF NRUN = NRUN + 1 * * End do for each value of NRHS in NSVAL. diff --git a/TESTING/LIN/zchksy_aa.f b/TESTING/LIN/zchksy_aa.f index ff4f6bead8..52e7d1e5bb 100644 --- a/TESTING/LIN/zchksy_aa.f +++ b/TESTING/LIN/zchksy_aa.f @@ -435,22 +435,22 @@ SUBROUTINE ZCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Adjust the expected value of INFO to account for * pivoting. * - IF( IZERO.GT.0 ) THEN - J = 1 - K = IZERO - 100 CONTINUE - IF( J.EQ.K ) THEN - K = IWORK( J ) - ELSE IF( IWORK( J ).EQ.K ) THEN - K = J - END IF - IF( J.LT.K ) THEN - J = J + 1 - GO TO 100 - END IF - ELSE +c IF( IZERO.GT.0 ) THEN +c J = 1 +c K = IZERO +c 100 CONTINUE +c IF( J.EQ.K ) THEN +c K = IWORK( J ) +c ELSE IF( IWORK( J ).EQ.K ) THEN +c K = J +c END IF +c IF( J.LT.K ) THEN +c J = J + 1 +c GO TO 100 +c END IF +c ELSE K = 0 - END IF +c END IF * * Check error code from ZSYTRF and handle error. * @@ -514,31 +514,34 @@ SUBROUTINE ZCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, * Check error code from ZSYTRS and handle error. * IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'ZSYTRS_AA', INFO, 0, - $ UPLO, N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) - END IF -* - CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) + IF( IZERO.EQ.0 ) THEN + CALL ALAERH( PATH, 'ZSYTRS_AA', INFO, 0, + $ UPLO, N, N, -1, -1, NRHS, IMAT, + $ NFAIL, NERRS, NOUT ) + END IF + ELSE + CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA + $ ) * -* Compute the residual for the solution +* Compute the residual for the solution * - CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, - $ LDA, RWORK, RESULT( 2 ) ) + CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, + $ WORK, LDA, RWORK, RESULT( 2 ) ) * * -* Print information about the tests that did not pass -* the threshold. +* Print information about the tests that did not pass +* the threshold. * - DO 120 K = 2, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 120 CONTINUE + DO 120 K = 2, 2 + IF( RESULT( K ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, + $ IMAT, K, RESULT( K ) + NFAIL = NFAIL + 1 + END IF + 120 CONTINUE + END IF NRUN = NRUN + 1 * * End do for each value of NRHS in NSVAL. From d7e47377bf09945f73462961bdd4604d6547b123 Mon Sep 17 00:00:00 2001 From: Ichitaro Yamazaki Date: Sun, 11 Jun 2017 22:05:09 -0400 Subject: [PATCH 3/3] fixing comments. --- SRC/chetrf_aa.f | 2 +- SRC/csytrf_aa.f | 2 +- SRC/dsytrf_aa.f | 2 +- SRC/ssytrf_aa.f | 2 +- SRC/zhetrf_aa.f | 8 ++------ SRC/zsytrf_aa.f | 8 ++------ 6 files changed, 8 insertions(+), 16 deletions(-) diff --git a/SRC/chetrf_aa.f b/SRC/chetrf_aa.f index d1357e1509..bed227f323 100644 --- a/SRC/chetrf_aa.f +++ b/SRC/chetrf_aa.f @@ -214,7 +214,7 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) RETURN END IF * -* Adjubst block size based on the workspace size +* Adjust block size based on the workspace size * IF( LWORK.LT.((1+NB)*N) ) THEN NB = ( LWORK-N ) / N diff --git a/SRC/csytrf_aa.f b/SRC/csytrf_aa.f index 2eb2e82270..b5f914155e 100644 --- a/SRC/csytrf_aa.f +++ b/SRC/csytrf_aa.f @@ -213,7 +213,7 @@ SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) RETURN END IF * -* Adjubst block size based on the workspace size +* Adjust block size based on the workspace size * IF( LWORK.LT.((1+NB)*N) ) THEN NB = ( LWORK-N ) / N diff --git a/SRC/dsytrf_aa.f b/SRC/dsytrf_aa.f index 1fabc235ee..174c0450fa 100644 --- a/SRC/dsytrf_aa.f +++ b/SRC/dsytrf_aa.f @@ -213,7 +213,7 @@ SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) RETURN END IF * -* Adjubst block size based on the workspace size +* Adjust block size based on the workspace size * IF( LWORK.LT.((1+NB)*N) ) THEN NB = ( LWORK-N ) / N diff --git a/SRC/ssytrf_aa.f b/SRC/ssytrf_aa.f index d9684b0513..6550a7ca1d 100644 --- a/SRC/ssytrf_aa.f +++ b/SRC/ssytrf_aa.f @@ -213,7 +213,7 @@ SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) RETURN END IF * -* Adjubst block size based on the workspace size +* Adjust block size based on the workspace size * IF( LWORK.LT.((1+NB)*N) ) THEN NB = ( LWORK-N ) / N diff --git a/SRC/zhetrf_aa.f b/SRC/zhetrf_aa.f index 7e1c7a5528..4196d47714 100644 --- a/SRC/zhetrf_aa.f +++ b/SRC/zhetrf_aa.f @@ -114,11 +114,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. +*> < 0: if INFO = -i, the i-th argument had an illegal value. *> \endverbatim * * Authors: @@ -218,7 +214,7 @@ SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) RETURN END IF * -* Adjubst block size based on the workspace size +* Adjust block size based on the workspace size * IF( LWORK.LT.((1+NB)*N) ) THEN NB = ( LWORK-N ) / N diff --git a/SRC/zsytrf_aa.f b/SRC/zsytrf_aa.f index bb832fc4cf..269f664f98 100644 --- a/SRC/zsytrf_aa.f +++ b/SRC/zsytrf_aa.f @@ -114,11 +114,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization -*> has been completed, but the block diagonal matrix D is -*> exactly singular, and division by zero will occur if it -*> is used to solve a system of equations. +*> < 0: if INFO = -i, the i-th argument had an illegal value. *> \endverbatim * * Authors: @@ -217,7 +213,7 @@ SUBROUTINE ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) RETURN END IF * -* Adjubst block size based on the workspace size +* Adjust block size based on the workspace size * IF( LWORK.LT.((1+NB)*N) ) THEN NB = ( LWORK-N ) / N