dorgbr_3.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 * dorgbr_3 is the test program for the C interface to LAPACK
00036 * routine dorgbr
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_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     /* Local scalars */
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     /* Local arrays */
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     /* Iniitialize the scalar parameters */
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     /* Allocate memory for the LAPACK routine arrays */
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     /* Allocate memory for the C interface function arrays */
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     /* Allocate memory for the backup arrays */
00105     a_save = (double *)LAPACKE_malloc( lda*n * sizeof(double) );
00106 
00107     /* Allocate memory for the row-major arrays */
00108     a_r = (double *)LAPACKE_malloc( m*(n+2) * sizeof(double) );
00109 
00110     /* Initialize input arrays */
00111     init_a( lda*n, a );
00112     init_tau( (MIN(m,k)), tau );
00113     init_work( lwork, work );
00114 
00115     /* Backup the ouptut arrays */
00116     for( i = 0; i < lda*n; i++ ) {
00117         a_save[i] = a[i];
00118     }
00119 
00120     /* Call the LAPACK routine */
00121     dorgbr_( &vect, &m, &n, &k, a, &lda, tau, work, &lwork, &info );
00122 
00123     /* Initialize input data, call the column-major middle-level
00124      * interface to LAPACK routine and check the results */
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     /* Initialize input data, call the column-major high-level
00145      * interface to LAPACK routine and check the results */
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     /* Initialize input data, call the row-major middle-level
00166      * interface to LAPACK routine and check the results */
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     /* Initialize input data, call the row-major high-level
00191      * interface to LAPACK routine and check the results */
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     /* Init row_major arrays */
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     /* Release memory */
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 /* Auxiliary function: dorgbr scalar parameters initialization */
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 = 'P';
00251     *m = 4;
00252     *n = 6;
00253     *k = 4;
00254     *lda = 8;
00255     *lwork = 1024;
00256 
00257     return;
00258 }
00259 
00260 /* Auxiliary functions: dorgbr array parameters initialization */
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] = 7.62923980485605120e+000;  /* a[0,0] */
00267     a[8] = -2.51355638263265290e-001;  /* a[0,1] */
00268     a[16] = 2.82008764880736670e-001;  /* a[0,2] */
00269     a[24] = -2.06908604667931820e-002;  /* a[0,3] */
00270     a[32] = -1.57863602079977600e-001;  /* a[0,4] */
00271     a[40] = -3.52510956100920840e-002;  /* a[0,5] */
00272     a[1] = -4.53044855881618140e-001;  /* a[1,0] */
00273     a[9] = -6.24192432214396750e+000;  /* a[1,1] */
00274     a[17] = -4.16926348215564240e-001;  /* a[1,2] */
00275     a[25] = 3.35316430183571880e-001;  /* a[1,3] */
00276     a[33] = 1.23460953196329050e-001;  /* a[1,4] */
00277     a[41] = -5.71694000548844450e-001;  /* a[1,5] */
00278     a[2] = -2.82852709291367410e-001;  /* a[2,0] */
00279     a[10] = -7.96095691784705070e-001;  /* a[2,1] */
00280     a[18] = 5.78019627661872270e+000;  /* a[2,2] */
00281     a[26] = 3.83992061573069370e-001;  /* a[2,3] */
00282     a[34] = -2.14742585177763570e-001;  /* a[2,4] */
00283     a[42] = 2.89900608322275270e-001;  /* a[2,5] */
00284     a[3] = 1.84063886692780260e-001;  /* a[3,0] */
00285     a[11] = -4.93144507778532140e-001;  /* a[3,1] */
00286     a[19] = -8.02571992839807850e-001;  /* a[3,2] */
00287     a[27] = 6.10134463207201080e+000;  /* a[3,3] */
00288     a[35] = -5.78704196113125070e-001;  /* a[3,4] */
00289     a[43] = -6.90157744391756700e-002;  /* a[3,5] */
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.71042464762349460e+000;
00297     tau[1] = 1.22824371572719590e+000;
00298     tau[2] = 1.56542705024096170e+000;
00299     tau[3] = 1.49291419213336620e+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 /* Auxiliary function: C interface to dorgbr results check */
00309 /* Return value: 0 - test is passed, non-zero - test is failed */
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 }


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