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_zunmqr( char *side, char *trans, lapack_int *m,
00055 lapack_int *n, lapack_int *k, lapack_int *lda,
00056 lapack_int *ldc, lapack_int *lwork );
00057 static void init_a( lapack_int size, lapack_complex_double *a );
00058 static void init_tau( lapack_int size, lapack_complex_double *tau );
00059 static void init_c( lapack_int size, lapack_complex_double *c );
00060 static void init_work( lapack_int size, lapack_complex_double *work );
00061 static int compare_zunmqr( lapack_complex_double *c, lapack_complex_double *c_i,
00062 lapack_int info, lapack_int info_i, lapack_int ldc,
00063 lapack_int n );
00064
00065 int main(void)
00066 {
00067
00068 char side, side_i;
00069 char trans, trans_i;
00070 lapack_int m, m_i;
00071 lapack_int n, n_i;
00072 lapack_int k, k_i;
00073 lapack_int lda, lda_i;
00074 lapack_int lda_r;
00075 lapack_int ldc, ldc_i;
00076 lapack_int ldc_r;
00077 lapack_int lwork, lwork_i;
00078 lapack_int info, info_i;
00079
00080 lapack_int r;
00081 lapack_int i;
00082 int failed;
00083
00084
00085 lapack_complex_double *a = NULL, *a_i = NULL;
00086 lapack_complex_double *tau = NULL, *tau_i = NULL;
00087 lapack_complex_double *c = NULL, *c_i = NULL;
00088 lapack_complex_double *work = NULL, *work_i = NULL;
00089 lapack_complex_double *c_save = NULL;
00090 lapack_complex_double *a_r = NULL;
00091 lapack_complex_double *c_r = NULL;
00092
00093
00094 init_scalars_zunmqr( &side, &trans, &m, &n, &k, &lda, &ldc, &lwork );
00095 r = LAPACKE_lsame( side, 'l' ) ? m : n;
00096 lda_r = k+2;
00097 ldc_r = n+2;
00098 side_i = side;
00099 trans_i = trans;
00100 m_i = m;
00101 n_i = n;
00102 k_i = k;
00103 lda_i = lda;
00104 ldc_i = ldc;
00105 lwork_i = lwork;
00106
00107
00108 a = (lapack_complex_double *)
00109 LAPACKE_malloc( lda*k * sizeof(lapack_complex_double) );
00110 tau = (lapack_complex_double *)
00111 LAPACKE_malloc( k * sizeof(lapack_complex_double) );
00112 c = (lapack_complex_double *)
00113 LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
00114 work = (lapack_complex_double *)
00115 LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
00116
00117
00118 a_i = (lapack_complex_double *)
00119 LAPACKE_malloc( lda*k * sizeof(lapack_complex_double) );
00120 tau_i = (lapack_complex_double *)
00121 LAPACKE_malloc( k * sizeof(lapack_complex_double) );
00122 c_i = (lapack_complex_double *)
00123 LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
00124 work_i = (lapack_complex_double *)
00125 LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
00126
00127
00128 c_save = (lapack_complex_double *)
00129 LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
00130
00131
00132 a_r = (lapack_complex_double *)
00133 LAPACKE_malloc( r*(k+2) * sizeof(lapack_complex_double) );
00134 c_r = (lapack_complex_double *)
00135 LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_double) );
00136
00137
00138 init_a( lda*k, a );
00139 init_tau( k, tau );
00140 init_c( ldc*n, c );
00141 init_work( lwork, work );
00142
00143
00144 for( i = 0; i < ldc*n; i++ ) {
00145 c_save[i] = c[i];
00146 }
00147
00148
00149 zunmqr_( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, &lwork,
00150 &info );
00151
00152
00153
00154 for( i = 0; i < lda*k; i++ ) {
00155 a_i[i] = a[i];
00156 }
00157 for( i = 0; i < k; i++ ) {
00158 tau_i[i] = tau[i];
00159 }
00160 for( i = 0; i < ldc*n; i++ ) {
00161 c_i[i] = c_save[i];
00162 }
00163 for( i = 0; i < lwork; i++ ) {
00164 work_i[i] = work[i];
00165 }
00166 info_i = LAPACKE_zunmqr_work( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i,
00167 k_i, a_i, lda_i, tau_i, c_i, ldc_i, work_i,
00168 lwork_i );
00169
00170 failed = compare_zunmqr( c, c_i, info, info_i, ldc, n );
00171 if( failed == 0 ) {
00172 printf( "PASSED: column-major middle-level interface to zunmqr\n" );
00173 } else {
00174 printf( "FAILED: column-major middle-level interface to zunmqr\n" );
00175 }
00176
00177
00178
00179 for( i = 0; i < lda*k; i++ ) {
00180 a_i[i] = a[i];
00181 }
00182 for( i = 0; i < k; i++ ) {
00183 tau_i[i] = tau[i];
00184 }
00185 for( i = 0; i < ldc*n; i++ ) {
00186 c_i[i] = c_save[i];
00187 }
00188 for( i = 0; i < lwork; i++ ) {
00189 work_i[i] = work[i];
00190 }
00191 info_i = LAPACKE_zunmqr( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i, k_i,
00192 a_i, lda_i, tau_i, c_i, ldc_i );
00193
00194 failed = compare_zunmqr( c, c_i, info, info_i, ldc, n );
00195 if( failed == 0 ) {
00196 printf( "PASSED: column-major high-level interface to zunmqr\n" );
00197 } else {
00198 printf( "FAILED: column-major high-level interface to zunmqr\n" );
00199 }
00200
00201
00202
00203 for( i = 0; i < lda*k; i++ ) {
00204 a_i[i] = a[i];
00205 }
00206 for( i = 0; i < k; i++ ) {
00207 tau_i[i] = tau[i];
00208 }
00209 for( i = 0; i < ldc*n; i++ ) {
00210 c_i[i] = c_save[i];
00211 }
00212 for( i = 0; i < lwork; i++ ) {
00213 work_i[i] = work[i];
00214 }
00215
00216 LAPACKE_zge_trans( LAPACK_COL_MAJOR, r, k, a_i, lda, a_r, k+2 );
00217 LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
00218 info_i = LAPACKE_zunmqr_work( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i,
00219 k_i, a_r, lda_r, tau_i, c_r, ldc_r, work_i,
00220 lwork_i );
00221
00222 LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
00223
00224 failed = compare_zunmqr( c, c_i, info, info_i, ldc, n );
00225 if( failed == 0 ) {
00226 printf( "PASSED: row-major middle-level interface to zunmqr\n" );
00227 } else {
00228 printf( "FAILED: row-major middle-level interface to zunmqr\n" );
00229 }
00230
00231
00232
00233 for( i = 0; i < lda*k; i++ ) {
00234 a_i[i] = a[i];
00235 }
00236 for( i = 0; i < k; i++ ) {
00237 tau_i[i] = tau[i];
00238 }
00239 for( i = 0; i < ldc*n; i++ ) {
00240 c_i[i] = c_save[i];
00241 }
00242 for( i = 0; i < lwork; i++ ) {
00243 work_i[i] = work[i];
00244 }
00245
00246
00247 LAPACKE_zge_trans( LAPACK_COL_MAJOR, r, k, a_i, lda, a_r, k+2 );
00248 LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
00249 info_i = LAPACKE_zunmqr( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i, k_i,
00250 a_r, lda_r, tau_i, c_r, ldc_r );
00251
00252 LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
00253
00254 failed = compare_zunmqr( c, c_i, info, info_i, ldc, n );
00255 if( failed == 0 ) {
00256 printf( "PASSED: row-major high-level interface to zunmqr\n" );
00257 } else {
00258 printf( "FAILED: row-major high-level interface to zunmqr\n" );
00259 }
00260
00261
00262 if( a != NULL ) {
00263 LAPACKE_free( a );
00264 }
00265 if( a_i != NULL ) {
00266 LAPACKE_free( a_i );
00267 }
00268 if( a_r != NULL ) {
00269 LAPACKE_free( a_r );
00270 }
00271 if( tau != NULL ) {
00272 LAPACKE_free( tau );
00273 }
00274 if( tau_i != NULL ) {
00275 LAPACKE_free( tau_i );
00276 }
00277 if( c != NULL ) {
00278 LAPACKE_free( c );
00279 }
00280 if( c_i != NULL ) {
00281 LAPACKE_free( c_i );
00282 }
00283 if( c_r != NULL ) {
00284 LAPACKE_free( c_r );
00285 }
00286 if( c_save != NULL ) {
00287 LAPACKE_free( c_save );
00288 }
00289 if( work != NULL ) {
00290 LAPACKE_free( work );
00291 }
00292 if( work_i != NULL ) {
00293 LAPACKE_free( work_i );
00294 }
00295
00296 return 0;
00297 }
00298
00299
00300 static void init_scalars_zunmqr( char *side, char *trans, lapack_int *m,
00301 lapack_int *n, lapack_int *k, lapack_int *lda,
00302 lapack_int *ldc, lapack_int *lwork )
00303 {
00304 *side = 'L';
00305 *trans = 'C';
00306 *m = 6;
00307 *n = 2;
00308 *k = 4;
00309 *lda = 8;
00310 *ldc = 8;
00311 *lwork = 512;
00312
00313 return;
00314 }
00315
00316
00317 static void init_a( lapack_int size, lapack_complex_double *a ) {
00318 lapack_int i;
00319 for( i = 0; i < size; i++ ) {
00320 a[i] = lapack_make_complex_double( 0.0, 0.0 );
00321 }
00322 a[0] = lapack_make_complex_double( -3.08700502105195800e+000,
00323 0.00000000000000000e+000 );
00324 a[8] = lapack_make_complex_double( -4.88499367417976620e-001,
00325 -1.14168910512461390e+000 );
00326 a[16] = lapack_make_complex_double( 3.77356043173210700e-001,
00327 -1.24372975548049110e+000 );
00328 a[24] = lapack_make_complex_double( -8.55165437696762120e-001,
00329 -7.07319873181135650e-001 );
00330 a[1] = lapack_make_complex_double( -3.26978431123342020e-001,
00331 4.23806608064021150e-001 );
00332 a[9] = lapack_make_complex_double( 1.51631604729093160e+000,
00333 0.00000000000000000e+000 );
00334 a[17] = lapack_make_complex_double( 1.37305509662697790e+000,
00335 -8.17629335421158570e-001 );
00336 a[25] = lapack_make_complex_double( -2.50862720262847670e-001,
00337 8.20348604045144430e-001 );
00338 a[2] = lapack_make_complex_double( 1.69172476430465120e-001,
00339 -7.98047673307239890e-002 );
00340 a[10] = lapack_make_complex_double( -4.53710486149829670e-001,
00341 -6.49149959135295050e-003 );
00342 a[18] = lapack_make_complex_double( -2.17134536255717010e+000,
00343 0.00000000000000000e+000 );
00344 a[26] = lapack_make_complex_double( -2.27267620328359900e-001,
00345 -2.95731405907064150e-001 );
00346 a[3] = lapack_make_complex_double( -1.05973629513027950e-001,
00347 7.26861860966964010e-002 );
00348 a[11] = lapack_make_complex_double( -2.73407174139646880e-001,
00349 9.78078838704348470e-002 );
00350 a[19] = lapack_make_complex_double( -2.91822737804995960e-001,
00351 4.88808144155306160e-001 );
00352 a[27] = lapack_make_complex_double( -2.35337610655542080e+000,
00353 0.00000000000000000e+000 );
00354 a[4] = lapack_make_complex_double( 1.72939632545932170e-001,
00355 1.60632640429298590e-001 );
00356 a[12] = lapack_make_complex_double( -3.23630471463261900e-001,
00357 1.23000700219973860e-001 );
00358 a[20] = lapack_make_complex_double( 2.72768506164479230e-001,
00359 4.69769330690376700e-002 );
00360 a[28] = lapack_make_complex_double( 7.05422688603155710e-001,
00361 2.51508056610988850e-001 );
00362 a[5] = lapack_make_complex_double( 2.69899674468747240e-001,
00363 -1.51670836485297000e-002 );
00364 a[13] = lapack_make_complex_double( -1.64593543935458470e-001,
00365 3.38900720348261240e-001 );
00366 a[21] = lapack_make_complex_double( 5.34839525361778920e-001,
00367 3.98829067784022160e-001 );
00368 a[29] = lapack_make_complex_double( 2.70306990523076050e-001,
00369 -7.26878326406570770e-002 );
00370 }
00371 static void init_tau( lapack_int size, lapack_complex_double *tau ) {
00372 lapack_int i;
00373 for( i = 0; i < size; i++ ) {
00374 tau[i] = lapack_make_complex_double( 0.0, 0.0 );
00375 }
00376 tau[0] = lapack_make_complex_double( 1.31098102965600650e+000,
00377 -2.62390243772255500e-001 );
00378 tau[1] = lapack_make_complex_double( 1.10510398911057410e+000,
00379 -4.50362538745018080e-001 );
00380 tau[2] = lapack_make_complex_double( 1.04025187161551910e+000,
00381 2.12175810726109660e-001 );
00382 tau[3] = lapack_make_complex_double( 1.18595901116610980e+000,
00383 2.01183600330743640e-001 );
00384 }
00385 static void init_c( lapack_int size, lapack_complex_double *c ) {
00386 lapack_int i;
00387 for( i = 0; i < size; i++ ) {
00388 c[i] = lapack_make_complex_double( 0.0, 0.0 );
00389 }
00390 c[0] = lapack_make_complex_double( -1.54000000000000000e+000,
00391 7.60000000000000010e-001 );
00392 c[8] = lapack_make_complex_double( 3.16999999999999990e+000,
00393 -2.08999999999999990e+000 );
00394 c[1] = lapack_make_complex_double( 1.20000000000000000e-001,
00395 -1.91999999999999990e+000 );
00396 c[9] = lapack_make_complex_double( -6.53000000000000020e+000,
00397 4.17999999999999970e+000 );
00398 c[2] = lapack_make_complex_double( -9.08000000000000010e+000,
00399 -4.30999999999999960e+000 );
00400 c[10] = lapack_make_complex_double( 7.28000000000000020e+000,
00401 7.29999999999999980e-001 );
00402 c[3] = lapack_make_complex_double( 7.49000000000000020e+000,
00403 3.64999999999999990e+000 );
00404 c[11] = lapack_make_complex_double( 9.10000000000000030e-001,
00405 -3.97000000000000020e+000 );
00406 c[4] = lapack_make_complex_double( -5.62999999999999990e+000,
00407 -2.12000000000000010e+000 );
00408 c[12] = lapack_make_complex_double( -5.46000000000000000e+000,
00409 -1.63999999999999990e+000 );
00410 c[5] = lapack_make_complex_double( 2.37000000000000010e+000,
00411 8.02999999999999940e+000 );
00412 c[13] = lapack_make_complex_double( -2.83999999999999990e+000,
00413 -5.86000000000000030e+000 );
00414 }
00415 static void init_work( lapack_int size, lapack_complex_double *work ) {
00416 lapack_int i;
00417 for( i = 0; i < size; i++ ) {
00418 work[i] = lapack_make_complex_double( 0.0, 0.0 );
00419 }
00420 }
00421
00422
00423
00424 static int compare_zunmqr( lapack_complex_double *c, lapack_complex_double *c_i,
00425 lapack_int info, lapack_int info_i, lapack_int ldc,
00426 lapack_int n )
00427 {
00428 lapack_int i;
00429 int failed = 0;
00430 for( i = 0; i < ldc*n; i++ ) {
00431 failed += compare_complex_doubles(c[i],c_i[i]);
00432 }
00433 failed += (info == info_i) ? 0 : 1;
00434 if( info != 0 || info_i != 0 ) {
00435 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00436 }
00437
00438 return failed;
00439 }