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_zhsein( char *job, char *eigsrc, char *initv,
00055 lapack_int *n, lapack_int *ldh,
00056 lapack_int *ldvl, lapack_int *ldvr,
00057 lapack_int *mm );
00058 static void init_select( lapack_int size, lapack_int *select );
00059 static void init_h( lapack_int size, lapack_complex_double *h );
00060 static void init_w( lapack_int size, lapack_complex_double *w );
00061 static void init_vl( lapack_int size, lapack_complex_double *vl );
00062 static void init_vr( lapack_int size, lapack_complex_double *vr );
00063 static void init_work( lapack_int size, lapack_complex_double *work );
00064 static void init_rwork( lapack_int size, double *rwork );
00065 static void init_ifaill( lapack_int size, lapack_int *ifaill );
00066 static void init_ifailr( lapack_int size, lapack_int *ifailr );
00067 static int compare_zhsein( lapack_complex_double *w, lapack_complex_double *w_i,
00068 lapack_complex_double *vl,
00069 lapack_complex_double *vl_i,
00070 lapack_complex_double *vr,
00071 lapack_complex_double *vr_i, lapack_int m,
00072 lapack_int m_i, lapack_int *ifaill,
00073 lapack_int *ifaill_i, lapack_int *ifailr,
00074 lapack_int *ifailr_i, lapack_int info,
00075 lapack_int info_i, char job, lapack_int ldvl,
00076 lapack_int ldvr, lapack_int mm, lapack_int n );
00077
00078 int main(void)
00079 {
00080
00081 char job, job_i;
00082 char eigsrc, eigsrc_i;
00083 char initv, initv_i;
00084 lapack_int n, n_i;
00085 lapack_int ldh, ldh_i;
00086 lapack_int ldh_r;
00087 lapack_int ldvl, ldvl_i;
00088 lapack_int ldvl_r;
00089 lapack_int ldvr, ldvr_i;
00090 lapack_int ldvr_r;
00091 lapack_int mm, mm_i;
00092 lapack_int m, m_i;
00093 lapack_int info, info_i;
00094 lapack_int i;
00095 int failed;
00096
00097
00098 lapack_int *select = NULL, *select_i = NULL;
00099 lapack_complex_double *h = NULL, *h_i = NULL;
00100 lapack_complex_double *w = NULL, *w_i = NULL;
00101 lapack_complex_double *vl = NULL, *vl_i = NULL;
00102 lapack_complex_double *vr = NULL, *vr_i = NULL;
00103 lapack_complex_double *work = NULL, *work_i = NULL;
00104 double *rwork = NULL, *rwork_i = NULL;
00105 lapack_int *ifaill = NULL, *ifaill_i = NULL;
00106 lapack_int *ifailr = NULL, *ifailr_i = NULL;
00107 lapack_complex_double *w_save = NULL;
00108 lapack_complex_double *vl_save = NULL;
00109 lapack_complex_double *vr_save = NULL;
00110 lapack_int *ifaill_save = NULL;
00111 lapack_int *ifailr_save = NULL;
00112 lapack_complex_double *h_r = NULL;
00113 lapack_complex_double *vl_r = NULL;
00114 lapack_complex_double *vr_r = NULL;
00115
00116
00117 init_scalars_zhsein( &job, &eigsrc, &initv, &n, &ldh, &ldvl, &ldvr, &mm );
00118 ldh_r = n+2;
00119 ldvl_r = mm+2;
00120 ldvr_r = mm+2;
00121 job_i = job;
00122 eigsrc_i = eigsrc;
00123 initv_i = initv;
00124 n_i = n;
00125 ldh_i = ldh;
00126 ldvl_i = ldvl;
00127 ldvr_i = ldvr;
00128 mm_i = mm;
00129
00130
00131 select = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00132 h = (lapack_complex_double *)
00133 LAPACKE_malloc( ldh*n * sizeof(lapack_complex_double) );
00134 w = (lapack_complex_double *)
00135 LAPACKE_malloc( n * sizeof(lapack_complex_double) );
00136 vl = (lapack_complex_double *)
00137 LAPACKE_malloc( ldvl*mm * sizeof(lapack_complex_double) );
00138 vr = (lapack_complex_double *)
00139 LAPACKE_malloc( ldvr*mm * sizeof(lapack_complex_double) );
00140 work = (lapack_complex_double *)
00141 LAPACKE_malloc( n*n * sizeof(lapack_complex_double) );
00142 rwork = (double *)LAPACKE_malloc( n * sizeof(double) );
00143 ifaill = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00144 ifailr = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00145
00146
00147 select_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00148 h_i = (lapack_complex_double *)
00149 LAPACKE_malloc( ldh*n * sizeof(lapack_complex_double) );
00150 w_i = (lapack_complex_double *)
00151 LAPACKE_malloc( n * sizeof(lapack_complex_double) );
00152 vl_i = (lapack_complex_double *)
00153 LAPACKE_malloc( ldvl*mm * sizeof(lapack_complex_double) );
00154 vr_i = (lapack_complex_double *)
00155 LAPACKE_malloc( ldvr*mm * sizeof(lapack_complex_double) );
00156 work_i = (lapack_complex_double *)
00157 LAPACKE_malloc( n*n * sizeof(lapack_complex_double) );
00158 rwork_i = (double *)LAPACKE_malloc( n * sizeof(double) );
00159 ifaill_i = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00160 ifailr_i = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00161
00162
00163 w_save = (lapack_complex_double *)
00164 LAPACKE_malloc( n * sizeof(lapack_complex_double) );
00165 vl_save = (lapack_complex_double *)
00166 LAPACKE_malloc( ldvl*mm * sizeof(lapack_complex_double) );
00167 vr_save = (lapack_complex_double *)
00168 LAPACKE_malloc( ldvr*mm * sizeof(lapack_complex_double) );
00169 ifaill_save = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00170 ifailr_save = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00171
00172
00173 h_r = (lapack_complex_double *)
00174 LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
00175 vl_r = (lapack_complex_double *)
00176 LAPACKE_malloc( n*(mm+2) * sizeof(lapack_complex_double) );
00177 vr_r = (lapack_complex_double *)
00178 LAPACKE_malloc( n*(mm+2) * sizeof(lapack_complex_double) );
00179
00180
00181 init_select( n, select );
00182 init_h( ldh*n, h );
00183 init_w( n, w );
00184 init_vl( ldvl*mm, vl );
00185 init_vr( ldvr*mm, vr );
00186 init_work( n*n, work );
00187 init_rwork( n, rwork );
00188 init_ifaill( mm, ifaill );
00189 init_ifailr( mm, ifailr );
00190
00191
00192 for( i = 0; i < n; i++ ) {
00193 w_save[i] = w[i];
00194 }
00195 for( i = 0; i < ldvl*mm; i++ ) {
00196 vl_save[i] = vl[i];
00197 }
00198 for( i = 0; i < ldvr*mm; i++ ) {
00199 vr_save[i] = vr[i];
00200 }
00201 for( i = 0; i < mm; i++ ) {
00202 ifaill_save[i] = ifaill[i];
00203 }
00204 for( i = 0; i < mm; i++ ) {
00205 ifailr_save[i] = ifailr[i];
00206 }
00207
00208
00209 zhsein_( &job, &eigsrc, &initv, select, &n, h, &ldh, w, vl, &ldvl, vr,
00210 &ldvr, &mm, &m, work, rwork, ifaill, ifailr, &info );
00211
00212
00213
00214 for( i = 0; i < n; i++ ) {
00215 select_i[i] = select[i];
00216 }
00217 for( i = 0; i < ldh*n; i++ ) {
00218 h_i[i] = h[i];
00219 }
00220 for( i = 0; i < n; i++ ) {
00221 w_i[i] = w_save[i];
00222 }
00223 for( i = 0; i < ldvl*mm; i++ ) {
00224 vl_i[i] = vl_save[i];
00225 }
00226 for( i = 0; i < ldvr*mm; i++ ) {
00227 vr_i[i] = vr_save[i];
00228 }
00229 for( i = 0; i < n*n; i++ ) {
00230 work_i[i] = work[i];
00231 }
00232 for( i = 0; i < n; i++ ) {
00233 rwork_i[i] = rwork[i];
00234 }
00235 for( i = 0; i < mm; i++ ) {
00236 ifaill_i[i] = ifaill_save[i];
00237 }
00238 for( i = 0; i < mm; i++ ) {
00239 ifailr_i[i] = ifailr_save[i];
00240 }
00241 info_i = LAPACKE_zhsein_work( LAPACK_COL_MAJOR, job_i, eigsrc_i, initv_i,
00242 select_i, n_i, h_i, ldh_i, w_i, vl_i, ldvl_i,
00243 vr_i, ldvr_i, mm_i, &m_i, work_i, rwork_i,
00244 ifaill_i, ifailr_i );
00245
00246 failed = compare_zhsein( w, w_i, vl, vl_i, vr, vr_i, m, m_i, ifaill,
00247 ifaill_i, ifailr, ifailr_i, info, info_i, job,
00248 ldvl, ldvr, mm, n );
00249 if( failed == 0 ) {
00250 printf( "PASSED: column-major middle-level interface to zhsein\n" );
00251 } else {
00252 printf( "FAILED: column-major middle-level interface to zhsein\n" );
00253 }
00254
00255
00256
00257 for( i = 0; i < n; i++ ) {
00258 select_i[i] = select[i];
00259 }
00260 for( i = 0; i < ldh*n; i++ ) {
00261 h_i[i] = h[i];
00262 }
00263 for( i = 0; i < n; i++ ) {
00264 w_i[i] = w_save[i];
00265 }
00266 for( i = 0; i < ldvl*mm; i++ ) {
00267 vl_i[i] = vl_save[i];
00268 }
00269 for( i = 0; i < ldvr*mm; i++ ) {
00270 vr_i[i] = vr_save[i];
00271 }
00272 for( i = 0; i < n*n; i++ ) {
00273 work_i[i] = work[i];
00274 }
00275 for( i = 0; i < n; i++ ) {
00276 rwork_i[i] = rwork[i];
00277 }
00278 for( i = 0; i < mm; i++ ) {
00279 ifaill_i[i] = ifaill_save[i];
00280 }
00281 for( i = 0; i < mm; i++ ) {
00282 ifailr_i[i] = ifailr_save[i];
00283 }
00284 info_i = LAPACKE_zhsein( LAPACK_COL_MAJOR, job_i, eigsrc_i, initv_i,
00285 select_i, n_i, h_i, ldh_i, w_i, vl_i, ldvl_i, vr_i,
00286 ldvr_i, mm_i, &m_i, ifaill_i, ifailr_i );
00287
00288 failed = compare_zhsein( w, w_i, vl, vl_i, vr, vr_i, m, m_i, ifaill,
00289 ifaill_i, ifailr, ifailr_i, info, info_i, job,
00290 ldvl, ldvr, mm, n );
00291 if( failed == 0 ) {
00292 printf( "PASSED: column-major high-level interface to zhsein\n" );
00293 } else {
00294 printf( "FAILED: column-major high-level interface to zhsein\n" );
00295 }
00296
00297
00298
00299 for( i = 0; i < n; i++ ) {
00300 select_i[i] = select[i];
00301 }
00302 for( i = 0; i < ldh*n; i++ ) {
00303 h_i[i] = h[i];
00304 }
00305 for( i = 0; i < n; i++ ) {
00306 w_i[i] = w_save[i];
00307 }
00308 for( i = 0; i < ldvl*mm; i++ ) {
00309 vl_i[i] = vl_save[i];
00310 }
00311 for( i = 0; i < ldvr*mm; i++ ) {
00312 vr_i[i] = vr_save[i];
00313 }
00314 for( i = 0; i < n*n; i++ ) {
00315 work_i[i] = work[i];
00316 }
00317 for( i = 0; i < n; i++ ) {
00318 rwork_i[i] = rwork[i];
00319 }
00320 for( i = 0; i < mm; i++ ) {
00321 ifaill_i[i] = ifaill_save[i];
00322 }
00323 for( i = 0; i < mm; i++ ) {
00324 ifailr_i[i] = ifailr_save[i];
00325 }
00326
00327 LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, h_i, ldh, h_r, n+2 );
00328 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00329 LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
00330 }
00331 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00332 LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
00333 }
00334 info_i = LAPACKE_zhsein_work( LAPACK_ROW_MAJOR, job_i, eigsrc_i, initv_i,
00335 select_i, n_i, h_r, ldh_r, w_i, vl_r, ldvl_r,
00336 vr_r, ldvr_r, mm_i, &m_i, work_i, rwork_i,
00337 ifaill_i, ifailr_i );
00338
00339 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00340 LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, mm, vl_r, mm+2, vl_i, ldvl );
00341 }
00342 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00343 LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, mm, vr_r, mm+2, vr_i, ldvr );
00344 }
00345
00346 failed = compare_zhsein( w, w_i, vl, vl_i, vr, vr_i, m, m_i, ifaill,
00347 ifaill_i, ifailr, ifailr_i, info, info_i, job,
00348 ldvl, ldvr, mm, n );
00349 if( failed == 0 ) {
00350 printf( "PASSED: row-major middle-level interface to zhsein\n" );
00351 } else {
00352 printf( "FAILED: row-major middle-level interface to zhsein\n" );
00353 }
00354
00355
00356
00357 for( i = 0; i < n; i++ ) {
00358 select_i[i] = select[i];
00359 }
00360 for( i = 0; i < ldh*n; i++ ) {
00361 h_i[i] = h[i];
00362 }
00363 for( i = 0; i < n; i++ ) {
00364 w_i[i] = w_save[i];
00365 }
00366 for( i = 0; i < ldvl*mm; i++ ) {
00367 vl_i[i] = vl_save[i];
00368 }
00369 for( i = 0; i < ldvr*mm; i++ ) {
00370 vr_i[i] = vr_save[i];
00371 }
00372 for( i = 0; i < n*n; i++ ) {
00373 work_i[i] = work[i];
00374 }
00375 for( i = 0; i < n; i++ ) {
00376 rwork_i[i] = rwork[i];
00377 }
00378 for( i = 0; i < mm; i++ ) {
00379 ifaill_i[i] = ifaill_save[i];
00380 }
00381 for( i = 0; i < mm; i++ ) {
00382 ifailr_i[i] = ifailr_save[i];
00383 }
00384
00385
00386 LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, h_i, ldh, h_r, n+2 );
00387 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00388 LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
00389 }
00390 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00391 LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
00392 }
00393 info_i = LAPACKE_zhsein( LAPACK_ROW_MAJOR, job_i, eigsrc_i, initv_i,
00394 select_i, n_i, h_r, ldh_r, w_i, vl_r, ldvl_r, vr_r,
00395 ldvr_r, mm_i, &m_i, ifaill_i, ifailr_i );
00396
00397 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00398 LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, mm, vl_r, mm+2, vl_i, ldvl );
00399 }
00400 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00401 LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, mm, vr_r, mm+2, vr_i, ldvr );
00402 }
00403
00404 failed = compare_zhsein( w, w_i, vl, vl_i, vr, vr_i, m, m_i, ifaill,
00405 ifaill_i, ifailr, ifailr_i, info, info_i, job,
00406 ldvl, ldvr, mm, n );
00407 if( failed == 0 ) {
00408 printf( "PASSED: row-major high-level interface to zhsein\n" );
00409 } else {
00410 printf( "FAILED: row-major high-level interface to zhsein\n" );
00411 }
00412
00413
00414 if( select != NULL ) {
00415 LAPACKE_free( select );
00416 }
00417 if( select_i != NULL ) {
00418 LAPACKE_free( select_i );
00419 }
00420 if( h != NULL ) {
00421 LAPACKE_free( h );
00422 }
00423 if( h_i != NULL ) {
00424 LAPACKE_free( h_i );
00425 }
00426 if( h_r != NULL ) {
00427 LAPACKE_free( h_r );
00428 }
00429 if( w != NULL ) {
00430 LAPACKE_free( w );
00431 }
00432 if( w_i != NULL ) {
00433 LAPACKE_free( w_i );
00434 }
00435 if( w_save != NULL ) {
00436 LAPACKE_free( w_save );
00437 }
00438 if( vl != NULL ) {
00439 LAPACKE_free( vl );
00440 }
00441 if( vl_i != NULL ) {
00442 LAPACKE_free( vl_i );
00443 }
00444 if( vl_r != NULL ) {
00445 LAPACKE_free( vl_r );
00446 }
00447 if( vl_save != NULL ) {
00448 LAPACKE_free( vl_save );
00449 }
00450 if( vr != NULL ) {
00451 LAPACKE_free( vr );
00452 }
00453 if( vr_i != NULL ) {
00454 LAPACKE_free( vr_i );
00455 }
00456 if( vr_r != NULL ) {
00457 LAPACKE_free( vr_r );
00458 }
00459 if( vr_save != NULL ) {
00460 LAPACKE_free( vr_save );
00461 }
00462 if( work != NULL ) {
00463 LAPACKE_free( work );
00464 }
00465 if( work_i != NULL ) {
00466 LAPACKE_free( work_i );
00467 }
00468 if( rwork != NULL ) {
00469 LAPACKE_free( rwork );
00470 }
00471 if( rwork_i != NULL ) {
00472 LAPACKE_free( rwork_i );
00473 }
00474 if( ifaill != NULL ) {
00475 LAPACKE_free( ifaill );
00476 }
00477 if( ifaill_i != NULL ) {
00478 LAPACKE_free( ifaill_i );
00479 }
00480 if( ifaill_save != NULL ) {
00481 LAPACKE_free( ifaill_save );
00482 }
00483 if( ifailr != NULL ) {
00484 LAPACKE_free( ifailr );
00485 }
00486 if( ifailr_i != NULL ) {
00487 LAPACKE_free( ifailr_i );
00488 }
00489 if( ifailr_save != NULL ) {
00490 LAPACKE_free( ifailr_save );
00491 }
00492
00493 return 0;
00494 }
00495
00496
00497 static void init_scalars_zhsein( char *job, char *eigsrc, char *initv,
00498 lapack_int *n, lapack_int *ldh,
00499 lapack_int *ldvl, lapack_int *ldvr,
00500 lapack_int *mm )
00501 {
00502 *job = 'R';
00503 *eigsrc = 'Q';
00504 *initv = 'N';
00505 *n = 4;
00506 *ldh = 8;
00507 *ldvl = 8;
00508 *ldvr = 8;
00509 *mm = 4;
00510
00511 return;
00512 }
00513
00514
00515 static void init_select( lapack_int size, lapack_int *select ) {
00516 lapack_int i;
00517 for( i = 0; i < size; i++ ) {
00518 select[i] = 0;
00519 }
00520 select[0] = -1;
00521 select[1] = -1;
00522 select[2] = 0;
00523 select[3] = 0;
00524 }
00525 static void init_h( lapack_int size, lapack_complex_double *h ) {
00526 lapack_int i;
00527 for( i = 0; i < size; i++ ) {
00528 h[i] = lapack_make_complex_double( 0.0, 0.0 );
00529 }
00530 h[0] = lapack_make_complex_double( -3.97000000000000020e+000,
00531 -5.04000000000000000e+000 );
00532 h[8] = lapack_make_complex_double( -1.13180518733977030e+000,
00533 -2.56930489882743900e+000 );
00534 h[16] = lapack_make_complex_double( -4.60274243753355350e+000,
00535 -1.42631904083292180e-001 );
00536 h[24] = lapack_make_complex_double( -1.42491228936652710e+000,
00537 1.73298370334218620e+000 );
00538 h[1] = lapack_make_complex_double( -5.47965327370263560e+000,
00539 0.00000000000000000e+000 );
00540 h[9] = lapack_make_complex_double( 1.85847282076558700e+000,
00541 -1.55018070644028950e+000 );
00542 h[17] = lapack_make_complex_double( 4.41446552691701300e+000,
00543 -7.63823711555098320e-001 );
00544 h[25] = lapack_make_complex_double( -4.80526133699015420e-001,
00545 -1.19759999733274710e+000 );
00546 h[2] = lapack_make_complex_double( 6.93222211814628180e-001,
00547 -4.82875276260254950e-001 );
00548 h[10] = lapack_make_complex_double( 6.26727681806422240e+000,
00549 0.00000000000000000e+000 );
00550 h[18] = lapack_make_complex_double( -4.50380940334500930e-001,
00551 -2.89818325981801020e-002 );
00552 h[26] = lapack_make_complex_double( -1.34668445007873290e+000,
00553 1.65792489538873020e+000 );
00554 h[3] = lapack_make_complex_double( -2.11294690792069330e-001,
00555 8.64412259893682090e-002 );
00556 h[11] = lapack_make_complex_double( 1.24214618876649560e-001,
00557 -2.28927604979682810e-001 );
00558 h[19] = lapack_make_complex_double( -3.49998583739325890e+000,
00559 0.00000000000000000e+000 );
00560 h[27] = lapack_make_complex_double( 2.56190811956891370e+000,
00561 -3.37083746096152880e+000 );
00562 }
00563 static void init_w( lapack_int size, lapack_complex_double *w ) {
00564 lapack_int i;
00565 for( i = 0; i < size; i++ ) {
00566 w[i] = lapack_make_complex_double( 0.0, 0.0 );
00567 }
00568 w[0] = lapack_make_complex_double( -6.00042534294925110e+000,
00569 -6.99984337157039070e+000 );
00570 w[1] = lapack_make_complex_double( -5.00003345759696490e+000,
00571 2.00602716231651220e+000 );
00572 w[2] = lapack_make_complex_double( 7.99819451620824480e+000,
00573 -9.96365091392899080e-001 );
00574 w[3] = lapack_make_complex_double( 3.00226428433797170e+000,
00575 -3.99981869935322360e+000 );
00576 }
00577 static void init_vl( lapack_int size, lapack_complex_double *vl ) {
00578 lapack_int i;
00579 for( i = 0; i < size; i++ ) {
00580 vl[i] = lapack_make_complex_double( 0.0, 0.0 );
00581 }
00582 vl[0] = lapack_make_complex_double( 0.00000000000000000e+000,
00583 0.00000000000000000e+000 );
00584 vl[8] = lapack_make_complex_double( 0.00000000000000000e+000,
00585 0.00000000000000000e+000 );
00586 vl[16] = lapack_make_complex_double( 0.00000000000000000e+000,
00587 0.00000000000000000e+000 );
00588 vl[24] = lapack_make_complex_double( 0.00000000000000000e+000,
00589 0.00000000000000000e+000 );
00590 vl[1] = lapack_make_complex_double( 0.00000000000000000e+000,
00591 0.00000000000000000e+000 );
00592 vl[9] = lapack_make_complex_double( 0.00000000000000000e+000,
00593 0.00000000000000000e+000 );
00594 vl[17] = lapack_make_complex_double( 0.00000000000000000e+000,
00595 0.00000000000000000e+000 );
00596 vl[25] = lapack_make_complex_double( 0.00000000000000000e+000,
00597 0.00000000000000000e+000 );
00598 vl[2] = lapack_make_complex_double( 0.00000000000000000e+000,
00599 0.00000000000000000e+000 );
00600 vl[10] = lapack_make_complex_double( 0.00000000000000000e+000,
00601 0.00000000000000000e+000 );
00602 vl[18] = lapack_make_complex_double( 0.00000000000000000e+000,
00603 0.00000000000000000e+000 );
00604 vl[26] = lapack_make_complex_double( 0.00000000000000000e+000,
00605 0.00000000000000000e+000 );
00606 vl[3] = lapack_make_complex_double( 0.00000000000000000e+000,
00607 0.00000000000000000e+000 );
00608 vl[11] = lapack_make_complex_double( 0.00000000000000000e+000,
00609 0.00000000000000000e+000 );
00610 vl[19] = lapack_make_complex_double( 0.00000000000000000e+000,
00611 0.00000000000000000e+000 );
00612 vl[27] = lapack_make_complex_double( 0.00000000000000000e+000,
00613 0.00000000000000000e+000 );
00614 }
00615 static void init_vr( lapack_int size, lapack_complex_double *vr ) {
00616 lapack_int i;
00617 for( i = 0; i < size; i++ ) {
00618 vr[i] = lapack_make_complex_double( 0.0, 0.0 );
00619 }
00620 vr[0] = lapack_make_complex_double( 0.00000000000000000e+000,
00621 0.00000000000000000e+000 );
00622 vr[8] = lapack_make_complex_double( 0.00000000000000000e+000,
00623 0.00000000000000000e+000 );
00624 vr[16] = lapack_make_complex_double( 0.00000000000000000e+000,
00625 0.00000000000000000e+000 );
00626 vr[24] = lapack_make_complex_double( 0.00000000000000000e+000,
00627 0.00000000000000000e+000 );
00628 vr[1] = lapack_make_complex_double( 0.00000000000000000e+000,
00629 0.00000000000000000e+000 );
00630 vr[9] = lapack_make_complex_double( 0.00000000000000000e+000,
00631 0.00000000000000000e+000 );
00632 vr[17] = lapack_make_complex_double( 0.00000000000000000e+000,
00633 0.00000000000000000e+000 );
00634 vr[25] = lapack_make_complex_double( 0.00000000000000000e+000,
00635 0.00000000000000000e+000 );
00636 vr[2] = lapack_make_complex_double( 0.00000000000000000e+000,
00637 0.00000000000000000e+000 );
00638 vr[10] = lapack_make_complex_double( 0.00000000000000000e+000,
00639 0.00000000000000000e+000 );
00640 vr[18] = lapack_make_complex_double( 0.00000000000000000e+000,
00641 0.00000000000000000e+000 );
00642 vr[26] = lapack_make_complex_double( 0.00000000000000000e+000,
00643 0.00000000000000000e+000 );
00644 vr[3] = lapack_make_complex_double( 0.00000000000000000e+000,
00645 0.00000000000000000e+000 );
00646 vr[11] = lapack_make_complex_double( 0.00000000000000000e+000,
00647 0.00000000000000000e+000 );
00648 vr[19] = lapack_make_complex_double( 0.00000000000000000e+000,
00649 0.00000000000000000e+000 );
00650 vr[27] = lapack_make_complex_double( 0.00000000000000000e+000,
00651 0.00000000000000000e+000 );
00652 }
00653 static void init_work( lapack_int size, lapack_complex_double *work ) {
00654 lapack_int i;
00655 for( i = 0; i < size; i++ ) {
00656 work[i] = lapack_make_complex_double( 0.0, 0.0 );
00657 }
00658 }
00659 static void init_rwork( lapack_int size, double *rwork ) {
00660 lapack_int i;
00661 for( i = 0; i < size; i++ ) {
00662 rwork[i] = 0;
00663 }
00664 }
00665 static void init_ifaill( lapack_int size, lapack_int *ifaill ) {
00666 lapack_int i;
00667 for( i = 0; i < size; i++ ) {
00668 ifaill[i] = 0;
00669 }
00670 }
00671 static void init_ifailr( lapack_int size, lapack_int *ifailr ) {
00672 lapack_int i;
00673 for( i = 0; i < size; i++ ) {
00674 ifailr[i] = 0;
00675 }
00676 }
00677
00678
00679
00680 static int compare_zhsein( lapack_complex_double *w, lapack_complex_double *w_i,
00681 lapack_complex_double *vl,
00682 lapack_complex_double *vl_i,
00683 lapack_complex_double *vr,
00684 lapack_complex_double *vr_i, lapack_int m,
00685 lapack_int m_i, lapack_int *ifaill,
00686 lapack_int *ifaill_i, lapack_int *ifailr,
00687 lapack_int *ifailr_i, lapack_int info,
00688 lapack_int info_i, char job, lapack_int ldvl,
00689 lapack_int ldvr, lapack_int mm, lapack_int n )
00690 {
00691 lapack_int i;
00692 int failed = 0;
00693 for( i = 0; i < n; i++ ) {
00694 failed += compare_complex_doubles(w[i],w_i[i]);
00695 }
00696 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00697 for( i = 0; i < ldvl*mm; i++ ) {
00698 failed += compare_complex_doubles(vl[i],vl_i[i]);
00699 }
00700 }
00701 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00702 for( i = 0; i < ldvr*mm; i++ ) {
00703 failed += compare_complex_doubles(vr[i],vr_i[i]);
00704 }
00705 }
00706 failed += (m == m_i) ? 0 : 1;
00707 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00708 for( i = 0; i < mm; i++ ) {
00709 failed += (ifaill[i] == ifaill_i[i]) ? 0 : 1;
00710 }
00711 }
00712 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00713 for( i = 0; i < mm; i++ ) {
00714 failed += (ifailr[i] == ifailr_i[i]) ? 0 : 1;
00715 }
00716 }
00717 failed += (info == info_i) ? 0 : 1;
00718 if( info != 0 || info_i != 0 ) {
00719 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00720 }
00721
00722 return failed;
00723 }