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_dorgbr( 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, double *a );
00058 static void init_tau( lapack_int size, double *tau );
00059 static void init_work( lapack_int size, double *work );
00060 static int compare_dorgbr( double *a, double *a_i, lapack_int info,
00061 lapack_int info_i, lapack_int lda, lapack_int n );
00062
00063 int main(void)
00064 {
00065
00066 char vect, vect_i;
00067 lapack_int m, m_i;
00068 lapack_int n, n_i;
00069 lapack_int k, k_i;
00070 lapack_int lda, lda_i;
00071 lapack_int lda_r;
00072 lapack_int lwork, lwork_i;
00073 lapack_int info, info_i;
00074 lapack_int i;
00075 int failed;
00076
00077
00078 double *a = NULL, *a_i = NULL;
00079 double *tau = NULL, *tau_i = NULL;
00080 double *work = NULL, *work_i = NULL;
00081 double *a_save = NULL;
00082 double *a_r = NULL;
00083
00084
00085 init_scalars_dorgbr( &vect, &m, &n, &k, &lda, &lwork );
00086 lda_r = n+2;
00087 vect_i = vect;
00088 m_i = m;
00089 n_i = n;
00090 k_i = k;
00091 lda_i = lda;
00092 lwork_i = lwork;
00093
00094
00095 a = (double *)LAPACKE_malloc( lda*n * sizeof(double) );
00096 tau = (double *)LAPACKE_malloc( MIN(m,k) * sizeof(double) );
00097 work = (double *)LAPACKE_malloc( lwork * sizeof(double) );
00098
00099
00100 a_i = (double *)LAPACKE_malloc( lda*n * sizeof(double) );
00101 tau_i = (double *)LAPACKE_malloc( MIN(m,k) * sizeof(double) );
00102 work_i = (double *)LAPACKE_malloc( lwork * sizeof(double) );
00103
00104
00105 a_save = (double *)LAPACKE_malloc( lda*n * sizeof(double) );
00106
00107
00108 a_r = (double *)LAPACKE_malloc( m*(n+2) * sizeof(double) );
00109
00110
00111 init_a( lda*n, a );
00112 init_tau( (MIN(m,k)), tau );
00113 init_work( lwork, work );
00114
00115
00116 for( i = 0; i < lda*n; i++ ) {
00117 a_save[i] = a[i];
00118 }
00119
00120
00121 dorgbr_( &vect, &m, &n, &k, a, &lda, tau, work, &lwork, &info );
00122
00123
00124
00125 for( i = 0; i < lda*n; i++ ) {
00126 a_i[i] = a_save[i];
00127 }
00128 for( i = 0; i < (MIN(m,k)); i++ ) {
00129 tau_i[i] = tau[i];
00130 }
00131 for( i = 0; i < lwork; i++ ) {
00132 work_i[i] = work[i];
00133 }
00134 info_i = LAPACKE_dorgbr_work( LAPACK_COL_MAJOR, vect_i, m_i, n_i, k_i, a_i,
00135 lda_i, tau_i, work_i, lwork_i );
00136
00137 failed = compare_dorgbr( a, a_i, info, info_i, lda, n );
00138 if( failed == 0 ) {
00139 printf( "PASSED: column-major middle-level interface to dorgbr\n" );
00140 } else {
00141 printf( "FAILED: column-major middle-level interface to dorgbr\n" );
00142 }
00143
00144
00145
00146 for( i = 0; i < lda*n; i++ ) {
00147 a_i[i] = a_save[i];
00148 }
00149 for( i = 0; i < (MIN(m,k)); i++ ) {
00150 tau_i[i] = tau[i];
00151 }
00152 for( i = 0; i < lwork; i++ ) {
00153 work_i[i] = work[i];
00154 }
00155 info_i = LAPACKE_dorgbr( LAPACK_COL_MAJOR, vect_i, m_i, n_i, k_i, a_i,
00156 lda_i, tau_i );
00157
00158 failed = compare_dorgbr( a, a_i, info, info_i, lda, n );
00159 if( failed == 0 ) {
00160 printf( "PASSED: column-major high-level interface to dorgbr\n" );
00161 } else {
00162 printf( "FAILED: column-major high-level interface to dorgbr\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,k)); i++ ) {
00171 tau_i[i] = tau[i];
00172 }
00173 for( i = 0; i < lwork; i++ ) {
00174 work_i[i] = work[i];
00175 }
00176
00177 LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00178 info_i = LAPACKE_dorgbr_work( LAPACK_ROW_MAJOR, vect_i, m_i, n_i, k_i, a_r,
00179 lda_r, tau_i, work_i, lwork_i );
00180
00181 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00182
00183 failed = compare_dorgbr( a, a_i, info, info_i, lda, n );
00184 if( failed == 0 ) {
00185 printf( "PASSED: row-major middle-level interface to dorgbr\n" );
00186 } else {
00187 printf( "FAILED: row-major middle-level interface to dorgbr\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,k)); i++ ) {
00196 tau_i[i] = tau[i];
00197 }
00198 for( i = 0; i < lwork; i++ ) {
00199 work_i[i] = work[i];
00200 }
00201
00202
00203 LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00204 info_i = LAPACKE_dorgbr( LAPACK_ROW_MAJOR, vect_i, m_i, n_i, k_i, a_r,
00205 lda_r, tau_i );
00206
00207 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00208
00209 failed = compare_dorgbr( a, a_i, info, info_i, lda, n );
00210 if( failed == 0 ) {
00211 printf( "PASSED: row-major high-level interface to dorgbr\n" );
00212 } else {
00213 printf( "FAILED: row-major high-level interface to dorgbr\n" );
00214 }
00215
00216
00217 if( a != NULL ) {
00218 LAPACKE_free( a );
00219 }
00220 if( a_i != NULL ) {
00221 LAPACKE_free( a_i );
00222 }
00223 if( a_r != NULL ) {
00224 LAPACKE_free( a_r );
00225 }
00226 if( a_save != NULL ) {
00227 LAPACKE_free( a_save );
00228 }
00229 if( tau != NULL ) {
00230 LAPACKE_free( tau );
00231 }
00232 if( tau_i != NULL ) {
00233 LAPACKE_free( tau_i );
00234 }
00235 if( work != NULL ) {
00236 LAPACKE_free( work );
00237 }
00238 if( work_i != NULL ) {
00239 LAPACKE_free( work_i );
00240 }
00241
00242 return 0;
00243 }
00244
00245
00246 static void init_scalars_dorgbr( char *vect, lapack_int *m, lapack_int *n,
00247 lapack_int *k, lapack_int *lda,
00248 lapack_int *lwork )
00249 {
00250 *vect = 'Q';
00251 *m = 6;
00252 *n = 4;
00253 *k = 4;
00254 *lda = 8;
00255 *lwork = 1024;
00256
00257 return;
00258 }
00259
00260
00261 static void init_a( lapack_int size, double *a ) {
00262 lapack_int i;
00263 for( i = 0; i < size; i++ ) {
00264 a[i] = 0;
00265 }
00266 a[0] = 3.61767881382524030e+000;
00267 a[8] = 0.00000000000000000e+000;
00268 a[16] = 0.00000000000000000e+000;
00269 a[24] = 0.00000000000000000e+000;
00270 a[1] = 4.60875842155869410e-001;
00271 a[9] = 2.41605534042332650e+000;
00272 a[17] = 0.00000000000000000e+000;
00273 a[25] = 0.00000000000000000e+000;
00274 a[2] = -5.49230278216839230e-001;
00275 a[10] = 1.21928809265552730e-001;
00276 a[18] = -1.92131096370999990e+000;
00277 a[26] = 0.00000000000000000e+000;
00278 a[3] = 4.60875842155869410e-001;
00279 a[11] = 7.70112917732269920e-002;
00280 a[19] = 5.56935175390500460e-002;
00281 a[27] = -1.42650154173085970e+000;
00282 a[4] = -3.58193659706634230e-002;
00283 a[12] = 3.30854378427113740e-001;
00284 a[20] = -1.24792496939576000e-001;
00285 a[28] = -4.04757520874447770e-001;
00286 a[5] = 4.77591546275512370e-003;
00287 a[13] = 2.79580407643883260e-001;
00288 a[21] = 8.32208314889596350e-001;
00289 a[29] = 2.19584086632569590e-001;
00290 }
00291 static void init_tau( lapack_int size, double *tau ) {
00292 lapack_int i;
00293 for( i = 0; i < size; i++ ) {
00294 tau[i] = 0;
00295 }
00296 tau[0] = 1.15755959258232120e+000;
00297 tau[1] = 1.65504384863705360e+000;
00298 tau[2] = 1.16873929901327080e+000;
00299 tau[3] = 1.65010263144901390e+000;
00300 }
00301 static void init_work( lapack_int size, double *work ) {
00302 lapack_int i;
00303 for( i = 0; i < size; i++ ) {
00304 work[i] = 0;
00305 }
00306 }
00307
00308
00309
00310 static int compare_dorgbr( double *a, double *a_i, lapack_int info,
00311 lapack_int info_i, lapack_int lda, lapack_int n )
00312 {
00313 lapack_int i;
00314 int failed = 0;
00315 for( i = 0; i < lda*n; i++ ) {
00316 failed += compare_doubles(a[i],a_i[i]);
00317 }
00318 failed += (info == info_i) ? 0 : 1;
00319 if( info != 0 || info_i != 0 ) {
00320 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00321 }
00322
00323 return failed;
00324 }