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_zunglq( lapack_int *m, lapack_int *n, lapack_int *k,
00055 lapack_int *lda, lapack_int *lwork );
00056 static void init_a( lapack_int size, lapack_complex_double *a );
00057 static void init_tau( lapack_int size, lapack_complex_double *tau );
00058 static void init_work( lapack_int size, lapack_complex_double *work );
00059 static int compare_zunglq( lapack_complex_double *a, lapack_complex_double *a_i,
00060 lapack_int info, lapack_int info_i, lapack_int lda,
00061 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 k, k_i;
00069 lapack_int lda, lda_i;
00070 lapack_int lda_r;
00071 lapack_int lwork, lwork_i;
00072 lapack_int info, info_i;
00073 lapack_int i;
00074 int failed;
00075
00076
00077 lapack_complex_double *a = NULL, *a_i = NULL;
00078 lapack_complex_double *tau = NULL, *tau_i = NULL;
00079 lapack_complex_double *work = NULL, *work_i = NULL;
00080 lapack_complex_double *a_save = NULL;
00081 lapack_complex_double *a_r = NULL;
00082
00083
00084 init_scalars_zunglq( &m, &n, &k, &lda, &lwork );
00085 lda_r = n+2;
00086 m_i = m;
00087 n_i = n;
00088 k_i = k;
00089 lda_i = lda;
00090 lwork_i = lwork;
00091
00092
00093 a = (lapack_complex_double *)
00094 LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
00095 tau = (lapack_complex_double *)
00096 LAPACKE_malloc( k * sizeof(lapack_complex_double) );
00097 work = (lapack_complex_double *)
00098 LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
00099
00100
00101 a_i = (lapack_complex_double *)
00102 LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
00103 tau_i = (lapack_complex_double *)
00104 LAPACKE_malloc( k * sizeof(lapack_complex_double) );
00105 work_i = (lapack_complex_double *)
00106 LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
00107
00108
00109 a_save = (lapack_complex_double *)
00110 LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
00111
00112
00113 a_r = (lapack_complex_double *)
00114 LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_double) );
00115
00116
00117 init_a( lda*n, a );
00118 init_tau( k, tau );
00119 init_work( lwork, work );
00120
00121
00122 for( i = 0; i < lda*n; i++ ) {
00123 a_save[i] = a[i];
00124 }
00125
00126
00127 zunglq_( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
00128
00129
00130
00131 for( i = 0; i < lda*n; i++ ) {
00132 a_i[i] = a_save[i];
00133 }
00134 for( i = 0; i < k; i++ ) {
00135 tau_i[i] = tau[i];
00136 }
00137 for( i = 0; i < lwork; i++ ) {
00138 work_i[i] = work[i];
00139 }
00140 info_i = LAPACKE_zunglq_work( LAPACK_COL_MAJOR, m_i, n_i, k_i, a_i, lda_i,
00141 tau_i, work_i, lwork_i );
00142
00143 failed = compare_zunglq( a, a_i, info, info_i, lda, n );
00144 if( failed == 0 ) {
00145 printf( "PASSED: column-major middle-level interface to zunglq\n" );
00146 } else {
00147 printf( "FAILED: column-major middle-level interface to zunglq\n" );
00148 }
00149
00150
00151
00152 for( i = 0; i < lda*n; i++ ) {
00153 a_i[i] = a_save[i];
00154 }
00155 for( i = 0; i < k; i++ ) {
00156 tau_i[i] = tau[i];
00157 }
00158 for( i = 0; i < lwork; i++ ) {
00159 work_i[i] = work[i];
00160 }
00161 info_i = LAPACKE_zunglq( LAPACK_COL_MAJOR, m_i, n_i, k_i, a_i, lda_i,
00162 tau_i );
00163
00164 failed = compare_zunglq( a, a_i, info, info_i, lda, n );
00165 if( failed == 0 ) {
00166 printf( "PASSED: column-major high-level interface to zunglq\n" );
00167 } else {
00168 printf( "FAILED: column-major high-level interface to zunglq\n" );
00169 }
00170
00171
00172
00173 for( i = 0; i < lda*n; i++ ) {
00174 a_i[i] = a_save[i];
00175 }
00176 for( i = 0; i < k; i++ ) {
00177 tau_i[i] = tau[i];
00178 }
00179 for( i = 0; i < lwork; i++ ) {
00180 work_i[i] = work[i];
00181 }
00182
00183 LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00184 info_i = LAPACKE_zunglq_work( LAPACK_ROW_MAJOR, m_i, n_i, k_i, a_r, lda_r,
00185 tau_i, work_i, lwork_i );
00186
00187 LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00188
00189 failed = compare_zunglq( a, a_i, info, info_i, lda, n );
00190 if( failed == 0 ) {
00191 printf( "PASSED: row-major middle-level interface to zunglq\n" );
00192 } else {
00193 printf( "FAILED: row-major middle-level interface to zunglq\n" );
00194 }
00195
00196
00197
00198 for( i = 0; i < lda*n; i++ ) {
00199 a_i[i] = a_save[i];
00200 }
00201 for( i = 0; i < k; i++ ) {
00202 tau_i[i] = tau[i];
00203 }
00204 for( i = 0; i < lwork; i++ ) {
00205 work_i[i] = work[i];
00206 }
00207
00208
00209 LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00210 info_i = LAPACKE_zunglq( LAPACK_ROW_MAJOR, m_i, n_i, k_i, a_r, lda_r,
00211 tau_i );
00212
00213 LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00214
00215 failed = compare_zunglq( a, a_i, info, info_i, lda, n );
00216 if( failed == 0 ) {
00217 printf( "PASSED: row-major high-level interface to zunglq\n" );
00218 } else {
00219 printf( "FAILED: row-major high-level interface to zunglq\n" );
00220 }
00221
00222
00223 if( a != NULL ) {
00224 LAPACKE_free( a );
00225 }
00226 if( a_i != NULL ) {
00227 LAPACKE_free( a_i );
00228 }
00229 if( a_r != NULL ) {
00230 LAPACKE_free( a_r );
00231 }
00232 if( a_save != NULL ) {
00233 LAPACKE_free( a_save );
00234 }
00235 if( tau != NULL ) {
00236 LAPACKE_free( tau );
00237 }
00238 if( tau_i != NULL ) {
00239 LAPACKE_free( tau_i );
00240 }
00241 if( work != NULL ) {
00242 LAPACKE_free( work );
00243 }
00244 if( work_i != NULL ) {
00245 LAPACKE_free( work_i );
00246 }
00247
00248 return 0;
00249 }
00250
00251
00252 static void init_scalars_zunglq( lapack_int *m, lapack_int *n, lapack_int *k,
00253 lapack_int *lda, lapack_int *lwork )
00254 {
00255 *m = 3;
00256 *n = 4;
00257 *k = 3;
00258 *lda = 8;
00259 *lwork = 512;
00260
00261 return;
00262 }
00263
00264
00265 static void init_a( lapack_int size, lapack_complex_double *a ) {
00266 lapack_int i;
00267 for( i = 0; i < size; i++ ) {
00268 a[i] = lapack_make_complex_double( 0.0, 0.0 );
00269 }
00270 a[0] = lapack_make_complex_double( -2.22551117723546850e+000,
00271 0.00000000000000000e+000 );
00272 a[8] = lapack_make_complex_double( 2.43844259461276080e-001,
00273 -3.08206993291480160e-001 );
00274 a[16] = lapack_make_complex_double( -2.74136498519149120e-001,
00275 -2.30966496866882000e-001 );
00276 a[24] = lapack_make_complex_double( 5.80770951470128920e-001,
00277 3.46866360216428750e-001 );
00278 a[1] = lapack_make_complex_double( 8.20755257796100150e-001,
00279 1.23845704671937580e+000 );
00280 a[9] = lapack_make_complex_double( 1.68810098934606920e+000,
00281 0.00000000000000000e+000 );
00282 a[17] = lapack_make_complex_double( -1.93641525844946090e-001,
00283 5.42951785523693940e-001 );
00284 a[25] = lapack_make_complex_double( 2.78908485124207680e-001,
00285 -2.20317579745833100e-001 );
00286 a[2] = lapack_make_complex_double( 1.03347043300727750e-003,
00287 -6.82225286276042620e-001 );
00288 a[10] = lapack_make_complex_double( 7.74751330164005660e-001,
00289 -6.15472715853114580e-001 );
00290 a[18] = lapack_make_complex_double( -1.59025825045931810e+000,
00291 0.00000000000000000e+000 );
00292 a[26] = lapack_make_complex_double( -1.26766851611322510e-001,
00293 1.10984520235717200e-001 );
00294 }
00295 static void init_tau( lapack_int size, lapack_complex_double *tau ) {
00296 lapack_int i;
00297 for( i = 0; i < size; i++ ) {
00298 tau[i] = lapack_make_complex_double( 0.0, 0.0 );
00299 }
00300 tau[0] = lapack_make_complex_double( 1.12581379184436000e+000,
00301 1.61760589514177240e-001 );
00302 tau[1] = lapack_make_complex_double( 1.09905366916895430e+000,
00303 5.46859059846678370e-001 );
00304 tau[2] = lapack_make_complex_double( 1.13292565731157910e+000,
00305 -9.59054047896148680e-001 );
00306 }
00307 static void init_work( lapack_int size, lapack_complex_double *work ) {
00308 lapack_int i;
00309 for( i = 0; i < size; i++ ) {
00310 work[i] = lapack_make_complex_double( 0.0, 0.0 );
00311 }
00312 }
00313
00314
00315
00316 static int compare_zunglq( lapack_complex_double *a, lapack_complex_double *a_i,
00317 lapack_int info, lapack_int info_i, lapack_int lda,
00318 lapack_int n )
00319 {
00320 lapack_int i;
00321 int failed = 0;
00322 for( i = 0; i < lda*n; i++ ) {
00323 failed += compare_complex_doubles(a[i],a_i[i]);
00324 }
00325 failed += (info == info_i) ? 0 : 1;
00326 if( info != 0 || info_i != 0 ) {
00327 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00328 }
00329
00330 return failed;
00331 }