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_zppsvx( int matrix_order, char fact, char uplo, lapack_int n,
00038 lapack_int nrhs, lapack_complex_double* ap,
00039 lapack_complex_double* afp, char* equed, double* s,
00040 lapack_complex_double* b, lapack_int ldb,
00041 lapack_complex_double* x, lapack_int ldx,
00042 double* rcond, double* ferr, double* berr )
00043 {
00044 lapack_int info = 0;
00045 double* rwork = NULL;
00046 lapack_complex_double* work = NULL;
00047 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00048 LAPACKE_xerbla( "LAPACKE_zppsvx", -1 );
00049 return -1;
00050 }
00051 #ifndef LAPACK_DISABLE_NAN_CHECK
00052
00053 if( LAPACKE_lsame( fact, 'f' ) ) {
00054 if( LAPACKE_zpp_nancheck( n, afp ) ) {
00055 return -7;
00056 }
00057 }
00058 if( LAPACKE_zpp_nancheck( n, ap ) ) {
00059 return -6;
00060 }
00061 if( LAPACKE_zge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
00062 return -10;
00063 }
00064 if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
00065 if( LAPACKE_d_nancheck( n, s, 1 ) ) {
00066 return -9;
00067 }
00068 }
00069 #endif
00070
00071 rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
00072 if( rwork == NULL ) {
00073 info = LAPACK_WORK_MEMORY_ERROR;
00074 goto exit_level_0;
00075 }
00076 work = (lapack_complex_double*)
00077 LAPACKE_malloc( sizeof(lapack_complex_double) * MAX(1,2*n) );
00078 if( work == NULL ) {
00079 info = LAPACK_WORK_MEMORY_ERROR;
00080 goto exit_level_1;
00081 }
00082
00083 info = LAPACKE_zppsvx_work( matrix_order, fact, uplo, n, nrhs, ap, afp,
00084 equed, s, b, ldb, x, ldx, rcond, ferr, berr,
00085 work, rwork );
00086
00087 LAPACKE_free( work );
00088 exit_level_1:
00089 LAPACKE_free( rwork );
00090 exit_level_0:
00091 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00092 LAPACKE_xerbla( "LAPACKE_zppsvx", info );
00093 }
00094 return info;
00095 }