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_sormqr( 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, float *a );
00058 static void init_tau( lapack_int size, float *tau );
00059 static void init_c( lapack_int size, float *c );
00060 static void init_work( lapack_int size, float *work );
00061 static int compare_sormqr( float *c, float *c_i, lapack_int info,
00062 lapack_int info_i, lapack_int ldc, lapack_int n );
00063
00064 int main(void)
00065 {
00066
00067 char side, side_i;
00068 char trans, trans_i;
00069 lapack_int m, m_i;
00070 lapack_int n, n_i;
00071 lapack_int k, k_i;
00072 lapack_int lda, lda_i;
00073 lapack_int lda_r;
00074 lapack_int ldc, ldc_i;
00075 lapack_int ldc_r;
00076 lapack_int lwork, lwork_i;
00077 lapack_int info, info_i;
00078
00079 lapack_int r;
00080 lapack_int i;
00081 int failed;
00082
00083
00084 float *a = NULL, *a_i = NULL;
00085 float *tau = NULL, *tau_i = NULL;
00086 float *c = NULL, *c_i = NULL;
00087 float *work = NULL, *work_i = NULL;
00088 float *c_save = NULL;
00089 float *a_r = NULL;
00090 float *c_r = NULL;
00091
00092
00093 init_scalars_sormqr( &side, &trans, &m, &n, &k, &lda, &ldc, &lwork );
00094 r = LAPACKE_lsame( side, 'l' ) ? m : n;
00095 lda_r = k+2;
00096 ldc_r = n+2;
00097 side_i = side;
00098 trans_i = trans;
00099 m_i = m;
00100 n_i = n;
00101 k_i = k;
00102 lda_i = lda;
00103 ldc_i = ldc;
00104 lwork_i = lwork;
00105
00106
00107 a = (float *)LAPACKE_malloc( lda*k * sizeof(float) );
00108 tau = (float *)LAPACKE_malloc( k * sizeof(float) );
00109 c = (float *)LAPACKE_malloc( ldc*n * sizeof(float) );
00110 work = (float *)LAPACKE_malloc( lwork * sizeof(float) );
00111
00112
00113 a_i = (float *)LAPACKE_malloc( lda*k * sizeof(float) );
00114 tau_i = (float *)LAPACKE_malloc( k * sizeof(float) );
00115 c_i = (float *)LAPACKE_malloc( ldc*n * sizeof(float) );
00116 work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) );
00117
00118
00119 c_save = (float *)LAPACKE_malloc( ldc*n * sizeof(float) );
00120
00121
00122 a_r = (float *)LAPACKE_malloc( r*(k+2) * sizeof(float) );
00123 c_r = (float *)LAPACKE_malloc( m*(n+2) * sizeof(float) );
00124
00125
00126 init_a( lda*k, a );
00127 init_tau( k, tau );
00128 init_c( ldc*n, c );
00129 init_work( lwork, work );
00130
00131
00132 for( i = 0; i < ldc*n; i++ ) {
00133 c_save[i] = c[i];
00134 }
00135
00136
00137 sormqr_( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, &lwork,
00138 &info );
00139
00140
00141
00142 for( i = 0; i < lda*k; i++ ) {
00143 a_i[i] = a[i];
00144 }
00145 for( i = 0; i < k; i++ ) {
00146 tau_i[i] = tau[i];
00147 }
00148 for( i = 0; i < ldc*n; i++ ) {
00149 c_i[i] = c_save[i];
00150 }
00151 for( i = 0; i < lwork; i++ ) {
00152 work_i[i] = work[i];
00153 }
00154 info_i = LAPACKE_sormqr_work( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i,
00155 k_i, a_i, lda_i, tau_i, c_i, ldc_i, work_i,
00156 lwork_i );
00157
00158 failed = compare_sormqr( c, c_i, info, info_i, ldc, n );
00159 if( failed == 0 ) {
00160 printf( "PASSED: column-major middle-level interface to sormqr\n" );
00161 } else {
00162 printf( "FAILED: column-major middle-level interface to sormqr\n" );
00163 }
00164
00165
00166
00167 for( i = 0; i < lda*k; i++ ) {
00168 a_i[i] = a[i];
00169 }
00170 for( i = 0; i < k; i++ ) {
00171 tau_i[i] = tau[i];
00172 }
00173 for( i = 0; i < ldc*n; i++ ) {
00174 c_i[i] = c_save[i];
00175 }
00176 for( i = 0; i < lwork; i++ ) {
00177 work_i[i] = work[i];
00178 }
00179 info_i = LAPACKE_sormqr( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i, k_i,
00180 a_i, lda_i, tau_i, c_i, ldc_i );
00181
00182 failed = compare_sormqr( c, c_i, info, info_i, ldc, n );
00183 if( failed == 0 ) {
00184 printf( "PASSED: column-major high-level interface to sormqr\n" );
00185 } else {
00186 printf( "FAILED: column-major high-level interface to sormqr\n" );
00187 }
00188
00189
00190
00191 for( i = 0; i < lda*k; i++ ) {
00192 a_i[i] = a[i];
00193 }
00194 for( i = 0; i < k; i++ ) {
00195 tau_i[i] = tau[i];
00196 }
00197 for( i = 0; i < ldc*n; i++ ) {
00198 c_i[i] = c_save[i];
00199 }
00200 for( i = 0; i < lwork; i++ ) {
00201 work_i[i] = work[i];
00202 }
00203
00204 LAPACKE_sge_trans( LAPACK_COL_MAJOR, r, k, a_i, lda, a_r, k+2 );
00205 LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
00206 info_i = LAPACKE_sormqr_work( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i,
00207 k_i, a_r, lda_r, tau_i, c_r, ldc_r, work_i,
00208 lwork_i );
00209
00210 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
00211
00212 failed = compare_sormqr( c, c_i, info, info_i, ldc, n );
00213 if( failed == 0 ) {
00214 printf( "PASSED: row-major middle-level interface to sormqr\n" );
00215 } else {
00216 printf( "FAILED: row-major middle-level interface to sormqr\n" );
00217 }
00218
00219
00220
00221 for( i = 0; i < lda*k; i++ ) {
00222 a_i[i] = a[i];
00223 }
00224 for( i = 0; i < k; i++ ) {
00225 tau_i[i] = tau[i];
00226 }
00227 for( i = 0; i < ldc*n; i++ ) {
00228 c_i[i] = c_save[i];
00229 }
00230 for( i = 0; i < lwork; i++ ) {
00231 work_i[i] = work[i];
00232 }
00233
00234
00235 LAPACKE_sge_trans( LAPACK_COL_MAJOR, r, k, a_i, lda, a_r, k+2 );
00236 LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
00237 info_i = LAPACKE_sormqr( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i, k_i,
00238 a_r, lda_r, tau_i, c_r, ldc_r );
00239
00240 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
00241
00242 failed = compare_sormqr( c, c_i, info, info_i, ldc, n );
00243 if( failed == 0 ) {
00244 printf( "PASSED: row-major high-level interface to sormqr\n" );
00245 } else {
00246 printf( "FAILED: row-major high-level interface to sormqr\n" );
00247 }
00248
00249
00250 if( a != NULL ) {
00251 LAPACKE_free( a );
00252 }
00253 if( a_i != NULL ) {
00254 LAPACKE_free( a_i );
00255 }
00256 if( a_r != NULL ) {
00257 LAPACKE_free( a_r );
00258 }
00259 if( tau != NULL ) {
00260 LAPACKE_free( tau );
00261 }
00262 if( tau_i != NULL ) {
00263 LAPACKE_free( tau_i );
00264 }
00265 if( c != NULL ) {
00266 LAPACKE_free( c );
00267 }
00268 if( c_i != NULL ) {
00269 LAPACKE_free( c_i );
00270 }
00271 if( c_r != NULL ) {
00272 LAPACKE_free( c_r );
00273 }
00274 if( c_save != NULL ) {
00275 LAPACKE_free( c_save );
00276 }
00277 if( work != NULL ) {
00278 LAPACKE_free( work );
00279 }
00280 if( work_i != NULL ) {
00281 LAPACKE_free( work_i );
00282 }
00283
00284 return 0;
00285 }
00286
00287
00288 static void init_scalars_sormqr( char *side, char *trans, lapack_int *m,
00289 lapack_int *n, lapack_int *k, lapack_int *lda,
00290 lapack_int *ldc, lapack_int *lwork )
00291 {
00292 *side = 'L';
00293 *trans = 'T';
00294 *m = 6;
00295 *n = 2;
00296 *k = 4;
00297 *lda = 8;
00298 *ldc = 8;
00299 *lwork = 512;
00300
00301 return;
00302 }
00303
00304
00305 static void init_a( lapack_int size, float *a ) {
00306 lapack_int i;
00307 for( i = 0; i < size; i++ ) {
00308 a[i] = 0;
00309 }
00310 a[0] = 3.617678881e+000;
00311 a[8] = -5.565999150e-001;
00312 a[16] = 8.473665714e-001;
00313 a[24] = 7.460032701e-001;
00314 a[1] = 4.608758390e-001;
00315 a[9] = -2.028077126e+000;
00316 a[17] = 5.513871908e-001;
00317 a[25] = 1.169962883e+000;
00318 a[2] = -5.492302775e-001;
00319 a[10] = -4.571098462e-002;
00320 a[18] = 1.374460578e+000;
00321 a[26] = -1.410473824e+000;
00322 a[3] = 4.608758390e-001;
00323 a[11] = 2.828431427e-001;
00324 a[19] = 4.430848639e-003;
00325 a[27] = -2.375527382e+000;
00326 a[4] = -3.581936657e-002;
00327 a[12] = 7.964268327e-002;
00328 a[20] = -7.728561759e-002;
00329 a[28] = -5.213745236e-001;
00330 a[5] = 4.775915295e-003;
00331 a[13] = 3.002941906e-001;
00332 a[21] = 8.016653657e-001;
00333 a[29] = 2.558113933e-001;
00334 }
00335 static void init_tau( lapack_int size, float *tau ) {
00336 lapack_int i;
00337 for( i = 0; i < size; i++ ) {
00338 tau[i] = 0;
00339 }
00340 tau[0] = 1.157559633e+000;
00341 tau[1] = 1.696915150e+000;
00342 tau[2] = 1.213106394e+000;
00343 tau[3] = 1.495583296e+000;
00344 }
00345 static void init_c( lapack_int size, float *c ) {
00346 lapack_int i;
00347 for( i = 0; i < size; i++ ) {
00348 c[i] = 0;
00349 }
00350 c[0] = -3.150000095e+000;
00351 c[8] = 2.190000057e+000;
00352 c[1] = -1.099999994e-001;
00353 c[9] = -3.640000105e+000;
00354 c[2] = 1.990000010e+000;
00355 c[10] = 5.699999928e-001;
00356 c[3] = -2.700000048e+000;
00357 c[11] = 8.229999542e+000;
00358 c[4] = 2.599999905e-001;
00359 c[12] = -6.349999905e+000;
00360 c[5] = 4.500000000e+000;
00361 c[13] = -1.480000019e+000;
00362 }
00363 static void init_work( lapack_int size, float *work ) {
00364 lapack_int i;
00365 for( i = 0; i < size; i++ ) {
00366 work[i] = 0;
00367 }
00368 }
00369
00370
00371
00372 static int compare_sormqr( float *c, float *c_i, lapack_int info,
00373 lapack_int info_i, lapack_int ldc, lapack_int n )
00374 {
00375 lapack_int i;
00376 int failed = 0;
00377 for( i = 0; i < ldc*n; i++ ) {
00378 failed += compare_floats(c[i],c_i[i]);
00379 }
00380 failed += (info == info_i) ? 0 : 1;
00381 if( info != 0 || info_i != 0 ) {
00382 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00383 }
00384
00385 return failed;
00386 }