sgebrd_1.c
Go to the documentation of this file.
00001 /*****************************************************************************
00002   Copyright (c) 2010, Intel Corp.
00003   All rights reserved.
00004 
00005   Redistribution and use in source and binary forms, with or without
00006   modification, are permitted provided that the following conditions are met:
00007 
00008     * Redistributions of source code must retain the above copyright notice,
00009       this list of conditions and the following disclaimer.
00010     * Redistributions in binary form must reproduce the above copyright
00011       notice, this list of conditions and the following disclaimer in the
00012       documentation and/or other materials provided with the distribution.
00013     * Neither the name of Intel Corporation nor the names of its contributors
00014       may be used to endorse or promote products derived from this software
00015       without specific prior written permission.
00016 
00017   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
00018   AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
00019   IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
00020   ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
00021   LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
00022   CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
00023   SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
00024   INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
00025   CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
00026   ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
00027   THE POSSIBILITY OF SUCH DAMAGE.
00028 *****************************************************************************/
00029 /*  Contents: test routine for C interface to LAPACK
00030 *   Author: Intel Corporation
00031 *   Created in March, 2010
00032 *
00033 * Purpose
00034 *
00035 * sgebrd_1 is the test program for the C interface to LAPACK
00036 * routine sgebrd
00037 * The program doesn't require an input, the input data is hardcoded in the
00038 * test program.
00039 * The program tests the C interface in the four combinations:
00040 *   1) column-major layout, middle-level interface
00041 *   2) column-major layout, high-level interface
00042 *   3) row-major layout, middle-level interface
00043 *   4) row-major layout, high-level interface
00044 * The output of the C interface function is compared to those obtained from
00045 * the corresponiding LAPACK routine with the same input data, and the
00046 * comparison diagnostics is then printed on the standard output having PASSED
00047 * keyword if the test is passed, and FAILED keyword if the test isn't passed.
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_sgebrd( lapack_int *m, lapack_int *n, lapack_int *lda,
00055                                  lapack_int *lwork );
00056 static void init_a( lapack_int size, float *a );
00057 static void init_d( lapack_int size, float *d );
00058 static void init_e( lapack_int size, float *e );
00059 static void init_tauq( lapack_int size, float *tauq );
00060 static void init_taup( lapack_int size, float *taup );
00061 static void init_work( lapack_int size, float *work );
00062 static int compare_sgebrd( float *a, float *a_i, float *d, float *d_i, float *e,
00063                            float *e_i, float *tauq, float *tauq_i, float *taup,
00064                            float *taup_i, lapack_int info, lapack_int info_i,
00065                            lapack_int lda, lapack_int m, lapack_int n );
00066 
00067 int main(void)
00068 {
00069     /* Local scalars */
00070     lapack_int m, m_i;
00071     lapack_int n, n_i;
00072     lapack_int lda, lda_i;
00073     lapack_int lda_r;
00074     lapack_int lwork, lwork_i;
00075     lapack_int info, info_i;
00076     lapack_int i;
00077     int failed;
00078 
00079     /* Local arrays */
00080     float *a = NULL, *a_i = NULL;
00081     float *d = NULL, *d_i = NULL;
00082     float *e = NULL, *e_i = NULL;
00083     float *tauq = NULL, *tauq_i = NULL;
00084     float *taup = NULL, *taup_i = NULL;
00085     float *work = NULL, *work_i = NULL;
00086     float *a_save = NULL;
00087     float *d_save = NULL;
00088     float *e_save = NULL;
00089     float *tauq_save = NULL;
00090     float *taup_save = NULL;
00091     float *a_r = NULL;
00092 
00093     /* Iniitialize the scalar parameters */
00094     init_scalars_sgebrd( &m, &n, &lda, &lwork );
00095     lda_r = n+2;
00096     m_i = m;
00097     n_i = n;
00098     lda_i = lda;
00099     lwork_i = lwork;
00100 
00101     /* Allocate memory for the LAPACK routine arrays */
00102     a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00103     d = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00104     e = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
00105     tauq = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00106     taup = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00107     work = (float *)LAPACKE_malloc( lwork * sizeof(float) );
00108 
00109     /* Allocate memory for the C interface function arrays */
00110     a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00111     d_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00112     e_i = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
00113     tauq_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00114     taup_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00115     work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) );
00116 
00117     /* Allocate memory for the backup arrays */
00118     a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00119     d_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00120     e_save = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
00121     tauq_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00122     taup_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00123 
00124     /* Allocate memory for the row-major arrays */
00125     a_r = (float *)LAPACKE_malloc( m*(n+2) * sizeof(float) );
00126 
00127     /* Initialize input arrays */
00128     init_a( lda*n, a );
00129     init_d( (MIN(m,n)), d );
00130     init_e( (MIN(m,n)-1), e );
00131     init_tauq( (MIN(m,n)), tauq );
00132     init_taup( (MIN(m,n)), taup );
00133     init_work( lwork, work );
00134 
00135     /* Backup the ouptut arrays */
00136     for( i = 0; i < lda*n; i++ ) {
00137         a_save[i] = a[i];
00138     }
00139     for( i = 0; i < (MIN(m,n)); i++ ) {
00140         d_save[i] = d[i];
00141     }
00142     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00143         e_save[i] = e[i];
00144     }
00145     for( i = 0; i < (MIN(m,n)); i++ ) {
00146         tauq_save[i] = tauq[i];
00147     }
00148     for( i = 0; i < (MIN(m,n)); i++ ) {
00149         taup_save[i] = taup[i];
00150     }
00151 
00152     /* Call the LAPACK routine */
00153     sgebrd_( &m, &n, a, &lda, d, e, tauq, taup, work, &lwork, &info );
00154 
00155     /* Initialize input data, call the column-major middle-level
00156      * interface to LAPACK routine and check the results */
00157     for( i = 0; i < lda*n; i++ ) {
00158         a_i[i] = a_save[i];
00159     }
00160     for( i = 0; i < (MIN(m,n)); i++ ) {
00161         d_i[i] = d_save[i];
00162     }
00163     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00164         e_i[i] = e_save[i];
00165     }
00166     for( i = 0; i < (MIN(m,n)); i++ ) {
00167         tauq_i[i] = tauq_save[i];
00168     }
00169     for( i = 0; i < (MIN(m,n)); i++ ) {
00170         taup_i[i] = taup_save[i];
00171     }
00172     for( i = 0; i < lwork; i++ ) {
00173         work_i[i] = work[i];
00174     }
00175     info_i = LAPACKE_sgebrd_work( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, d_i,
00176                                   e_i, tauq_i, taup_i, work_i, lwork_i );
00177 
00178     failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00179                              info, info_i, lda, m, n );
00180     if( failed == 0 ) {
00181         printf( "PASSED: column-major middle-level interface to sgebrd\n" );
00182     } else {
00183         printf( "FAILED: column-major middle-level interface to sgebrd\n" );
00184     }
00185 
00186     /* Initialize input data, call the column-major high-level
00187      * interface to LAPACK routine and check the results */
00188     for( i = 0; i < lda*n; i++ ) {
00189         a_i[i] = a_save[i];
00190     }
00191     for( i = 0; i < (MIN(m,n)); i++ ) {
00192         d_i[i] = d_save[i];
00193     }
00194     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00195         e_i[i] = e_save[i];
00196     }
00197     for( i = 0; i < (MIN(m,n)); i++ ) {
00198         tauq_i[i] = tauq_save[i];
00199     }
00200     for( i = 0; i < (MIN(m,n)); i++ ) {
00201         taup_i[i] = taup_save[i];
00202     }
00203     for( i = 0; i < lwork; i++ ) {
00204         work_i[i] = work[i];
00205     }
00206     info_i = LAPACKE_sgebrd( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, d_i, e_i,
00207                              tauq_i, taup_i );
00208 
00209     failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00210                              info, info_i, lda, m, n );
00211     if( failed == 0 ) {
00212         printf( "PASSED: column-major high-level interface to sgebrd\n" );
00213     } else {
00214         printf( "FAILED: column-major high-level interface to sgebrd\n" );
00215     }
00216 
00217     /* Initialize input data, call the row-major middle-level
00218      * interface to LAPACK routine and check the results */
00219     for( i = 0; i < lda*n; i++ ) {
00220         a_i[i] = a_save[i];
00221     }
00222     for( i = 0; i < (MIN(m,n)); i++ ) {
00223         d_i[i] = d_save[i];
00224     }
00225     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00226         e_i[i] = e_save[i];
00227     }
00228     for( i = 0; i < (MIN(m,n)); i++ ) {
00229         tauq_i[i] = tauq_save[i];
00230     }
00231     for( i = 0; i < (MIN(m,n)); i++ ) {
00232         taup_i[i] = taup_save[i];
00233     }
00234     for( i = 0; i < lwork; i++ ) {
00235         work_i[i] = work[i];
00236     }
00237 
00238     LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00239     info_i = LAPACKE_sgebrd_work( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, d_i,
00240                                   e_i, tauq_i, taup_i, work_i, lwork_i );
00241 
00242     LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00243 
00244     failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00245                              info, info_i, lda, m, n );
00246     if( failed == 0 ) {
00247         printf( "PASSED: row-major middle-level interface to sgebrd\n" );
00248     } else {
00249         printf( "FAILED: row-major middle-level interface to sgebrd\n" );
00250     }
00251 
00252     /* Initialize input data, call the row-major high-level
00253      * interface to LAPACK routine and check the results */
00254     for( i = 0; i < lda*n; i++ ) {
00255         a_i[i] = a_save[i];
00256     }
00257     for( i = 0; i < (MIN(m,n)); i++ ) {
00258         d_i[i] = d_save[i];
00259     }
00260     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00261         e_i[i] = e_save[i];
00262     }
00263     for( i = 0; i < (MIN(m,n)); i++ ) {
00264         tauq_i[i] = tauq_save[i];
00265     }
00266     for( i = 0; i < (MIN(m,n)); i++ ) {
00267         taup_i[i] = taup_save[i];
00268     }
00269     for( i = 0; i < lwork; i++ ) {
00270         work_i[i] = work[i];
00271     }
00272 
00273     /* Init row_major arrays */
00274     LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00275     info_i = LAPACKE_sgebrd( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, d_i, e_i,
00276                              tauq_i, taup_i );
00277 
00278     LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00279 
00280     failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00281                              info, info_i, lda, m, n );
00282     if( failed == 0 ) {
00283         printf( "PASSED: row-major high-level interface to sgebrd\n" );
00284     } else {
00285         printf( "FAILED: row-major high-level interface to sgebrd\n" );
00286     }
00287 
00288     /* Release memory */
00289     if( a != NULL ) {
00290         LAPACKE_free( a );
00291     }
00292     if( a_i != NULL ) {
00293         LAPACKE_free( a_i );
00294     }
00295     if( a_r != NULL ) {
00296         LAPACKE_free( a_r );
00297     }
00298     if( a_save != NULL ) {
00299         LAPACKE_free( a_save );
00300     }
00301     if( d != NULL ) {
00302         LAPACKE_free( d );
00303     }
00304     if( d_i != NULL ) {
00305         LAPACKE_free( d_i );
00306     }
00307     if( d_save != NULL ) {
00308         LAPACKE_free( d_save );
00309     }
00310     if( e != NULL ) {
00311         LAPACKE_free( e );
00312     }
00313     if( e_i != NULL ) {
00314         LAPACKE_free( e_i );
00315     }
00316     if( e_save != NULL ) {
00317         LAPACKE_free( e_save );
00318     }
00319     if( tauq != NULL ) {
00320         LAPACKE_free( tauq );
00321     }
00322     if( tauq_i != NULL ) {
00323         LAPACKE_free( tauq_i );
00324     }
00325     if( tauq_save != NULL ) {
00326         LAPACKE_free( tauq_save );
00327     }
00328     if( taup != NULL ) {
00329         LAPACKE_free( taup );
00330     }
00331     if( taup_i != NULL ) {
00332         LAPACKE_free( taup_i );
00333     }
00334     if( taup_save != NULL ) {
00335         LAPACKE_free( taup_save );
00336     }
00337     if( work != NULL ) {
00338         LAPACKE_free( work );
00339     }
00340     if( work_i != NULL ) {
00341         LAPACKE_free( work_i );
00342     }
00343 
00344     return 0;
00345 }
00346 
00347 /* Auxiliary function: sgebrd scalar parameters initialization */
00348 static void init_scalars_sgebrd( lapack_int *m, lapack_int *n, lapack_int *lda,
00349                                  lapack_int *lwork )
00350 {
00351     *m = 6;
00352     *n = 4;
00353     *lda = 8;
00354     *lwork = 1024;
00355 
00356     return;
00357 }
00358 
00359 /* Auxiliary functions: sgebrd array parameters initialization */
00360 static void init_a( lapack_int size, float *a ) {
00361     lapack_int i;
00362     for( i = 0; i < size; i++ ) {
00363         a[i] = 0;
00364     }
00365     a[0] = -5.699999928e-001;  /* a[0,0] */
00366     a[8] = -1.279999971e+000;  /* a[0,1] */
00367     a[16] = -3.899999857e-001;  /* a[0,2] */
00368     a[24] = 2.500000000e-001;  /* a[0,3] */
00369     a[1] = -1.929999948e+000;  /* a[1,0] */
00370     a[9] = 1.080000043e+000;  /* a[1,1] */
00371     a[17] = -3.100000024e-001;  /* a[1,2] */
00372     a[25] = -2.140000105e+000;  /* a[1,3] */
00373     a[2] = 2.299999952e+000;  /* a[2,0] */
00374     a[10] = 2.399999946e-001;  /* a[2,1] */
00375     a[18] = 4.000000060e-001;  /* a[2,2] */
00376     a[26] = -3.499999940e-001;  /* a[2,3] */
00377     a[3] = -1.929999948e+000;  /* a[3,0] */
00378     a[11] = 6.399999857e-001;  /* a[3,1] */
00379     a[19] = -6.600000262e-001;  /* a[3,2] */
00380     a[27] = 7.999999821e-002;  /* a[3,3] */
00381     a[4] = 1.500000060e-001;  /* a[4,0] */
00382     a[12] = 3.000000119e-001;  /* a[4,1] */
00383     a[20] = 1.500000060e-001;  /* a[4,2] */
00384     a[28] = -2.130000114e+000;  /* a[4,3] */
00385     a[5] = -1.999999955e-002;  /* a[5,0] */
00386     a[13] = 1.029999971e+000;  /* a[5,1] */
00387     a[21] = -1.429999948e+000;  /* a[5,2] */
00388     a[29] = 5.000000000e-001;  /* a[5,3] */
00389 }
00390 static void init_d( lapack_int size, float *d ) {
00391     lapack_int i;
00392     for( i = 0; i < size; i++ ) {
00393         d[i] = 0;
00394     }
00395 }
00396 static void init_e( lapack_int size, float *e ) {
00397     lapack_int i;
00398     for( i = 0; i < size; i++ ) {
00399         e[i] = 0;
00400     }
00401 }
00402 static void init_tauq( lapack_int size, float *tauq ) {
00403     lapack_int i;
00404     for( i = 0; i < size; i++ ) {
00405         tauq[i] = 0;
00406     }
00407 }
00408 static void init_taup( lapack_int size, float *taup ) {
00409     lapack_int i;
00410     for( i = 0; i < size; i++ ) {
00411         taup[i] = 0;
00412     }
00413 }
00414 static void init_work( lapack_int size, float *work ) {
00415     lapack_int i;
00416     for( i = 0; i < size; i++ ) {
00417         work[i] = 0;
00418     }
00419 }
00420 
00421 /* Auxiliary function: C interface to sgebrd results check */
00422 /* Return value: 0 - test is passed, non-zero - test is failed */
00423 static int compare_sgebrd( float *a, float *a_i, float *d, float *d_i, float *e,
00424                            float *e_i, float *tauq, float *tauq_i, float *taup,
00425                            float *taup_i, lapack_int info, lapack_int info_i,
00426                            lapack_int lda, lapack_int m, lapack_int n )
00427 {
00428     lapack_int i;
00429     int failed = 0;
00430     for( i = 0; i < lda*n; i++ ) {
00431         failed += compare_floats(a[i],a_i[i]);
00432     }
00433     for( i = 0; i < (MIN(m,n)); i++ ) {
00434         failed += compare_floats(d[i],d_i[i]);
00435     }
00436     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00437         failed += compare_floats(e[i],e_i[i]);
00438     }
00439     for( i = 0; i < (MIN(m,n)); i++ ) {
00440         failed += compare_floats(tauq[i],tauq_i[i]);
00441     }
00442     for( i = 0; i < (MIN(m,n)); i++ ) {
00443         failed += compare_floats(taup[i],taup_i[i]);
00444     }
00445     failed += (info == info_i) ? 0 : 1;
00446     if( info != 0 || info_i != 0 ) {
00447         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00448     }
00449 
00450     return failed;
00451 }


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:06