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_sorghr( lapack_int *n, lapack_int *ilo,
00055 lapack_int *ihi, lapack_int *lda,
00056 lapack_int *lwork );
00057 static void init_a( lapack_int size, float *a );
00058 static void init_tau( lapack_int size, float *tau );
00059 static void init_work( lapack_int size, float *work );
00060 static int compare_sorghr( float *a, float *a_i, lapack_int info,
00061 lapack_int info_i, lapack_int lda, lapack_int n );
00062
00063 int main(void)
00064 {
00065
00066 lapack_int n, n_i;
00067 lapack_int ilo, ilo_i;
00068 lapack_int ihi, ihi_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 float *a = NULL, *a_i = NULL;
00078 float *tau = NULL, *tau_i = NULL;
00079 float *work = NULL, *work_i = NULL;
00080 float *a_save = NULL;
00081 float *a_r = NULL;
00082
00083
00084 init_scalars_sorghr( &n, &ilo, &ihi, &lda, &lwork );
00085 lda_r = n+2;
00086 n_i = n;
00087 ilo_i = ilo;
00088 ihi_i = ihi;
00089 lda_i = lda;
00090 lwork_i = lwork;
00091
00092
00093 a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00094 tau = (float *)LAPACKE_malloc( (n-1) * sizeof(float) );
00095 work = (float *)LAPACKE_malloc( lwork * sizeof(float) );
00096
00097
00098 a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00099 tau_i = (float *)LAPACKE_malloc( (n-1) * sizeof(float) );
00100 work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) );
00101
00102
00103 a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00104
00105
00106 a_r = (float *)LAPACKE_malloc( n*(n+2) * sizeof(float) );
00107
00108
00109 init_a( lda*n, a );
00110 init_tau( (n-1), tau );
00111 init_work( lwork, work );
00112
00113
00114 for( i = 0; i < lda*n; i++ ) {
00115 a_save[i] = a[i];
00116 }
00117
00118
00119 sorghr_( &n, &ilo, &ihi, a, &lda, tau, work, &lwork, &info );
00120
00121
00122
00123 for( i = 0; i < lda*n; i++ ) {
00124 a_i[i] = a_save[i];
00125 }
00126 for( i = 0; i < (n-1); i++ ) {
00127 tau_i[i] = tau[i];
00128 }
00129 for( i = 0; i < lwork; i++ ) {
00130 work_i[i] = work[i];
00131 }
00132 info_i = LAPACKE_sorghr_work( LAPACK_COL_MAJOR, n_i, ilo_i, ihi_i, a_i,
00133 lda_i, tau_i, work_i, lwork_i );
00134
00135 failed = compare_sorghr( a, a_i, info, info_i, lda, n );
00136 if( failed == 0 ) {
00137 printf( "PASSED: column-major middle-level interface to sorghr\n" );
00138 } else {
00139 printf( "FAILED: column-major middle-level interface to sorghr\n" );
00140 }
00141
00142
00143
00144 for( i = 0; i < lda*n; i++ ) {
00145 a_i[i] = a_save[i];
00146 }
00147 for( i = 0; i < (n-1); i++ ) {
00148 tau_i[i] = tau[i];
00149 }
00150 for( i = 0; i < lwork; i++ ) {
00151 work_i[i] = work[i];
00152 }
00153 info_i = LAPACKE_sorghr( LAPACK_COL_MAJOR, n_i, ilo_i, ihi_i, a_i, lda_i,
00154 tau_i );
00155
00156 failed = compare_sorghr( a, a_i, info, info_i, lda, n );
00157 if( failed == 0 ) {
00158 printf( "PASSED: column-major high-level interface to sorghr\n" );
00159 } else {
00160 printf( "FAILED: column-major high-level interface to sorghr\n" );
00161 }
00162
00163
00164
00165 for( i = 0; i < lda*n; i++ ) {
00166 a_i[i] = a_save[i];
00167 }
00168 for( i = 0; i < (n-1); i++ ) {
00169 tau_i[i] = tau[i];
00170 }
00171 for( i = 0; i < lwork; i++ ) {
00172 work_i[i] = work[i];
00173 }
00174
00175 LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
00176 info_i = LAPACKE_sorghr_work( LAPACK_ROW_MAJOR, n_i, ilo_i, ihi_i, a_r,
00177 lda_r, tau_i, work_i, lwork_i );
00178
00179 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
00180
00181 failed = compare_sorghr( a, a_i, info, info_i, lda, n );
00182 if( failed == 0 ) {
00183 printf( "PASSED: row-major middle-level interface to sorghr\n" );
00184 } else {
00185 printf( "FAILED: row-major middle-level interface to sorghr\n" );
00186 }
00187
00188
00189
00190 for( i = 0; i < lda*n; i++ ) {
00191 a_i[i] = a_save[i];
00192 }
00193 for( i = 0; i < (n-1); i++ ) {
00194 tau_i[i] = tau[i];
00195 }
00196 for( i = 0; i < lwork; i++ ) {
00197 work_i[i] = work[i];
00198 }
00199
00200
00201 LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
00202 info_i = LAPACKE_sorghr( LAPACK_ROW_MAJOR, n_i, ilo_i, ihi_i, a_r, lda_r,
00203 tau_i );
00204
00205 LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
00206
00207 failed = compare_sorghr( a, a_i, info, info_i, lda, n );
00208 if( failed == 0 ) {
00209 printf( "PASSED: row-major high-level interface to sorghr\n" );
00210 } else {
00211 printf( "FAILED: row-major high-level interface to sorghr\n" );
00212 }
00213
00214
00215 if( a != NULL ) {
00216 LAPACKE_free( a );
00217 }
00218 if( a_i != NULL ) {
00219 LAPACKE_free( a_i );
00220 }
00221 if( a_r != NULL ) {
00222 LAPACKE_free( a_r );
00223 }
00224 if( a_save != NULL ) {
00225 LAPACKE_free( a_save );
00226 }
00227 if( tau != NULL ) {
00228 LAPACKE_free( tau );
00229 }
00230 if( tau_i != NULL ) {
00231 LAPACKE_free( tau_i );
00232 }
00233 if( work != NULL ) {
00234 LAPACKE_free( work );
00235 }
00236 if( work_i != NULL ) {
00237 LAPACKE_free( work_i );
00238 }
00239
00240 return 0;
00241 }
00242
00243
00244 static void init_scalars_sorghr( lapack_int *n, lapack_int *ilo,
00245 lapack_int *ihi, lapack_int *lda,
00246 lapack_int *lwork )
00247 {
00248 *n = 4;
00249 *ilo = 1;
00250 *ihi = 4;
00251 *lda = 8;
00252 *lwork = 512;
00253
00254 return;
00255 }
00256
00257
00258 static void init_a( lapack_int size, float *a ) {
00259 lapack_int i;
00260 for( i = 0; i < size; i++ ) {
00261 a[i] = 0;
00262 }
00263 a[0] = -4.000000060e-001;
00264 a[8] = 3.200000048e+000;
00265 a[16] = -9.225028753e-001;
00266 a[24] = -7.691487312e+000;
00267 a[1] = 0.000000000e+000;
00268 a[9] = 2.000000030e-001;
00269 a[17] = -4.382602215e+000;
00270 a[25] = 4.674933255e-001;
00271 a[2] = 0.000000000e+000;
00272 a[10] = -2.944163799e+000;
00273 a[18] = -8.932390213e-001;
00274 a[26] = -6.791973114e-001;
00275 a[3] = 0.000000000e+000;
00276 a[11] = 7.264869809e-001;
00277 a[19] = -2.139196396e+000;
00278 a[27] = 6.693238735e+000;
00279 }
00280 static void init_tau( lapack_int size, float *tau ) {
00281 lapack_int i;
00282 for( i = 0; i < size; i++ ) {
00283 tau[i] = 0;
00284 }
00285 tau[0] = 0.000000000e+000;
00286 tau[1] = 1.309086084e+000;
00287 tau[2] = 0.000000000e+000;
00288 }
00289 static void init_work( lapack_int size, float *work ) {
00290 lapack_int i;
00291 for( i = 0; i < size; i++ ) {
00292 work[i] = 0;
00293 }
00294 }
00295
00296
00297
00298 static int compare_sorghr( float *a, float *a_i, lapack_int info,
00299 lapack_int info_i, lapack_int lda, lapack_int n )
00300 {
00301 lapack_int i;
00302 int failed = 0;
00303 for( i = 0; i < lda*n; i++ ) {
00304 failed += compare_floats(a[i],a_i[i]);
00305 }
00306 failed += (info == info_i) ? 0 : 1;
00307 if( info != 0 || info_i != 0 ) {
00308 printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00309 }
00310
00311 return failed;
00312 }