From 095393a41cc165aa38798b8fc030e2baeb0bdeae Mon Sep 17 00:00:00 2001 From: julie Date: Mon, 15 Aug 2011 20:53:17 +0000 Subject: [PATCH] Correct Bug in the testing of CHERFSX function reported by omitrofa (olga.mitrofanova@intel.com) See Forum 2644 Test of CHERFSX function doesn't work because there is an error in ../TESTING/LIN/cerrhex.f ( lines 284-330 ). This function uses the diagonal pivoting factorization of a Hermitian indefinite matrix instead of the diagonal pivoting factorization of a Hermitian indefinite packed matrix. When CHERFSX is included in conditional "IF( LSAMEN( 2, C2, 'HE' ) ) THEN " the test works. --- TESTING/LIN/cerrhex.f | 94 +++++++++++++++++++++---------------------- 1 file changed, 47 insertions(+), 47 deletions(-) diff --git a/TESTING/LIN/cerrhex.f b/TESTING/LIN/cerrhex.f index 15fd4132..1172225c 100644 --- a/TESTING/LIN/cerrhex.f +++ b/TESTING/LIN/cerrhex.f @@ -217,6 +217,53 @@ CALL CHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK ) * +* CHERFSX +* + N_ERR_BNDS = 3 + NPARAMS = 0 + SRNAMT = 'CHERFSX' + INFOT = 1 + CALL CHERFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, + $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, + $ PARAMS, W, R, INFO ) + CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, + $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, + $ PARAMS, W, R, INFO ) + CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) + EQ = 'N' + INFOT = 3 + CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, + $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, + $ PARAMS, W, R, INFO ) + CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CHERFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1, + $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, + $ PARAMS, W, R, INFO ) + CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) + INFOT = 6 + CALL CHERFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2, + $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, + $ PARAMS, W, R, INFO ) + CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2, + $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, + $ PARAMS, W, R, INFO ) + CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) + INFOT = 11 + CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2, + $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, + $ PARAMS, W, R, INFO ) + CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1, + $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, + $ PARAMS, W, R, INFO ) + CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) +* * Test error exits of the routines that use the diagonal pivoting * factorization of a Hermitian indefinite packed matrix. * @@ -282,53 +329,6 @@ $ INFO ) CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK ) * -* CHERFSX -* - N_ERR_BNDS = 3 - NPARAMS = 0 - SRNAMT = 'CHERFSX' - INFOT = 1 - CALL CHERFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, - $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, - $ PARAMS, W, R, INFO ) - CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) - INFOT = 2 - CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, - $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, - $ PARAMS, W, R, INFO ) - CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) - EQ = 'N' - INFOT = 3 - CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1, - $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, - $ PARAMS, W, R, INFO ) - CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) - INFOT = 4 - CALL CHERFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1, - $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, - $ PARAMS, W, R, INFO ) - CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) - INFOT = 6 - CALL CHERFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2, - $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, - $ PARAMS, W, R, INFO ) - CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) - INFOT = 8 - CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2, - $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, - $ PARAMS, W, R, INFO ) - CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) - INFOT = 11 - CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2, - $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, - $ PARAMS, W, R, INFO ) - CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) - INFOT = 13 - CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1, - $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS, - $ PARAMS, W, R, INFO ) - CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK ) -* * CHPCON * SRNAMT = 'CHPCON' -- 2.34.1