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


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