sgeqpf_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 * sgeqpf_1 is the test program for the C interface to LAPACK
00036 * routine sgeqpf
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_sgeqpf( lapack_int *m, lapack_int *n,
00055                                  lapack_int *lda );
00056 static void init_a( lapack_int size, float *a );
00057 static void init_jpvt( lapack_int size, lapack_int *jpvt );
00058 static void init_tau( lapack_int size, float *tau );
00059 static void init_work( lapack_int size, float *work );
00060 static int compare_sgeqpf( float *a, float *a_i, lapack_int *jpvt,
00061                            lapack_int *jpvt_i, float *tau, float *tau_i,
00062                            lapack_int info, lapack_int info_i, lapack_int lda,
00063                            lapack_int m, lapack_int n );
00064 
00065 int main(void)
00066 {
00067     /* Local scalars */
00068     lapack_int m, m_i;
00069     lapack_int n, n_i;
00070     lapack_int lda, lda_i;
00071     lapack_int lda_r;
00072     lapack_int info, info_i;
00073     lapack_int i;
00074     int failed;
00075 
00076     /* Local arrays */
00077     float *a = NULL, *a_i = NULL;
00078     lapack_int *jpvt = NULL, *jpvt_i = NULL;
00079     float *tau = NULL, *tau_i = NULL;
00080     float *work = NULL, *work_i = NULL;
00081     float *a_save = NULL;
00082     lapack_int *jpvt_save = NULL;
00083     float *tau_save = NULL;
00084     float *a_r = NULL;
00085 
00086     /* Iniitialize the scalar parameters */
00087     init_scalars_sgeqpf( &m, &n, &lda );
00088     lda_r = n+2;
00089     m_i = m;
00090     n_i = n;
00091     lda_i = lda;
00092 
00093     /* Allocate memory for the LAPACK routine arrays */
00094     a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00095     jpvt = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00096     tau = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00097     work = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
00098 
00099     /* Allocate memory for the C interface function arrays */
00100     a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00101     jpvt_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00102     tau_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00103     work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
00104 
00105     /* Allocate memory for the backup arrays */
00106     a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
00107     jpvt_save = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00108     tau_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
00109 
00110     /* Allocate memory for the row-major arrays */
00111     a_r = (float *)LAPACKE_malloc( m*(n+2) * sizeof(float) );
00112 
00113     /* Initialize input arrays */
00114     init_a( lda*n, a );
00115     init_jpvt( n, jpvt );
00116     init_tau( (MIN(m,n)), tau );
00117     init_work( 3*n, work );
00118 
00119     /* Backup the ouptut arrays */
00120     for( i = 0; i < lda*n; i++ ) {
00121         a_save[i] = a[i];
00122     }
00123     for( i = 0; i < n; i++ ) {
00124         jpvt_save[i] = jpvt[i];
00125     }
00126     for( i = 0; i < (MIN(m,n)); i++ ) {
00127         tau_save[i] = tau[i];
00128     }
00129 
00130     /* Call the LAPACK routine */
00131     sgeqpf_( &m, &n, a, &lda, jpvt, tau, work, &info );
00132 
00133     /* Initialize input data, call the column-major middle-level
00134      * interface to LAPACK routine and check the results */
00135     for( i = 0; i < lda*n; i++ ) {
00136         a_i[i] = a_save[i];
00137     }
00138     for( i = 0; i < n; i++ ) {
00139         jpvt_i[i] = jpvt_save[i];
00140     }
00141     for( i = 0; i < (MIN(m,n)); i++ ) {
00142         tau_i[i] = tau_save[i];
00143     }
00144     for( i = 0; i < 3*n; i++ ) {
00145         work_i[i] = work[i];
00146     }
00147     info_i = LAPACKE_sgeqpf_work( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i,
00148                                   jpvt_i, tau_i, work_i );
00149 
00150     failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
00151                              lda, m, n );
00152     if( failed == 0 ) {
00153         printf( "PASSED: column-major middle-level interface to sgeqpf\n" );
00154     } else {
00155         printf( "FAILED: column-major middle-level interface to sgeqpf\n" );
00156     }
00157 
00158     /* Initialize input data, call the column-major high-level
00159      * interface to LAPACK routine and check the results */
00160     for( i = 0; i < lda*n; i++ ) {
00161         a_i[i] = a_save[i];
00162     }
00163     for( i = 0; i < n; i++ ) {
00164         jpvt_i[i] = jpvt_save[i];
00165     }
00166     for( i = 0; i < (MIN(m,n)); i++ ) {
00167         tau_i[i] = tau_save[i];
00168     }
00169     for( i = 0; i < 3*n; i++ ) {
00170         work_i[i] = work[i];
00171     }
00172     info_i = LAPACKE_sgeqpf( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, jpvt_i,
00173                              tau_i );
00174 
00175     failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
00176                              lda, m, n );
00177     if( failed == 0 ) {
00178         printf( "PASSED: column-major high-level interface to sgeqpf\n" );
00179     } else {
00180         printf( "FAILED: column-major high-level interface to sgeqpf\n" );
00181     }
00182 
00183     /* Initialize input data, call the row-major middle-level
00184      * interface to LAPACK routine and check the results */
00185     for( i = 0; i < lda*n; i++ ) {
00186         a_i[i] = a_save[i];
00187     }
00188     for( i = 0; i < n; i++ ) {
00189         jpvt_i[i] = jpvt_save[i];
00190     }
00191     for( i = 0; i < (MIN(m,n)); i++ ) {
00192         tau_i[i] = tau_save[i];
00193     }
00194     for( i = 0; i < 3*n; i++ ) {
00195         work_i[i] = work[i];
00196     }
00197 
00198     LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00199     info_i = LAPACKE_sgeqpf_work( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r,
00200                                   jpvt_i, tau_i, work_i );
00201 
00202     LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00203 
00204     failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
00205                              lda, m, n );
00206     if( failed == 0 ) {
00207         printf( "PASSED: row-major middle-level interface to sgeqpf\n" );
00208     } else {
00209         printf( "FAILED: row-major middle-level interface to sgeqpf\n" );
00210     }
00211 
00212     /* Initialize input data, call the row-major high-level
00213      * interface to LAPACK routine and check the results */
00214     for( i = 0; i < lda*n; i++ ) {
00215         a_i[i] = a_save[i];
00216     }
00217     for( i = 0; i < n; i++ ) {
00218         jpvt_i[i] = jpvt_save[i];
00219     }
00220     for( i = 0; i < (MIN(m,n)); i++ ) {
00221         tau_i[i] = tau_save[i];
00222     }
00223     for( i = 0; i < 3*n; i++ ) {
00224         work_i[i] = work[i];
00225     }
00226 
00227     /* Init row_major arrays */
00228     LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
00229     info_i = LAPACKE_sgeqpf( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, jpvt_i,
00230                              tau_i );
00231 
00232     LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
00233 
00234     failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
00235                              lda, m, n );
00236     if( failed == 0 ) {
00237         printf( "PASSED: row-major high-level interface to sgeqpf\n" );
00238     } else {
00239         printf( "FAILED: row-major high-level interface to sgeqpf\n" );
00240     }
00241 
00242     /* Release memory */
00243     if( a != NULL ) {
00244         LAPACKE_free( a );
00245     }
00246     if( a_i != NULL ) {
00247         LAPACKE_free( a_i );
00248     }
00249     if( a_r != NULL ) {
00250         LAPACKE_free( a_r );
00251     }
00252     if( a_save != NULL ) {
00253         LAPACKE_free( a_save );
00254     }
00255     if( jpvt != NULL ) {
00256         LAPACKE_free( jpvt );
00257     }
00258     if( jpvt_i != NULL ) {
00259         LAPACKE_free( jpvt_i );
00260     }
00261     if( jpvt_save != NULL ) {
00262         LAPACKE_free( jpvt_save );
00263     }
00264     if( tau != NULL ) {
00265         LAPACKE_free( tau );
00266     }
00267     if( tau_i != NULL ) {
00268         LAPACKE_free( tau_i );
00269     }
00270     if( tau_save != NULL ) {
00271         LAPACKE_free( tau_save );
00272     }
00273     if( work != NULL ) {
00274         LAPACKE_free( work );
00275     }
00276     if( work_i != NULL ) {
00277         LAPACKE_free( work_i );
00278     }
00279 
00280     return 0;
00281 }
00282 
00283 /* Auxiliary function: sgeqpf scalar parameters initialization */
00284 static void init_scalars_sgeqpf( lapack_int *m, lapack_int *n, lapack_int *lda )
00285 {
00286     *m = 6;
00287     *n = 5;
00288     *lda = 8;
00289 
00290     return;
00291 }
00292 
00293 /* Auxiliary functions: sgeqpf array parameters initialization */
00294 static void init_a( lapack_int size, float *a ) {
00295     lapack_int i;
00296     for( i = 0; i < size; i++ ) {
00297         a[i] = 0;
00298     }
00299     a[0] = -9.000000358e-002;  /* a[0,0] */
00300     a[8] = 1.400000006e-001;  /* a[0,1] */
00301     a[16] = -4.600000083e-001;  /* a[0,2] */
00302     a[24] = 6.800000072e-001;  /* a[0,3] */
00303     a[32] = 1.289999962e+000;  /* a[0,4] */
00304     a[1] = -1.559999943e+000;  /* a[1,0] */
00305     a[9] = 2.000000030e-001;  /* a[1,1] */
00306     a[17] = 2.899999917e-001;  /* a[1,2] */
00307     a[25] = 1.090000033e+000;  /* a[1,3] */
00308     a[33] = 5.099999905e-001;  /* a[1,4] */
00309     a[2] = -1.480000019e+000;  /* a[2,0] */
00310     a[10] = -4.300000072e-001;  /* a[2,1] */
00311     a[18] = 8.899999857e-001;  /* a[2,2] */
00312     a[26] = -7.099999785e-001;  /* a[2,3] */
00313     a[34] = -9.599999785e-001;  /* a[2,4] */
00314     a[3] = -1.090000033e+000;  /* a[3,0] */
00315     a[11] = 8.399999738e-001;  /* a[3,1] */
00316     a[19] = 7.699999809e-001;  /* a[3,2] */
00317     a[27] = 2.109999895e+000;  /* a[3,3] */
00318     a[35] = -1.269999981e+000;  /* a[3,4] */
00319     a[4] = 7.999999821e-002;  /* a[4,0] */
00320     a[12] = 5.500000119e-001;  /* a[4,1] */
00321     a[20] = -1.129999995e+000;  /* a[4,2] */
00322     a[28] = 1.400000006e-001;  /* a[4,3] */
00323     a[36] = 1.740000010e+000;  /* a[4,4] */
00324     a[5] = -1.590000033e+000;  /* a[5,0] */
00325     a[13] = -7.200000286e-001;  /* a[5,1] */
00326     a[21] = 1.059999943e+000;  /* a[5,2] */
00327     a[29] = 1.240000010e+000;  /* a[5,3] */
00328     a[37] = 3.400000036e-001;  /* a[5,4] */
00329 }
00330 static void init_jpvt( lapack_int size, lapack_int *jpvt ) {
00331     lapack_int i;
00332     for( i = 0; i < size; i++ ) {
00333         jpvt[i] = 0;
00334     }
00335     jpvt[0] = 0;
00336     jpvt[1] = 0;
00337     jpvt[2] = 0;
00338     jpvt[3] = 0;
00339     jpvt[4] = 0;
00340 }
00341 static void init_tau( lapack_int size, float *tau ) {
00342     lapack_int i;
00343     for( i = 0; i < size; i++ ) {
00344         tau[i] = 0;
00345     }
00346 }
00347 static void init_work( lapack_int size, float *work ) {
00348     lapack_int i;
00349     for( i = 0; i < size; i++ ) {
00350         work[i] = 0;
00351     }
00352 }
00353 
00354 /* Auxiliary function: C interface to sgeqpf results check */
00355 /* Return value: 0 - test is passed, non-zero - test is failed */
00356 static int compare_sgeqpf( float *a, float *a_i, lapack_int *jpvt,
00357                            lapack_int *jpvt_i, float *tau, float *tau_i,
00358                            lapack_int info, lapack_int info_i, lapack_int lda,
00359                            lapack_int m, lapack_int n )
00360 {
00361     lapack_int i;
00362     int failed = 0;
00363     for( i = 0; i < lda*n; i++ ) {
00364         failed += compare_floats(a[i],a_i[i]);
00365     }
00366     for( i = 0; i < n; i++ ) {
00367         failed += (jpvt[i] == jpvt_i[i]) ? 0 : 1;
00368     }
00369     for( i = 0; i < (MIN(m,n)); i++ ) {
00370         failed += compare_floats(tau[i],tau_i[i]);
00371     }
00372     failed += (info == info_i) ? 0 : 1;
00373     if( info != 0 || info_i != 0 ) {
00374         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00375     }
00376 
00377     return failed;
00378 }


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