cungbr_4.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 * cungbr_4 is the test program for the C interface to LAPACK
00036 * routine cungbr
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_cungbr( 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, lapack_complex_float *a );
00058 static void init_tau( lapack_int size, lapack_complex_float *tau );
00059 static void init_work( lapack_int size, lapack_complex_float *work );
00060 static int compare_cungbr( lapack_complex_float *a, lapack_complex_float *a_i,
00061                            lapack_int info, lapack_int info_i, lapack_int lda,
00062                            lapack_int n );
00063 
00064 int main(void)
00065 {
00066     /* Local scalars */
00067     char vect, vect_i;
00068     lapack_int m, m_i;
00069     lapack_int n, n_i;
00070     lapack_int k, k_i;
00071     lapack_int lda, lda_i;
00072     lapack_int lda_r;
00073     lapack_int lwork, lwork_i;
00074     lapack_int info, info_i;
00075     lapack_int i;
00076     int failed;
00077 
00078     /* Local arrays */
00079     lapack_complex_float *a = NULL, *a_i = NULL;
00080     lapack_complex_float *tau = NULL, *tau_i = NULL;
00081     lapack_complex_float *work = NULL, *work_i = NULL;
00082     lapack_complex_float *a_save = NULL;
00083     lapack_complex_float *a_r = NULL;
00084 
00085     /* Iniitialize the scalar parameters */
00086     init_scalars_cungbr( &vect, &m, &n, &k, &lda, &lwork );
00087     lda_r = n+2;
00088     vect_i = vect;
00089     m_i = m;
00090     n_i = n;
00091     k_i = k;
00092     lda_i = lda;
00093     lwork_i = lwork;
00094 
00095     /* Allocate memory for the LAPACK routine arrays */
00096     a = (lapack_complex_float *)
00097         LAPACKE_malloc( lda*n * sizeof(lapack_complex_float) );
00098     tau = (lapack_complex_float *)
00099         LAPACKE_malloc( MIN(m,k) * sizeof(lapack_complex_float) );
00100     work = (lapack_complex_float *)
00101         LAPACKE_malloc( lwork * sizeof(lapack_complex_float) );
00102 
00103     /* Allocate memory for the C interface function arrays */
00104     a_i = (lapack_complex_float *)
00105         LAPACKE_malloc( lda*n * sizeof(lapack_complex_float) );
00106     tau_i = (lapack_complex_float *)
00107         LAPACKE_malloc( MIN(m,k) * sizeof(lapack_complex_float) );
00108     work_i = (lapack_complex_float *)
00109         LAPACKE_malloc( lwork * sizeof(lapack_complex_float) );
00110 
00111     /* Allocate memory for the backup arrays */
00112     a_save = (lapack_complex_float *)
00113         LAPACKE_malloc( lda*n * sizeof(lapack_complex_float) );
00114 
00115     /* Allocate memory for the row-major arrays */
00116     a_r = (lapack_complex_float *)
00117         LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_float) );
00118 
00119     /* Initialize input arrays */
00120     init_a( lda*n, a );
00121     init_tau( (MIN(m,k)), tau );
00122     init_work( lwork, work );
00123 
00124     /* Backup the ouptut arrays */
00125     for( i = 0; i < lda*n; i++ ) {
00126         a_save[i] = a[i];
00127     }
00128 
00129     /* Call the LAPACK routine */
00130     cungbr_( &vect, &m, &n, &k, a, &lda, tau, work, &lwork, &info );
00131 
00132     /* Initialize input data, call the column-major middle-level
00133      * interface to LAPACK routine and check the results */
00134     for( i = 0; i < lda*n; i++ ) {
00135         a_i[i] = a_save[i];
00136     }
00137     for( i = 0; i < (MIN(m,k)); i++ ) {
00138         tau_i[i] = tau[i];
00139     }
00140     for( i = 0; i < lwork; i++ ) {
00141         work_i[i] = work[i];
00142     }
00143     info_i = LAPACKE_cungbr_work( LAPACK_COL_MAJOR, vect_i, m_i, n_i, k_i, a_i,
00144                                   lda_i, tau_i, work_i, lwork_i );
00145 
00146     failed = compare_cungbr( a, a_i, info, info_i, lda, n );
00147     if( failed == 0 ) {
00148         printf( "PASSED: column-major middle-level interface to cungbr\n" );
00149     } else {
00150         printf( "FAILED: column-major middle-level interface to cungbr\n" );
00151     }
00152 
00153     /* Initialize input data, call the column-major high-level
00154      * interface to LAPACK routine and check the results */
00155     for( i = 0; i < lda*n; i++ ) {
00156         a_i[i] = a_save[i];
00157     }
00158     for( i = 0; i < (MIN(m,k)); i++ ) {
00159         tau_i[i] = tau[i];
00160     }
00161     for( i = 0; i < lwork; i++ ) {
00162         work_i[i] = work[i];
00163     }
00164     info_i = LAPACKE_cungbr( LAPACK_COL_MAJOR, vect_i, m_i, n_i, k_i, a_i,
00165                              lda_i, tau_i );
00166 
00167     failed = compare_cungbr( a, a_i, info, info_i, lda, n );
00168     if( failed == 0 ) {
00169         printf( "PASSED: column-major high-level interface to cungbr\n" );
00170     } else {
00171         printf( "FAILED: column-major high-level interface to cungbr\n" );
00172     }
00173 
00174     /* Initialize input data, call the row-major middle-level
00175      * interface to LAPACK routine and check the results */
00176     for( i = 0; i < lda*n; i++ ) {
00177         a_i[i] = a_save[i];
00178     }
00179     for( i = 0; i < (MIN(m,k)); i++ ) {
00180         tau_i[i] = tau[i];
00181     }
00182     for( i = 0; i < lwork; i++ ) {
00183         work_i[i] = work[i];
00184     }
00185 
00186     LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00187     info_i = LAPACKE_cungbr_work( LAPACK_ROW_MAJOR, vect_i, m_i, n_i, k_i, a_r,
00188                                   lda_r, tau_i, work_i, lwork_i );
00189 
00190     LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00191 
00192     failed = compare_cungbr( a, a_i, info, info_i, lda, n );
00193     if( failed == 0 ) {
00194         printf( "PASSED: row-major middle-level interface to cungbr\n" );
00195     } else {
00196         printf( "FAILED: row-major middle-level interface to cungbr\n" );
00197     }
00198 
00199     /* Initialize input data, call the row-major high-level
00200      * interface to LAPACK routine and check the results */
00201     for( i = 0; i < lda*n; i++ ) {
00202         a_i[i] = a_save[i];
00203     }
00204     for( i = 0; i < (MIN(m,k)); i++ ) {
00205         tau_i[i] = tau[i];
00206     }
00207     for( i = 0; i < lwork; i++ ) {
00208         work_i[i] = work[i];
00209     }
00210 
00211     /* Init row_major arrays */
00212     LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00213     info_i = LAPACKE_cungbr( LAPACK_ROW_MAJOR, vect_i, m_i, n_i, k_i, a_r,
00214                              lda_r, tau_i );
00215 
00216     LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00217 
00218     failed = compare_cungbr( a, a_i, info, info_i, lda, n );
00219     if( failed == 0 ) {
00220         printf( "PASSED: row-major high-level interface to cungbr\n" );
00221     } else {
00222         printf( "FAILED: row-major high-level interface to cungbr\n" );
00223     }
00224 
00225     /* Release memory */
00226     if( a != NULL ) {
00227         LAPACKE_free( a );
00228     }
00229     if( a_i != NULL ) {
00230         LAPACKE_free( a_i );
00231     }
00232     if( a_r != NULL ) {
00233         LAPACKE_free( a_r );
00234     }
00235     if( a_save != NULL ) {
00236         LAPACKE_free( a_save );
00237     }
00238     if( tau != NULL ) {
00239         LAPACKE_free( tau );
00240     }
00241     if( tau_i != NULL ) {
00242         LAPACKE_free( tau_i );
00243     }
00244     if( work != NULL ) {
00245         LAPACKE_free( work );
00246     }
00247     if( work_i != NULL ) {
00248         LAPACKE_free( work_i );
00249     }
00250 
00251     return 0;
00252 }
00253 
00254 /* Auxiliary function: cungbr scalar parameters initialization */
00255 static void init_scalars_cungbr( char *vect, lapack_int *m, lapack_int *n,
00256                                  lapack_int *k, lapack_int *lda,
00257                                  lapack_int *lwork )
00258 {
00259     *vect = 'Q';
00260     *m = 3;
00261     *n = 3;
00262     *k = 4;
00263     *lda = 8;
00264     *lwork = 1024;
00265 
00266     return;
00267 }
00268 
00269 /* Auxiliary functions: cungbr array parameters initialization */
00270 static void init_a( lapack_int size, lapack_complex_float *a ) {
00271     lapack_int i;
00272     for( i = 0; i < size; i++ ) {
00273         a[i] = lapack_make_complex_float( 0.0f, 0.0f );
00274     }
00275     a[0] = lapack_make_complex_float( -2.225511312e+000, 0.000000000e+000 );
00276     a[8] = lapack_make_complex_float( -2.687473297e-001, -2.749204636e-001 );
00277     a[16] = lapack_make_complex_float( 2.450530082e-001, 4.657298625e-001 );
00278     a[1] = lapack_make_complex_float( -1.634884596e+000, 0.000000000e+000 );
00279     a[9] = lapack_make_complex_float( 1.604558587e+000, 0.000000000e+000 );
00280     a[17] = lapack_make_complex_float( 4.328967631e-001, -1.758079231e-001 );
00281     a[2] = lapack_make_complex_float( -1.113663465e-001, -2.216541171e-001 );
00282     a[10] = lapack_make_complex_float( 9.919312596e-001, 0.000000000e+000 );
00283     a[18] = lapack_make_complex_float( -1.673056483e+000, 0.000000000e+000 );
00284 }
00285 static void init_tau( lapack_int size, lapack_complex_float *tau ) {
00286     lapack_int i;
00287     for( i = 0; i < size; i++ ) {
00288         tau[i] = lapack_make_complex_float( 0.0f, 0.0f );
00289     }
00290     tau[0] = lapack_make_complex_float( 1.502026558e+000, 7.575196028e-001 );
00291     tau[1] = lapack_make_complex_float( 1.994343996e+000, 1.062079370e-001 );
00292     tau[2] = lapack_make_complex_float( 0.000000000e+000, 0.000000000e+000 );
00293 }
00294 static void init_work( lapack_int size, lapack_complex_float *work ) {
00295     lapack_int i;
00296     for( i = 0; i < size; i++ ) {
00297         work[i] = lapack_make_complex_float( 0.0f, 0.0f );
00298     }
00299 }
00300 
00301 /* Auxiliary function: C interface to cungbr results check */
00302 /* Return value: 0 - test is passed, non-zero - test is failed */
00303 static int compare_cungbr( lapack_complex_float *a, lapack_complex_float *a_i,
00304                            lapack_int info, lapack_int info_i, lapack_int lda,
00305                            lapack_int n )
00306 {
00307     lapack_int i;
00308     int failed = 0;
00309     for( i = 0; i < lda*n; i++ ) {
00310         failed += compare_complex_floats(a[i],a_i[i]);
00311     }
00312     failed += (info == info_i) ? 0 : 1;
00313     if( info != 0 || info_i != 0 ) {
00314         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00315     }
00316 
00317     return failed;
00318 }


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