00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034 #include "lapacke.h"
00035 #include "lapacke_utils.h"
00036
00037 lapack_int LAPACKE_sporfsx( int matrix_order, char uplo, char equed,
00038 lapack_int n, lapack_int nrhs, const float* a,
00039 lapack_int lda, const float* af, lapack_int ldaf,
00040 const float* s, const float* b, lapack_int ldb,
00041 float* x, lapack_int ldx, float* rcond, float* berr,
00042 lapack_int n_err_bnds, float* err_bnds_norm,
00043 float* err_bnds_comp, lapack_int nparams,
00044 float* params )
00045 {
00046 lapack_int info = 0;
00047 lapack_int* iwork = NULL;
00048 float* work = NULL;
00049 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00050 LAPACKE_xerbla( "LAPACKE_sporfsx", -1 );
00051 return -1;
00052 }
00053 #ifndef LAPACK_DISABLE_NAN_CHECK
00054
00055 if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, a, lda ) ) {
00056 return -6;
00057 }
00058 if( LAPACKE_ssy_nancheck( matrix_order, uplo, n, af, ldaf ) ) {
00059 return -8;
00060 }
00061 if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
00062 return -11;
00063 }
00064 if( nparams>0 ) {
00065 if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
00066 return -21;
00067 }
00068 }
00069 if( LAPACKE_lsame( equed, 'y' ) ) {
00070 if( LAPACKE_s_nancheck( n, s, 1 ) ) {
00071 return -10;
00072 }
00073 }
00074 if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
00075 return -13;
00076 }
00077 #endif
00078
00079 iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
00080 if( iwork == NULL ) {
00081 info = LAPACK_WORK_MEMORY_ERROR;
00082 goto exit_level_0;
00083 }
00084 work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,4*n) );
00085 if( work == NULL ) {
00086 info = LAPACK_WORK_MEMORY_ERROR;
00087 goto exit_level_1;
00088 }
00089
00090 info = LAPACKE_sporfsx_work( matrix_order, uplo, equed, n, nrhs, a, lda, af,
00091 ldaf, s, b, ldb, x, ldx, rcond, berr,
00092 n_err_bnds, err_bnds_norm, err_bnds_comp,
00093 nparams, params, work, iwork );
00094
00095 LAPACKE_free( work );
00096 exit_level_1:
00097 LAPACKE_free( iwork );
00098 exit_level_0:
00099 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00100 LAPACKE_xerbla( "LAPACKE_sporfsx", info );
00101 }
00102 return info;
00103 }