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_sgtsvx( int matrix_order, char fact, char trans,
00038 lapack_int n, lapack_int nrhs, const float* dl,
00039 const float* d, const float* du, float* dlf,
00040 float* df, float* duf, float* du2, lapack_int* ipiv,
00041 const float* b, lapack_int ldb, float* x,
00042 lapack_int ldx, float* rcond, float* ferr,
00043 float* berr )
00044 {
00045 lapack_int info = 0;
00046 lapack_int* iwork = NULL;
00047 float* work = NULL;
00048 if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
00049 LAPACKE_xerbla( "LAPACKE_sgtsvx", -1 );
00050 return -1;
00051 }
00052 #ifndef LAPACK_DISABLE_NAN_CHECK
00053
00054 if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
00055 return -14;
00056 }
00057 if( LAPACKE_s_nancheck( n, d, 1 ) ) {
00058 return -7;
00059 }
00060 if( LAPACKE_lsame( fact, 'f' ) ) {
00061 if( LAPACKE_s_nancheck( n, df, 1 ) ) {
00062 return -10;
00063 }
00064 }
00065 if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
00066 return -6;
00067 }
00068 if( LAPACKE_lsame( fact, 'f' ) ) {
00069 if( LAPACKE_s_nancheck( n-1, dlf, 1 ) ) {
00070 return -9;
00071 }
00072 }
00073 if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
00074 return -8;
00075 }
00076 if( LAPACKE_lsame( fact, 'f' ) ) {
00077 if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
00078 return -12;
00079 }
00080 }
00081 if( LAPACKE_lsame( fact, 'f' ) ) {
00082 if( LAPACKE_s_nancheck( n-1, duf, 1 ) ) {
00083 return -11;
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 = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
00094 if( work == NULL ) {
00095 info = LAPACK_WORK_MEMORY_ERROR;
00096 goto exit_level_1;
00097 }
00098
00099 info = LAPACKE_sgtsvx_work( matrix_order, fact, trans, n, nrhs, dl, d, du,
00100 dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond,
00101 ferr, berr, work, iwork );
00102
00103 LAPACKE_free( work );
00104 exit_level_1:
00105 LAPACKE_free( iwork );
00106 exit_level_0:
00107 if( info == LAPACK_WORK_MEMORY_ERROR ) {
00108 LAPACKE_xerbla( "LAPACKE_sgtsvx", info );
00109 }
00110 return info;
00111 }