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_dpbrfs( int matrix_order, char uplo, lapack_int n,
00038 lapack_int kd, lapack_int nrhs, const double* ab,
00039 lapack_int ldab, const double* afb, lapack_int ldafb,
00040 const double* b, lapack_int ldb, double* x,
00041 lapack_int ldx, double* ferr, double* berr )
00042 {
00043 lapack_int info = 0;
00044 lapack_int* iwork = NULL;
00045 double* work = NULL;
00046 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00047 LAPACKE_xerbla( "LAPACKE_dpbrfs", -1 );
00048 return -1;
00049 }
00050 #ifndef LAPACK_DISABLE_NAN_CHECK
00051
00052 if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kd, ab, ldab ) ) {
00053 return -6;
00054 }
00055 if( LAPACKE_dpb_nancheck( matrix_order, uplo, n, kd, afb, ldafb ) ) {
00056 return -8;
00057 }
00058 if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
00059 return -10;
00060 }
00061 if( LAPACKE_dge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
00062 return -12;
00063 }
00064 #endif
00065
00066 iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) );
00067 if( iwork == NULL ) {
00068 info = LAPACK_WORK_MEMORY_ERROR;
00069 goto exit_level_0;
00070 }
00071 work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,3*n) );
00072 if( work == NULL ) {
00073 info = LAPACK_WORK_MEMORY_ERROR;
00074 goto exit_level_1;
00075 }
00076
00077 info = LAPACKE_dpbrfs_work( matrix_order, uplo, n, kd, nrhs, ab, ldab, afb,
00078 ldafb, b, ldb, x, ldx, ferr, berr, work,
00079 iwork );
00080
00081 LAPACKE_free( work );
00082 exit_level_1:
00083 LAPACKE_free( iwork );
00084 exit_level_0:
00085 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00086 LAPACKE_xerbla( "LAPACKE_dpbrfs", info );
00087 }
00088 return info;
00089 }