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_sgebrd( lapack_int *m, lapack_int *n, lapack_int *lda,
00055 lapack_int *lwork );
00056 static void init_a( lapack_int size, float *a );
00057 static void init_d( lapack_int size, float *d );
00058 static void init_e( lapack_int size, float *e );
00059 static void init_tauq( lapack_int size, float *tauq );
00060 static void init_taup( lapack_int size, float *taup );
00061 static void init_work( lapack_int size, float *work );
00062 static int compare_sgebrd( float *a, float *a_i, float *d, float *d_i, float *e,
00063 float *e_i, float *tauq, float *tauq_i, float *taup,
00064 float *taup_i, lapack_int info, lapack_int info_i,
00065 lapack_int lda, lapack_int m, lapack_int n );
00066
00067 int main(void)
00068 {
00069
00070 lapack_int m, m_i;
00071 lapack_int n, n_i;
00072 lapack_int lda, lda_i;
00073 lapack_int lda_r;
00074 lapack_int lwork, lwork_i;
00075 lapack_int info, info_i;
00076 lapack_int i;
00077 int failed;
00078
00079
00080 float *a = NULL, *a_i = NULL;
00081 float *d = NULL, *d_i = NULL;
00082 float *e = NULL, *e_i = NULL;
00083 float *tauq = NULL, *tauq_i = NULL;
00084 float *taup = NULL, *taup_i = NULL;
00085 float *work = NULL, *work_i = NULL;
00086 float *a_save = NULL;
00087 float *d_save = NULL;
00088 float *e_save = NULL;
00089 float *tauq_save = NULL;
00090 float *taup_save = NULL;
00091 float *a_r = NULL;
00092
00093
00094 init_scalars_sgebrd( &m, &n, &lda, &lwork );
00095 lda_r = n+2;
00096 m_i = m;
00097 n_i = n;
00098 lda_i = lda;
00099 lwork_i = lwork;
00100
00101
00102 a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00103 d = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00104 e = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
00105 tauq = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00106 taup = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00107 work = (float *)LAPACKE_malloc( lwork * sizeof(float) );
00108
00109
00110 a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00111 d_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00112 e_i = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
00113 tauq_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00114 taup_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00115 work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) );
00116
00117
00118 a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00119 d_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00120 e_save = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
00121 tauq_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00122 taup_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00123
00124
00125 a_r = (float *)LAPACKE_malloc( m*(n+2) * sizeof(float) );
00126
00127
00128 init_a( lda*n, a );
00129 init_d( (MIN(m,n)), d );
00130 init_e( (MIN(m,n)-1), e );
00131 init_tauq( (MIN(m,n)), tauq );
00132 init_taup( (MIN(m,n)), taup );
00133 init_work( lwork, work );
00134
00135
00136 for( i = 0; i < lda*n; i++ ) {
00137 a_save[i] = a[i];
00138 }
00139 for( i = 0; i < (MIN(m,n)); i++ ) {
00140 d_save[i] = d[i];
00141 }
00142 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00143 e_save[i] = e[i];
00144 }
00145 for( i = 0; i < (MIN(m,n)); i++ ) {
00146 tauq_save[i] = tauq[i];
00147 }
00148 for( i = 0; i < (MIN(m,n)); i++ ) {
00149 taup_save[i] = taup[i];
00150 }
00151
00152
00153 sgebrd_( &m, &n, a, &lda, d, e, tauq, taup, work, &lwork, &info );
00154
00155
00156
00157 for( i = 0; i < lda*n; i++ ) {
00158 a_i[i] = a_save[i];
00159 }
00160 for( i = 0; i < (MIN(m,n)); i++ ) {
00161 d_i[i] = d_save[i];
00162 }
00163 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00164 e_i[i] = e_save[i];
00165 }
00166 for( i = 0; i < (MIN(m,n)); i++ ) {
00167 tauq_i[i] = tauq_save[i];
00168 }
00169 for( i = 0; i < (MIN(m,n)); i++ ) {
00170 taup_i[i] = taup_save[i];
00171 }
00172 for( i = 0; i < lwork; i++ ) {
00173 work_i[i] = work[i];
00174 }
00175 info_i = LAPACKE_sgebrd_work( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, d_i,
00176 e_i, tauq_i, taup_i, work_i, lwork_i );
00177
00178 failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00179 info, info_i, lda, m, n );
00180 if( failed == 0 ) {
00181 printf( "PASSED: column-major middle-level interface to sgebrd\n" );
00182 } else {
00183 printf( "FAILED: column-major middle-level interface to sgebrd\n" );
00184 }
00185
00186
00187
00188 for( i = 0; i < lda*n; i++ ) {
00189 a_i[i] = a_save[i];
00190 }
00191 for( i = 0; i < (MIN(m,n)); i++ ) {
00192 d_i[i] = d_save[i];
00193 }
00194 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00195 e_i[i] = e_save[i];
00196 }
00197 for( i = 0; i < (MIN(m,n)); i++ ) {
00198 tauq_i[i] = tauq_save[i];
00199 }
00200 for( i = 0; i < (MIN(m,n)); i++ ) {
00201 taup_i[i] = taup_save[i];
00202 }
00203 for( i = 0; i < lwork; i++ ) {
00204 work_i[i] = work[i];
00205 }
00206 info_i = LAPACKE_sgebrd( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, d_i, e_i,
00207 tauq_i, taup_i );
00208
00209 failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00210 info, info_i, lda, m, n );
00211 if( failed == 0 ) {
00212 printf( "PASSED: column-major high-level interface to sgebrd\n" );
00213 } else {
00214 printf( "FAILED: column-major high-level interface to sgebrd\n" );
00215 }
00216
00217
00218
00219 for( i = 0; i < lda*n; i++ ) {
00220 a_i[i] = a_save[i];
00221 }
00222 for( i = 0; i < (MIN(m,n)); i++ ) {
00223 d_i[i] = d_save[i];
00224 }
00225 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00226 e_i[i] = e_save[i];
00227 }
00228 for( i = 0; i < (MIN(m,n)); i++ ) {
00229 tauq_i[i] = tauq_save[i];
00230 }
00231 for( i = 0; i < (MIN(m,n)); i++ ) {
00232 taup_i[i] = taup_save[i];
00233 }
00234 for( i = 0; i < lwork; i++ ) {
00235 work_i[i] = work[i];
00236 }
00237
00238 LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00239 info_i = LAPACKE_sgebrd_work( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, d_i,
00240 e_i, tauq_i, taup_i, work_i, lwork_i );
00241
00242 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00243
00244 failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00245 info, info_i, lda, m, n );
00246 if( failed == 0 ) {
00247 printf( "PASSED: row-major middle-level interface to sgebrd\n" );
00248 } else {
00249 printf( "FAILED: row-major middle-level interface to sgebrd\n" );
00250 }
00251
00252
00253
00254 for( i = 0; i < lda*n; i++ ) {
00255 a_i[i] = a_save[i];
00256 }
00257 for( i = 0; i < (MIN(m,n)); i++ ) {
00258 d_i[i] = d_save[i];
00259 }
00260 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00261 e_i[i] = e_save[i];
00262 }
00263 for( i = 0; i < (MIN(m,n)); i++ ) {
00264 tauq_i[i] = tauq_save[i];
00265 }
00266 for( i = 0; i < (MIN(m,n)); i++ ) {
00267 taup_i[i] = taup_save[i];
00268 }
00269 for( i = 0; i < lwork; i++ ) {
00270 work_i[i] = work[i];
00271 }
00272
00273
00274 LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00275 info_i = LAPACKE_sgebrd( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, d_i, e_i,
00276 tauq_i, taup_i );
00277
00278 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00279
00280 failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00281 info, info_i, lda, m, n );
00282 if( failed == 0 ) {
00283 printf( "PASSED: row-major high-level interface to sgebrd\n" );
00284 } else {
00285 printf( "FAILED: row-major high-level interface to sgebrd\n" );
00286 }
00287
00288
00289 if( a != NULL ) {
00290 LAPACKE_free( a );
00291 }
00292 if( a_i != NULL ) {
00293 LAPACKE_free( a_i );
00294 }
00295 if( a_r != NULL ) {
00296 LAPACKE_free( a_r );
00297 }
00298 if( a_save != NULL ) {
00299 LAPACKE_free( a_save );
00300 }
00301 if( d != NULL ) {
00302 LAPACKE_free( d );
00303 }
00304 if( d_i != NULL ) {
00305 LAPACKE_free( d_i );
00306 }
00307 if( d_save != NULL ) {
00308 LAPACKE_free( d_save );
00309 }
00310 if( e != NULL ) {
00311 LAPACKE_free( e );
00312 }
00313 if( e_i != NULL ) {
00314 LAPACKE_free( e_i );
00315 }
00316 if( e_save != NULL ) {
00317 LAPACKE_free( e_save );
00318 }
00319 if( tauq != NULL ) {
00320 LAPACKE_free( tauq );
00321 }
00322 if( tauq_i != NULL ) {
00323 LAPACKE_free( tauq_i );
00324 }
00325 if( tauq_save != NULL ) {
00326 LAPACKE_free( tauq_save );
00327 }
00328 if( taup != NULL ) {
00329 LAPACKE_free( taup );
00330 }
00331 if( taup_i != NULL ) {
00332 LAPACKE_free( taup_i );
00333 }
00334 if( taup_save != NULL ) {
00335 LAPACKE_free( taup_save );
00336 }
00337 if( work != NULL ) {
00338 LAPACKE_free( work );
00339 }
00340 if( work_i != NULL ) {
00341 LAPACKE_free( work_i );
00342 }
00343
00344 return 0;
00345 }
00346
00347
00348 static void init_scalars_sgebrd( lapack_int *m, lapack_int *n, lapack_int *lda,
00349 lapack_int *lwork )
00350 {
00351 *m = 4;
00352 *n = 4;
00353 *lda = 8;
00354 *lwork = 1024;
00355
00356 return;
00357 }
00358
00359
00360 static void init_a( lapack_int size, float *a ) {
00361 lapack_int i;
00362 for( i = 0; i < size; i++ ) {
00363 a[i] = 0;
00364 }
00365 a[0] = 7.629240036e+000;
00366 a[8] = 0.000000000e+000;
00367 a[16] = 0.000000000e+000;
00368 a[24] = 0.000000000e+000;
00369 a[1] = 1.206805706e-001;
00370 a[9] = 6.484792709e+000;
00371 a[17] = 0.000000000e+000;
00372 a[25] = 0.000000000e+000;
00373 a[2] = 1.021463647e-001;
00374 a[10] = -1.661861420e+000;
00375 a[18] = -5.426580906e+000;
00376 a[26] = 0.000000000e+000;
00377 a[3] = 1.476634502e+000;
00378 a[11] = 1.088234186e-001;
00379 a[19] = 4.222885072e-001;
00380 a[27] = 6.255532265e+000;
00381 }
00382 static void init_d( lapack_int size, float *d ) {
00383 lapack_int i;
00384 for( i = 0; i < size; i++ ) {
00385 d[i] = 0;
00386 }
00387 }
00388 static void init_e( lapack_int size, float *e ) {
00389 lapack_int i;
00390 for( i = 0; i < size; i++ ) {
00391 e[i] = 0;
00392 }
00393 }
00394 static void init_tauq( lapack_int size, float *tauq ) {
00395 lapack_int i;
00396 for( i = 0; i < size; i++ ) {
00397 tauq[i] = 0;
00398 }
00399 }
00400 static void init_taup( lapack_int size, float *taup ) {
00401 lapack_int i;
00402 for( i = 0; i < size; i++ ) {
00403 taup[i] = 0;
00404 }
00405 }
00406 static void init_work( lapack_int size, float *work ) {
00407 lapack_int i;
00408 for( i = 0; i < size; i++ ) {
00409 work[i] = 0;
00410 }
00411 }
00412
00413
00414
00415 static int compare_sgebrd( float *a, float *a_i, float *d, float *d_i, float *e,
00416 float *e_i, float *tauq, float *tauq_i, float *taup,
00417 float *taup_i, lapack_int info, lapack_int info_i,
00418 lapack_int lda, lapack_int m, lapack_int n )
00419 {
00420 lapack_int i;
00421 int failed = 0;
00422 for( i = 0; i < lda*n; i++ ) {
00423 failed += compare_floats(a[i],a_i[i]);
00424 }
00425 for( i = 0; i < (MIN(m,n)); i++ ) {
00426 failed += compare_floats(d[i],d_i[i]);
00427 }
00428 for( i = 0; i < (MIN(m,n)-1); i++ ) {
00429 failed += compare_floats(e[i],e_i[i]);
00430 }
00431 for( i = 0; i < (MIN(m,n)); i++ ) {
00432 failed += compare_floats(tauq[i],tauq_i[i]);
00433 }
00434 for( i = 0; i < (MIN(m,n)); i++ ) {
00435 failed += compare_floats(taup[i],taup_i[i]);
00436 }
00437 failed += (info == info_i) ? 0 : 1;
00438 if( info != 0 || info_i != 0 ) {
00439 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00440 }
00441
00442 return failed;
00443 }