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_ztprfs( int matrix_order, char uplo, char trans, char diag,
00038 lapack_int n, lapack_int nrhs,
00039 const lapack_complex_double* ap,
00040 const lapack_complex_double* b, lapack_int ldb,
00041 const lapack_complex_double* x, lapack_int ldx,
00042 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_ztprfs", -1 );
00049 return -1;
00050 }
00051 #ifndef LAPACK_DISABLE_NAN_CHECK
00052
00053 if( LAPACKE_ztp_nancheck( matrix_order, uplo, diag, n, ap ) ) {
00054 return -7;
00055 }
00056 if( LAPACKE_zge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
00057 return -8;
00058 }
00059 if( LAPACKE_zge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
00060 return -10;
00061 }
00062 #endif
00063
00064 rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
00065 if( rwork == NULL ) {
00066 info = LAPACK_WORK_MEMORY_ERROR;
00067 goto exit_level_0;
00068 }
00069 work = (lapack_complex_double*)
00070 LAPACKE_malloc( sizeof(lapack_complex_double) * MAX(1,2*n) );
00071 if( work == NULL ) {
00072 info = LAPACK_WORK_MEMORY_ERROR;
00073 goto exit_level_1;
00074 }
00075
00076 info = LAPACKE_ztprfs_work( matrix_order, uplo, trans, diag, n, nrhs, ap, b,
00077 ldb, x, ldx, ferr, berr, work, rwork );
00078
00079 LAPACKE_free( work );
00080 exit_level_1:
00081 LAPACKE_free( rwork );
00082 exit_level_0:
00083 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00084 LAPACKE_xerbla( "LAPACKE_ztprfs", info );
00085 }
00086 return info;
00087 }