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_dgbsvxx( int matrix_order, char fact, char trans,
00038 lapack_int n, lapack_int kl, lapack_int ku,
00039 lapack_int nrhs, double* ab, lapack_int ldab,
00040 double* afb, lapack_int ldafb, lapack_int* ipiv,
00041 char* equed, double* r, double* c, double* b,
00042 lapack_int ldb, double* x, lapack_int ldx,
00043 double* rcond, double* rpvgrw, double* berr,
00044 lapack_int n_err_bnds, double* err_bnds_norm,
00045 double* err_bnds_comp, lapack_int nparams,
00046 double* params )
00047 {
00048 lapack_int info = 0;
00049 lapack_int* iwork = NULL;
00050 double* work = NULL;
00051 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00052 LAPACKE_xerbla( "LAPACKE_dgbsvxx", -1 );
00053 return -1;
00054 }
00055 #ifndef LAPACK_DISABLE_NAN_CHECK
00056
00057 if( LAPACKE_dgb_nancheck( matrix_order, n, n, kl, ku, ab, ldab ) ) {
00058 return -8;
00059 }
00060 if( LAPACKE_lsame( fact, 'f' ) ) {
00061 if( LAPACKE_dgb_nancheck( matrix_order, n, n, kl, kl+ku, afb,
00062 ldafb ) ) {
00063 return -10;
00064 }
00065 }
00066 if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
00067 return -16;
00068 }
00069 if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
00070 LAPACKE_lsame( *equed, 'c' ) ) ) {
00071 if( LAPACKE_d_nancheck( n, c, 1 ) ) {
00072 return -15;
00073 }
00074 }
00075 if( nparams>0 ) {
00076 if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
00077 return -27;
00078 }
00079 }
00080 if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
00081 LAPACKE_lsame( *equed, 'r' ) ) ) {
00082 if( LAPACKE_d_nancheck( n, r, 1 ) ) {
00083 return -14;
00084 }
00085 }
00086 #endif
00087
00088 iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
00089 if( iwork == NULL ) {
00090 info = LAPACK_WORK_MEMORY_ERROR;
00091 goto exit_level_0;
00092 }
00093 work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,4*n) );
00094 if( work == NULL ) {
00095 info = LAPACK_WORK_MEMORY_ERROR;
00096 goto exit_level_1;
00097 }
00098
00099 info = LAPACKE_dgbsvxx_work( matrix_order, fact, trans, n, kl, ku, nrhs, ab,
00100 ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x,
00101 ldx, rcond, rpvgrw, berr, n_err_bnds,
00102 err_bnds_norm, err_bnds_comp, nparams, params,
00103 work, iwork );
00104
00105 LAPACKE_free( work );
00106 exit_level_1:
00107 LAPACKE_free( iwork );
00108 exit_level_0:
00109 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00110 LAPACKE_xerbla( "LAPACKE_dgbsvxx", info );
00111 }
00112 return info;
00113 }