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_cppsvx_work( int matrix_order, char fact, char uplo,
00038 lapack_int n, lapack_int nrhs,
00039 lapack_complex_float* ap,
00040 lapack_complex_float* afp, char* equed,
00041 float* s, lapack_complex_float* b,
00042 lapack_int ldb, lapack_complex_float* x,
00043 lapack_int ldx, float* rcond, float* ferr,
00044 float* berr, lapack_complex_float* work,
00045 float* rwork )
00046 {
00047 lapack_int info = 0;
00048 if( matrix_order == LAPACK_COL_MAJOR ) {
00049
00050 LAPACK_cppsvx( &fact, &uplo, &n, &nrhs, ap, afp, equed, s, b, &ldb, x,
00051 &ldx, rcond, ferr, berr, work, rwork, &info );
00052 if( info < 0 ) {
00053 info = info - 1;
00054 }
00055 } else if( matrix_order == LAPACK_ROW_MAJOR ) {
00056 lapack_int ldb_t = MAX(1,n);
00057 lapack_int ldx_t = MAX(1,n);
00058 lapack_complex_float* b_t = NULL;
00059 lapack_complex_float* x_t = NULL;
00060 lapack_complex_float* ap_t = NULL;
00061 lapack_complex_float* afp_t = NULL;
00062
00063 if( ldb < nrhs ) {
00064 info = -11;
00065 LAPACKE_xerbla( "LAPACKE_cppsvx_work", info );
00066 return info;
00067 }
00068 if( ldx < nrhs ) {
00069 info = -13;
00070 LAPACKE_xerbla( "LAPACKE_cppsvx_work", info );
00071 return info;
00072 }
00073
00074 b_t = (lapack_complex_float*)
00075 LAPACKE_malloc( sizeof(lapack_complex_float) *
00076 ldb_t * MAX(1,nrhs) );
00077 if( b_t == NULL ) {
00078 info = LAPACK_TRANSPOSE_MEMORY_ERROR;
00079 goto exit_level_0;
00080 }
00081 x_t = (lapack_complex_float*)
00082 LAPACKE_malloc( sizeof(lapack_complex_float) *
00083 ldx_t * MAX(1,nrhs) );
00084 if( x_t == NULL ) {
00085 info = LAPACK_TRANSPOSE_MEMORY_ERROR;
00086 goto exit_level_1;
00087 }
00088 ap_t = (lapack_complex_float*)
00089 LAPACKE_malloc( sizeof(lapack_complex_float) *
00090 ( MAX(1,n) * MAX(2,n+1) ) / 2 );
00091 if( ap_t == NULL ) {
00092 info = LAPACK_TRANSPOSE_MEMORY_ERROR;
00093 goto exit_level_2;
00094 }
00095 afp_t = (lapack_complex_float*)
00096 LAPACKE_malloc( sizeof(lapack_complex_float) *
00097 ( MAX(1,n) * MAX(2,n+1) ) / 2 );
00098 if( afp_t == NULL ) {
00099 info = LAPACK_TRANSPOSE_MEMORY_ERROR;
00100 goto exit_level_3;
00101 }
00102
00103 LAPACKE_cge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
00104 LAPACKE_cpp_trans( matrix_order, uplo, n, ap, ap_t );
00105 if( LAPACKE_lsame( fact, 'f' ) ) {
00106 LAPACKE_cpp_trans( matrix_order, uplo, n, afp, afp_t );
00107 }
00108
00109 LAPACK_cppsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, equed, s, b_t,
00110 &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, rwork,
00111 &info );
00112 if( info < 0 ) {
00113 info = info - 1;
00114 }
00115
00116 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
00117 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
00118 if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) {
00119 LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
00120 }
00121 if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
00122 LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp );
00123 }
00124
00125 LAPACKE_free( afp_t );
00126 exit_level_3:
00127 LAPACKE_free( ap_t );
00128 exit_level_2:
00129 LAPACKE_free( x_t );
00130 exit_level_1:
00131 LAPACKE_free( b_t );
00132 exit_level_0:
00133 if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
00134 LAPACKE_xerbla( "LAPACKE_cppsvx_work", info );
00135 }
00136 } else {
00137 info = -1;
00138 LAPACKE_xerbla( "LAPACKE_cppsvx_work", info );
00139 }
00140 return info;
00141 }