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_cungbr( char *vect, lapack_int *m, lapack_int *n,
00055 lapack_int *k, lapack_int *lda,
00056 lapack_int *lwork );
00057 static void init_a( lapack_int size, lapack_complex_float *a );
00058 static void init_tau( lapack_int size, lapack_complex_float *tau );
00059 static void init_work( lapack_int size, lapack_complex_float *work );
00060 static int compare_cungbr( lapack_complex_float *a, lapack_complex_float *a_i,
00061 lapack_int info, lapack_int info_i, lapack_int lda,
00062 lapack_int n );
00063
00064 int main(void)
00065 {
00066
00067 char vect, vect_i;
00068 lapack_int m, m_i;
00069 lapack_int n, n_i;
00070 lapack_int k, k_i;
00071 lapack_int lda, lda_i;
00072 lapack_int lda_r;
00073 lapack_int lwork, lwork_i;
00074 lapack_int info, info_i;
00075 lapack_int i;
00076 int failed;
00077
00078
00079 lapack_complex_float *a = NULL, *a_i = NULL;
00080 lapack_complex_float *tau = NULL, *tau_i = NULL;
00081 lapack_complex_float *work = NULL, *work_i = NULL;
00082 lapack_complex_float *a_save = NULL;
00083 lapack_complex_float *a_r = NULL;
00084
00085
00086 init_scalars_cungbr( &vect, &m, &n, &k, &lda, &lwork );
00087 lda_r = n+2;
00088 vect_i = vect;
00089 m_i = m;
00090 n_i = n;
00091 k_i = k;
00092 lda_i = lda;
00093 lwork_i = lwork;
00094
00095
00096 a = (lapack_complex_float *)
00097 LAPACKE_malloc( lda*n * sizeof(lapack_complex_float) );
00098 tau = (lapack_complex_float *)
00099 LAPACKE_malloc( MIN(m,k) * sizeof(lapack_complex_float) );
00100 work = (lapack_complex_float *)
00101 LAPACKE_malloc( lwork * sizeof(lapack_complex_float) );
00102
00103
00104 a_i = (lapack_complex_float *)
00105 LAPACKE_malloc( lda*n * sizeof(lapack_complex_float) );
00106 tau_i = (lapack_complex_float *)
00107 LAPACKE_malloc( MIN(m,k) * sizeof(lapack_complex_float) );
00108 work_i = (lapack_complex_float *)
00109 LAPACKE_malloc( lwork * sizeof(lapack_complex_float) );
00110
00111
00112 a_save = (lapack_complex_float *)
00113 LAPACKE_malloc( lda*n * sizeof(lapack_complex_float) );
00114
00115
00116 a_r = (lapack_complex_float *)
00117 LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_float) );
00118
00119
00120 init_a( lda*n, a );
00121 init_tau( (MIN(m,k)), tau );
00122 init_work( lwork, work );
00123
00124
00125 for( i = 0; i < lda*n; i++ ) {
00126 a_save[i] = a[i];
00127 }
00128
00129
00130 cungbr_( &vect, &m, &n, &k, a, &lda, tau, work, &lwork, &info );
00131
00132
00133
00134 for( i = 0; i < lda*n; i++ ) {
00135 a_i[i] = a_save[i];
00136 }
00137 for( i = 0; i < (MIN(m,k)); i++ ) {
00138 tau_i[i] = tau[i];
00139 }
00140 for( i = 0; i < lwork; i++ ) {
00141 work_i[i] = work[i];
00142 }
00143 info_i = LAPACKE_cungbr_work( LAPACK_COL_MAJOR, vect_i, m_i, n_i, k_i, a_i,
00144 lda_i, tau_i, work_i, lwork_i );
00145
00146 failed = compare_cungbr( a, a_i, info, info_i, lda, n );
00147 if( failed == 0 ) {
00148 printf( "PASSED: column-major middle-level interface to cungbr\n" );
00149 } else {
00150 printf( "FAILED: column-major middle-level interface to cungbr\n" );
00151 }
00152
00153
00154
00155 for( i = 0; i < lda*n; i++ ) {
00156 a_i[i] = a_save[i];
00157 }
00158 for( i = 0; i < (MIN(m,k)); i++ ) {
00159 tau_i[i] = tau[i];
00160 }
00161 for( i = 0; i < lwork; i++ ) {
00162 work_i[i] = work[i];
00163 }
00164 info_i = LAPACKE_cungbr( LAPACK_COL_MAJOR, vect_i, m_i, n_i, k_i, a_i,
00165 lda_i, tau_i );
00166
00167 failed = compare_cungbr( a, a_i, info, info_i, lda, n );
00168 if( failed == 0 ) {
00169 printf( "PASSED: column-major high-level interface to cungbr\n" );
00170 } else {
00171 printf( "FAILED: column-major high-level interface to cungbr\n" );
00172 }
00173
00174
00175
00176 for( i = 0; i < lda*n; i++ ) {
00177 a_i[i] = a_save[i];
00178 }
00179 for( i = 0; i < (MIN(m,k)); i++ ) {
00180 tau_i[i] = tau[i];
00181 }
00182 for( i = 0; i < lwork; i++ ) {
00183 work_i[i] = work[i];
00184 }
00185
00186 LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00187 info_i = LAPACKE_cungbr_work( LAPACK_ROW_MAJOR, vect_i, m_i, n_i, k_i, a_r,
00188 lda_r, tau_i, work_i, lwork_i );
00189
00190 LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00191
00192 failed = compare_cungbr( a, a_i, info, info_i, lda, n );
00193 if( failed == 0 ) {
00194 printf( "PASSED: row-major middle-level interface to cungbr\n" );
00195 } else {
00196 printf( "FAILED: row-major middle-level interface to cungbr\n" );
00197 }
00198
00199
00200
00201 for( i = 0; i < lda*n; i++ ) {
00202 a_i[i] = a_save[i];
00203 }
00204 for( i = 0; i < (MIN(m,k)); i++ ) {
00205 tau_i[i] = tau[i];
00206 }
00207 for( i = 0; i < lwork; i++ ) {
00208 work_i[i] = work[i];
00209 }
00210
00211
00212 LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00213 info_i = LAPACKE_cungbr( LAPACK_ROW_MAJOR, vect_i, m_i, n_i, k_i, a_r,
00214 lda_r, tau_i );
00215
00216 LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00217
00218 failed = compare_cungbr( a, a_i, info, info_i, lda, n );
00219 if( failed == 0 ) {
00220 printf( "PASSED: row-major high-level interface to cungbr\n" );
00221 } else {
00222 printf( "FAILED: row-major high-level interface to cungbr\n" );
00223 }
00224
00225
00226 if( a != NULL ) {
00227 LAPACKE_free( a );
00228 }
00229 if( a_i != NULL ) {
00230 LAPACKE_free( a_i );
00231 }
00232 if( a_r != NULL ) {
00233 LAPACKE_free( a_r );
00234 }
00235 if( a_save != NULL ) {
00236 LAPACKE_free( a_save );
00237 }
00238 if( tau != NULL ) {
00239 LAPACKE_free( tau );
00240 }
00241 if( tau_i != NULL ) {
00242 LAPACKE_free( tau_i );
00243 }
00244 if( work != NULL ) {
00245 LAPACKE_free( work );
00246 }
00247 if( work_i != NULL ) {
00248 LAPACKE_free( work_i );
00249 }
00250
00251 return 0;
00252 }
00253
00254
00255 static void init_scalars_cungbr( char *vect, lapack_int *m, lapack_int *n,
00256 lapack_int *k, lapack_int *lda,
00257 lapack_int *lwork )
00258 {
00259 *vect = 'Q';
00260 *m = 6;
00261 *n = 4;
00262 *k = 4;
00263 *lda = 8;
00264 *lwork = 1024;
00265
00266 return;
00267 }
00268
00269
00270 static void init_a( lapack_int size, lapack_complex_float *a ) {
00271 lapack_int i;
00272 for( i = 0; i < size; i++ ) {
00273 a[i] = lapack_make_complex_float( 0.0f, 0.0f );
00274 }
00275 a[0] = lapack_make_complex_float( -3.087005138e+000, 0.000000000e+000 );
00276 a[8] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00277 a[16] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00278 a[24] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00279 a[1] = lapack_make_complex_float( -3.269784153e-001, 4.238066077e-001 );
00280 a[9] = lapack_make_complex_float( 2.066039324e+000, 0.000000000e+000 );
00281 a[17] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00282 a[25] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00283 a[2] = lapack_make_complex_float( 1.691724658e-001, -7.980476320e-002 );
00284 a[10] = lapack_make_complex_float( -2.585049868e-001, -1.367808506e-002 );
00285 a[18] = lapack_make_complex_float( 1.873128653e+000, 0.000000000e+000 );
00286 a[26] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00287 a[3] = lapack_make_complex_float( -1.059736237e-001, 7.268618047e-002 );
00288 a[11] = lapack_make_complex_float( 5.820717663e-002, 6.751044653e-003 );
00289 a[19] = lapack_make_complex_float( -3.219398558e-001, 3.404291272e-001 );
00290 a[27] = lapack_make_complex_float( 2.002182961e+000, 0.000000000e+000 );
00291 a[4] = lapack_make_complex_float( 1.729396135e-001, 1.606326252e-001 );
00292 a[12] = lapack_make_complex_float( 8.840744942e-002, -1.430363506e-001 );
00293 a[20] = lapack_make_complex_float( -4.052029848e-001, -2.475408018e-001 );
00294 a[28] = lapack_make_complex_float( 2.871161103e-001, 1.826060414e-001 );
00295 a[5] = lapack_make_complex_float( 2.698996663e-001, -1.516707987e-002 );
00296 a[13] = lapack_make_complex_float( -5.511574820e-002, -1.064893007e-001 );
00297 a[21] = lapack_make_complex_float( 2.171671987e-001, 2.910265326e-001 );
00298 a[29] = lapack_make_complex_float( 5.596351027e-001, -5.694419146e-002 );
00299 }
00300 static void init_tau( lapack_int size, lapack_complex_float *tau ) {
00301 lapack_int i;
00302 for( i = 0; i < size; i++ ) {
00303 tau[i] = lapack_make_complex_float( 0.0f, 0.0f );
00304 }
00305 tau[0] = lapack_make_complex_float( 1.310981035e+000, -2.623902261e-001 );
00306 tau[1] = lapack_make_complex_float( 1.796481013e+000, -2.341232263e-002 );
00307 tau[2] = lapack_make_complex_float( 1.242043018e+000, -1.807348728e-001 );
00308 tau[3] = lapack_make_complex_float( 1.014396429e+000, 6.225289106e-001 );
00309 }
00310 static void init_work( lapack_int size, lapack_complex_float *work ) {
00311 lapack_int i;
00312 for( i = 0; i < size; i++ ) {
00313 work[i] = lapack_make_complex_float( 0.0f, 0.0f );
00314 }
00315 }
00316
00317
00318
00319 static int compare_cungbr( lapack_complex_float *a, lapack_complex_float *a_i,
00320 lapack_int info, lapack_int info_i, lapack_int lda,
00321 lapack_int n )
00322 {
00323 lapack_int i;
00324 int failed = 0;
00325 for( i = 0; i < lda*n; i++ ) {
00326 failed += compare_complex_floats(a[i],a_i[i]);
00327 }
00328 failed += (info == info_i) ? 0 : 1;
00329 if( info != 0 || info_i != 0 ) {
00330 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00331 }
00332
00333 return failed;
00334 }