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_strevc( char *side, char *howmny, lapack_int *n,
00055 lapack_int *ldt, lapack_int *ldvl,
00056 lapack_int *ldvr, lapack_int *mm );
00057 static void init_select( lapack_int size, lapack_int *select );
00058 static void init_t( lapack_int size, float *t );
00059 static void init_vl( lapack_int size, float *vl );
00060 static void init_vr( lapack_int size, float *vr );
00061 static void init_work( lapack_int size, float *work );
00062 static int compare_strevc( lapack_int *select, lapack_int *select_i, float *vl,
00063 float *vl_i, float *vr, float *vr_i, lapack_int m,
00064 lapack_int m_i, lapack_int info, lapack_int info_i,
00065 char howmny, lapack_int ldvl, lapack_int ldvr,
00066 lapack_int mm, lapack_int n, char side );
00067
00068 int main(void)
00069 {
00070
00071 char side, side_i;
00072 char howmny, howmny_i;
00073 lapack_int n, n_i;
00074 lapack_int ldt, ldt_i;
00075 lapack_int ldt_r;
00076 lapack_int ldvl, ldvl_i;
00077 lapack_int ldvl_r;
00078 lapack_int ldvr, ldvr_i;
00079 lapack_int ldvr_r;
00080 lapack_int mm, mm_i;
00081 lapack_int m, m_i;
00082 lapack_int info, info_i;
00083 lapack_int i;
00084 int failed;
00085
00086
00087 lapack_int *select = NULL, *select_i = NULL;
00088 float *t = NULL, *t_i = NULL;
00089 float *vl = NULL, *vl_i = NULL;
00090 float *vr = NULL, *vr_i = NULL;
00091 float *work = NULL, *work_i = NULL;
00092 lapack_int *select_save = NULL;
00093 float *vl_save = NULL;
00094 float *vr_save = NULL;
00095 float *t_r = NULL;
00096 float *vl_r = NULL;
00097 float *vr_r = NULL;
00098
00099
00100 init_scalars_strevc( &side, &howmny, &n, &ldt, &ldvl, &ldvr, &mm );
00101 ldt_r = n+2;
00102 ldvl_r = mm+2;
00103 ldvr_r = mm+2;
00104 side_i = side;
00105 howmny_i = howmny;
00106 n_i = n;
00107 ldt_i = ldt;
00108 ldvl_i = ldvl;
00109 ldvr_i = ldvr;
00110 mm_i = mm;
00111
00112
00113 select = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00114 t = (float *)LAPACKE_malloc( ldt*n * sizeof(float) );
00115 vl = (float *)LAPACKE_malloc( ldvl*mm * sizeof(float) );
00116 vr = (float *)LAPACKE_malloc( ldvr*mm * sizeof(float) );
00117 work = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
00118
00119
00120 select_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00121 t_i = (float *)LAPACKE_malloc( ldt*n * sizeof(float) );
00122 vl_i = (float *)LAPACKE_malloc( ldvl*mm * sizeof(float) );
00123 vr_i = (float *)LAPACKE_malloc( ldvr*mm * sizeof(float) );
00124 work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
00125
00126
00127 select_save = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00128 vl_save = (float *)LAPACKE_malloc( ldvl*mm * sizeof(float) );
00129 vr_save = (float *)LAPACKE_malloc( ldvr*mm * sizeof(float) );
00130
00131
00132 t_r = (float *)LAPACKE_malloc( n*(n+2) * sizeof(float) );
00133 vl_r = (float *)LAPACKE_malloc( n*(mm+2) * sizeof(float) );
00134 vr_r = (float *)LAPACKE_malloc( n*(mm+2) * sizeof(float) );
00135
00136
00137 init_select( n, select );
00138 init_t( ldt*n, t );
00139 init_vl( ldvl*mm, vl );
00140 init_vr( ldvr*mm, vr );
00141 init_work( 3*n, work );
00142
00143
00144 for( i = 0; i < n; i++ ) {
00145 select_save[i] = select[i];
00146 }
00147 for( i = 0; i < ldvl*mm; i++ ) {
00148 vl_save[i] = vl[i];
00149 }
00150 for( i = 0; i < ldvr*mm; i++ ) {
00151 vr_save[i] = vr[i];
00152 }
00153
00154
00155 strevc_( &side, &howmny, select, &n, t, &ldt, vl, &ldvl, vr, &ldvr, &mm, &m,
00156 work, &info );
00157
00158
00159
00160 for( i = 0; i < n; i++ ) {
00161 select_i[i] = select_save[i];
00162 }
00163 for( i = 0; i < ldt*n; i++ ) {
00164 t_i[i] = t[i];
00165 }
00166 for( i = 0; i < ldvl*mm; i++ ) {
00167 vl_i[i] = vl_save[i];
00168 }
00169 for( i = 0; i < ldvr*mm; i++ ) {
00170 vr_i[i] = vr_save[i];
00171 }
00172 for( i = 0; i < 3*n; i++ ) {
00173 work_i[i] = work[i];
00174 }
00175 info_i = LAPACKE_strevc_work( LAPACK_COL_MAJOR, side_i, howmny_i, select_i,
00176 n_i, t_i, ldt_i, vl_i, ldvl_i, vr_i, ldvr_i,
00177 mm_i, &m_i, work_i );
00178
00179 failed = compare_strevc( select, select_i, vl, vl_i, vr, vr_i, m, m_i, info,
00180 info_i, howmny, ldvl, ldvr, mm, n, side );
00181 if( failed == 0 ) {
00182 printf( "PASSED: column-major middle-level interface to strevc\n" );
00183 } else {
00184 printf( "FAILED: column-major middle-level interface to strevc\n" );
00185 }
00186
00187
00188
00189 for( i = 0; i < n; i++ ) {
00190 select_i[i] = select_save[i];
00191 }
00192 for( i = 0; i < ldt*n; i++ ) {
00193 t_i[i] = t[i];
00194 }
00195 for( i = 0; i < ldvl*mm; i++ ) {
00196 vl_i[i] = vl_save[i];
00197 }
00198 for( i = 0; i < ldvr*mm; i++ ) {
00199 vr_i[i] = vr_save[i];
00200 }
00201 for( i = 0; i < 3*n; i++ ) {
00202 work_i[i] = work[i];
00203 }
00204 info_i = LAPACKE_strevc( LAPACK_COL_MAJOR, side_i, howmny_i, select_i, n_i,
00205 t_i, ldt_i, vl_i, ldvl_i, vr_i, ldvr_i, mm_i,
00206 &m_i );
00207
00208 failed = compare_strevc( select, select_i, vl, vl_i, vr, vr_i, m, m_i, info,
00209 info_i, howmny, ldvl, ldvr, mm, n, side );
00210 if( failed == 0 ) {
00211 printf( "PASSED: column-major high-level interface to strevc\n" );
00212 } else {
00213 printf( "FAILED: column-major high-level interface to strevc\n" );
00214 }
00215
00216
00217
00218 for( i = 0; i < n; i++ ) {
00219 select_i[i] = select_save[i];
00220 }
00221 for( i = 0; i < ldt*n; i++ ) {
00222 t_i[i] = t[i];
00223 }
00224 for( i = 0; i < ldvl*mm; i++ ) {
00225 vl_i[i] = vl_save[i];
00226 }
00227 for( i = 0; i < ldvr*mm; i++ ) {
00228 vr_i[i] = vr_save[i];
00229 }
00230 for( i = 0; i < 3*n; i++ ) {
00231 work_i[i] = work[i];
00232 }
00233
00234 LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
00235 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
00236 LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
00237 }
00238 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
00239 LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
00240 }
00241 info_i = LAPACKE_strevc_work( LAPACK_ROW_MAJOR, side_i, howmny_i, select_i,
00242 n_i, t_r, ldt_r, vl_r, ldvl_r, vr_r, ldvr_r,
00243 mm_i, &m_i, work_i );
00244
00245 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
00246 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, mm, vl_r, mm+2, vl_i, ldvl );
00247 }
00248 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
00249 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, mm, vr_r, mm+2, vr_i, ldvr );
00250 }
00251
00252 failed = compare_strevc( select, select_i, vl, vl_i, vr, vr_i, m, m_i, info,
00253 info_i, howmny, ldvl, ldvr, mm, n, side );
00254 if( failed == 0 ) {
00255 printf( "PASSED: row-major middle-level interface to strevc\n" );
00256 } else {
00257 printf( "FAILED: row-major middle-level interface to strevc\n" );
00258 }
00259
00260
00261
00262 for( i = 0; i < n; i++ ) {
00263 select_i[i] = select_save[i];
00264 }
00265 for( i = 0; i < ldt*n; i++ ) {
00266 t_i[i] = t[i];
00267 }
00268 for( i = 0; i < ldvl*mm; i++ ) {
00269 vl_i[i] = vl_save[i];
00270 }
00271 for( i = 0; i < ldvr*mm; i++ ) {
00272 vr_i[i] = vr_save[i];
00273 }
00274 for( i = 0; i < 3*n; i++ ) {
00275 work_i[i] = work[i];
00276 }
00277
00278
00279 LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
00280 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
00281 LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
00282 }
00283 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
00284 LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
00285 }
00286 info_i = LAPACKE_strevc( LAPACK_ROW_MAJOR, side_i, howmny_i, select_i, n_i,
00287 t_r, ldt_r, vl_r, ldvl_r, vr_r, ldvr_r, mm_i,
00288 &m_i );
00289
00290 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
00291 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, mm, vl_r, mm+2, vl_i, ldvl );
00292 }
00293 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
00294 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, mm, vr_r, mm+2, vr_i, ldvr );
00295 }
00296
00297 failed = compare_strevc( select, select_i, vl, vl_i, vr, vr_i, m, m_i, info,
00298 info_i, howmny, ldvl, ldvr, mm, n, side );
00299 if( failed == 0 ) {
00300 printf( "PASSED: row-major high-level interface to strevc\n" );
00301 } else {
00302 printf( "FAILED: row-major high-level interface to strevc\n" );
00303 }
00304
00305
00306 if( select != NULL ) {
00307 LAPACKE_free( select );
00308 }
00309 if( select_i != NULL ) {
00310 LAPACKE_free( select_i );
00311 }
00312 if( select_save != NULL ) {
00313 LAPACKE_free( select_save );
00314 }
00315 if( t != NULL ) {
00316 LAPACKE_free( t );
00317 }
00318 if( t_i != NULL ) {
00319 LAPACKE_free( t_i );
00320 }
00321 if( t_r != NULL ) {
00322 LAPACKE_free( t_r );
00323 }
00324 if( vl != NULL ) {
00325 LAPACKE_free( vl );
00326 }
00327 if( vl_i != NULL ) {
00328 LAPACKE_free( vl_i );
00329 }
00330 if( vl_r != NULL ) {
00331 LAPACKE_free( vl_r );
00332 }
00333 if( vl_save != NULL ) {
00334 LAPACKE_free( vl_save );
00335 }
00336 if( vr != NULL ) {
00337 LAPACKE_free( vr );
00338 }
00339 if( vr_i != NULL ) {
00340 LAPACKE_free( vr_i );
00341 }
00342 if( vr_r != NULL ) {
00343 LAPACKE_free( vr_r );
00344 }
00345 if( vr_save != NULL ) {
00346 LAPACKE_free( vr_save );
00347 }
00348 if( work != NULL ) {
00349 LAPACKE_free( work );
00350 }
00351 if( work_i != NULL ) {
00352 LAPACKE_free( work_i );
00353 }
00354
00355 return 0;
00356 }
00357
00358
00359 static void init_scalars_strevc( char *side, char *howmny, lapack_int *n,
00360 lapack_int *ldt, lapack_int *ldvl,
00361 lapack_int *ldvr, lapack_int *mm )
00362 {
00363 *side = 'B';
00364 *howmny = 'A';
00365 *n = 4;
00366 *ldt = 8;
00367 *ldvl = 8;
00368 *ldvr = 8;
00369 *mm = 4;
00370
00371 return;
00372 }
00373
00374
00375 static void init_select( lapack_int size, lapack_int *select ) {
00376 lapack_int i;
00377 for( i = 0; i < size; i++ ) {
00378 select[i] = 0;
00379 }
00380 select[0] = 0;
00381 select[1] = 0;
00382 select[2] = 0;
00383 select[3] = 0;
00384 }
00385 static void init_t( lapack_int size, float *t ) {
00386 lapack_int i;
00387 for( i = 0; i < size; i++ ) {
00388 t[i] = 0;
00389 }
00390 t[0] = 7.994999886e-001;
00391 t[8] = -1.143999994e-001;
00392 t[16] = 6.000000052e-003;
00393 t[24] = 3.359999880e-002;
00394 t[1] = 0.000000000e+000;
00395 t[9] = -9.939999878e-002;
00396 t[17] = 2.477999926e-001;
00397 t[25] = 3.474000096e-001;
00398 t[2] = 0.000000000e+000;
00399 t[10] = -6.482999921e-001;
00400 t[18] = -9.939999878e-002;
00401 t[26] = 2.026000023e-001;
00402 t[3] = 0.000000000e+000;
00403 t[11] = 0.000000000e+000;
00404 t[19] = 0.000000000e+000;
00405 t[27] = -1.006999984e-001;
00406 }
00407 static void init_vl( lapack_int size, float *vl ) {
00408 lapack_int i;
00409 for( i = 0; i < size; i++ ) {
00410 vl[i] = 0;
00411 }
00412 vl[0] = 0.000000000e+000;
00413 vl[8] = 0.000000000e+000;
00414 vl[16] = 0.000000000e+000;
00415 vl[24] = 0.000000000e+000;
00416 vl[1] = 0.000000000e+000;
00417 vl[9] = 0.000000000e+000;
00418 vl[17] = 0.000000000e+000;
00419 vl[25] = 0.000000000e+000;
00420 vl[2] = 0.000000000e+000;
00421 vl[10] = 0.000000000e+000;
00422 vl[18] = 0.000000000e+000;
00423 vl[26] = 0.000000000e+000;
00424 vl[3] = 0.000000000e+000;
00425 vl[11] = 0.000000000e+000;
00426 vl[19] = 0.000000000e+000;
00427 vl[27] = 0.000000000e+000;
00428 }
00429 static void init_vr( lapack_int size, float *vr ) {
00430 lapack_int i;
00431 for( i = 0; i < size; i++ ) {
00432 vr[i] = 0;
00433 }
00434 vr[0] = 0.000000000e+000;
00435 vr[8] = 0.000000000e+000;
00436 vr[16] = 0.000000000e+000;
00437 vr[24] = 0.000000000e+000;
00438 vr[1] = 0.000000000e+000;
00439 vr[9] = 0.000000000e+000;
00440 vr[17] = 0.000000000e+000;
00441 vr[25] = 0.000000000e+000;
00442 vr[2] = 0.000000000e+000;
00443 vr[10] = 0.000000000e+000;
00444 vr[18] = 0.000000000e+000;
00445 vr[26] = 0.000000000e+000;
00446 vr[3] = 0.000000000e+000;
00447 vr[11] = 0.000000000e+000;
00448 vr[19] = 0.000000000e+000;
00449 vr[27] = 0.000000000e+000;
00450 }
00451 static void init_work( lapack_int size, float *work ) {
00452 lapack_int i;
00453 for( i = 0; i < size; i++ ) {
00454 work[i] = 0;
00455 }
00456 }
00457
00458
00459
00460 static int compare_strevc( lapack_int *select, lapack_int *select_i, float *vl,
00461 float *vl_i, float *vr, float *vr_i, lapack_int m,
00462 lapack_int m_i, lapack_int info, lapack_int info_i,
00463 char howmny, lapack_int ldvl, lapack_int ldvr,
00464 lapack_int mm, lapack_int n, char side )
00465 {
00466 lapack_int i;
00467 int failed = 0;
00468 if( LAPACKE_lsame( howmny, 's' ) ) {
00469 for( i = 0; i < n; i++ ) {
00470 failed += (select[i] == select_i[i]) ? 0 : 1;
00471 }
00472 }
00473 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
00474 for( i = 0; i < ldvl*mm; i++ ) {
00475 failed += compare_floats(vl[i],vl_i[i]);
00476 }
00477 }
00478 if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
00479 for( i = 0; i < ldvr*mm; i++ ) {
00480 failed += compare_floats(vr[i],vr_i[i]);
00481 }
00482 }
00483 failed += (m == m_i) ? 0 : 1;
00484 failed += (info == info_i) ? 0 : 1;
00485 if( info != 0 || info_i != 0 ) {
00486 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00487 }
00488
00489 return failed;
00490 }