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_dgbbrd( char *vect, lapack_int *m, lapack_int *n,
00055 lapack_int *ncc, lapack_int *kl,
00056 lapack_int *ku, lapack_int *ldab,
00057 lapack_int *ldq, lapack_int *ldpt,
00058 lapack_int *ldc );
00059 static void init_ab( lapack_int size, double *ab );
00060 static void init_d( lapack_int size, double *d );
00061 static void init_e( lapack_int size, double *e );
00062 static void init_q( lapack_int size, double *q );
00063 static void init_pt( lapack_int size, double *pt );
00064 static void init_c( lapack_int size, double *c );
00065 static void init_work( lapack_int size, double *work );
00066 static int compare_dgbbrd( double *ab, double *ab_i, double *d, double *d_i,
00067 double *e, double *e_i, double *q, double *q_i,
00068 double *pt, double *pt_i, double *c, double *c_i,
00069 lapack_int info, lapack_int info_i, lapack_int ldab,
00070 lapack_int ldc, lapack_int ldpt, lapack_int ldq,
00071 lapack_int m, lapack_int n, lapack_int ncc,
00072 char vect );
00073
00074 int main(void)
00075 {
00076
00077 char vect, vect_i;
00078 lapack_int m, m_i;
00079 lapack_int n, n_i;
00080 lapack_int ncc, ncc_i;
00081 lapack_int kl, kl_i;
00082 lapack_int ku, ku_i;
00083 lapack_int ldab, ldab_i;
00084 lapack_int ldab_r;
00085 lapack_int ldq, ldq_i;
00086 lapack_int ldq_r;
00087 lapack_int ldpt, ldpt_i;
00088 lapack_int ldpt_r;
00089 lapack_int ldc, ldc_i;
00090 lapack_int ldc_r;
00091 lapack_int info, info_i;
00092 lapack_int i;
00093 int failed;
00094
00095
00096 double *ab = NULL, *ab_i = NULL;
00097 double *d = NULL, *d_i = NULL;
00098 double *e = NULL, *e_i = NULL;
00099 double *q = NULL, *q_i = NULL;
00100 double *pt = NULL, *pt_i = NULL;
00101 double *c = NULL, *c_i = NULL;
00102 double *work = NULL, *work_i = NULL;
00103 double *ab_save = NULL;
00104 double *d_save = NULL;
00105 double *e_save = NULL;
00106 double *q_save = NULL;
00107 double *pt_save = NULL;
00108 double *c_save = NULL;
00109 double *ab_r = NULL;
00110 double *q_r = NULL;
00111 double *pt_r = NULL;
00112 double *c_r = NULL;
00113
00114
00115 init_scalars_dgbbrd( &vect, &m, &n, &ncc, &kl, &ku, &ldab, &ldq, &ldpt,
00116 &ldc );
00117 ldab_r = n+2;
00118 ldq_r = m+2;
00119 ldpt_r = n+2;
00120 ldc_r = ncc+2;
00121 vect_i = vect;
00122 m_i = m;
00123 n_i = n;
00124 ncc_i = ncc;
00125 kl_i = kl;
00126 ku_i = ku;
00127 ldab_i = ldab;
00128 ldq_i = ldq;
00129 ldpt_i = ldpt;
00130 ldc_i = ldc;
00131
00132
00133 ab = (double *)LAPACKE_malloc( ldab*n * sizeof(double) );
00134 d = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00135 e = (double *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(double) );
00136 q = (double *)LAPACKE_malloc( ldq*m * sizeof(double) );
00137 pt = (double *)LAPACKE_malloc( ldpt*n * sizeof(double) );
00138 c = (double *)LAPACKE_malloc( ldc*ncc * sizeof(double) );
00139 work = (double *)LAPACKE_malloc( ((2*MAX(m,n))) * sizeof(double) );
00140
00141
00142 ab_i = (double *)LAPACKE_malloc( ldab*n * sizeof(double) );
00143 d_i = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00144 e_i = (double *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(double) );
00145 q_i = (double *)LAPACKE_malloc( ldq*m * sizeof(double) );
00146 pt_i = (double *)LAPACKE_malloc( ldpt*n * sizeof(double) );
00147 c_i = (double *)LAPACKE_malloc( ldc*ncc * sizeof(double) );
00148 work_i = (double *)LAPACKE_malloc( ((2*MAX(m,n))) * sizeof(double) );
00149
00150
00151 ab_save = (double *)LAPACKE_malloc( ldab*n * sizeof(double) );
00152 d_save = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00153 e_save = (double *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(double) );
00154 q_save = (double *)LAPACKE_malloc( ldq*m * sizeof(double) );
00155 pt_save = (double *)LAPACKE_malloc( ldpt*n * sizeof(double) );
00156 c_save = (double *)LAPACKE_malloc( ldc*ncc * sizeof(double) );
00157
00158
00159 ab_r = (double *)LAPACKE_malloc( (kl+ku+1)*(n+2) * sizeof(double) );
00160 q_r = (double *)LAPACKE_malloc( m*(m+2) * sizeof(double) );
00161 pt_r = (double *)LAPACKE_malloc( n*(n+2) * sizeof(double) );
00162 c_r = (double *)LAPACKE_malloc( m*(ncc+2) * sizeof(double) );
00163
00164
00165 init_ab( ldab*n, ab );
00166 init_d( (MIN(m,n)), d );
00167 init_e( (MIN(m,n)-1), e );
00168 init_q( ldq*m, q );
00169 init_pt( ldpt*n, pt );
00170 init_c( ldc*ncc, c );
00171 init_work( (2*MAX(m,n)), work );
00172
00173
00174 for( i = 0; i < ldab*n; i++ ) {
00175 ab_save[i] = ab[i];
00176 }
00177 for( i = 0; i < (MIN(m,n)); i++ ) {
00178 d_save[i] = d[i];
00179 }
00180 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00181 e_save[i] = e[i];
00182 }
00183 for( i = 0; i < ldq*m; i++ ) {
00184 q_save[i] = q[i];
00185 }
00186 for( i = 0; i < ldpt*n; i++ ) {
00187 pt_save[i] = pt[i];
00188 }
00189 for( i = 0; i < ldc*ncc; i++ ) {
00190 c_save[i] = c[i];
00191 }
00192
00193
00194 dgbbrd_( &vect, &m, &n, &ncc, &kl, &ku, ab, &ldab, d, e, q, &ldq, pt, &ldpt,
00195 c, &ldc, work, &info );
00196
00197
00198
00199 for( i = 0; i < ldab*n; i++ ) {
00200 ab_i[i] = ab_save[i];
00201 }
00202 for( i = 0; i < (MIN(m,n)); i++ ) {
00203 d_i[i] = d_save[i];
00204 }
00205 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00206 e_i[i] = e_save[i];
00207 }
00208 for( i = 0; i < ldq*m; i++ ) {
00209 q_i[i] = q_save[i];
00210 }
00211 for( i = 0; i < ldpt*n; i++ ) {
00212 pt_i[i] = pt_save[i];
00213 }
00214 for( i = 0; i < ldc*ncc; i++ ) {
00215 c_i[i] = c_save[i];
00216 }
00217 for( i = 0; i < (2*MAX(m,n)); i++ ) {
00218 work_i[i] = work[i];
00219 }
00220 info_i = LAPACKE_dgbbrd_work( LAPACK_COL_MAJOR, vect_i, m_i, n_i, ncc_i,
00221 kl_i, ku_i, ab_i, ldab_i, d_i, e_i, q_i,
00222 ldq_i, pt_i, ldpt_i, c_i, ldc_i, work_i );
00223
00224 failed = compare_dgbbrd( ab, ab_i, d, d_i, e, e_i, q, q_i, pt, pt_i, c, c_i,
00225 info, info_i, ldab, ldc, ldpt, ldq, m, n, ncc,
00226 vect );
00227 if( failed == 0 ) {
00228 printf( "PASSED: column-major middle-level interface to dgbbrd\n" );
00229 } else {
00230 printf( "FAILED: column-major middle-level interface to dgbbrd\n" );
00231 }
00232
00233
00234
00235 for( i = 0; i < ldab*n; i++ ) {
00236 ab_i[i] = ab_save[i];
00237 }
00238 for( i = 0; i < (MIN(m,n)); i++ ) {
00239 d_i[i] = d_save[i];
00240 }
00241 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00242 e_i[i] = e_save[i];
00243 }
00244 for( i = 0; i < ldq*m; i++ ) {
00245 q_i[i] = q_save[i];
00246 }
00247 for( i = 0; i < ldpt*n; i++ ) {
00248 pt_i[i] = pt_save[i];
00249 }
00250 for( i = 0; i < ldc*ncc; i++ ) {
00251 c_i[i] = c_save[i];
00252 }
00253 for( i = 0; i < (2*MAX(m,n)); i++ ) {
00254 work_i[i] = work[i];
00255 }
00256 info_i = LAPACKE_dgbbrd( LAPACK_COL_MAJOR, vect_i, m_i, n_i, ncc_i, kl_i,
00257 ku_i, ab_i, ldab_i, d_i, e_i, q_i, ldq_i, pt_i,
00258 ldpt_i, c_i, ldc_i );
00259
00260 failed = compare_dgbbrd( ab, ab_i, d, d_i, e, e_i, q, q_i, pt, pt_i, c, c_i,
00261 info, info_i, ldab, ldc, ldpt, ldq, m, n, ncc,
00262 vect );
00263 if( failed == 0 ) {
00264 printf( "PASSED: column-major high-level interface to dgbbrd\n" );
00265 } else {
00266 printf( "FAILED: column-major high-level interface to dgbbrd\n" );
00267 }
00268
00269
00270
00271 for( i = 0; i < ldab*n; i++ ) {
00272 ab_i[i] = ab_save[i];
00273 }
00274 for( i = 0; i < (MIN(m,n)); i++ ) {
00275 d_i[i] = d_save[i];
00276 }
00277 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00278 e_i[i] = e_save[i];
00279 }
00280 for( i = 0; i < ldq*m; i++ ) {
00281 q_i[i] = q_save[i];
00282 }
00283 for( i = 0; i < ldpt*n; i++ ) {
00284 pt_i[i] = pt_save[i];
00285 }
00286 for( i = 0; i < ldc*ncc; i++ ) {
00287 c_i[i] = c_save[i];
00288 }
00289 for( i = 0; i < (2*MAX(m,n)); i++ ) {
00290 work_i[i] = work[i];
00291 }
00292
00293 LAPACKE_dge_trans( LAPACK_COL_MAJOR, kl+ku+1, n, ab_i, ldab, ab_r, n+2 );
00294 if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
00295 LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, q_i, ldq, q_r, m+2 );
00296 }
00297 if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
00298 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, pt_i, ldpt, pt_r, n+2 );
00299 }
00300 if( ncc != 0 ) {
00301 LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, ncc, c_i, ldc, c_r, ncc+2 );
00302 }
00303 info_i = LAPACKE_dgbbrd_work( LAPACK_ROW_MAJOR, vect_i, m_i, n_i, ncc_i,
00304 kl_i, ku_i, ab_r, ldab_r, d_i, e_i, q_r,
00305 ldq_r, pt_r, ldpt_r, c_r, ldc_r, work_i );
00306
00307 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, kl+ku+1, n, ab_r, n+2, ab_i, ldab );
00308 if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
00309 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, m, q_r, m+2, q_i, ldq );
00310 }
00311 if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
00312 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, pt_r, n+2, pt_i, ldpt );
00313 }
00314 if( ncc != 0 ) {
00315 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, ncc, c_r, ncc+2, c_i, ldc );
00316 }
00317
00318 failed = compare_dgbbrd( ab, ab_i, d, d_i, e, e_i, q, q_i, pt, pt_i, c, c_i,
00319 info, info_i, ldab, ldc, ldpt, ldq, m, n, ncc,
00320 vect );
00321 if( failed == 0 ) {
00322 printf( "PASSED: row-major middle-level interface to dgbbrd\n" );
00323 } else {
00324 printf( "FAILED: row-major middle-level interface to dgbbrd\n" );
00325 }
00326
00327
00328
00329 for( i = 0; i < ldab*n; i++ ) {
00330 ab_i[i] = ab_save[i];
00331 }
00332 for( i = 0; i < (MIN(m,n)); i++ ) {
00333 d_i[i] = d_save[i];
00334 }
00335 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00336 e_i[i] = e_save[i];
00337 }
00338 for( i = 0; i < ldq*m; i++ ) {
00339 q_i[i] = q_save[i];
00340 }
00341 for( i = 0; i < ldpt*n; i++ ) {
00342 pt_i[i] = pt_save[i];
00343 }
00344 for( i = 0; i < ldc*ncc; i++ ) {
00345 c_i[i] = c_save[i];
00346 }
00347 for( i = 0; i < (2*MAX(m,n)); i++ ) {
00348 work_i[i] = work[i];
00349 }
00350
00351
00352 LAPACKE_dge_trans( LAPACK_COL_MAJOR, kl+ku+1, n, ab_i, ldab, ab_r, n+2 );
00353 if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
00354 LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, q_i, ldq, q_r, m+2 );
00355 }
00356 if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
00357 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, pt_i, ldpt, pt_r, n+2 );
00358 }
00359 if( ncc != 0 ) {
00360 LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, ncc, c_i, ldc, c_r, ncc+2 );
00361 }
00362 info_i = LAPACKE_dgbbrd( LAPACK_ROW_MAJOR, vect_i, m_i, n_i, ncc_i, kl_i,
00363 ku_i, ab_r, ldab_r, d_i, e_i, q_r, ldq_r, pt_r,
00364 ldpt_r, c_r, ldc_r );
00365
00366 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, kl+ku+1, n, ab_r, n+2, ab_i, ldab );
00367 if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
00368 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, m, q_r, m+2, q_i, ldq );
00369 }
00370 if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
00371 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, pt_r, n+2, pt_i, ldpt );
00372 }
00373 if( ncc != 0 ) {
00374 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, ncc, c_r, ncc+2, c_i, ldc );
00375 }
00376
00377 failed = compare_dgbbrd( ab, ab_i, d, d_i, e, e_i, q, q_i, pt, pt_i, c, c_i,
00378 info, info_i, ldab, ldc, ldpt, ldq, m, n, ncc,
00379 vect );
00380 if( failed == 0 ) {
00381 printf( "PASSED: row-major high-level interface to dgbbrd\n" );
00382 } else {
00383 printf( "FAILED: row-major high-level interface to dgbbrd\n" );
00384 }
00385
00386
00387 if( ab != NULL ) {
00388 LAPACKE_free( ab );
00389 }
00390 if( ab_i != NULL ) {
00391 LAPACKE_free( ab_i );
00392 }
00393 if( ab_r != NULL ) {
00394 LAPACKE_free( ab_r );
00395 }
00396 if( ab_save != NULL ) {
00397 LAPACKE_free( ab_save );
00398 }
00399 if( d != NULL ) {
00400 LAPACKE_free( d );
00401 }
00402 if( d_i != NULL ) {
00403 LAPACKE_free( d_i );
00404 }
00405 if( d_save != NULL ) {
00406 LAPACKE_free( d_save );
00407 }
00408 if( e != NULL ) {
00409 LAPACKE_free( e );
00410 }
00411 if( e_i != NULL ) {
00412 LAPACKE_free( e_i );
00413 }
00414 if( e_save != NULL ) {
00415 LAPACKE_free( e_save );
00416 }
00417 if( q != NULL ) {
00418 LAPACKE_free( q );
00419 }
00420 if( q_i != NULL ) {
00421 LAPACKE_free( q_i );
00422 }
00423 if( q_r != NULL ) {
00424 LAPACKE_free( q_r );
00425 }
00426 if( q_save != NULL ) {
00427 LAPACKE_free( q_save );
00428 }
00429 if( pt != NULL ) {
00430 LAPACKE_free( pt );
00431 }
00432 if( pt_i != NULL ) {
00433 LAPACKE_free( pt_i );
00434 }
00435 if( pt_r != NULL ) {
00436 LAPACKE_free( pt_r );
00437 }
00438 if( pt_save != NULL ) {
00439 LAPACKE_free( pt_save );
00440 }
00441 if( c != NULL ) {
00442 LAPACKE_free( c );
00443 }
00444 if( c_i != NULL ) {
00445 LAPACKE_free( c_i );
00446 }
00447 if( c_r != NULL ) {
00448 LAPACKE_free( c_r );
00449 }
00450 if( c_save != NULL ) {
00451 LAPACKE_free( c_save );
00452 }
00453 if( work != NULL ) {
00454 LAPACKE_free( work );
00455 }
00456 if( work_i != NULL ) {
00457 LAPACKE_free( work_i );
00458 }
00459
00460 return 0;
00461 }
00462
00463
00464 static void init_scalars_dgbbrd( char *vect, lapack_int *m, lapack_int *n,
00465 lapack_int *ncc, lapack_int *kl,
00466 lapack_int *ku, lapack_int *ldab,
00467 lapack_int *ldq, lapack_int *ldpt,
00468 lapack_int *ldc )
00469 {
00470 *vect = 'N';
00471 *m = 6;
00472 *n = 4;
00473 *ncc = 0;
00474 *kl = 2;
00475 *ku = 1;
00476 *ldab = 17;
00477 *ldq = 8;
00478 *ldpt = 8;
00479 *ldc = 8;
00480
00481 return;
00482 }
00483
00484
00485 static void init_ab( lapack_int size, double *ab ) {
00486 lapack_int i;
00487 for( i = 0; i < size; i++ ) {
00488 ab[i] = 0;
00489 }
00490 ab[0] = 0.00000000000000000e+000;
00491 ab[17] = -1.28000000000000000e+000;
00492 ab[34] = -3.10000000000000000e-001;
00493 ab[51] = -3.49999999999999980e-001;
00494 ab[1] = -5.69999999999999950e-001;
00495 ab[18] = 1.08000000000000010e+000;
00496 ab[35] = 4.00000000000000020e-001;
00497 ab[52] = 8.00000000000000020e-002;
00498 ab[2] = -1.92999999999999990e+000;
00499 ab[19] = 2.39999999999999990e-001;
00500 ab[36] = -6.60000000000000030e-001;
00501 ab[53] = -2.12999999999999990e+000;
00502 ab[3] = 2.29999999999999980e+000;
00503 ab[20] = 6.40000000000000010e-001;
00504 ab[37] = 1.49999999999999990e-001;
00505 ab[54] = 5.00000000000000000e-001;
00506 }
00507 static void init_d( lapack_int size, double *d ) {
00508 lapack_int i;
00509 for( i = 0; i < size; i++ ) {
00510 d[i] = 0;
00511 }
00512 }
00513 static void init_e( lapack_int size, double *e ) {
00514 lapack_int i;
00515 for( i = 0; i < size; i++ ) {
00516 e[i] = 0;
00517 }
00518 }
00519 static void init_q( lapack_int size, double *q ) {
00520 lapack_int i;
00521 for( i = 0; i < size; i++ ) {
00522 q[i] = 0;
00523 }
00524 }
00525 static void init_pt( lapack_int size, double *pt ) {
00526 lapack_int i;
00527 for( i = 0; i < size; i++ ) {
00528 pt[i] = 0;
00529 }
00530 }
00531 static void init_c( lapack_int size, double *c ) {
00532 lapack_int i;
00533 for( i = 0; i < size; i++ ) {
00534 c[i] = 0;
00535 }
00536 }
00537 static void init_work( lapack_int size, double *work ) {
00538 lapack_int i;
00539 for( i = 0; i < size; i++ ) {
00540 work[i] = 0;
00541 }
00542 }
00543
00544
00545
00546 static int compare_dgbbrd( double *ab, double *ab_i, double *d, double *d_i,
00547 double *e, double *e_i, double *q, double *q_i,
00548 double *pt, double *pt_i, double *c, double *c_i,
00549 lapack_int info, lapack_int info_i, lapack_int ldab,
00550 lapack_int ldc, lapack_int ldpt, lapack_int ldq,
00551 lapack_int m, lapack_int n, lapack_int ncc,
00552 char vect )
00553 {
00554 lapack_int i;
00555 int failed = 0;
00556 for( i = 0; i < ldab*n; i++ ) {
00557 failed += compare_doubles(ab[i],ab_i[i]);
00558 }
00559 for( i = 0; i < (MIN(m,n)); i++ ) {
00560 failed += compare_doubles(d[i],d_i[i]);
00561 }
00562 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00563 failed += compare_doubles(e[i],e_i[i]);
00564 }
00565 if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
00566 for( i = 0; i < ldq*m; i++ ) {
00567 failed += compare_doubles(q[i],q_i[i]);
00568 }
00569 }
00570 if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
00571 for( i = 0; i < ldpt*n; i++ ) {
00572 failed += compare_doubles(pt[i],pt_i[i]);
00573 }
00574 }
00575 if( ncc != 0 ) {
00576 for( i = 0; i < ldc*ncc; i++ ) {
00577 failed += compare_doubles(c[i],c_i[i]);
00578 }
00579 }
00580 failed += (info == info_i) ? 0 : 1;
00581 if( info != 0 || info_i != 0 ) {
00582 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00583 }
00584
00585 return failed;
00586 }