Go to the documentation of this file.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_zsprfs( int matrix_order, char uplo, lapack_int n,
00038 lapack_int nrhs, const lapack_complex_double* ap,
00039 const lapack_complex_double* afp,
00040 const lapack_int* ipiv,
00041 const lapack_complex_double* b, lapack_int ldb,
00042 lapack_complex_double* x, lapack_int ldx,
00043 double* ferr, double* berr )
00044 {
00045 lapack_int info = 0;
00046 double* rwork = NULL;
00047 lapack_complex_double* work = NULL;
00048 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00049 LAPACKE_xerbla( "LAPACKE_zsprfs", -1 );
00050 return -1;
00051 }
00052 #ifndef LAPACK_DISABLE_NAN_CHECK
00053
00054 if( LAPACKE_zsp_nancheck( n, afp ) ) {
00055 return -6;
00056 }
00057 if( LAPACKE_zsp_nancheck( n, ap ) ) {
00058 return -5;
00059 }
00060 if( LAPACKE_zge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
00061 return -8;
00062 }
00063 if( LAPACKE_zge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
00064 return -10;
00065 }
00066 #endif
00067
00068 rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
00069 if( rwork == NULL ) {
00070 info = LAPACK_WORK_MEMORY_ERROR;
00071 goto exit_level_0;
00072 }
00073 work = (lapack_complex_double*)
00074 LAPACKE_malloc( sizeof(lapack_complex_double) * MAX(1,2*n) );
00075 if( work == NULL ) {
00076 info = LAPACK_WORK_MEMORY_ERROR;
00077 goto exit_level_1;
00078 }
00079
00080 info = LAPACKE_zsprfs_work( matrix_order, uplo, n, nrhs, ap, afp, ipiv, b,
00081 ldb, x, ldx, ferr, berr, work, rwork );
00082
00083 LAPACKE_free( work );
00084 exit_level_1:
00085 LAPACKE_free( rwork );
00086 exit_level_0:
00087 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00088 LAPACKE_xerbla( "LAPACKE_zsprfs", info );
00089 }
00090 return info;
00091 }