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_sgeqrf( 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_tau( lapack_int size, float *tau );
00058 static void init_work( lapack_int size, float *work );
00059 static int compare_sgeqrf( float *a, float *a_i, float *tau, float *tau_i,
00060 lapack_int info, lapack_int info_i, lapack_int lda,
00061 lapack_int m, lapack_int n );
00062
00063 int main(void)
00064 {
00065
00066 lapack_int m, m_i;
00067 lapack_int n, n_i;
00068 lapack_int lda, lda_i;
00069 lapack_int lda_r;
00070 lapack_int lwork, lwork_i;
00071 lapack_int info, info_i;
00072 lapack_int i;
00073 int failed;
00074
00075
00076 float *a = NULL, *a_i = NULL;
00077 float *tau = NULL, *tau_i = NULL;
00078 float *work = NULL, *work_i = NULL;
00079 float *a_save = NULL;
00080 float *tau_save = NULL;
00081 float *a_r = NULL;
00082
00083
00084 init_scalars_sgeqrf( &m, &n, &lda, &lwork );
00085 lda_r = n+2;
00086 m_i = m;
00087 n_i = n;
00088 lda_i = lda;
00089 lwork_i = lwork;
00090
00091
00092 a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00093 tau = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00094 work = (float *)LAPACKE_malloc( lwork * sizeof(float) );
00095
00096
00097 a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00098 tau_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00099 work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) );
00100
00101
00102 a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00103 tau_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00104
00105
00106 a_r = (float *)LAPACKE_malloc( m*(n+2) * sizeof(float) );
00107
00108
00109 init_a( lda*n, a );
00110 init_tau( (MIN(m,n)), tau );
00111 init_work( lwork, work );
00112
00113
00114 for( i = 0; i < lda*n; i++ ) {
00115 a_save[i] = a[i];
00116 }
00117 for( i = 0; i < (MIN(m,n)); i++ ) {
00118 tau_save[i] = tau[i];
00119 }
00120
00121
00122 sgeqrf_( &m, &n, a, &lda, tau, work, &lwork, &info );
00123
00124
00125
00126 for( i = 0; i < lda*n; i++ ) {
00127 a_i[i] = a_save[i];
00128 }
00129 for( i = 0; i < (MIN(m,n)); i++ ) {
00130 tau_i[i] = tau_save[i];
00131 }
00132 for( i = 0; i < lwork; i++ ) {
00133 work_i[i] = work[i];
00134 }
00135 info_i = LAPACKE_sgeqrf_work( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, tau_i,
00136 work_i, lwork_i );
00137
00138 failed = compare_sgeqrf( a, a_i, tau, tau_i, info, info_i, lda, m, n );
00139 if( failed == 0 ) {
00140 printf( "PASSED: column-major middle-level interface to sgeqrf\n" );
00141 } else {
00142 printf( "FAILED: column-major middle-level interface to sgeqrf\n" );
00143 }
00144
00145
00146
00147 for( i = 0; i < lda*n; i++ ) {
00148 a_i[i] = a_save[i];
00149 }
00150 for( i = 0; i < (MIN(m,n)); i++ ) {
00151 tau_i[i] = tau_save[i];
00152 }
00153 for( i = 0; i < lwork; i++ ) {
00154 work_i[i] = work[i];
00155 }
00156 info_i = LAPACKE_sgeqrf( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, tau_i );
00157
00158 failed = compare_sgeqrf( a, a_i, tau, tau_i, info, info_i, lda, m, n );
00159 if( failed == 0 ) {
00160 printf( "PASSED: column-major high-level interface to sgeqrf\n" );
00161 } else {
00162 printf( "FAILED: column-major high-level interface to sgeqrf\n" );
00163 }
00164
00165
00166
00167 for( i = 0; i < lda*n; i++ ) {
00168 a_i[i] = a_save[i];
00169 }
00170 for( i = 0; i < (MIN(m,n)); i++ ) {
00171 tau_i[i] = tau_save[i];
00172 }
00173 for( i = 0; i < lwork; i++ ) {
00174 work_i[i] = work[i];
00175 }
00176
00177 LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00178 info_i = LAPACKE_sgeqrf_work( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, tau_i,
00179 work_i, lwork_i );
00180
00181 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00182
00183 failed = compare_sgeqrf( a, a_i, tau, tau_i, info, info_i, lda, m, n );
00184 if( failed == 0 ) {
00185 printf( "PASSED: row-major middle-level interface to sgeqrf\n" );
00186 } else {
00187 printf( "FAILED: row-major middle-level interface to sgeqrf\n" );
00188 }
00189
00190
00191
00192 for( i = 0; i < lda*n; i++ ) {
00193 a_i[i] = a_save[i];
00194 }
00195 for( i = 0; i < (MIN(m,n)); i++ ) {
00196 tau_i[i] = tau_save[i];
00197 }
00198 for( i = 0; i < lwork; i++ ) {
00199 work_i[i] = work[i];
00200 }
00201
00202
00203 LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00204 info_i = LAPACKE_sgeqrf( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, tau_i );
00205
00206 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00207
00208 failed = compare_sgeqrf( a, a_i, tau, tau_i, info, info_i, lda, m, n );
00209 if( failed == 0 ) {
00210 printf( "PASSED: row-major high-level interface to sgeqrf\n" );
00211 } else {
00212 printf( "FAILED: row-major high-level interface to sgeqrf\n" );
00213 }
00214
00215
00216 if( a != NULL ) {
00217 LAPACKE_free( a );
00218 }
00219 if( a_i != NULL ) {
00220 LAPACKE_free( a_i );
00221 }
00222 if( a_r != NULL ) {
00223 LAPACKE_free( a_r );
00224 }
00225 if( a_save != NULL ) {
00226 LAPACKE_free( a_save );
00227 }
00228 if( tau != NULL ) {
00229 LAPACKE_free( tau );
00230 }
00231 if( tau_i != NULL ) {
00232 LAPACKE_free( tau_i );
00233 }
00234 if( tau_save != NULL ) {
00235 LAPACKE_free( tau_save );
00236 }
00237 if( work != NULL ) {
00238 LAPACKE_free( work );
00239 }
00240 if( work_i != NULL ) {
00241 LAPACKE_free( work_i );
00242 }
00243
00244 return 0;
00245 }
00246
00247
00248 static void init_scalars_sgeqrf( lapack_int *m, lapack_int *n, lapack_int *lda,
00249 lapack_int *lwork )
00250 {
00251 *m = 6;
00252 *n = 4;
00253 *lda = 8;
00254 *lwork = 1024;
00255
00256 return;
00257 }
00258
00259
00260 static void init_a( lapack_int size, float *a ) {
00261 lapack_int i;
00262 for( i = 0; i < size; i++ ) {
00263 a[i] = 0;
00264 }
00265 a[0] = -5.699999928e-001;
00266 a[8] = -1.279999971e+000;
00267 a[16] = -3.899999857e-001;
00268 a[24] = 2.500000000e-001;
00269 a[1] = -1.929999948e+000;
00270 a[9] = 1.080000043e+000;
00271 a[17] = -3.100000024e-001;
00272 a[25] = -2.140000105e+000;
00273 a[2] = 2.299999952e+000;
00274 a[10] = 2.399999946e-001;
00275 a[18] = 4.000000060e-001;
00276 a[26] = -3.499999940e-001;
00277 a[3] = -1.929999948e+000;
00278 a[11] = 6.399999857e-001;
00279 a[19] = -6.600000262e-001;
00280 a[27] = 7.999999821e-002;
00281 a[4] = 1.500000060e-001;
00282 a[12] = 3.000000119e-001;
00283 a[20] = 1.500000060e-001;
00284 a[28] = -2.130000114e+000;
00285 a[5] = -1.999999955e-002;
00286 a[13] = 1.029999971e+000;
00287 a[21] = -1.429999948e+000;
00288 a[29] = 5.000000000e-001;
00289 }
00290 static void init_tau( lapack_int size, float *tau ) {
00291 lapack_int i;
00292 for( i = 0; i < size; i++ ) {
00293 tau[i] = 0;
00294 }
00295 }
00296 static void init_work( lapack_int size, float *work ) {
00297 lapack_int i;
00298 for( i = 0; i < size; i++ ) {
00299 work[i] = 0;
00300 }
00301 }
00302
00303
00304
00305 static int compare_sgeqrf( float *a, float *a_i, float *tau, float *tau_i,
00306 lapack_int info, lapack_int info_i, lapack_int lda,
00307 lapack_int m, lapack_int n )
00308 {
00309 lapack_int i;
00310 int failed = 0;
00311 for( i = 0; i < lda*n; i++ ) {
00312 failed += compare_floats(a[i],a_i[i]);
00313 }
00314 for( i = 0; i < (MIN(m,n)); i++ ) {
00315 failed += compare_floats(tau[i],tau_i[i]);
00316 }
00317 failed += (info == info_i) ? 0 : 1;
00318 if( info != 0 || info_i != 0 ) {
00319 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00320 }
00321
00322 return failed;
00323 }