/*------------------------------------------------------------------------ * Check the accuracy of the condition estimator */ static int check_estimator(PLASMA_enum uplo, int N, PLASMA_Complex64_t *A1, int LDA, PLASMA_Complex64_t *A2, double Anorm, double Acond, double eps) { int info_solution; double result, Acond_lapack; double invcond, invcond_lapack; info_solution = LAPACKE_zpocon(LAPACK_COL_MAJOR, lapack_const(uplo), N, A2, LDA, Anorm, &Acond_lapack); if ( info_solution != 0 ) { printf(" PLASMA_zgecon returned info = %d\n", info_solution ); return info_solution; } invcond_lapack = 1. / ( Acond_lapack ); invcond = 1. / ( Acond ); printf("============\n"); printf("Checking the condition number \n"); printf("-- Acond_plasma = %e, Acond_lapack = %e \n" "-- Ainvcond_plasma = %e, Ainvcond_lapack = %e \n", Acond, Acond_lapack, invcond, invcond_lapack ); result = fabs( Acond_lapack - Acond ) / eps; if ( result > 60. ) { printf("-- The solution is suspicious ! \n"); info_solution = 1; } else{ printf("-- The solution is CORRECT ! \n"); info_solution = 0; } return info_solution; }
int main(void) { /* Local scalars */ char uplo, uplo_i; lapack_int n, n_i; lapack_int lda, lda_i; lapack_int lda_r; double anorm, anorm_i; double rcond, rcond_i; lapack_int info, info_i; lapack_int i; int failed; /* Local arrays */ lapack_complex_double *a = NULL, *a_i = NULL; lapack_complex_double *work = NULL, *work_i = NULL; double *rwork = NULL, *rwork_i = NULL; lapack_complex_double *a_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_zpocon( &uplo, &n, &lda, &anorm ); lda_r = n+2; uplo_i = uplo; n_i = n; lda_i = lda; anorm_i = anorm; /* Allocate memory for the LAPACK routine arrays */ a = (lapack_complex_double *) LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) ); work = (lapack_complex_double *) LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) ); rwork = (double *)LAPACKE_malloc( n * sizeof(double) ); /* Allocate memory for the C interface function arrays */ a_i = (lapack_complex_double *) LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) ); work_i = (lapack_complex_double *) LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) ); rwork_i = (double *)LAPACKE_malloc( n * sizeof(double) ); /* Allocate memory for the row-major arrays */ a_r = (lapack_complex_double *) LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) ); /* Initialize input arrays */ init_a( lda*n, a ); init_work( 2*n, work ); init_rwork( n, rwork ); /* Call the LAPACK routine */ zpocon_( &uplo, &n, a, &lda, &anorm, &rcond, work, rwork, &info ); /* Initialize input data, call the column-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a[i]; } for( i = 0; i < 2*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { rwork_i[i] = rwork[i]; } info_i = LAPACKE_zpocon_work( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i, anorm_i, &rcond_i, work_i, rwork_i ); failed = compare_zpocon( rcond, rcond_i, info, info_i ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to zpocon\n" ); } else { printf( "FAILED: column-major middle-level interface to zpocon\n" ); } /* Initialize input data, call the column-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a[i]; } for( i = 0; i < 2*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { rwork_i[i] = rwork[i]; } info_i = LAPACKE_zpocon( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i, anorm_i, &rcond_i ); failed = compare_zpocon( rcond, rcond_i, info, info_i ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to zpocon\n" ); } else { printf( "FAILED: column-major high-level interface to zpocon\n" ); } /* Initialize input data, call the row-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a[i]; } for( i = 0; i < 2*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { rwork_i[i] = rwork[i]; } LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 ); info_i = LAPACKE_zpocon_work( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r, anorm_i, &rcond_i, work_i, rwork_i ); failed = compare_zpocon( rcond, rcond_i, info, info_i ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to zpocon\n" ); } else { printf( "FAILED: row-major middle-level interface to zpocon\n" ); } /* Initialize input data, call the row-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a[i]; } for( i = 0; i < 2*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { rwork_i[i] = rwork[i]; } /* Init row_major arrays */ LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 ); info_i = LAPACKE_zpocon( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r, anorm_i, &rcond_i ); failed = compare_zpocon( rcond, rcond_i, info, info_i ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to zpocon\n" ); } else { printf( "FAILED: row-major high-level interface to zpocon\n" ); } /* Release memory */ if( a != NULL ) { LAPACKE_free( a ); } if( a_i != NULL ) { LAPACKE_free( a_i ); } if( a_r != NULL ) { LAPACKE_free( a_r ); } if( work != NULL ) { LAPACKE_free( work ); } if( work_i != NULL ) { LAPACKE_free( work_i ); } if( rwork != NULL ) { LAPACKE_free( rwork ); } if( rwork_i != NULL ) { LAPACKE_free( rwork_i ); } return 0; }