dormhr_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 * dormhr_1 is the test program for the C interface to LAPACK
00036 * routine dormhr
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_dormhr( char *side, char *trans, lapack_int *m,
00055                                  lapack_int *n, lapack_int *ilo,
00056                                  lapack_int *ihi, lapack_int *lda,
00057                                  lapack_int *ldc, lapack_int *lwork );
00058 static void init_a( lapack_int size, double *a );
00059 static void init_tau( lapack_int size, double *tau );
00060 static void init_c( lapack_int size, double *c );
00061 static void init_work( lapack_int size, double *work );
00062 static int compare_dormhr( double *c, double *c_i, lapack_int info,
00063                            lapack_int info_i, lapack_int ldc, lapack_int n );
00064 
00065 int main(void)
00066 {
00067     /* Local scalars */
00068     char side, side_i;
00069     char trans, trans_i;
00070     lapack_int m, m_i;
00071     lapack_int n, n_i;
00072     lapack_int ilo, ilo_i;
00073     lapack_int ihi, ihi_i;
00074     lapack_int lda, lda_i;
00075     lapack_int lda_r;
00076     lapack_int ldc, ldc_i;
00077     lapack_int ldc_r;
00078     lapack_int lwork, lwork_i;
00079     lapack_int info, info_i;
00080     /* Declare scalars */
00081     lapack_int r;
00082     lapack_int i;
00083     int failed;
00084 
00085     /* Local arrays */
00086     double *a = NULL, *a_i = NULL;
00087     double *tau = NULL, *tau_i = NULL;
00088     double *c = NULL, *c_i = NULL;
00089     double *work = NULL, *work_i = NULL;
00090     double *c_save = NULL;
00091     double *a_r = NULL;
00092     double *c_r = NULL;
00093 
00094     /* Iniitialize the scalar parameters */
00095     init_scalars_dormhr( &side, &trans, &m, &n, &ilo, &ihi, &lda, &ldc,
00096                          &lwork );
00097     r = LAPACKE_lsame( side, 'l' ) ? m : n;
00098     lda_r = r+2;
00099     ldc_r = n+2;
00100     side_i = side;
00101     trans_i = trans;
00102     m_i = m;
00103     n_i = n;
00104     ilo_i = ilo;
00105     ihi_i = ihi;
00106     lda_i = lda;
00107     ldc_i = ldc;
00108     lwork_i = lwork;
00109 
00110     /* Allocate memory for the LAPACK routine arrays */
00111     a = (double *)LAPACKE_malloc( lda*m * sizeof(double) );
00112     tau = (double *)LAPACKE_malloc( (m-1) * sizeof(double) );
00113     c = (double *)LAPACKE_malloc( ldc*n * sizeof(double) );
00114     work = (double *)LAPACKE_malloc( lwork * sizeof(double) );
00115 
00116     /* Allocate memory for the C interface function arrays */
00117     a_i = (double *)LAPACKE_malloc( lda*m * sizeof(double) );
00118     tau_i = (double *)LAPACKE_malloc( (m-1) * sizeof(double) );
00119     c_i = (double *)LAPACKE_malloc( ldc*n * sizeof(double) );
00120     work_i = (double *)LAPACKE_malloc( lwork * sizeof(double) );
00121 
00122     /* Allocate memory for the backup arrays */
00123     c_save = (double *)LAPACKE_malloc( ldc*n * sizeof(double) );
00124 
00125     /* Allocate memory for the row-major arrays */
00126     a_r = (double *)LAPACKE_malloc( r*(r+2) * sizeof(double) );
00127     c_r = (double *)LAPACKE_malloc( m*(n+2) * sizeof(double) );
00128 
00129     /* Initialize input arrays */
00130     init_a( lda*m, a );
00131     init_tau( (m-1), tau );
00132     init_c( ldc*n, c );
00133     init_work( lwork, work );
00134 
00135     /* Backup the ouptut arrays */
00136     for( i = 0; i < ldc*n; i++ ) {
00137         c_save[i] = c[i];
00138     }
00139 
00140     /* Call the LAPACK routine */
00141     dormhr_( &side, &trans, &m, &n, &ilo, &ihi, a, &lda, tau, c, &ldc, work,
00142              &lwork, &info );
00143 
00144     /* Initialize input data, call the column-major middle-level
00145      * interface to LAPACK routine and check the results */
00146     for( i = 0; i < lda*m; i++ ) {
00147         a_i[i] = a[i];
00148     }
00149     for( i = 0; i < (m-1); i++ ) {
00150         tau_i[i] = tau[i];
00151     }
00152     for( i = 0; i < ldc*n; i++ ) {
00153         c_i[i] = c_save[i];
00154     }
00155     for( i = 0; i < lwork; i++ ) {
00156         work_i[i] = work[i];
00157     }
00158     info_i = LAPACKE_dormhr_work( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i,
00159                                   ilo_i, ihi_i, a_i, lda_i, tau_i, c_i, ldc_i,
00160                                   work_i, lwork_i );
00161 
00162     failed = compare_dormhr( c, c_i, info, info_i, ldc, n );
00163     if( failed == 0 ) {
00164         printf( "PASSED: column-major middle-level interface to dormhr\n" );
00165     } else {
00166         printf( "FAILED: column-major middle-level interface to dormhr\n" );
00167     }
00168 
00169     /* Initialize input data, call the column-major high-level
00170      * interface to LAPACK routine and check the results */
00171     for( i = 0; i < lda*m; i++ ) {
00172         a_i[i] = a[i];
00173     }
00174     for( i = 0; i < (m-1); i++ ) {
00175         tau_i[i] = tau[i];
00176     }
00177     for( i = 0; i < ldc*n; i++ ) {
00178         c_i[i] = c_save[i];
00179     }
00180     for( i = 0; i < lwork; i++ ) {
00181         work_i[i] = work[i];
00182     }
00183     info_i = LAPACKE_dormhr( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i, ilo_i,
00184                              ihi_i, a_i, lda_i, tau_i, c_i, ldc_i );
00185 
00186     failed = compare_dormhr( c, c_i, info, info_i, ldc, n );
00187     if( failed == 0 ) {
00188         printf( "PASSED: column-major high-level interface to dormhr\n" );
00189     } else {
00190         printf( "FAILED: column-major high-level interface to dormhr\n" );
00191     }
00192 
00193     /* Initialize input data, call the row-major middle-level
00194      * interface to LAPACK routine and check the results */
00195     for( i = 0; i < lda*m; i++ ) {
00196         a_i[i] = a[i];
00197     }
00198     for( i = 0; i < (m-1); i++ ) {
00199         tau_i[i] = tau[i];
00200     }
00201     for( i = 0; i < ldc*n; i++ ) {
00202         c_i[i] = c_save[i];
00203     }
00204     for( i = 0; i < lwork; i++ ) {
00205         work_i[i] = work[i];
00206     }
00207 
00208     LAPACKE_dge_trans( LAPACK_COL_MAJOR, r, r, a_i, lda, a_r, r+2 );
00209     LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
00210     info_i = LAPACKE_dormhr_work( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i,
00211                                   ilo_i, ihi_i, a_r, lda_r, tau_i, c_r, ldc_r,
00212                                   work_i, lwork_i );
00213 
00214     LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
00215 
00216     failed = compare_dormhr( c, c_i, info, info_i, ldc, n );
00217     if( failed == 0 ) {
00218         printf( "PASSED: row-major middle-level interface to dormhr\n" );
00219     } else {
00220         printf( "FAILED: row-major middle-level interface to dormhr\n" );
00221     }
00222 
00223     /* Initialize input data, call the row-major high-level
00224      * interface to LAPACK routine and check the results */
00225     for( i = 0; i < lda*m; i++ ) {
00226         a_i[i] = a[i];
00227     }
00228     for( i = 0; i < (m-1); i++ ) {
00229         tau_i[i] = tau[i];
00230     }
00231     for( i = 0; i < ldc*n; i++ ) {
00232         c_i[i] = c_save[i];
00233     }
00234     for( i = 0; i < lwork; i++ ) {
00235         work_i[i] = work[i];
00236     }
00237 
00238     /* Init row_major arrays */
00239     LAPACKE_dge_trans( LAPACK_COL_MAJOR, r, r, a_i, lda, a_r, r+2 );
00240     LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
00241     info_i = LAPACKE_dormhr( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i, ilo_i,
00242                              ihi_i, a_r, lda_r, tau_i, c_r, ldc_r );
00243 
00244     LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
00245 
00246     failed = compare_dormhr( c, c_i, info, info_i, ldc, n );
00247     if( failed == 0 ) {
00248         printf( "PASSED: row-major high-level interface to dormhr\n" );
00249     } else {
00250         printf( "FAILED: row-major high-level interface to dormhr\n" );
00251     }
00252 
00253     /* Release memory */
00254     if( a != NULL ) {
00255         LAPACKE_free( a );
00256     }
00257     if( a_i != NULL ) {
00258         LAPACKE_free( a_i );
00259     }
00260     if( a_r != NULL ) {
00261         LAPACKE_free( a_r );
00262     }
00263     if( tau != NULL ) {
00264         LAPACKE_free( tau );
00265     }
00266     if( tau_i != NULL ) {
00267         LAPACKE_free( tau_i );
00268     }
00269     if( c != NULL ) {
00270         LAPACKE_free( c );
00271     }
00272     if( c_i != NULL ) {
00273         LAPACKE_free( c_i );
00274     }
00275     if( c_r != NULL ) {
00276         LAPACKE_free( c_r );
00277     }
00278     if( c_save != NULL ) {
00279         LAPACKE_free( c_save );
00280     }
00281     if( work != NULL ) {
00282         LAPACKE_free( work );
00283     }
00284     if( work_i != NULL ) {
00285         LAPACKE_free( work_i );
00286     }
00287 
00288     return 0;
00289 }
00290 
00291 /* Auxiliary function: dormhr scalar parameters initialization */
00292 static void init_scalars_dormhr( char *side, char *trans, lapack_int *m,
00293                                  lapack_int *n, lapack_int *ilo,
00294                                  lapack_int *ihi, lapack_int *lda,
00295                                  lapack_int *ldc, lapack_int *lwork )
00296 {
00297     *side = 'L';
00298     *trans = 'N';
00299     *m = 4;
00300     *n = 3;
00301     *ilo = 1;
00302     *ihi = 4;
00303     *lda = 8;
00304     *ldc = 8;
00305     *lwork = 512;
00306 
00307     return;
00308 }
00309 
00310 /* Auxiliary functions: dormhr array parameters initialization */
00311 static void init_a( lapack_int size, double *a ) {
00312     lapack_int i;
00313     for( i = 0; i < size; i++ ) {
00314         a[i] = 0;
00315     }
00316     a[0] = 3.49999999999999980e-001;  /* a[0,0] */
00317     a[8] = -1.15952429620503390e-001;  /* a[0,1] */
00318     a[16] = -3.88601034323321160e-001;  /* a[0,2] */
00319     a[24] = -2.94184075347302120e-001;  /* a[0,3] */
00320     a[1] = -5.14003891035855980e-001;  /* a[1,0] */
00321     a[9] = 1.22486752460257420e-001;  /* a[1,1] */
00322     a[17] = 1.00359789682150170e-001;  /* a[1,2] */
00323     a[25] = 1.12561879970531830e-001;  /* a[1,3] */
00324     a[2] = -7.28472128292762870e-001;  /* a[2,0] */
00325     a[10] = 6.44263618527061930e-001;  /* a[2,1] */
00326     a[18] = -1.35700171757113630e-001;  /* a[2,2] */
00327     a[26] = -9.76816227049334410e-002;  /* a[2,3] */
00328     a[3] = 4.13904618348160720e-001;  /* a[3,0] */
00329     a[11] = -1.66544579490569860e-001;  /* a[3,1] */
00330     a[19] = 4.26244372207844720e-001;  /* a[3,2] */
00331     a[27] = 1.63213419296856090e-001;  /* a[3,3] */
00332 }
00333 static void init_tau( lapack_int size, double *tau ) {
00334     lapack_int i;
00335     for( i = 0; i < size; i++ ) {
00336         tau[i] = 0;
00337     }
00338     tau[0] = 1.17509595076921650e+000;
00339     tau[1] = 1.94602297213986320e+000;
00340     tau[2] = 0.00000000000000000e+000;
00341 }
00342 static void init_c( lapack_int size, double *c ) {
00343     lapack_int i;
00344     for( i = 0; i < size; i++ ) {
00345         c[i] = 0;
00346     }
00347     c[0] = 3.40425282021908690e-001;  /* c[0,0] */
00348     c[8] = -1.14648651155983450e-001;  /* c[0,1] */
00349     c[16] = 1.49321841610791820e-001;  /* c[0,2] */
00350     c[1] = 1.60347783845988720e-001;  /* c[1,0] */
00351     c[9] = 3.43227040040292810e-001;  /* c[1,1] */
00352     c[17] = 1.17945426752373240e-001;  /* c[1,2] */
00353     c[2] = 6.62270414022458340e-001;  /* c[2,0] */
00354     c[10] = -3.37729585977541660e-001;  /* c[2,1] */
00355     c[18] = -6.19059517257969930e-001;  /* c[2,2] */
00356     c[3] = -5.74166490700157910e-001;  /* c[3,0] */
00357     c[11] = -3.28095137542947390e-001;  /* c[3,1] */
00358     c[19] = 1.00000000000000000e+000;  /* c[3,2] */
00359 }
00360 static void init_work( lapack_int size, double *work ) {
00361     lapack_int i;
00362     for( i = 0; i < size; i++ ) {
00363         work[i] = 0;
00364     }
00365 }
00366 
00367 /* Auxiliary function: C interface to dormhr results check */
00368 /* Return value: 0 - test is passed, non-zero - test is failed */
00369 static int compare_dormhr( double *c, double *c_i, lapack_int info,
00370                            lapack_int info_i, lapack_int ldc, lapack_int n )
00371 {
00372     lapack_int i;
00373     int failed = 0;
00374     for( i = 0; i < ldc*n; i++ ) {
00375         failed += compare_doubles(c[i],c_i[i]);
00376     }
00377     failed += (info == info_i) ? 0 : 1;
00378     if( info != 0 || info_i != 0 ) {
00379         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00380     }
00381 
00382     return failed;
00383 }


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