From e6a1be32cd979edb7369b6f208d6734128e2c2aa Mon Sep 17 00:00:00 2001 From: Ichitaro Yamazaki Date: Sun, 20 Nov 2016 20:39:53 -0500 Subject: [PATCH] skip checking solution in tester since xSYTRI is not implemented to compute condition number. --- TESTING/LIN/cchkaa.f | 2 +- TESTING/LIN/cdrvhe_aa.f | 37 +----------------------------- TESTING/LIN/cdrvsy_aa.f | 36 +---------------------------- TESTING/LIN/chet01_aa.f | 36 +++++++++++++++-------------- TESTING/LIN/csyt01_aa.f | 36 ++++++++++++++--------------- TESTING/LIN/ddrvsy_aa.f | 36 +---------------------------- TESTING/LIN/dsyt01_aa.f | 34 ++++++++++++++-------------- TESTING/LIN/sdrvsy_aa.f | 36 +---------------------------- TESTING/LIN/ssyt01_aa.f | 34 ++++++++++++++-------------- TESTING/LIN/zdrvhe_aa.f | 35 +---------------------------- TESTING/LIN/zdrvsy_aa.f | 36 +---------------------------- TESTING/LIN/zhet01_aa.f | 60 +++++++++++++++++++++++++------------------------ TESTING/LIN/zsyt01_aa.f | 36 ++++++++++++++--------------- 13 files changed, 127 insertions(+), 327 deletions(-) diff --git a/TESTING/LIN/cchkaa.f b/TESTING/LIN/cchkaa.f index 5a32fb2..f2ef59f 100644 --- a/TESTING/LIN/cchkaa.f +++ b/TESTING/LIN/cchkaa.f @@ -840,7 +840,7 @@ IF( TSTCHK ) THEN CALL CCHKSY_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), - $ E, A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), + $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/cdrvhe_aa.f b/TESTING/LIN/cdrvhe_aa.f index 77f26dc..c21a888 100644 --- a/TESTING/LIN/cdrvhe_aa.f +++ b/TESTING/LIN/cdrvhe_aa.f @@ -392,36 +392,6 @@ IF( IFACT.EQ.1 ) $ GO TO 150 RCONDC = ZERO -* - ELSE IF( IFACT.EQ.1 ) THEN -* -* Compute the 1-norm of A. -* - ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK ) -* -* Factor the matrix A. -* -c CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) -c SRNAMT = 'CHETRF_AA' -c CALL CHETRF_AA( UPLO, N, AFAC, LDA, IWORK, -c $ WORK, LWORK, INFO ) -* -* Compute inv(A) and take its norm. -* -c CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) -c LWORK = (N+NB+1)*(NB+3) -c SRNAMT = 'CHETRI2' -c CALL CHETRI2( UPLO, N, AINV, LDA, IWORK, WORK, -c $ LWORK, INFO ) -c AINVNM = CLANHE( '1', UPLO, N, AINV, LDA, RWORK ) -* -* Compute the 1-norm condition number of A. -* -c IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN -c RCONDC = ONE -c ELSE -c RCONDC = ( ONE / ANORM ) / AINVNM -c END IF END IF * * Form an exact solution and set the right hand side. @@ -487,12 +457,7 @@ c END IF CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, $ LDA, RWORK, RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 3 ) ) - NT = 3 + NT = 2 * * Print information about the tests that did not pass * the threshold. diff --git a/TESTING/LIN/cdrvsy_aa.f b/TESTING/LIN/cdrvsy_aa.f index b1e6b3b..7ace06e 100644 --- a/TESTING/LIN/cdrvsy_aa.f +++ b/TESTING/LIN/cdrvsy_aa.f @@ -387,35 +387,6 @@ IF( IFACT.EQ.1 ) $ GO TO 150 RCONDC = ZERO -* - ELSE IF( IFACT.EQ.1 ) THEN -* -* Compute the 1-norm of A. -* - ANORM = CLANSY( '1', UPLO, N, A, LDA, RWORK ) -* -* Factor the matrix A. -* -c CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) -c CALL CSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK, -c $ LWORK, INFO ) -* -* Compute inv(A) and take its norm. -* -c CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) -c LWORK = (N+NB+1)*(NB+3) -c SRNAMT = 'DSYTRI2' -c CALL DSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK, -c $ LWORK, INFO ) -c AINVNM = CLANSY( '1', UPLO, N, AINV, LDA, RWORK ) -* -* Compute the 1-norm condition number of A. -* -c IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN -c RCONDC = ONE -c ELSE -c RCONDC = ( ONE / ANORM ) / AINVNM -c END IF END IF * * Form an exact solution and set the right hand side. @@ -481,12 +452,7 @@ c END IF CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, $ LDA, RWORK, RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 3 ) ) - NT = 3 + NT = 2 * * Print information about the tests that did not pass * the threshold. diff --git a/TESTING/LIN/chet01_aa.f b/TESTING/LIN/chet01_aa.f index c2b237d..31b504d 100644 --- a/TESTING/LIN/chet01_aa.f +++ b/TESTING/LIN/chet01_aa.f @@ -197,27 +197,29 @@ $ LDC+1 ) CALL CLACGV( N-1, C( 1, 2 ), LDC+1 ) ENDIF - ENDIF * -* Call CTRMM to form the product U' * D (or L * D ). +* Call CTRMM to form the product U' * D (or L * D ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL CTRMM( 'Left', UPLO, 'Conjugate transpose', 'Unit', N-1, - $ N, CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC ) - ELSE - CALL CTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, - $ CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL CTRMM( 'Left', UPLO, 'Conjugate transpose', 'Unit', + $ N-1, N, CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), + $ LDC ) + ELSE + CALL CTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, + $ CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) + END IF * -* Call CTRMM again to multiply by U (or L ). +* Call CTRMM again to multiply by U (or L ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL CTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, - $ CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) - ELSE - CALL CTRMM( 'Right', UPLO, 'Conjugate transpose', 'Unit', N, - $ N-1, CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL CTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, + $ CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) + ELSE + CALL CTRMM( 'Right', UPLO, 'Conjugate transpose', 'Unit', N, + $ N-1, CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), + $ LDC ) + END IF + ENDIF * * Apply hermitian pivots * diff --git a/TESTING/LIN/csyt01_aa.f b/TESTING/LIN/csyt01_aa.f index abcd079..7c7382a 100644 --- a/TESTING/LIN/csyt01_aa.f +++ b/TESTING/LIN/csyt01_aa.f @@ -195,29 +195,29 @@ CALL CLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 2, 1 ), $ LDC+1 ) ENDIF - ENDIF * -* Call CTRMM to form the product U' * D (or L * D ). +* Call CTRMM to form the product U' * D (or L * D ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL CTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N, - $ CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC ) - ELSE - CALL CTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, - $ CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL CTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N, + $ CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC ) + ELSE + CALL CTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, + $ CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) + END IF * -* Call CTRMM again to multiply by U (or L ). +* Call CTRMM again to multiply by U (or L ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL CTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, - $ CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) - ELSE - CALL CTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1, - $ CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL CTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, + $ CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) + ELSE + CALL CTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1, + $ CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC ) + END IF + ENDIF * -* Apply hermitian pivots +* Apply symmetric pivots * DO J = N, 1, -1 I = IPIV( J ) diff --git a/TESTING/LIN/ddrvsy_aa.f b/TESTING/LIN/ddrvsy_aa.f index 08a6bac..1b350fc 100644 --- a/TESTING/LIN/ddrvsy_aa.f +++ b/TESTING/LIN/ddrvsy_aa.f @@ -383,35 +383,6 @@ IF( IFACT.EQ.1 ) $ GO TO 150 RCONDC = ZERO -* - ELSE IF( IFACT.EQ.1 ) THEN -* -* Compute the 1-norm of A. -* - ANORM = DLANSY( '1', UPLO, N, A, LDA, RWORK ) -* -* Factor the matrix A. -* -c CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) -c CALL DSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK, -c $ LWORK, INFO ) -* -* Compute inv(A) and take its norm. -* -c CALL DLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) -c LWORK = (N+NB+1)*(NB+3) -c SRNAMT = 'DSYTRI2' -c CALL DSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK, -c $ LWORK, INFO ) -c AINVNM = DLANSY( '1', UPLO, N, AINV, LDA, RWORK ) -* -* Compute the 1-norm condition number of A. -* -c IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN -c RCONDC = ONE -c ELSE -c RCONDC = ( ONE / ANORM ) / AINVNM -c END IF END IF * * Form an exact solution and set the right hand side. @@ -477,12 +448,7 @@ c END IF CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, $ LDA, RWORK, RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 3 ) ) - NT = 3 + NT = 2 * * Print information about the tests that did not pass * the threshold. diff --git a/TESTING/LIN/dsyt01_aa.f b/TESTING/LIN/dsyt01_aa.f index c0654e7..3a704de 100644 --- a/TESTING/LIN/dsyt01_aa.f +++ b/TESTING/LIN/dsyt01_aa.f @@ -193,27 +193,27 @@ CALL DLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 2, 1 ), $ LDC+1 ) ENDIF - ENDIF * -* Call DTRMM to form the product U' * D (or L * D ). +* Call DTRMM to form the product U' * D (or L * D ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL DTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N, - $ ONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC ) - ELSE - CALL DTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, - $ ONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL DTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N, + $ ONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC ) + ELSE + CALL DTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, + $ ONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) + END IF * -* Call DTRMM again to multiply by U (or L ). +* Call DTRMM again to multiply by U (or L ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL DTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, - $ ONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) - ELSE - CALL DTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1, - $ ONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL DTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, + $ ONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) + ELSE + CALL DTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1, + $ ONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC ) + END IF + ENDIF * * Apply symmetric pivots * diff --git a/TESTING/LIN/sdrvsy_aa.f b/TESTING/LIN/sdrvsy_aa.f index ffdccee..8332df1 100644 --- a/TESTING/LIN/sdrvsy_aa.f +++ b/TESTING/LIN/sdrvsy_aa.f @@ -381,35 +381,6 @@ IF( IFACT.EQ.1 ) $ GO TO 150 RCONDC = ZERO -* - ELSE IF( IFACT.EQ.1 ) THEN -* -* Compute the 1-norm of A. -* - ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) -* -* Factor the matrix A. -* -c CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) -c CALL SSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK, -c $ LWORK, INFO ) -* -* Compute inv(A) and take its norm. -* -c CALL SLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) -c LWORK = (N+NB+1)*(NB+3) -c SRNAMT = 'DSYTRI2' -c CALL DSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK, -c $ LWORK, INFO ) -c AINVNM = SLANSY( '1', UPLO, N, AINV, LDA, RWORK ) -* -* Compute the 1-norm condition number of A. -* -c IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN -c RCONDC = ONE -c ELSE -c RCONDC = ( ONE / ANORM ) / AINVNM -c END IF END IF * * Form an exact solution and set the right hand side. @@ -475,12 +446,7 @@ c END IF CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, $ LDA, RWORK, RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 3 ) ) - NT = 3 + NT = 2 * * Print information about the tests that did not pass * the threshold. diff --git a/TESTING/LIN/ssyt01_aa.f b/TESTING/LIN/ssyt01_aa.f index e70dc2b..5855ba2 100644 --- a/TESTING/LIN/ssyt01_aa.f +++ b/TESTING/LIN/ssyt01_aa.f @@ -192,27 +192,27 @@ CALL SLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 2, 1 ), $ LDC+1 ) ENDIF - ENDIF * -* Call STRMM to form the product U' * D (or L * D ). +* Call STRMM to form the product U' * D (or L * D ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL STRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N, - $ ONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC ) - ELSE - CALL STRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, - $ ONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL STRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N, + $ ONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC ) + ELSE + CALL STRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, + $ ONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) + END IF * -* Call STRMM again to multiply by U (or L ). +* Call STRMM again to multiply by U (or L ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL STRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, - $ ONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) - ELSE - CALL STRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1, - $ ONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL STRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, + $ ONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) + ELSE + CALL STRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1, + $ ONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC ) + END IF + ENDIF * * Apply symmetric pivots * diff --git a/TESTING/LIN/zdrvhe_aa.f b/TESTING/LIN/zdrvhe_aa.f index 1322150..129ae62 100644 --- a/TESTING/LIN/zdrvhe_aa.f +++ b/TESTING/LIN/zdrvhe_aa.f @@ -390,34 +390,6 @@ IF( IFACT.EQ.1 ) $ GO TO 150 RCONDC = ZERO -* - ELSE IF( IFACT.EQ.1 ) THEN -* -* Compute the 1-norm of A. -* - ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK ) -* -* Factor the matrix A. -* -c CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) -c CALL ZHETRF( UPLO, N, AFAC, LDA, IWORK, WORK, -c $ LWORK, INFO ) -* -* Compute inv(A) and take its norm. -* -c CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) -c LWORK = (N+NB+1)*(NB+3) -c CALL ZHETRI2( UPLO, N, AINV, LDA, IWORK, WORK, -c $ LWORK, INFO ) -c AINVNM = ZLANHE( '1', UPLO, N, AINV, LDA, RWORK ) -* -* Compute the 1-norm condition number of A. -* -c IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN -c RCONDC = ONE -c ELSE -c RCONDC = ( ONE / ANORM ) / AINVNM -c END IF END IF * * Form an exact solution and set the right hand side. @@ -483,12 +455,7 @@ c END IF CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, $ LDA, RWORK, RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 3 ) ) - NT = 3 + NT = 2 * * Print information about the tests that did not pass * the threshold. diff --git a/TESTING/LIN/zdrvsy_aa.f b/TESTING/LIN/zdrvsy_aa.f index c933fdc..322fd3b 100644 --- a/TESTING/LIN/zdrvsy_aa.f +++ b/TESTING/LIN/zdrvsy_aa.f @@ -387,35 +387,6 @@ IF( IFACT.EQ.1 ) $ GO TO 150 RCONDC = ZERO -* - ELSE IF( IFACT.EQ.1 ) THEN -* -* Compute the 1-norm of A. -* - ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK ) -* -* Factor the matrix A. -* -c CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) -c CALL ZSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK, -c $ LWORK, INFO ) -* -* Compute inv(A) and take its norm. -* -c CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) -c LWORK = (N+NB+1)*(NB+3) -c SRNAMT = 'DSYTRI2' -c CALL DSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK, -c $ LWORK, INFO ) -c AINVNM = ZLANSY( '1', UPLO, N, AINV, LDA, RWORK ) -* -* Compute the 1-norm condition number of A. -* -c IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN -c RCONDC = ONE -c ELSE -c RCONDC = ( ONE / ANORM ) / AINVNM -c END IF END IF * * Form an exact solution and set the right hand side. @@ -481,12 +452,7 @@ c END IF CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, $ LDA, RWORK, RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 3 ) ) - NT = 3 + NT = 2 * * Print information about the tests that did not pass * the threshold. diff --git a/TESTING/LIN/zhet01_aa.f b/TESTING/LIN/zhet01_aa.f index 760926b..c4734fc 100644 --- a/TESTING/LIN/zhet01_aa.f +++ b/TESTING/LIN/zhet01_aa.f @@ -197,40 +197,42 @@ $ LDC+1 ) CALL ZLACGV( N-1, C( 1, 2 ), LDC+1 ) ENDIF - ENDIF * -* Call ZTRMM to form the product U' * D (or L * D ). +* Call ZTRMM to form the product U' * D (or L * D ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL ZTRMM( 'Left', UPLO, 'Conjugate transpose', 'Unit', N-1, - $ N, CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC ) - ELSE - CALL ZTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, - $ CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL ZTRMM( 'Left', UPLO, 'Conjugate transpose', 'Unit', + $ N-1, N, CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), + $ LDC ) + ELSE + CALL ZTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, + $ CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) + END IF * -* Call ZTRMM again to multiply by U (or L ). +* Call ZTRMM again to multiply by U (or L ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL ZTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, - $ CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) - ELSE - CALL ZTRMM( 'Right', UPLO, 'Conjugate transpose', 'Unit', N, - $ N-1, CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL ZTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, + $ CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) + ELSE + CALL ZTRMM( 'Right', UPLO, 'Conjugate transpose', 'Unit', N, + $ N-1, CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), + $ LDC ) + END IF +* +* Apply hermitian pivots * -* Apply hermitian pivots -* - DO J = N, 1, -1 - I = IPIV( J ) - IF( I.NE.J ) - $ CALL ZSWAP( N, C( J, 1 ), LDC, C( I, 1 ), LDC ) - END DO - DO J = N, 1, -1 - I = IPIV( J ) - IF( I.NE.J ) - $ CALL ZSWAP( N, C( 1, J ), 1, C( 1, I ), 1 ) - END DO + DO J = N, 1, -1 + I = IPIV( J ) + IF( I.NE.J ) + $ CALL ZSWAP( N, C( J, 1 ), LDC, C( I, 1 ), LDC ) + END DO + DO J = N, 1, -1 + I = IPIV( J ) + IF( I.NE.J ) + $ CALL ZSWAP( N, C( 1, J ), 1, C( 1, I ), 1 ) + END DO + ENDIF * * * Compute the difference C - A . diff --git a/TESTING/LIN/zsyt01_aa.f b/TESTING/LIN/zsyt01_aa.f index 7660a57..988f4be 100644 --- a/TESTING/LIN/zsyt01_aa.f +++ b/TESTING/LIN/zsyt01_aa.f @@ -195,29 +195,29 @@ CALL ZLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 2, 1 ), $ LDC+1 ) ENDIF - ENDIF * -* Call ZTRMM to form the product U' * D (or L * D ). +* Call ZTRMM to form the product U' * D (or L * D ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL ZTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N, - $ CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC ) - ELSE - CALL ZTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, - $ CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL ZTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N, + $ CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC ) + ELSE + CALL ZTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N, + $ CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC ) + END IF * -* Call ZTRMM again to multiply by U (or L ). +* Call ZTRMM again to multiply by U (or L ). * - IF( LSAME( UPLO, 'U' ) ) THEN - CALL ZTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, - $ CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) - ELSE - CALL ZTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1, - $ CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC ) - END IF + IF( LSAME( UPLO, 'U' ) ) THEN + CALL ZTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1, + $ CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC ) + ELSE + CALL ZTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1, + $ CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC ) + END IF + ENDIF * -* Apply hermitian pivots +* Apply symmetric pivots * DO J = N, 1, -1 I = IPIV( J ) -- 2.7.4