dgebrd_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 * dgebrd_1 is the test program for the C interface to LAPACK
00036 * routine dgebrd
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_dgebrd( lapack_int *m, lapack_int *n, lapack_int *lda,
00055                                  lapack_int *lwork );
00056 static void init_a( lapack_int size, double *a );
00057 static void init_d( lapack_int size, double *d );
00058 static void init_e( lapack_int size, double *e );
00059 static void init_tauq( lapack_int size, double *tauq );
00060 static void init_taup( lapack_int size, double *taup );
00061 static void init_work( lapack_int size, double *work );
00062 static int compare_dgebrd( double *a, double *a_i, double *d, double *d_i,
00063                            double *e, double *e_i, double *tauq, double *tauq_i,
00064                            double *taup, double *taup_i, lapack_int info,
00065                            lapack_int info_i, lapack_int lda, lapack_int m,
00066                            lapack_int n );
00067 
00068 int main(void)
00069 {
00070     /* Local scalars */
00071     lapack_int m, m_i;
00072     lapack_int n, n_i;
00073     lapack_int lda, lda_i;
00074     lapack_int lda_r;
00075     lapack_int lwork, lwork_i;
00076     lapack_int info, info_i;
00077     lapack_int i;
00078     int failed;
00079 
00080     /* Local arrays */
00081     double *a = NULL, *a_i = NULL;
00082     double *d = NULL, *d_i = NULL;
00083     double *e = NULL, *e_i = NULL;
00084     double *tauq = NULL, *tauq_i = NULL;
00085     double *taup = NULL, *taup_i = NULL;
00086     double *work = NULL, *work_i = NULL;
00087     double *a_save = NULL;
00088     double *d_save = NULL;
00089     double *e_save = NULL;
00090     double *tauq_save = NULL;
00091     double *taup_save = NULL;
00092     double *a_r = NULL;
00093 
00094     /* Iniitialize the scalar parameters */
00095     init_scalars_dgebrd( &m, &n, &lda, &lwork );
00096     lda_r = n+2;
00097     m_i = m;
00098     n_i = n;
00099     lda_i = lda;
00100     lwork_i = lwork;
00101 
00102     /* Allocate memory for the LAPACK routine arrays */
00103     a = (double *)LAPACKE_malloc( lda*n * sizeof(double) );
00104     d = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00105     e = (double *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(double) );
00106     tauq = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00107     taup = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00108     work = (double *)LAPACKE_malloc( lwork * sizeof(double) );
00109 
00110     /* Allocate memory for the C interface function arrays */
00111     a_i = (double *)LAPACKE_malloc( lda*n * sizeof(double) );
00112     d_i = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00113     e_i = (double *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(double) );
00114     tauq_i = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00115     taup_i = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00116     work_i = (double *)LAPACKE_malloc( lwork * sizeof(double) );
00117 
00118     /* Allocate memory for the backup arrays */
00119     a_save = (double *)LAPACKE_malloc( lda*n * sizeof(double) );
00120     d_save = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00121     e_save = (double *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(double) );
00122     tauq_save = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00123     taup_save = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00124 
00125     /* Allocate memory for the row-major arrays */
00126     a_r = (double *)LAPACKE_malloc( m*(n+2) * sizeof(double) );
00127 
00128     /* Initialize input arrays */
00129     init_a( lda*n, a );
00130     init_d( (MIN(m,n)), d );
00131     init_e( (MIN(m,n)-1), e );
00132     init_tauq( (MIN(m,n)), tauq );
00133     init_taup( (MIN(m,n)), taup );
00134     init_work( lwork, work );
00135 
00136     /* Backup the ouptut arrays */
00137     for( i = 0; i < lda*n; i++ ) {
00138         a_save[i] = a[i];
00139     }
00140     for( i = 0; i < (MIN(m,n)); i++ ) {
00141         d_save[i] = d[i];
00142     }
00143     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00144         e_save[i] = e[i];
00145     }
00146     for( i = 0; i < (MIN(m,n)); i++ ) {
00147         tauq_save[i] = tauq[i];
00148     }
00149     for( i = 0; i < (MIN(m,n)); i++ ) {
00150         taup_save[i] = taup[i];
00151     }
00152 
00153     /* Call the LAPACK routine */
00154     dgebrd_( &m, &n, a, &lda, d, e, tauq, taup, work, &lwork, &info );
00155 
00156     /* Initialize input data, call the column-major middle-level
00157      * interface to LAPACK routine and check the results */
00158     for( i = 0; i < lda*n; i++ ) {
00159         a_i[i] = a_save[i];
00160     }
00161     for( i = 0; i < (MIN(m,n)); i++ ) {
00162         d_i[i] = d_save[i];
00163     }
00164     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00165         e_i[i] = e_save[i];
00166     }
00167     for( i = 0; i < (MIN(m,n)); i++ ) {
00168         tauq_i[i] = tauq_save[i];
00169     }
00170     for( i = 0; i < (MIN(m,n)); i++ ) {
00171         taup_i[i] = taup_save[i];
00172     }
00173     for( i = 0; i < lwork; i++ ) {
00174         work_i[i] = work[i];
00175     }
00176     info_i = LAPACKE_dgebrd_work( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, d_i,
00177                                   e_i, tauq_i, taup_i, work_i, lwork_i );
00178 
00179     failed = compare_dgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00180                              info, info_i, lda, m, n );
00181     if( failed == 0 ) {
00182         printf( "PASSED: column-major middle-level interface to dgebrd\n" );
00183     } else {
00184         printf( "FAILED: column-major middle-level interface to dgebrd\n" );
00185     }
00186 
00187     /* Initialize input data, call the column-major high-level
00188      * interface to LAPACK routine and check the results */
00189     for( i = 0; i < lda*n; i++ ) {
00190         a_i[i] = a_save[i];
00191     }
00192     for( i = 0; i < (MIN(m,n)); i++ ) {
00193         d_i[i] = d_save[i];
00194     }
00195     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00196         e_i[i] = e_save[i];
00197     }
00198     for( i = 0; i < (MIN(m,n)); i++ ) {
00199         tauq_i[i] = tauq_save[i];
00200     }
00201     for( i = 0; i < (MIN(m,n)); i++ ) {
00202         taup_i[i] = taup_save[i];
00203     }
00204     for( i = 0; i < lwork; i++ ) {
00205         work_i[i] = work[i];
00206     }
00207     info_i = LAPACKE_dgebrd( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, d_i, e_i,
00208                              tauq_i, taup_i );
00209 
00210     failed = compare_dgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00211                              info, info_i, lda, m, n );
00212     if( failed == 0 ) {
00213         printf( "PASSED: column-major high-level interface to dgebrd\n" );
00214     } else {
00215         printf( "FAILED: column-major high-level interface to dgebrd\n" );
00216     }
00217 
00218     /* Initialize input data, call the row-major middle-level
00219      * interface to LAPACK routine and check the results */
00220     for( i = 0; i < lda*n; i++ ) {
00221         a_i[i] = a_save[i];
00222     }
00223     for( i = 0; i < (MIN(m,n)); i++ ) {
00224         d_i[i] = d_save[i];
00225     }
00226     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00227         e_i[i] = e_save[i];
00228     }
00229     for( i = 0; i < (MIN(m,n)); i++ ) {
00230         tauq_i[i] = tauq_save[i];
00231     }
00232     for( i = 0; i < (MIN(m,n)); i++ ) {
00233         taup_i[i] = taup_save[i];
00234     }
00235     for( i = 0; i < lwork; i++ ) {
00236         work_i[i] = work[i];
00237     }
00238 
00239     LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00240     info_i = LAPACKE_dgebrd_work( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, d_i,
00241                                   e_i, tauq_i, taup_i, work_i, lwork_i );
00242 
00243     LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00244 
00245     failed = compare_dgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00246                              info, info_i, lda, m, n );
00247     if( failed == 0 ) {
00248         printf( "PASSED: row-major middle-level interface to dgebrd\n" );
00249     } else {
00250         printf( "FAILED: row-major middle-level interface to dgebrd\n" );
00251     }
00252 
00253     /* Initialize input data, call the row-major high-level
00254      * interface to LAPACK routine and check the results */
00255     for( i = 0; i < lda*n; i++ ) {
00256         a_i[i] = a_save[i];
00257     }
00258     for( i = 0; i < (MIN(m,n)); i++ ) {
00259         d_i[i] = d_save[i];
00260     }
00261     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00262         e_i[i] = e_save[i];
00263     }
00264     for( i = 0; i < (MIN(m,n)); i++ ) {
00265         tauq_i[i] = tauq_save[i];
00266     }
00267     for( i = 0; i < (MIN(m,n)); i++ ) {
00268         taup_i[i] = taup_save[i];
00269     }
00270     for( i = 0; i < lwork; i++ ) {
00271         work_i[i] = work[i];
00272     }
00273 
00274     /* Init row_major arrays */
00275     LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00276     info_i = LAPACKE_dgebrd( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, d_i, e_i,
00277                              tauq_i, taup_i );
00278 
00279     LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00280 
00281     failed = compare_dgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
00282                              info, info_i, lda, m, n );
00283     if( failed == 0 ) {
00284         printf( "PASSED: row-major high-level interface to dgebrd\n" );
00285     } else {
00286         printf( "FAILED: row-major high-level interface to dgebrd\n" );
00287     }
00288 
00289     /* Release memory */
00290     if( a != NULL ) {
00291         LAPACKE_free( a );
00292     }
00293     if( a_i != NULL ) {
00294         LAPACKE_free( a_i );
00295     }
00296     if( a_r != NULL ) {
00297         LAPACKE_free( a_r );
00298     }
00299     if( a_save != NULL ) {
00300         LAPACKE_free( a_save );
00301     }
00302     if( d != NULL ) {
00303         LAPACKE_free( d );
00304     }
00305     if( d_i != NULL ) {
00306         LAPACKE_free( d_i );
00307     }
00308     if( d_save != NULL ) {
00309         LAPACKE_free( d_save );
00310     }
00311     if( e != NULL ) {
00312         LAPACKE_free( e );
00313     }
00314     if( e_i != NULL ) {
00315         LAPACKE_free( e_i );
00316     }
00317     if( e_save != NULL ) {
00318         LAPACKE_free( e_save );
00319     }
00320     if( tauq != NULL ) {
00321         LAPACKE_free( tauq );
00322     }
00323     if( tauq_i != NULL ) {
00324         LAPACKE_free( tauq_i );
00325     }
00326     if( tauq_save != NULL ) {
00327         LAPACKE_free( tauq_save );
00328     }
00329     if( taup != NULL ) {
00330         LAPACKE_free( taup );
00331     }
00332     if( taup_i != NULL ) {
00333         LAPACKE_free( taup_i );
00334     }
00335     if( taup_save != NULL ) {
00336         LAPACKE_free( taup_save );
00337     }
00338     if( work != NULL ) {
00339         LAPACKE_free( work );
00340     }
00341     if( work_i != NULL ) {
00342         LAPACKE_free( work_i );
00343     }
00344 
00345     return 0;
00346 }
00347 
00348 /* Auxiliary function: dgebrd scalar parameters initialization */
00349 static void init_scalars_dgebrd( lapack_int *m, lapack_int *n, lapack_int *lda,
00350                                  lapack_int *lwork )
00351 {
00352     *m = 6;
00353     *n = 4;
00354     *lda = 8;
00355     *lwork = 1024;
00356 
00357     return;
00358 }
00359 
00360 /* Auxiliary functions: dgebrd array parameters initialization */
00361 static void init_a( lapack_int size, double *a ) {
00362     lapack_int i;
00363     for( i = 0; i < size; i++ ) {
00364         a[i] = 0;
00365     }
00366     a[0] = -5.69999999999999950e-001;  /* a[0,0] */
00367     a[8] = -1.28000000000000000e+000;  /* a[0,1] */
00368     a[16] = -3.90000000000000010e-001;  /* a[0,2] */
00369     a[24] = 2.50000000000000000e-001;  /* a[0,3] */
00370     a[1] = -1.92999999999999990e+000;  /* a[1,0] */
00371     a[9] = 1.08000000000000010e+000;  /* a[1,1] */
00372     a[17] = -3.10000000000000000e-001;  /* a[1,2] */
00373     a[25] = -2.14000000000000010e+000;  /* a[1,3] */
00374     a[2] = 2.29999999999999980e+000;  /* a[2,0] */
00375     a[10] = 2.39999999999999990e-001;  /* a[2,1] */
00376     a[18] = 4.00000000000000020e-001;  /* a[2,2] */
00377     a[26] = -3.49999999999999980e-001;  /* a[2,3] */
00378     a[3] = -1.92999999999999990e+000;  /* a[3,0] */
00379     a[11] = 6.40000000000000010e-001;  /* a[3,1] */
00380     a[19] = -6.60000000000000030e-001;  /* a[3,2] */
00381     a[27] = 8.00000000000000020e-002;  /* a[3,3] */
00382     a[4] = 1.49999999999999990e-001;  /* a[4,0] */
00383     a[12] = 2.99999999999999990e-001;  /* a[4,1] */
00384     a[20] = 1.49999999999999990e-001;  /* a[4,2] */
00385     a[28] = -2.12999999999999990e+000;  /* a[4,3] */
00386     a[5] = -2.00000000000000000e-002;  /* a[5,0] */
00387     a[13] = 1.03000000000000000e+000;  /* a[5,1] */
00388     a[21] = -1.42999999999999990e+000;  /* a[5,2] */
00389     a[29] = 5.00000000000000000e-001;  /* a[5,3] */
00390 }
00391 static void init_d( lapack_int size, double *d ) {
00392     lapack_int i;
00393     for( i = 0; i < size; i++ ) {
00394         d[i] = 0;
00395     }
00396 }
00397 static void init_e( lapack_int size, double *e ) {
00398     lapack_int i;
00399     for( i = 0; i < size; i++ ) {
00400         e[i] = 0;
00401     }
00402 }
00403 static void init_tauq( lapack_int size, double *tauq ) {
00404     lapack_int i;
00405     for( i = 0; i < size; i++ ) {
00406         tauq[i] = 0;
00407     }
00408 }
00409 static void init_taup( lapack_int size, double *taup ) {
00410     lapack_int i;
00411     for( i = 0; i < size; i++ ) {
00412         taup[i] = 0;
00413     }
00414 }
00415 static void init_work( lapack_int size, double *work ) {
00416     lapack_int i;
00417     for( i = 0; i < size; i++ ) {
00418         work[i] = 0;
00419     }
00420 }
00421 
00422 /* Auxiliary function: C interface to dgebrd results check */
00423 /* Return value: 0 - test is passed, non-zero - test is failed */
00424 static int compare_dgebrd( double *a, double *a_i, double *d, double *d_i,
00425                            double *e, double *e_i, double *tauq, double *tauq_i,
00426                            double *taup, double *taup_i, lapack_int info,
00427                            lapack_int info_i, lapack_int lda, lapack_int m,
00428                            lapack_int n )
00429 {
00430     lapack_int i;
00431     int failed = 0;
00432     for( i = 0; i < lda*n; i++ ) {
00433         failed += compare_doubles(a[i],a_i[i]);
00434     }
00435     for( i = 0; i < (MIN(m,n)); i++ ) {
00436         failed += compare_doubles(d[i],d_i[i]);
00437     }
00438     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00439         failed += compare_doubles(e[i],e_i[i]);
00440     }
00441     for( i = 0; i < (MIN(m,n)); i++ ) {
00442         failed += compare_doubles(tauq[i],tauq_i[i]);
00443     }
00444     for( i = 0; i < (MIN(m,n)); i++ ) {
00445         failed += compare_doubles(taup[i],taup_i[i]);
00446     }
00447     failed += (info == info_i) ? 0 : 1;
00448     if( info != 0 || info_i != 0 ) {
00449         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00450     }
00451 
00452     return failed;
00453 }


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:43