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_dgbrfs( char *trans, lapack_int *n, lapack_int *kl,
00055 lapack_int *ku, lapack_int *nrhs,
00056 lapack_int *ldab, lapack_int *ldafb,
00057 lapack_int *ldb, lapack_int *ldx );
00058 static void init_ab( lapack_int size, double *ab );
00059 static void init_afb( lapack_int size, double *afb );
00060 static void init_ipiv( lapack_int size, lapack_int *ipiv );
00061 static void init_b( lapack_int size, double *b );
00062 static void init_x( lapack_int size, double *x );
00063 static void init_ferr( lapack_int size, double *ferr );
00064 static void init_berr( lapack_int size, double *berr );
00065 static void init_work( lapack_int size, double *work );
00066 static void init_iwork( lapack_int size, lapack_int *iwork );
00067 static int compare_dgbrfs( double *x, double *x_i, double *ferr, double *ferr_i,
00068 double *berr, double *berr_i, lapack_int info,
00069 lapack_int info_i, lapack_int ldx, lapack_int nrhs );
00070
00071 int main(void)
00072 {
00073
00074 char trans, trans_i;
00075 lapack_int n, n_i;
00076 lapack_int kl, kl_i;
00077 lapack_int ku, ku_i;
00078 lapack_int nrhs, nrhs_i;
00079 lapack_int ldab, ldab_i;
00080 lapack_int ldab_r;
00081 lapack_int ldafb, ldafb_i;
00082 lapack_int ldafb_r;
00083 lapack_int ldb, ldb_i;
00084 lapack_int ldb_r;
00085 lapack_int ldx, ldx_i;
00086 lapack_int ldx_r;
00087 lapack_int info, info_i;
00088 lapack_int i;
00089 int failed;
00090
00091
00092 double *ab = NULL, *ab_i = NULL;
00093 double *afb = NULL, *afb_i = NULL;
00094 lapack_int *ipiv = NULL, *ipiv_i = NULL;
00095 double *b = NULL, *b_i = NULL;
00096 double *x = NULL, *x_i = NULL;
00097 double *ferr = NULL, *ferr_i = NULL;
00098 double *berr = NULL, *berr_i = NULL;
00099 double *work = NULL, *work_i = NULL;
00100 lapack_int *iwork = NULL, *iwork_i = NULL;
00101 double *x_save = NULL;
00102 double *ferr_save = NULL;
00103 double *berr_save = NULL;
00104 double *ab_r = NULL;
00105 double *afb_r = NULL;
00106 double *b_r = NULL;
00107 double *x_r = NULL;
00108
00109
00110 init_scalars_dgbrfs( &trans, &n, &kl, &ku, &nrhs, &ldab, &ldafb, &ldb,
00111 &ldx );
00112 ldab_r = n+2;
00113 ldafb_r = n+2;
00114 ldb_r = nrhs+2;
00115 ldx_r = nrhs+2;
00116 trans_i = trans;
00117 n_i = n;
00118 kl_i = kl;
00119 ku_i = ku;
00120 nrhs_i = nrhs;
00121 ldab_i = ldab;
00122 ldafb_i = ldafb;
00123 ldb_i = ldb;
00124 ldx_i = ldx;
00125
00126
00127 ab = (double *)LAPACKE_malloc( ldab*n * sizeof(double) );
00128 afb = (double *)LAPACKE_malloc( ldafb*n * sizeof(double) );
00129 ipiv = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00130 b = (double *)LAPACKE_malloc( ldb*nrhs * sizeof(double) );
00131 x = (double *)LAPACKE_malloc( ldx*nrhs * sizeof(double) );
00132 ferr = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
00133 berr = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
00134 work = (double *)LAPACKE_malloc( 3*n * sizeof(double) );
00135 iwork = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00136
00137
00138 ab_i = (double *)LAPACKE_malloc( ldab*n * sizeof(double) );
00139 afb_i = (double *)LAPACKE_malloc( ldafb*n * sizeof(double) );
00140 ipiv_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00141 b_i = (double *)LAPACKE_malloc( ldb*nrhs * sizeof(double) );
00142 x_i = (double *)LAPACKE_malloc( ldx*nrhs * sizeof(double) );
00143 ferr_i = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
00144 berr_i = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
00145 work_i = (double *)LAPACKE_malloc( 3*n * sizeof(double) );
00146 iwork_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00147
00148
00149 x_save = (double *)LAPACKE_malloc( ldx*nrhs * sizeof(double) );
00150 ferr_save = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
00151 berr_save = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
00152
00153
00154 ab_r = (double *)LAPACKE_malloc( (kl+ku+1)*(n+2) * sizeof(double) );
00155 afb_r = (double *)LAPACKE_malloc( ((2*kl+ku+1)*(n+2)) * sizeof(double) );
00156 b_r = (double *)LAPACKE_malloc( n*(nrhs+2) * sizeof(double) );
00157 x_r = (double *)LAPACKE_malloc( n*(nrhs+2) * sizeof(double) );
00158
00159
00160 init_ab( ldab*n, ab );
00161 init_afb( ldafb*n, afb );
00162 init_ipiv( n, ipiv );
00163 init_b( ldb*nrhs, b );
00164 init_x( ldx*nrhs, x );
00165 init_ferr( nrhs, ferr );
00166 init_berr( nrhs, berr );
00167 init_work( 3*n, work );
00168 init_iwork( n, iwork );
00169
00170
00171 for( i = 0; i < ldx*nrhs; i++ ) {
00172 x_save[i] = x[i];
00173 }
00174 for( i = 0; i < nrhs; i++ ) {
00175 ferr_save[i] = ferr[i];
00176 }
00177 for( i = 0; i < nrhs; i++ ) {
00178 berr_save[i] = berr[i];
00179 }
00180
00181
00182 dgbrfs_( &trans, &n, &kl, &ku, &nrhs, ab, &ldab, afb, &ldafb, ipiv, b, &ldb,
00183 x, &ldx, ferr, berr, work, iwork, &info );
00184
00185
00186
00187 for( i = 0; i < ldab*n; i++ ) {
00188 ab_i[i] = ab[i];
00189 }
00190 for( i = 0; i < ldafb*n; i++ ) {
00191 afb_i[i] = afb[i];
00192 }
00193 for( i = 0; i < n; i++ ) {
00194 ipiv_i[i] = ipiv[i];
00195 }
00196 for( i = 0; i < ldb*nrhs; i++ ) {
00197 b_i[i] = b[i];
00198 }
00199 for( i = 0; i < ldx*nrhs; i++ ) {
00200 x_i[i] = x_save[i];
00201 }
00202 for( i = 0; i < nrhs; i++ ) {
00203 ferr_i[i] = ferr_save[i];
00204 }
00205 for( i = 0; i < nrhs; i++ ) {
00206 berr_i[i] = berr_save[i];
00207 }
00208 for( i = 0; i < 3*n; i++ ) {
00209 work_i[i] = work[i];
00210 }
00211 for( i = 0; i < n; i++ ) {
00212 iwork_i[i] = iwork[i];
00213 }
00214 info_i = LAPACKE_dgbrfs_work( LAPACK_COL_MAJOR, trans_i, n_i, kl_i, ku_i,
00215 nrhs_i, ab_i, ldab_i, afb_i, ldafb_i, ipiv_i,
00216 b_i, ldb_i, x_i, ldx_i, ferr_i, berr_i,
00217 work_i, iwork_i );
00218
00219 failed = compare_dgbrfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i,
00220 ldx, nrhs );
00221 if( failed == 0 ) {
00222 printf( "PASSED: column-major middle-level interface to dgbrfs\n" );
00223 } else {
00224 printf( "FAILED: column-major middle-level interface to dgbrfs\n" );
00225 }
00226
00227
00228
00229 for( i = 0; i < ldab*n; i++ ) {
00230 ab_i[i] = ab[i];
00231 }
00232 for( i = 0; i < ldafb*n; i++ ) {
00233 afb_i[i] = afb[i];
00234 }
00235 for( i = 0; i < n; i++ ) {
00236 ipiv_i[i] = ipiv[i];
00237 }
00238 for( i = 0; i < ldb*nrhs; i++ ) {
00239 b_i[i] = b[i];
00240 }
00241 for( i = 0; i < ldx*nrhs; i++ ) {
00242 x_i[i] = x_save[i];
00243 }
00244 for( i = 0; i < nrhs; i++ ) {
00245 ferr_i[i] = ferr_save[i];
00246 }
00247 for( i = 0; i < nrhs; i++ ) {
00248 berr_i[i] = berr_save[i];
00249 }
00250 for( i = 0; i < 3*n; i++ ) {
00251 work_i[i] = work[i];
00252 }
00253 for( i = 0; i < n; i++ ) {
00254 iwork_i[i] = iwork[i];
00255 }
00256 info_i = LAPACKE_dgbrfs( LAPACK_COL_MAJOR, trans_i, n_i, kl_i, ku_i, nrhs_i,
00257 ab_i, ldab_i, afb_i, ldafb_i, ipiv_i, b_i, ldb_i,
00258 x_i, ldx_i, ferr_i, berr_i );
00259
00260 failed = compare_dgbrfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i,
00261 ldx, nrhs );
00262 if( failed == 0 ) {
00263 printf( "PASSED: column-major high-level interface to dgbrfs\n" );
00264 } else {
00265 printf( "FAILED: column-major high-level interface to dgbrfs\n" );
00266 }
00267
00268
00269
00270 for( i = 0; i < ldab*n; i++ ) {
00271 ab_i[i] = ab[i];
00272 }
00273 for( i = 0; i < ldafb*n; i++ ) {
00274 afb_i[i] = afb[i];
00275 }
00276 for( i = 0; i < n; i++ ) {
00277 ipiv_i[i] = ipiv[i];
00278 }
00279 for( i = 0; i < ldb*nrhs; i++ ) {
00280 b_i[i] = b[i];
00281 }
00282 for( i = 0; i < ldx*nrhs; i++ ) {
00283 x_i[i] = x_save[i];
00284 }
00285 for( i = 0; i < nrhs; i++ ) {
00286 ferr_i[i] = ferr_save[i];
00287 }
00288 for( i = 0; i < nrhs; i++ ) {
00289 berr_i[i] = berr_save[i];
00290 }
00291 for( i = 0; i < 3*n; i++ ) {
00292 work_i[i] = work[i];
00293 }
00294 for( i = 0; i < n; i++ ) {
00295 iwork_i[i] = iwork[i];
00296 }
00297
00298 LAPACKE_dge_trans( LAPACK_COL_MAJOR, kl+ku+1, n, ab_i, ldab, ab_r, n+2 );
00299 LAPACKE_dge_trans( LAPACK_COL_MAJOR, 2*kl+ku+1, n, afb_i, ldafb, afb_r,
00300 n+2 );
00301 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
00302 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
00303 info_i = LAPACKE_dgbrfs_work( LAPACK_ROW_MAJOR, trans_i, n_i, kl_i, ku_i,
00304 nrhs_i, ab_r, ldab_r, afb_r, ldafb_r, ipiv_i,
00305 b_r, ldb_r, x_r, ldx_r, ferr_i, berr_i,
00306 work_i, iwork_i );
00307
00308 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, nrhs, x_r, nrhs+2, x_i, ldx );
00309
00310 failed = compare_dgbrfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i,
00311 ldx, nrhs );
00312 if( failed == 0 ) {
00313 printf( "PASSED: row-major middle-level interface to dgbrfs\n" );
00314 } else {
00315 printf( "FAILED: row-major middle-level interface to dgbrfs\n" );
00316 }
00317
00318
00319
00320 for( i = 0; i < ldab*n; i++ ) {
00321 ab_i[i] = ab[i];
00322 }
00323 for( i = 0; i < ldafb*n; i++ ) {
00324 afb_i[i] = afb[i];
00325 }
00326 for( i = 0; i < n; i++ ) {
00327 ipiv_i[i] = ipiv[i];
00328 }
00329 for( i = 0; i < ldb*nrhs; i++ ) {
00330 b_i[i] = b[i];
00331 }
00332 for( i = 0; i < ldx*nrhs; i++ ) {
00333 x_i[i] = x_save[i];
00334 }
00335 for( i = 0; i < nrhs; i++ ) {
00336 ferr_i[i] = ferr_save[i];
00337 }
00338 for( i = 0; i < nrhs; i++ ) {
00339 berr_i[i] = berr_save[i];
00340 }
00341 for( i = 0; i < 3*n; i++ ) {
00342 work_i[i] = work[i];
00343 }
00344 for( i = 0; i < n; i++ ) {
00345 iwork_i[i] = iwork[i];
00346 }
00347
00348
00349 LAPACKE_dge_trans( LAPACK_COL_MAJOR, kl+ku+1, n, ab_i, ldab, ab_r, n+2 );
00350 LAPACKE_dge_trans( LAPACK_COL_MAJOR, 2*kl+ku+1, n, afb_i, ldafb, afb_r,
00351 n+2 );
00352 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
00353 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
00354 info_i = LAPACKE_dgbrfs( LAPACK_ROW_MAJOR, trans_i, n_i, kl_i, ku_i, nrhs_i,
00355 ab_r, ldab_r, afb_r, ldafb_r, ipiv_i, b_r, ldb_r,
00356 x_r, ldx_r, ferr_i, berr_i );
00357
00358 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, nrhs, x_r, nrhs+2, x_i, ldx );
00359
00360 failed = compare_dgbrfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i,
00361 ldx, nrhs );
00362 if( failed == 0 ) {
00363 printf( "PASSED: row-major high-level interface to dgbrfs\n" );
00364 } else {
00365 printf( "FAILED: row-major high-level interface to dgbrfs\n" );
00366 }
00367
00368
00369 if( ab != NULL ) {
00370 LAPACKE_free( ab );
00371 }
00372 if( ab_i != NULL ) {
00373 LAPACKE_free( ab_i );
00374 }
00375 if( ab_r != NULL ) {
00376 LAPACKE_free( ab_r );
00377 }
00378 if( afb != NULL ) {
00379 LAPACKE_free( afb );
00380 }
00381 if( afb_i != NULL ) {
00382 LAPACKE_free( afb_i );
00383 }
00384 if( afb_r != NULL ) {
00385 LAPACKE_free( afb_r );
00386 }
00387 if( ipiv != NULL ) {
00388 LAPACKE_free( ipiv );
00389 }
00390 if( ipiv_i != NULL ) {
00391 LAPACKE_free( ipiv_i );
00392 }
00393 if( b != NULL ) {
00394 LAPACKE_free( b );
00395 }
00396 if( b_i != NULL ) {
00397 LAPACKE_free( b_i );
00398 }
00399 if( b_r != NULL ) {
00400 LAPACKE_free( b_r );
00401 }
00402 if( x != NULL ) {
00403 LAPACKE_free( x );
00404 }
00405 if( x_i != NULL ) {
00406 LAPACKE_free( x_i );
00407 }
00408 if( x_r != NULL ) {
00409 LAPACKE_free( x_r );
00410 }
00411 if( x_save != NULL ) {
00412 LAPACKE_free( x_save );
00413 }
00414 if( ferr != NULL ) {
00415 LAPACKE_free( ferr );
00416 }
00417 if( ferr_i != NULL ) {
00418 LAPACKE_free( ferr_i );
00419 }
00420 if( ferr_save != NULL ) {
00421 LAPACKE_free( ferr_save );
00422 }
00423 if( berr != NULL ) {
00424 LAPACKE_free( berr );
00425 }
00426 if( berr_i != NULL ) {
00427 LAPACKE_free( berr_i );
00428 }
00429 if( berr_save != NULL ) {
00430 LAPACKE_free( berr_save );
00431 }
00432 if( work != NULL ) {
00433 LAPACKE_free( work );
00434 }
00435 if( work_i != NULL ) {
00436 LAPACKE_free( work_i );
00437 }
00438 if( iwork != NULL ) {
00439 LAPACKE_free( iwork );
00440 }
00441 if( iwork_i != NULL ) {
00442 LAPACKE_free( iwork_i );
00443 }
00444
00445 return 0;
00446 }
00447
00448
00449 static void init_scalars_dgbrfs( char *trans, lapack_int *n, lapack_int *kl,
00450 lapack_int *ku, lapack_int *nrhs,
00451 lapack_int *ldab, lapack_int *ldafb,
00452 lapack_int *ldb, lapack_int *ldx )
00453 {
00454 *trans = 'N';
00455 *n = 4;
00456 *kl = 1;
00457 *ku = 2;
00458 *nrhs = 2;
00459 *ldab = 17;
00460 *ldafb = 25;
00461 *ldb = 8;
00462 *ldx = 8;
00463
00464 return;
00465 }
00466
00467
00468 static void init_ab( lapack_int size, double *ab ) {
00469 lapack_int i;
00470 for( i = 0; i < size; i++ ) {
00471 ab[i] = 0;
00472 }
00473 ab[0] = 0.00000000000000000e+000;
00474 ab[17] = 0.00000000000000000e+000;
00475 ab[34] = -3.66000000000000010e+000;
00476 ab[51] = -2.12999999999999990e+000;
00477 ab[1] = 0.00000000000000000e+000;
00478 ab[18] = 2.54000000000000000e+000;
00479 ab[35] = -2.73000000000000000e+000;
00480 ab[52] = 4.07000000000000030e+000;
00481 ab[2] = -2.30000000000000010e-001;
00482 ab[19] = 2.46000000000000000e+000;
00483 ab[36] = 2.46000000000000000e+000;
00484 ab[53] = -3.81999999999999980e+000;
00485 ab[3] = -6.98000000000000040e+000;
00486 ab[20] = 2.56000000000000010e+000;
00487 ab[37] = -4.78000000000000020e+000;
00488 ab[54] = 0.00000000000000000e+000;
00489 }
00490 static void init_afb( lapack_int size, double *afb ) {
00491 lapack_int i;
00492 for( i = 0; i < size; i++ ) {
00493 afb[i] = 0;
00494 }
00495 afb[0] = 0.00000000000000000e+000;
00496 afb[25] = 0.00000000000000000e+000;
00497 afb[50] = 0.00000000000000000e+000;
00498 afb[75] = -2.12999999999999990e+000;
00499 afb[1] = 0.00000000000000000e+000;
00500 afb[26] = 0.00000000000000000e+000;
00501 afb[51] = -2.73000000000000000e+000;
00502 afb[76] = 4.07000000000000030e+000;
00503 afb[2] = 0.00000000000000000e+000;
00504 afb[27] = 2.46000000000000000e+000;
00505 afb[52] = 2.46000000000000000e+000;
00506 afb[77] = -3.83914387088108940e+000;
00507 afb[3] = -6.98000000000000040e+000;
00508 afb[28] = 2.56000000000000010e+000;
00509 afb[53] = -5.93293047098853950e+000;
00510 afb[78] = -7.26906663992311850e-001;
00511 afb[4] = 3.29512893982807990e-002;
00512 afb[29] = 9.60523370343839610e-001;
00513 afb[54] = 8.05672681211037410e-001;
00514 afb[79] = 0.00000000000000000e+000;
00515 }
00516 static void init_ipiv( lapack_int size, lapack_int *ipiv ) {
00517 lapack_int i;
00518 for( i = 0; i < size; i++ ) {
00519 ipiv[i] = 0;
00520 }
00521 ipiv[0] = 2;
00522 ipiv[1] = 3;
00523 ipiv[2] = 3;
00524 ipiv[3] = 4;
00525 }
00526 static void init_b( lapack_int size, double *b ) {
00527 lapack_int i;
00528 for( i = 0; i < size; i++ ) {
00529 b[i] = 0;
00530 }
00531 b[0] = 4.41999999999999990e+000;
00532 b[8] = -3.60099999999999980e+001;
00533 b[1] = 2.71299999999999990e+001;
00534 b[9] = -3.16700000000000020e+001;
00535 b[2] = -6.13999999999999970e+000;
00536 b[10] = -1.15999999999999990e+000;
00537 b[3] = 1.05000000000000000e+001;
00538 b[11] = -2.58200000000000000e+001;
00539 }
00540 static void init_x( lapack_int size, double *x ) {
00541 lapack_int i;
00542 for( i = 0; i < size; i++ ) {
00543 x[i] = 0;
00544 }
00545 x[0] = -2.00000000000000040e+000;
00546 x[8] = 9.99999999999998000e-001;
00547 x[1] = 3.00000000000000040e+000;
00548 x[9] = -4.00000000000000440e+000;
00549 x[2] = 1.00000000000000090e+000;
00550 x[10] = 6.99999999999999560e+000;
00551 x[3] = -4.00000000000000090e+000;
00552 x[11] = -1.99999999999999380e+000;
00553 }
00554 static void init_ferr( lapack_int size, double *ferr ) {
00555 lapack_int i;
00556 for( i = 0; i < size; i++ ) {
00557 ferr[i] = 0;
00558 }
00559 }
00560 static void init_berr( lapack_int size, double *berr ) {
00561 lapack_int i;
00562 for( i = 0; i < size; i++ ) {
00563 berr[i] = 0;
00564 }
00565 }
00566 static void init_work( lapack_int size, double *work ) {
00567 lapack_int i;
00568 for( i = 0; i < size; i++ ) {
00569 work[i] = 0;
00570 }
00571 }
00572 static void init_iwork( lapack_int size, lapack_int *iwork ) {
00573 lapack_int i;
00574 for( i = 0; i < size; i++ ) {
00575 iwork[i] = 0;
00576 }
00577 }
00578
00579
00580
00581 static int compare_dgbrfs( double *x, double *x_i, double *ferr, double *ferr_i,
00582 double *berr, double *berr_i, lapack_int info,
00583 lapack_int info_i, lapack_int ldx, lapack_int nrhs )
00584 {
00585 lapack_int i;
00586 int failed = 0;
00587 for( i = 0; i < ldx*nrhs; i++ ) {
00588 failed += compare_doubles(x[i],x_i[i]);
00589 }
00590 for( i = 0; i < nrhs; i++ ) {
00591 failed += compare_doubles(ferr[i],ferr_i[i]);
00592 }
00593 for( i = 0; i < nrhs; i++ ) {
00594 failed += compare_doubles(berr[i],berr_i[i]);
00595 }
00596 failed += (info == info_i) ? 0 : 1;
00597 if( info != 0 || info_i != 0 ) {
00598 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00599 }
00600
00601 return failed;
00602 }