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
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049 #include <stdio.h>
00050 #include "lapacke.h"
00051 #include "lapacke_utils.h"
00052 #include "test_utils.h"
00053
00054 static void init_scalars_ctprfs( char *uplo, char *trans, char *diag,
00055 lapack_int *n, lapack_int *nrhs,
00056 lapack_int *ldb, lapack_int *ldx );
00057 static void init_ap( lapack_int size, lapack_complex_float *ap );
00058 static void init_b( lapack_int size, lapack_complex_float *b );
00059 static void init_x( lapack_int size, lapack_complex_float *x );
00060 static void init_ferr( lapack_int size, float *ferr );
00061 static void init_berr( lapack_int size, float *berr );
00062 static void init_work( lapack_int size, lapack_complex_float *work );
00063 static void init_rwork( lapack_int size, float *rwork );
00064 static int compare_ctprfs( float *ferr, float *ferr_i, float *berr,
00065 float *berr_i, lapack_int info, lapack_int info_i,
00066 lapack_int nrhs );
00067
00068 int main(void)
00069 {
00070
00071 char uplo, uplo_i;
00072 char trans, trans_i;
00073 char diag, diag_i;
00074 lapack_int n, n_i;
00075 lapack_int nrhs, nrhs_i;
00076 lapack_int ldb, ldb_i;
00077 lapack_int ldb_r;
00078 lapack_int ldx, ldx_i;
00079 lapack_int ldx_r;
00080 lapack_int info, info_i;
00081 lapack_int i;
00082 int failed;
00083
00084
00085 lapack_complex_float *ap = NULL, *ap_i = NULL;
00086 lapack_complex_float *b = NULL, *b_i = NULL;
00087 lapack_complex_float *x = NULL, *x_i = NULL;
00088 float *ferr = NULL, *ferr_i = NULL;
00089 float *berr = NULL, *berr_i = NULL;
00090 lapack_complex_float *work = NULL, *work_i = NULL;
00091 float *rwork = NULL, *rwork_i = NULL;
00092 float *ferr_save = NULL;
00093 float *berr_save = NULL;
00094 lapack_complex_float *ap_r = NULL;
00095 lapack_complex_float *b_r = NULL;
00096 lapack_complex_float *x_r = NULL;
00097
00098
00099 init_scalars_ctprfs( &uplo, &trans, &diag, &n, &nrhs, &ldb, &ldx );
00100 ldb_r = nrhs+2;
00101 ldx_r = nrhs+2;
00102 uplo_i = uplo;
00103 trans_i = trans;
00104 diag_i = diag;
00105 n_i = n;
00106 nrhs_i = nrhs;
00107 ldb_i = ldb;
00108 ldx_i = ldx;
00109
00110
00111 ap = (lapack_complex_float *)
00112 LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(lapack_complex_float) );
00113 b = (lapack_complex_float *)
00114 LAPACKE_malloc( ldb*nrhs * sizeof(lapack_complex_float) );
00115 x = (lapack_complex_float *)
00116 LAPACKE_malloc( ldx*nrhs * sizeof(lapack_complex_float) );
00117 ferr = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00118 berr = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00119 work = (lapack_complex_float *)
00120 LAPACKE_malloc( 2*n * sizeof(lapack_complex_float) );
00121 rwork = (float *)LAPACKE_malloc( n * sizeof(float) );
00122
00123
00124 ap_i = (lapack_complex_float *)
00125 LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(lapack_complex_float) );
00126 b_i = (lapack_complex_float *)
00127 LAPACKE_malloc( ldb*nrhs * sizeof(lapack_complex_float) );
00128 x_i = (lapack_complex_float *)
00129 LAPACKE_malloc( ldx*nrhs * sizeof(lapack_complex_float) );
00130 ferr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00131 berr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00132 work_i = (lapack_complex_float *)
00133 LAPACKE_malloc( 2*n * sizeof(lapack_complex_float) );
00134 rwork_i = (float *)LAPACKE_malloc( n * sizeof(float) );
00135
00136
00137 ferr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00138 berr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00139
00140
00141 ap_r = (lapack_complex_float *)
00142 LAPACKE_malloc( n*(n+1)/2 * sizeof(lapack_complex_float) );
00143 b_r = (lapack_complex_float *)
00144 LAPACKE_malloc( n*(nrhs+2) * sizeof(lapack_complex_float) );
00145 x_r = (lapack_complex_float *)
00146 LAPACKE_malloc( n*(nrhs+2) * sizeof(lapack_complex_float) );
00147
00148
00149 init_ap( (n*(n+1)/2), ap );
00150 init_b( ldb*nrhs, b );
00151 init_x( ldx*nrhs, x );
00152 init_ferr( nrhs, ferr );
00153 init_berr( nrhs, berr );
00154 init_work( 2*n, work );
00155 init_rwork( n, rwork );
00156
00157
00158 for( i = 0; i < nrhs; i++ ) {
00159 ferr_save[i] = ferr[i];
00160 }
00161 for( i = 0; i < nrhs; i++ ) {
00162 berr_save[i] = berr[i];
00163 }
00164
00165
00166 ctprfs_( &uplo, &trans, &diag, &n, &nrhs, ap, b, &ldb, x, &ldx, ferr, berr,
00167 work, rwork, &info );
00168
00169
00170
00171 for( i = 0; i < (n*(n+1)/2); i++ ) {
00172 ap_i[i] = ap[i];
00173 }
00174 for( i = 0; i < ldb*nrhs; i++ ) {
00175 b_i[i] = b[i];
00176 }
00177 for( i = 0; i < ldx*nrhs; i++ ) {
00178 x_i[i] = x[i];
00179 }
00180 for( i = 0; i < nrhs; i++ ) {
00181 ferr_i[i] = ferr_save[i];
00182 }
00183 for( i = 0; i < nrhs; i++ ) {
00184 berr_i[i] = berr_save[i];
00185 }
00186 for( i = 0; i < 2*n; i++ ) {
00187 work_i[i] = work[i];
00188 }
00189 for( i = 0; i < n; i++ ) {
00190 rwork_i[i] = rwork[i];
00191 }
00192 info_i = LAPACKE_ctprfs_work( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i,
00193 n_i, nrhs_i, ap_i, b_i, ldb_i, x_i, ldx_i,
00194 ferr_i, berr_i, work_i, rwork_i );
00195
00196 failed = compare_ctprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
00197 if( failed == 0 ) {
00198 printf( "PASSED: column-major middle-level interface to ctprfs\n" );
00199 } else {
00200 printf( "FAILED: column-major middle-level interface to ctprfs\n" );
00201 }
00202
00203
00204
00205 for( i = 0; i < (n*(n+1)/2); i++ ) {
00206 ap_i[i] = ap[i];
00207 }
00208 for( i = 0; i < ldb*nrhs; i++ ) {
00209 b_i[i] = b[i];
00210 }
00211 for( i = 0; i < ldx*nrhs; i++ ) {
00212 x_i[i] = x[i];
00213 }
00214 for( i = 0; i < nrhs; i++ ) {
00215 ferr_i[i] = ferr_save[i];
00216 }
00217 for( i = 0; i < nrhs; i++ ) {
00218 berr_i[i] = berr_save[i];
00219 }
00220 for( i = 0; i < 2*n; i++ ) {
00221 work_i[i] = work[i];
00222 }
00223 for( i = 0; i < n; i++ ) {
00224 rwork_i[i] = rwork[i];
00225 }
00226 info_i = LAPACKE_ctprfs( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i, n_i,
00227 nrhs_i, ap_i, b_i, ldb_i, x_i, ldx_i, ferr_i,
00228 berr_i );
00229
00230 failed = compare_ctprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
00231 if( failed == 0 ) {
00232 printf( "PASSED: column-major high-level interface to ctprfs\n" );
00233 } else {
00234 printf( "FAILED: column-major high-level interface to ctprfs\n" );
00235 }
00236
00237
00238
00239 for( i = 0; i < (n*(n+1)/2); i++ ) {
00240 ap_i[i] = ap[i];
00241 }
00242 for( i = 0; i < ldb*nrhs; i++ ) {
00243 b_i[i] = b[i];
00244 }
00245 for( i = 0; i < ldx*nrhs; i++ ) {
00246 x_i[i] = x[i];
00247 }
00248 for( i = 0; i < nrhs; i++ ) {
00249 ferr_i[i] = ferr_save[i];
00250 }
00251 for( i = 0; i < nrhs; i++ ) {
00252 berr_i[i] = berr_save[i];
00253 }
00254 for( i = 0; i < 2*n; i++ ) {
00255 work_i[i] = work[i];
00256 }
00257 for( i = 0; i < n; i++ ) {
00258 rwork_i[i] = rwork[i];
00259 }
00260
00261 LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
00262 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
00263 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
00264 info_i = LAPACKE_ctprfs_work( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i,
00265 n_i, nrhs_i, ap_r, b_r, ldb_r, x_r, ldx_r,
00266 ferr_i, berr_i, work_i, rwork_i );
00267
00268 failed = compare_ctprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
00269 if( failed == 0 ) {
00270 printf( "PASSED: row-major middle-level interface to ctprfs\n" );
00271 } else {
00272 printf( "FAILED: row-major middle-level interface to ctprfs\n" );
00273 }
00274
00275
00276
00277 for( i = 0; i < (n*(n+1)/2); i++ ) {
00278 ap_i[i] = ap[i];
00279 }
00280 for( i = 0; i < ldb*nrhs; i++ ) {
00281 b_i[i] = b[i];
00282 }
00283 for( i = 0; i < ldx*nrhs; i++ ) {
00284 x_i[i] = x[i];
00285 }
00286 for( i = 0; i < nrhs; i++ ) {
00287 ferr_i[i] = ferr_save[i];
00288 }
00289 for( i = 0; i < nrhs; i++ ) {
00290 berr_i[i] = berr_save[i];
00291 }
00292 for( i = 0; i < 2*n; i++ ) {
00293 work_i[i] = work[i];
00294 }
00295 for( i = 0; i < n; i++ ) {
00296 rwork_i[i] = rwork[i];
00297 }
00298
00299
00300 LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
00301 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
00302 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
00303 info_i = LAPACKE_ctprfs( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i, n_i,
00304 nrhs_i, ap_r, b_r, ldb_r, x_r, ldx_r, ferr_i,
00305 berr_i );
00306
00307 failed = compare_ctprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
00308 if( failed == 0 ) {
00309 printf( "PASSED: row-major high-level interface to ctprfs\n" );
00310 } else {
00311 printf( "FAILED: row-major high-level interface to ctprfs\n" );
00312 }
00313
00314
00315 if( ap != NULL ) {
00316 LAPACKE_free( ap );
00317 }
00318 if( ap_i != NULL ) {
00319 LAPACKE_free( ap_i );
00320 }
00321 if( ap_r != NULL ) {
00322 LAPACKE_free( ap_r );
00323 }
00324 if( b != NULL ) {
00325 LAPACKE_free( b );
00326 }
00327 if( b_i != NULL ) {
00328 LAPACKE_free( b_i );
00329 }
00330 if( b_r != NULL ) {
00331 LAPACKE_free( b_r );
00332 }
00333 if( x != NULL ) {
00334 LAPACKE_free( x );
00335 }
00336 if( x_i != NULL ) {
00337 LAPACKE_free( x_i );
00338 }
00339 if( x_r != NULL ) {
00340 LAPACKE_free( x_r );
00341 }
00342 if( ferr != NULL ) {
00343 LAPACKE_free( ferr );
00344 }
00345 if( ferr_i != NULL ) {
00346 LAPACKE_free( ferr_i );
00347 }
00348 if( ferr_save != NULL ) {
00349 LAPACKE_free( ferr_save );
00350 }
00351 if( berr != NULL ) {
00352 LAPACKE_free( berr );
00353 }
00354 if( berr_i != NULL ) {
00355 LAPACKE_free( berr_i );
00356 }
00357 if( berr_save != NULL ) {
00358 LAPACKE_free( berr_save );
00359 }
00360 if( work != NULL ) {
00361 LAPACKE_free( work );
00362 }
00363 if( work_i != NULL ) {
00364 LAPACKE_free( work_i );
00365 }
00366 if( rwork != NULL ) {
00367 LAPACKE_free( rwork );
00368 }
00369 if( rwork_i != NULL ) {
00370 LAPACKE_free( rwork_i );
00371 }
00372
00373 return 0;
00374 }
00375
00376
00377 static void init_scalars_ctprfs( char *uplo, char *trans, char *diag,
00378 lapack_int *n, lapack_int *nrhs,
00379 lapack_int *ldb, lapack_int *ldx )
00380 {
00381 *uplo = 'L';
00382 *trans = 'N';
00383 *diag = 'N';
00384 *n = 4;
00385 *nrhs = 2;
00386 *ldb = 8;
00387 *ldx = 8;
00388
00389 return;
00390 }
00391
00392
00393 static void init_ap( lapack_int size, lapack_complex_float *ap ) {
00394 lapack_int i;
00395 for( i = 0; i < size; i++ ) {
00396 ap[i] = lapack_make_complex_float( 0.0f, 0.0f );
00397 }
00398 ap[0] = lapack_make_complex_float( 4.780000210e+000, 4.559999943e+000 );
00399 ap[1] = lapack_make_complex_float( 2.000000000e+000, -3.000000119e-001 );
00400 ap[2] = lapack_make_complex_float( 2.890000105e+000, -1.340000033e+000 );
00401 ap[3] = lapack_make_complex_float( -1.889999986e+000, 1.149999976e+000 );
00402 ap[4] = lapack_make_complex_float( -4.110000134e+000, 1.250000000e+000 );
00403 ap[5] = lapack_make_complex_float( 2.359999895e+000, -4.250000000e+000 );
00404 ap[6] = lapack_make_complex_float( 3.999999911e-002, -3.690000057e+000 );
00405 ap[7] = lapack_make_complex_float( 4.150000095e+000, 8.000000119e-001 );
00406 ap[8] = lapack_make_complex_float( -1.999999955e-002, 4.600000083e-001 );
00407 ap[9] = lapack_make_complex_float( 3.300000131e-001, -2.599999905e-001 );
00408 }
00409 static void init_b( lapack_int size, lapack_complex_float *b ) {
00410 lapack_int i;
00411 for( i = 0; i < size; i++ ) {
00412 b[i] = lapack_make_complex_float( 0.0f, 0.0f );
00413 }
00414 b[0] = lapack_make_complex_float( -1.477999973e+001, -3.236000061e+001 );
00415 b[8] = lapack_make_complex_float( -1.802000046e+001, 2.845999908e+001 );
00416 b[1] = lapack_make_complex_float( 2.980000019e+000, -2.140000105e+000 );
00417 b[9] = lapack_make_complex_float( 1.422000027e+001, 1.542000008e+001 );
00418 b[2] = lapack_make_complex_float( -2.095999908e+001, 1.705999947e+001 );
00419 b[10] = lapack_make_complex_float( 5.619999886e+000, 3.588999939e+001 );
00420 b[3] = lapack_make_complex_float( 9.539999962e+000, 9.909999847e+000 );
00421 b[11] = lapack_make_complex_float( -1.645999908e+001, -1.730000019e+000 );
00422 }
00423 static void init_x( lapack_int size, lapack_complex_float *x ) {
00424 lapack_int i;
00425 for( i = 0; i < size; i++ ) {
00426 x[i] = lapack_make_complex_float( 0.0f, 0.0f );
00427 }
00428 x[0] = lapack_make_complex_float( -5.000000000e+000, -2.000000238e+000 );
00429 x[8] = lapack_make_complex_float( 9.999997020e-001, 5.000000000e+000 );
00430 x[1] = lapack_make_complex_float( -2.999999762e+000, -1.000000000e+000 );
00431 x[9] = lapack_make_complex_float( -2.000000238e+000, -2.000000000e+000 );
00432 x[2] = lapack_make_complex_float( 2.000000238e+000, 9.999999404e-001 );
00433 x[10] = lapack_make_complex_float( 3.000000000e+000, 3.999999523e+000 );
00434 x[3] = lapack_make_complex_float( 4.000000954e+000, 2.999998331e+000 );
00435 x[11] = lapack_make_complex_float( 4.000001431e+000, -3.000001669e+000 );
00436 }
00437 static void init_ferr( lapack_int size, float *ferr ) {
00438 lapack_int i;
00439 for( i = 0; i < size; i++ ) {
00440 ferr[i] = 0;
00441 }
00442 }
00443 static void init_berr( lapack_int size, float *berr ) {
00444 lapack_int i;
00445 for( i = 0; i < size; i++ ) {
00446 berr[i] = 0;
00447 }
00448 }
00449 static void init_work( lapack_int size, lapack_complex_float *work ) {
00450 lapack_int i;
00451 for( i = 0; i < size; i++ ) {
00452 work[i] = lapack_make_complex_float( 0.0f, 0.0f );
00453 }
00454 }
00455 static void init_rwork( lapack_int size, float *rwork ) {
00456 lapack_int i;
00457 for( i = 0; i < size; i++ ) {
00458 rwork[i] = 0;
00459 }
00460 }
00461
00462
00463
00464 static int compare_ctprfs( float *ferr, float *ferr_i, float *berr,
00465 float *berr_i, lapack_int info, lapack_int info_i,
00466 lapack_int nrhs )
00467 {
00468 lapack_int i;
00469 int failed = 0;
00470 for( i = 0; i < nrhs; i++ ) {
00471 failed += compare_floats(ferr[i],ferr_i[i]);
00472 }
00473 for( i = 0; i < nrhs; i++ ) {
00474 failed += compare_floats(berr[i],berr_i[i]);
00475 }
00476 failed += (info == info_i) ? 0 : 1;
00477 if( info != 0 || info_i != 0 ) {
00478 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00479 }
00480
00481 return failed;
00482 }