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_dtrexc( char *compq, lapack_int *n, lapack_int *ldt,
00055 lapack_int *ldq, lapack_int *ifst,
00056 lapack_int *ilst );
00057 static void init_t( lapack_int size, double *t );
00058 static void init_q( lapack_int size, double *q );
00059 static void init_work( lapack_int size, double *work );
00060 static int compare_dtrexc( double *t, double *t_i, double *q, double *q_i,
00061 lapack_int ifst, lapack_int ifst_i, lapack_int ilst,
00062 lapack_int ilst_i, lapack_int info,
00063 lapack_int info_i, char compq, lapack_int ldq,
00064 lapack_int ldt, lapack_int n );
00065
00066 int main(void)
00067 {
00068
00069 char compq, compq_i;
00070 lapack_int n, n_i;
00071 lapack_int ldt, ldt_i;
00072 lapack_int ldt_r;
00073 lapack_int ldq, ldq_i;
00074 lapack_int ldq_r;
00075 lapack_int ifst, ifst_i, ifst_save;
00076 lapack_int ilst, ilst_i, ilst_save;
00077 lapack_int info, info_i;
00078 lapack_int i;
00079 int failed;
00080
00081
00082 double *t = NULL, *t_i = NULL;
00083 double *q = NULL, *q_i = NULL;
00084 double *work = NULL, *work_i = NULL;
00085 double *t_save = NULL;
00086 double *q_save = NULL;
00087 double *t_r = NULL;
00088 double *q_r = NULL;
00089
00090
00091 init_scalars_dtrexc( &compq, &n, &ldt, &ldq, &ifst, &ilst );
00092 ldt_r = n+2;
00093 ldq_r = n+2;
00094 compq_i = compq;
00095 n_i = n;
00096 ldt_i = ldt;
00097 ldq_i = ldq;
00098 ifst_i = ifst_save = ifst;
00099 ilst_i = ilst_save = ilst;
00100
00101
00102 t = (double *)LAPACKE_malloc( ldt*n * sizeof(double) );
00103 q = (double *)LAPACKE_malloc( ldq*n * sizeof(double) );
00104 work = (double *)LAPACKE_malloc( n * sizeof(double) );
00105
00106
00107 t_i = (double *)LAPACKE_malloc( ldt*n * sizeof(double) );
00108 q_i = (double *)LAPACKE_malloc( ldq*n * sizeof(double) );
00109 work_i = (double *)LAPACKE_malloc( n * sizeof(double) );
00110
00111
00112 t_save = (double *)LAPACKE_malloc( ldt*n * sizeof(double) );
00113 q_save = (double *)LAPACKE_malloc( ldq*n * sizeof(double) );
00114
00115
00116 t_r = (double *)LAPACKE_malloc( n*(n+2) * sizeof(double) );
00117 q_r = (double *)LAPACKE_malloc( n*(n+2) * sizeof(double) );
00118
00119
00120 init_t( ldt*n, t );
00121 init_q( ldq*n, q );
00122 init_work( n, work );
00123
00124
00125 for( i = 0; i < ldt*n; i++ ) {
00126 t_save[i] = t[i];
00127 }
00128 for( i = 0; i < ldq*n; i++ ) {
00129 q_save[i] = q[i];
00130 }
00131
00132
00133 dtrexc_( &compq, &n, t, &ldt, q, &ldq, &ifst, &ilst, work, &info );
00134
00135
00136
00137 ifst_i = ifst_save;
00138 ilst_i = ilst_save;
00139 for( i = 0; i < ldt*n; i++ ) {
00140 t_i[i] = t_save[i];
00141 }
00142 for( i = 0; i < ldq*n; i++ ) {
00143 q_i[i] = q_save[i];
00144 }
00145 for( i = 0; i < n; i++ ) {
00146 work_i[i] = work[i];
00147 }
00148 info_i = LAPACKE_dtrexc_work( LAPACK_COL_MAJOR, compq_i, n_i, t_i, ldt_i,
00149 q_i, ldq_i, &ifst_i, &ilst_i, work_i );
00150
00151 failed = compare_dtrexc( t, t_i, q, q_i, ifst, ifst_i, ilst, ilst_i, info,
00152 info_i, compq, ldq, ldt, n );
00153 if( failed == 0 ) {
00154 printf( "PASSED: column-major middle-level interface to dtrexc\n" );
00155 } else {
00156 printf( "FAILED: column-major middle-level interface to dtrexc\n" );
00157 }
00158
00159
00160
00161 ifst_i = ifst_save;
00162 ilst_i = ilst_save;
00163 for( i = 0; i < ldt*n; i++ ) {
00164 t_i[i] = t_save[i];
00165 }
00166 for( i = 0; i < ldq*n; i++ ) {
00167 q_i[i] = q_save[i];
00168 }
00169 for( i = 0; i < n; i++ ) {
00170 work_i[i] = work[i];
00171 }
00172 info_i = LAPACKE_dtrexc( LAPACK_COL_MAJOR, compq_i, n_i, t_i, ldt_i, q_i,
00173 ldq_i, &ifst_i, &ilst_i );
00174
00175 failed = compare_dtrexc( t, t_i, q, q_i, ifst, ifst_i, ilst, ilst_i, info,
00176 info_i, compq, ldq, ldt, n );
00177 if( failed == 0 ) {
00178 printf( "PASSED: column-major high-level interface to dtrexc\n" );
00179 } else {
00180 printf( "FAILED: column-major high-level interface to dtrexc\n" );
00181 }
00182
00183
00184
00185 ifst_i = ifst_save;
00186 ilst_i = ilst_save;
00187 for( i = 0; i < ldt*n; i++ ) {
00188 t_i[i] = t_save[i];
00189 }
00190 for( i = 0; i < ldq*n; i++ ) {
00191 q_i[i] = q_save[i];
00192 }
00193 for( i = 0; i < n; i++ ) {
00194 work_i[i] = work[i];
00195 }
00196
00197 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
00198 if( LAPACKE_lsame( compq, 'v' ) ) {
00199 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_i, ldq, q_r, n+2 );
00200 }
00201 info_i = LAPACKE_dtrexc_work( LAPACK_ROW_MAJOR, compq_i, n_i, t_r, ldt_r,
00202 q_r, ldq_r, &ifst_i, &ilst_i, work_i );
00203
00204 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, t_r, n+2, t_i, ldt );
00205 if( LAPACKE_lsame( compq, 'v' ) ) {
00206 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, q_r, n+2, q_i, ldq );
00207 }
00208
00209 failed = compare_dtrexc( t, t_i, q, q_i, ifst, ifst_i, ilst, ilst_i, info,
00210 info_i, compq, ldq, ldt, n );
00211 if( failed == 0 ) {
00212 printf( "PASSED: row-major middle-level interface to dtrexc\n" );
00213 } else {
00214 printf( "FAILED: row-major middle-level interface to dtrexc\n" );
00215 }
00216
00217
00218
00219 ifst_i = ifst_save;
00220 ilst_i = ilst_save;
00221 for( i = 0; i < ldt*n; i++ ) {
00222 t_i[i] = t_save[i];
00223 }
00224 for( i = 0; i < ldq*n; i++ ) {
00225 q_i[i] = q_save[i];
00226 }
00227 for( i = 0; i < n; i++ ) {
00228 work_i[i] = work[i];
00229 }
00230
00231
00232 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
00233 if( LAPACKE_lsame( compq, 'v' ) ) {
00234 LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_i, ldq, q_r, n+2 );
00235 }
00236 info_i = LAPACKE_dtrexc( LAPACK_ROW_MAJOR, compq_i, n_i, t_r, ldt_r, q_r,
00237 ldq_r, &ifst_i, &ilst_i );
00238
00239 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, t_r, n+2, t_i, ldt );
00240 if( LAPACKE_lsame( compq, 'v' ) ) {
00241 LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, q_r, n+2, q_i, ldq );
00242 }
00243
00244 failed = compare_dtrexc( t, t_i, q, q_i, ifst, ifst_i, ilst, ilst_i, info,
00245 info_i, compq, ldq, ldt, n );
00246 if( failed == 0 ) {
00247 printf( "PASSED: row-major high-level interface to dtrexc\n" );
00248 } else {
00249 printf( "FAILED: row-major high-level interface to dtrexc\n" );
00250 }
00251
00252
00253 if( t != NULL ) {
00254 LAPACKE_free( t );
00255 }
00256 if( t_i != NULL ) {
00257 LAPACKE_free( t_i );
00258 }
00259 if( t_r != NULL ) {
00260 LAPACKE_free( t_r );
00261 }
00262 if( t_save != NULL ) {
00263 LAPACKE_free( t_save );
00264 }
00265 if( q != NULL ) {
00266 LAPACKE_free( q );
00267 }
00268 if( q_i != NULL ) {
00269 LAPACKE_free( q_i );
00270 }
00271 if( q_r != NULL ) {
00272 LAPACKE_free( q_r );
00273 }
00274 if( q_save != NULL ) {
00275 LAPACKE_free( q_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_dtrexc( char *compq, lapack_int *n, lapack_int *ldt,
00289 lapack_int *ldq, lapack_int *ifst,
00290 lapack_int *ilst )
00291 {
00292 *compq = 'N';
00293 *n = 4;
00294 *ldt = 8;
00295 *ldq = 1;
00296 *ifst = 2;
00297 *ilst = 1;
00298
00299 return;
00300 }
00301
00302
00303 static void init_t( lapack_int size, double *t ) {
00304 lapack_int i;
00305 for( i = 0; i < size; i++ ) {
00306 t[i] = 0;
00307 }
00308 t[0] = 8.00000000000000040e-001;
00309 t[8] = -1.10000000000000000e-001;
00310 t[16] = 1.00000000000000000e-002;
00311 t[24] = 2.99999999999999990e-002;
00312 t[1] = 0.00000000000000000e+000;
00313 t[9] = -1.00000000000000010e-001;
00314 t[17] = 2.50000000000000000e-001;
00315 t[25] = 3.49999999999999980e-001;
00316 t[2] = 0.00000000000000000e+000;
00317 t[10] = -6.50000000000000020e-001;
00318 t[18] = -1.00000000000000010e-001;
00319 t[26] = 2.00000000000000010e-001;
00320 t[3] = 0.00000000000000000e+000;
00321 t[11] = 0.00000000000000000e+000;
00322 t[19] = 0.00000000000000000e+000;
00323 t[27] = -1.00000000000000010e-001;
00324 }
00325 static void init_q( lapack_int size, double *q ) {
00326 lapack_int i;
00327 for( i = 0; i < size; i++ ) {
00328 q[i] = 0;
00329 }
00330 q[0] = 0.00000000000000000e+000;
00331 q[1] = 0.00000000000000000e+000;
00332 q[2] = 0.00000000000000000e+000;
00333 q[3] = 0.00000000000000000e+000;
00334 q[1] = 0.00000000000000000e+000;
00335 q[2] = 0.00000000000000000e+000;
00336 q[3] = 0.00000000000000000e+000;
00337 q[2] = 0.00000000000000000e+000;
00338 q[3] = 0.00000000000000000e+000;
00339 q[3] = 0.00000000000000000e+000;
00340 }
00341 static void init_work( lapack_int size, double *work ) {
00342 lapack_int i;
00343 for( i = 0; i < size; i++ ) {
00344 work[i] = 0;
00345 }
00346 }
00347
00348
00349
00350 static int compare_dtrexc( double *t, double *t_i, double *q, double *q_i,
00351 lapack_int ifst, lapack_int ifst_i, lapack_int ilst,
00352 lapack_int ilst_i, lapack_int info,
00353 lapack_int info_i, char compq, lapack_int ldq,
00354 lapack_int ldt, lapack_int n )
00355 {
00356 lapack_int i;
00357 int failed = 0;
00358 for( i = 0; i < ldt*n; i++ ) {
00359 failed += compare_doubles(t[i],t_i[i]);
00360 }
00361 if( LAPACKE_lsame( compq, 'v' ) ) {
00362 for( i = 0; i < ldq*n; i++ ) {
00363 failed += compare_doubles(q[i],q_i[i]);
00364 }
00365 }
00366 failed += (ifst == ifst_i) ? 0 : 1;
00367 failed += (ilst == ilst_i) ? 0 : 1;
00368 failed += (info == info_i) ? 0 : 1;
00369 if( info != 0 || info_i != 0 ) {
00370 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00371 }
00372
00373 return failed;
00374 }