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_ctrsna( char *job, char *howmny, lapack_int *n,
00055 lapack_int *ldt, lapack_int *ldvl,
00056 lapack_int *ldvr, lapack_int *mm,
00057 lapack_int *ldwork );
00058 static void init_select( lapack_int size, lapack_int *select );
00059 static void init_t( lapack_int size, lapack_complex_float *t );
00060 static void init_vl( lapack_int size, lapack_complex_float *vl );
00061 static void init_vr( lapack_int size, lapack_complex_float *vr );
00062 static void init_s( lapack_int size, float *s );
00063 static void init_sep( lapack_int size, float *sep );
00064 static void init_work( lapack_int size, lapack_complex_float *work );
00065 static void init_rwork( lapack_int size, float *rwork );
00066 static int compare_ctrsna( float *s, float *s_i, float *sep, float *sep_i,
00067 lapack_int m, lapack_int m_i, lapack_int info,
00068 lapack_int info_i, char job, lapack_int mm );
00069
00070 int main(void)
00071 {
00072
00073 char job, job_i;
00074 char howmny, howmny_i;
00075 lapack_int n, n_i;
00076 lapack_int ldt, ldt_i;
00077 lapack_int ldt_r;
00078 lapack_int ldvl, ldvl_i;
00079 lapack_int ldvl_r;
00080 lapack_int ldvr, ldvr_i;
00081 lapack_int ldvr_r;
00082 lapack_int mm, mm_i;
00083 lapack_int m, m_i;
00084 lapack_int ldwork, ldwork_i;
00085 lapack_int info, info_i;
00086 lapack_int i;
00087 int failed;
00088
00089
00090 lapack_int *select = NULL, *select_i = NULL;
00091 lapack_complex_float *t = NULL, *t_i = NULL;
00092 lapack_complex_float *vl = NULL, *vl_i = NULL;
00093 lapack_complex_float *vr = NULL, *vr_i = NULL;
00094 float *s = NULL, *s_i = NULL;
00095 float *sep = NULL, *sep_i = NULL;
00096 lapack_complex_float *work = NULL, *work_i = NULL;
00097 float *rwork = NULL, *rwork_i = NULL;
00098 float *s_save = NULL;
00099 float *sep_save = NULL;
00100 lapack_complex_float *t_r = NULL;
00101 lapack_complex_float *vl_r = NULL;
00102 lapack_complex_float *vr_r = NULL;
00103
00104
00105 init_scalars_ctrsna( &job, &howmny, &n, &ldt, &ldvl, &ldvr, &mm, &ldwork );
00106 ldt_r = n+2;
00107 ldvl_r = mm+2;
00108 ldvr_r = mm+2;
00109 job_i = job;
00110 howmny_i = howmny;
00111 n_i = n;
00112 ldt_i = ldt;
00113 ldvl_i = ldvl;
00114 ldvr_i = ldvr;
00115 mm_i = mm;
00116 ldwork_i = ldwork;
00117
00118
00119 select = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00120 t = (lapack_complex_float *)
00121 LAPACKE_malloc( ldt*n * sizeof(lapack_complex_float) );
00122 vl = (lapack_complex_float *)
00123 LAPACKE_malloc( ldvl*mm * sizeof(lapack_complex_float) );
00124 vr = (lapack_complex_float *)
00125 LAPACKE_malloc( ldvr*mm * sizeof(lapack_complex_float) );
00126 s = (float *)LAPACKE_malloc( mm * sizeof(float) );
00127 sep = (float *)LAPACKE_malloc( mm * sizeof(float) );
00128 work = (lapack_complex_float *)
00129 LAPACKE_malloc( ldwork*(n+1) * sizeof(lapack_complex_float) );
00130 rwork = (float *)LAPACKE_malloc( n * sizeof(float) );
00131
00132
00133 select_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00134 t_i = (lapack_complex_float *)
00135 LAPACKE_malloc( ldt*n * sizeof(lapack_complex_float) );
00136 vl_i = (lapack_complex_float *)
00137 LAPACKE_malloc( ldvl*mm * sizeof(lapack_complex_float) );
00138 vr_i = (lapack_complex_float *)
00139 LAPACKE_malloc( ldvr*mm * sizeof(lapack_complex_float) );
00140 s_i = (float *)LAPACKE_malloc( mm * sizeof(float) );
00141 sep_i = (float *)LAPACKE_malloc( mm * sizeof(float) );
00142 work_i = (lapack_complex_float *)
00143 LAPACKE_malloc( ldwork*(n+1) * sizeof(lapack_complex_float) );
00144 rwork_i = (float *)LAPACKE_malloc( n * sizeof(float) );
00145
00146
00147 s_save = (float *)LAPACKE_malloc( mm * sizeof(float) );
00148 sep_save = (float *)LAPACKE_malloc( mm * sizeof(float) );
00149
00150
00151 t_r = (lapack_complex_float *)
00152 LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_float) );
00153 vl_r = (lapack_complex_float *)
00154 LAPACKE_malloc( n*(mm+2) * sizeof(lapack_complex_float) );
00155 vr_r = (lapack_complex_float *)
00156 LAPACKE_malloc( n*(mm+2) * sizeof(lapack_complex_float) );
00157
00158
00159 init_select( n, select );
00160 init_t( ldt*n, t );
00161 init_vl( ldvl*mm, vl );
00162 init_vr( ldvr*mm, vr );
00163 init_s( mm, s );
00164 init_sep( mm, sep );
00165 init_work( ldwork*(n+1), work );
00166 init_rwork( n, rwork );
00167
00168
00169 for( i = 0; i < mm; i++ ) {
00170 s_save[i] = s[i];
00171 }
00172 for( i = 0; i < mm; i++ ) {
00173 sep_save[i] = sep[i];
00174 }
00175
00176
00177 ctrsna_( &job, &howmny, select, &n, t, &ldt, vl, &ldvl, vr, &ldvr, s, sep,
00178 &mm, &m, work, &ldwork, rwork, &info );
00179
00180
00181
00182 for( i = 0; i < n; i++ ) {
00183 select_i[i] = select[i];
00184 }
00185 for( i = 0; i < ldt*n; i++ ) {
00186 t_i[i] = t[i];
00187 }
00188 for( i = 0; i < ldvl*mm; i++ ) {
00189 vl_i[i] = vl[i];
00190 }
00191 for( i = 0; i < ldvr*mm; i++ ) {
00192 vr_i[i] = vr[i];
00193 }
00194 for( i = 0; i < mm; i++ ) {
00195 s_i[i] = s_save[i];
00196 }
00197 for( i = 0; i < mm; i++ ) {
00198 sep_i[i] = sep_save[i];
00199 }
00200 for( i = 0; i < ldwork*(n+1); i++ ) {
00201 work_i[i] = work[i];
00202 }
00203 for( i = 0; i < n; i++ ) {
00204 rwork_i[i] = rwork[i];
00205 }
00206 info_i = LAPACKE_ctrsna_work( LAPACK_COL_MAJOR, job_i, howmny_i, select_i,
00207 n_i, t_i, ldt_i, vl_i, ldvl_i, vr_i, ldvr_i,
00208 s_i, sep_i, mm_i, &m_i, work_i, ldwork_i,
00209 rwork_i );
00210
00211 failed = compare_ctrsna( s, s_i, sep, sep_i, m, m_i, info, info_i, job,
00212 mm );
00213 if( failed == 0 ) {
00214 printf( "PASSED: column-major middle-level interface to ctrsna\n" );
00215 } else {
00216 printf( "FAILED: column-major middle-level interface to ctrsna\n" );
00217 }
00218
00219
00220
00221 for( i = 0; i < n; i++ ) {
00222 select_i[i] = select[i];
00223 }
00224 for( i = 0; i < ldt*n; i++ ) {
00225 t_i[i] = t[i];
00226 }
00227 for( i = 0; i < ldvl*mm; i++ ) {
00228 vl_i[i] = vl[i];
00229 }
00230 for( i = 0; i < ldvr*mm; i++ ) {
00231 vr_i[i] = vr[i];
00232 }
00233 for( i = 0; i < mm; i++ ) {
00234 s_i[i] = s_save[i];
00235 }
00236 for( i = 0; i < mm; i++ ) {
00237 sep_i[i] = sep_save[i];
00238 }
00239 for( i = 0; i < ldwork*(n+1); i++ ) {
00240 work_i[i] = work[i];
00241 }
00242 for( i = 0; i < n; i++ ) {
00243 rwork_i[i] = rwork[i];
00244 }
00245 info_i = LAPACKE_ctrsna( LAPACK_COL_MAJOR, job_i, howmny_i, select_i, n_i,
00246 t_i, ldt_i, vl_i, ldvl_i, vr_i, ldvr_i, s_i, sep_i,
00247 mm_i, &m_i );
00248
00249 failed = compare_ctrsna( s, s_i, sep, sep_i, m, m_i, info, info_i, job,
00250 mm );
00251 if( failed == 0 ) {
00252 printf( "PASSED: column-major high-level interface to ctrsna\n" );
00253 } else {
00254 printf( "FAILED: column-major high-level interface to ctrsna\n" );
00255 }
00256
00257
00258
00259 for( i = 0; i < n; i++ ) {
00260 select_i[i] = select[i];
00261 }
00262 for( i = 0; i < ldt*n; i++ ) {
00263 t_i[i] = t[i];
00264 }
00265 for( i = 0; i < ldvl*mm; i++ ) {
00266 vl_i[i] = vl[i];
00267 }
00268 for( i = 0; i < ldvr*mm; i++ ) {
00269 vr_i[i] = vr[i];
00270 }
00271 for( i = 0; i < mm; i++ ) {
00272 s_i[i] = s_save[i];
00273 }
00274 for( i = 0; i < mm; i++ ) {
00275 sep_i[i] = sep_save[i];
00276 }
00277 for( i = 0; i < ldwork*(n+1); i++ ) {
00278 work_i[i] = work[i];
00279 }
00280 for( i = 0; i < n; i++ ) {
00281 rwork_i[i] = rwork[i];
00282 }
00283
00284 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
00285 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
00286 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
00287 }
00288 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
00289 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
00290 }
00291 info_i = LAPACKE_ctrsna_work( LAPACK_ROW_MAJOR, job_i, howmny_i, select_i,
00292 n_i, t_r, ldt_r, vl_r, ldvl_r, vr_r, ldvr_r,
00293 s_i, sep_i, mm_i, &m_i, work_i, ldwork_i,
00294 rwork_i );
00295
00296 failed = compare_ctrsna( s, s_i, sep, sep_i, m, m_i, info, info_i, job,
00297 mm );
00298 if( failed == 0 ) {
00299 printf( "PASSED: row-major middle-level interface to ctrsna\n" );
00300 } else {
00301 printf( "FAILED: row-major middle-level interface to ctrsna\n" );
00302 }
00303
00304
00305
00306 for( i = 0; i < n; i++ ) {
00307 select_i[i] = select[i];
00308 }
00309 for( i = 0; i < ldt*n; i++ ) {
00310 t_i[i] = t[i];
00311 }
00312 for( i = 0; i < ldvl*mm; i++ ) {
00313 vl_i[i] = vl[i];
00314 }
00315 for( i = 0; i < ldvr*mm; i++ ) {
00316 vr_i[i] = vr[i];
00317 }
00318 for( i = 0; i < mm; i++ ) {
00319 s_i[i] = s_save[i];
00320 }
00321 for( i = 0; i < mm; i++ ) {
00322 sep_i[i] = sep_save[i];
00323 }
00324 for( i = 0; i < ldwork*(n+1); i++ ) {
00325 work_i[i] = work[i];
00326 }
00327 for( i = 0; i < n; i++ ) {
00328 rwork_i[i] = rwork[i];
00329 }
00330
00331
00332 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
00333 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
00334 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
00335 }
00336 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
00337 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
00338 }
00339 info_i = LAPACKE_ctrsna( LAPACK_ROW_MAJOR, job_i, howmny_i, select_i, n_i,
00340 t_r, ldt_r, vl_r, ldvl_r, vr_r, ldvr_r, s_i, sep_i,
00341 mm_i, &m_i );
00342
00343 failed = compare_ctrsna( s, s_i, sep, sep_i, m, m_i, info, info_i, job,
00344 mm );
00345 if( failed == 0 ) {
00346 printf( "PASSED: row-major high-level interface to ctrsna\n" );
00347 } else {
00348 printf( "FAILED: row-major high-level interface to ctrsna\n" );
00349 }
00350
00351
00352 if( select != NULL ) {
00353 LAPACKE_free( select );
00354 }
00355 if( select_i != NULL ) {
00356 LAPACKE_free( select_i );
00357 }
00358 if( t != NULL ) {
00359 LAPACKE_free( t );
00360 }
00361 if( t_i != NULL ) {
00362 LAPACKE_free( t_i );
00363 }
00364 if( t_r != NULL ) {
00365 LAPACKE_free( t_r );
00366 }
00367 if( vl != NULL ) {
00368 LAPACKE_free( vl );
00369 }
00370 if( vl_i != NULL ) {
00371 LAPACKE_free( vl_i );
00372 }
00373 if( vl_r != NULL ) {
00374 LAPACKE_free( vl_r );
00375 }
00376 if( vr != NULL ) {
00377 LAPACKE_free( vr );
00378 }
00379 if( vr_i != NULL ) {
00380 LAPACKE_free( vr_i );
00381 }
00382 if( vr_r != NULL ) {
00383 LAPACKE_free( vr_r );
00384 }
00385 if( s != NULL ) {
00386 LAPACKE_free( s );
00387 }
00388 if( s_i != NULL ) {
00389 LAPACKE_free( s_i );
00390 }
00391 if( s_save != NULL ) {
00392 LAPACKE_free( s_save );
00393 }
00394 if( sep != NULL ) {
00395 LAPACKE_free( sep );
00396 }
00397 if( sep_i != NULL ) {
00398 LAPACKE_free( sep_i );
00399 }
00400 if( sep_save != NULL ) {
00401 LAPACKE_free( sep_save );
00402 }
00403 if( work != NULL ) {
00404 LAPACKE_free( work );
00405 }
00406 if( work_i != NULL ) {
00407 LAPACKE_free( work_i );
00408 }
00409 if( rwork != NULL ) {
00410 LAPACKE_free( rwork );
00411 }
00412 if( rwork_i != NULL ) {
00413 LAPACKE_free( rwork_i );
00414 }
00415
00416 return 0;
00417 }
00418
00419
00420 static void init_scalars_ctrsna( char *job, char *howmny, lapack_int *n,
00421 lapack_int *ldt, lapack_int *ldvl,
00422 lapack_int *ldvr, lapack_int *mm,
00423 lapack_int *ldwork )
00424 {
00425 *job = 'B';
00426 *howmny = 'A';
00427 *n = 4;
00428 *ldt = 8;
00429 *ldvl = 8;
00430 *ldvr = 8;
00431 *mm = 4;
00432 *ldwork = 8;
00433
00434 return;
00435 }
00436
00437
00438 static void init_select( lapack_int size, lapack_int *select ) {
00439 lapack_int i;
00440 for( i = 0; i < size; i++ ) {
00441 select[i] = 0;
00442 }
00443 select[0] = 0;
00444 select[1] = 0;
00445 select[2] = 0;
00446 select[3] = 0;
00447 }
00448 static void init_t( lapack_int size, lapack_complex_float *t ) {
00449 lapack_int i;
00450 for( i = 0; i < size; i++ ) {
00451 t[i] = lapack_make_complex_float( 0.0f, 0.0f );
00452 }
00453 t[0] = lapack_make_complex_float( -6.000400066e+000, -6.999899864e+000 );
00454 t[8] = lapack_make_complex_float( 3.637000024e-001, -3.655999899e-001 );
00455 t[16] = lapack_make_complex_float( -1.879999936e-001, 4.787000120e-001 );
00456 t[24] = lapack_make_complex_float( 8.784999847e-001, -2.538999915e-001 );
00457 t[1] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00458 t[9] = lapack_make_complex_float( -5.000000000e+000, 2.006000042e+000 );
00459 t[17] = lapack_make_complex_float( -3.070000000e-002, -7.217000127e-001 );
00460 t[25] = lapack_make_complex_float( -2.290000021e-001, 1.313000023e-001 );
00461 t[2] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00462 t[10] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00463 t[18] = lapack_make_complex_float( 7.998199940e+000, -9.963999987e-001 );
00464 t[26] = lapack_make_complex_float( 9.356999993e-001, 5.358999968e-001 );
00465 t[3] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00466 t[11] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00467 t[19] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00468 t[27] = lapack_make_complex_float( 3.002300024e+000, -3.999799967e+000 );
00469 }
00470 static void init_vl( lapack_int size, lapack_complex_float *vl ) {
00471 lapack_int i;
00472 for( i = 0; i < size; i++ ) {
00473 vl[i] = lapack_make_complex_float( 0.0f, 0.0f );
00474 }
00475 vl[0] = lapack_make_complex_float( 1.000000000e+000, 0.000000000e+000 );
00476 vl[8] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00477 vl[16] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00478 vl[24] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00479 vl[1] = lapack_make_complex_float( 3.566943482e-002, -4.434689879e-002 );
00480 vl[9] = lapack_make_complex_float( 1.000000000e+000, 0.000000000e+000 );
00481 vl[17] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00482 vl[25] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00483 vl[2] = lapack_make_complex_float( -2.207376994e-003, 3.131341189e-002 );
00484 vl[10] = lapack_make_complex_float( -9.933197871e-003, -5.322864652e-002 );
00485 vl[18] = lapack_make_complex_float( 1.000000000e+000, 0.000000000e+000 );
00486 vl[26] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00487 vl[3] = lapack_make_complex_float( -7.824388146e-002, -5.827078223e-002 );
00488 vl[11] = lapack_make_complex_float( 3.187495098e-002, -1.955906162e-003 );
00489 vl[19] = lapack_make_complex_float( 1.849408895e-001, 3.913496155e-003 );
00490 vl[27] = lapack_make_complex_float( 1.000000000e+000, 0.000000000e+000 );
00491 }
00492 static void init_vr( lapack_int size, lapack_complex_float *vr ) {
00493 lapack_int i;
00494 for( i = 0; i < size; i++ ) {
00495 vr[i] = lapack_make_complex_float( 0.0f, 0.0f );
00496 }
00497 vr[0] = lapack_make_complex_float( 1.000000000e+000, 0.000000000e+000 );
00498 vr[8] = lapack_make_complex_float( -3.566943482e-002, -4.434689879e-002 );
00499 vr[16] = lapack_make_complex_float( -5.074592773e-004, 3.277154267e-002 );
00500 vr[24] = lapack_make_complex_float( 7.925970852e-002, -6.285025179e-002 );
00501 vr[1] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00502 vr[9] = lapack_make_complex_float( 1.000000000e+000, 0.000000000e+000 );
00503 vr[17] = lapack_make_complex_float( 9.933197871e-003, -5.322864652e-002 );
00504 vr[25] = lapack_make_complex_float( -3.350369632e-002, 7.927120663e-003 );
00505 vr[2] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00506 vr[10] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00507 vr[18] = lapack_make_complex_float( 1.000000000e+000, 0.000000000e+000 );
00508 vr[26] = lapack_make_complex_float( -1.849408895e-001, 3.913496155e-003 );
00509 vr[3] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00510 vr[11] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00511 vr[19] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00512 vr[27] = lapack_make_complex_float( 1.000000000e+000, 0.000000000e+000 );
00513 }
00514 static void init_s( lapack_int size, float *s ) {
00515 lapack_int i;
00516 for( i = 0; i < size; i++ ) {
00517 s[i] = 0;
00518 }
00519 }
00520 static void init_sep( lapack_int size, float *sep ) {
00521 lapack_int i;
00522 for( i = 0; i < size; i++ ) {
00523 sep[i] = 0;
00524 }
00525 }
00526 static void init_work( lapack_int size, lapack_complex_float *work ) {
00527 lapack_int i;
00528 for( i = 0; i < size; i++ ) {
00529 work[i] = lapack_make_complex_float( 0.0f, 0.0f );
00530 }
00531 }
00532 static void init_rwork( lapack_int size, float *rwork ) {
00533 lapack_int i;
00534 for( i = 0; i < size; i++ ) {
00535 rwork[i] = 0;
00536 }
00537 }
00538
00539
00540
00541 static int compare_ctrsna( float *s, float *s_i, float *sep, float *sep_i,
00542 lapack_int m, lapack_int m_i, lapack_int info,
00543 lapack_int info_i, char job, lapack_int mm )
00544 {
00545 lapack_int i;
00546 int failed = 0;
00547 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
00548 for( i = 0; i < mm; i++ ) {
00549 failed += compare_floats(s[i],s_i[i]);
00550 }
00551 }
00552 if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
00553 for( i = 0; i < mm; i++ ) {
00554 failed += compare_floats(sep[i],sep_i[i]);
00555 }
00556 }
00557 failed += (m == m_i) ? 0 : 1;
00558 failed += (info == info_i) ? 0 : 1;
00559 if( info != 0 || info_i != 0 ) {
00560 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00561 }
00562
00563 return failed;
00564 }