dsteqr_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 * dsteqr_4 is the test program for the C interface to LAPACK
00036 * routine dsteqr
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_dsteqr( char *compz, lapack_int *n, lapack_int *ldz );
00055 static void init_d( lapack_int size, double *d );
00056 static void init_e( lapack_int size, double *e );
00057 static void init_z( lapack_int size, double *z );
00058 static void init_work( lapack_int size, double *work );
00059 static int compare_dsteqr( double *d, double *d_i, double *e, double *e_i,
00060                            double *z, double *z_i, lapack_int info,
00061                            lapack_int info_i, char compz, lapack_int ldz,
00062                            lapack_int n );
00063 
00064 int main(void)
00065 {
00066     /* Local scalars */
00067     char compz, compz_i;
00068     lapack_int n, n_i;
00069     lapack_int ldz, ldz_i;
00070     lapack_int ldz_r;
00071     lapack_int info, info_i;
00072     lapack_int i;
00073     int failed;
00074 
00075     /* Local arrays */
00076     double *d = NULL, *d_i = NULL;
00077     double *e = NULL, *e_i = NULL;
00078     double *z = NULL, *z_i = NULL;
00079     double *work = NULL, *work_i = NULL;
00080     double *d_save = NULL;
00081     double *e_save = NULL;
00082     double *z_save = NULL;
00083     double *z_r = NULL;
00084 
00085     /* Iniitialize the scalar parameters */
00086     init_scalars_dsteqr( &compz, &n, &ldz );
00087     ldz_r = n+2;
00088     compz_i = compz;
00089     n_i = n;
00090     ldz_i = ldz;
00091 
00092     /* Allocate memory for the LAPACK routine arrays */
00093     d = (double *)LAPACKE_malloc( n * sizeof(double) );
00094     e = (double *)LAPACKE_malloc( (n-1) * sizeof(double) );
00095     z = (double *)LAPACKE_malloc( ldz*n * sizeof(double) );
00096     work = (double *)LAPACKE_malloc( ((MAX(1,2*n-2))) * sizeof(double) );
00097 
00098     /* Allocate memory for the C interface function arrays */
00099     d_i = (double *)LAPACKE_malloc( n * sizeof(double) );
00100     e_i = (double *)LAPACKE_malloc( (n-1) * sizeof(double) );
00101     z_i = (double *)LAPACKE_malloc( ldz*n * sizeof(double) );
00102     work_i = (double *)LAPACKE_malloc( ((MAX(1,2*n-2))) * sizeof(double) );
00103 
00104     /* Allocate memory for the backup arrays */
00105     d_save = (double *)LAPACKE_malloc( n * sizeof(double) );
00106     e_save = (double *)LAPACKE_malloc( (n-1) * sizeof(double) );
00107     z_save = (double *)LAPACKE_malloc( ldz*n * sizeof(double) );
00108 
00109     /* Allocate memory for the row-major arrays */
00110     z_r = (double *)LAPACKE_malloc( n*(n+2) * sizeof(double) );
00111 
00112     /* Initialize input arrays */
00113     init_d( n, d );
00114     init_e( (n-1), e );
00115     init_z( ldz*n, z );
00116     init_work( (MAX(1,2*n-2)), work );
00117 
00118     /* Backup the ouptut arrays */
00119     for( i = 0; i < n; i++ ) {
00120         d_save[i] = d[i];
00121     }
00122     for( i = 0; i < (n-1); i++ ) {
00123         e_save[i] = e[i];
00124     }
00125     for( i = 0; i < ldz*n; i++ ) {
00126         z_save[i] = z[i];
00127     }
00128 
00129     /* Call the LAPACK routine */
00130     dsteqr_( &compz, &n, d, e, z, &ldz, work, &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 < n; i++ ) {
00135         d_i[i] = d_save[i];
00136     }
00137     for( i = 0; i < (n-1); i++ ) {
00138         e_i[i] = e_save[i];
00139     }
00140     for( i = 0; i < ldz*n; i++ ) {
00141         z_i[i] = z_save[i];
00142     }
00143     for( i = 0; i < (MAX(1,2*n-2)); i++ ) {
00144         work_i[i] = work[i];
00145     }
00146     info_i = LAPACKE_dsteqr_work( LAPACK_COL_MAJOR, compz_i, n_i, d_i, e_i, z_i,
00147                                   ldz_i, work_i );
00148 
00149     failed = compare_dsteqr( d, d_i, e, e_i, z, z_i, info, info_i, compz, ldz,
00150                              n );
00151     if( failed == 0 ) {
00152         printf( "PASSED: column-major middle-level interface to dsteqr\n" );
00153     } else {
00154         printf( "FAILED: column-major middle-level interface to dsteqr\n" );
00155     }
00156 
00157     /* Initialize input data, call the column-major high-level
00158      * interface to LAPACK routine and check the results */
00159     for( i = 0; i < n; i++ ) {
00160         d_i[i] = d_save[i];
00161     }
00162     for( i = 0; i < (n-1); i++ ) {
00163         e_i[i] = e_save[i];
00164     }
00165     for( i = 0; i < ldz*n; i++ ) {
00166         z_i[i] = z_save[i];
00167     }
00168     for( i = 0; i < (MAX(1,2*n-2)); i++ ) {
00169         work_i[i] = work[i];
00170     }
00171     info_i = LAPACKE_dsteqr( LAPACK_COL_MAJOR, compz_i, n_i, d_i, e_i, z_i,
00172                              ldz_i );
00173 
00174     failed = compare_dsteqr( d, d_i, e, e_i, z, z_i, info, info_i, compz, ldz,
00175                              n );
00176     if( failed == 0 ) {
00177         printf( "PASSED: column-major high-level interface to dsteqr\n" );
00178     } else {
00179         printf( "FAILED: column-major high-level interface to dsteqr\n" );
00180     }
00181 
00182     /* Initialize input data, call the row-major middle-level
00183      * interface to LAPACK routine and check the results */
00184     for( i = 0; i < n; i++ ) {
00185         d_i[i] = d_save[i];
00186     }
00187     for( i = 0; i < (n-1); i++ ) {
00188         e_i[i] = e_save[i];
00189     }
00190     for( i = 0; i < ldz*n; i++ ) {
00191         z_i[i] = z_save[i];
00192     }
00193     for( i = 0; i < (MAX(1,2*n-2)); i++ ) {
00194         work_i[i] = work[i];
00195     }
00196 
00197     if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
00198         LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_i, ldz, z_r, n+2 );
00199     }
00200     info_i = LAPACKE_dsteqr_work( LAPACK_ROW_MAJOR, compz_i, n_i, d_i, e_i, z_r,
00201                                   ldz_r, work_i );
00202 
00203     if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
00204         LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, z_r, n+2, z_i, ldz );
00205     }
00206 
00207     failed = compare_dsteqr( d, d_i, e, e_i, z, z_i, info, info_i, compz, ldz,
00208                              n );
00209     if( failed == 0 ) {
00210         printf( "PASSED: row-major middle-level interface to dsteqr\n" );
00211     } else {
00212         printf( "FAILED: row-major middle-level interface to dsteqr\n" );
00213     }
00214 
00215     /* Initialize input data, call the row-major high-level
00216      * interface to LAPACK routine and check the results */
00217     for( i = 0; i < n; i++ ) {
00218         d_i[i] = d_save[i];
00219     }
00220     for( i = 0; i < (n-1); i++ ) {
00221         e_i[i] = e_save[i];
00222     }
00223     for( i = 0; i < ldz*n; i++ ) {
00224         z_i[i] = z_save[i];
00225     }
00226     for( i = 0; i < (MAX(1,2*n-2)); i++ ) {
00227         work_i[i] = work[i];
00228     }
00229 
00230     /* Init row_major arrays */
00231     if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
00232         LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_i, ldz, z_r, n+2 );
00233     }
00234     info_i = LAPACKE_dsteqr( LAPACK_ROW_MAJOR, compz_i, n_i, d_i, e_i, z_r,
00235                              ldz_r );
00236 
00237     if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
00238         LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, z_r, n+2, z_i, ldz );
00239     }
00240 
00241     failed = compare_dsteqr( d, d_i, e, e_i, z, z_i, info, info_i, compz, ldz,
00242                              n );
00243     if( failed == 0 ) {
00244         printf( "PASSED: row-major high-level interface to dsteqr\n" );
00245     } else {
00246         printf( "FAILED: row-major high-level interface to dsteqr\n" );
00247     }
00248 
00249     /* Release memory */
00250     if( d != NULL ) {
00251         LAPACKE_free( d );
00252     }
00253     if( d_i != NULL ) {
00254         LAPACKE_free( d_i );
00255     }
00256     if( d_save != NULL ) {
00257         LAPACKE_free( d_save );
00258     }
00259     if( e != NULL ) {
00260         LAPACKE_free( e );
00261     }
00262     if( e_i != NULL ) {
00263         LAPACKE_free( e_i );
00264     }
00265     if( e_save != NULL ) {
00266         LAPACKE_free( e_save );
00267     }
00268     if( z != NULL ) {
00269         LAPACKE_free( z );
00270     }
00271     if( z_i != NULL ) {
00272         LAPACKE_free( z_i );
00273     }
00274     if( z_r != NULL ) {
00275         LAPACKE_free( z_r );
00276     }
00277     if( z_save != NULL ) {
00278         LAPACKE_free( z_save );
00279     }
00280     if( work != NULL ) {
00281         LAPACKE_free( work );
00282     }
00283     if( work_i != NULL ) {
00284         LAPACKE_free( work_i );
00285     }
00286 
00287     return 0;
00288 }
00289 
00290 /* Auxiliary function: dsteqr scalar parameters initialization */
00291 static void init_scalars_dsteqr( char *compz, lapack_int *n, lapack_int *ldz )
00292 {
00293     *compz = 'I';
00294     *n = 4;
00295     *ldz = 8;
00296 
00297     return;
00298 }
00299 
00300 /* Auxiliary functions: dsteqr array parameters initialization */
00301 static void init_d( lapack_int size, double *d ) {
00302     lapack_int i;
00303     for( i = 0; i < size; i++ ) {
00304         d[i] = 0;
00305     }
00306     d[0] = -6.99000000000000020e+000;
00307     d[1] = 7.91999999999999990e+000;
00308     d[2] = 2.33999999999999990e+000;
00309     d[3] = 3.20000000000000010e-001;
00310 }
00311 static void init_e( lapack_int size, double *e ) {
00312     lapack_int i;
00313     for( i = 0; i < size; i++ ) {
00314         e[i] = 0;
00315     }
00316     e[0] = -4.40000000000000000e-001;
00317     e[1] = -2.62999999999999990e+000;
00318     e[2] = -1.17999999999999990e+000;
00319 }
00320 static void init_z( lapack_int size, double *z ) {
00321     lapack_int i;
00322     for( i = 0; i < size; i++ ) {
00323         z[i] = 0;
00324     }
00325     z[0] = 0.00000000000000000e+000;  /* z[0,0] */
00326     z[8] = 0.00000000000000000e+000;  /* z[0,1] */
00327     z[16] = 0.00000000000000000e+000;  /* z[0,2] */
00328     z[24] = 0.00000000000000000e+000;  /* z[0,3] */
00329     z[1] = 0.00000000000000000e+000;  /* z[1,0] */
00330     z[9] = 0.00000000000000000e+000;  /* z[1,1] */
00331     z[17] = 0.00000000000000000e+000;  /* z[1,2] */
00332     z[25] = 0.00000000000000000e+000;  /* z[1,3] */
00333     z[2] = 0.00000000000000000e+000;  /* z[2,0] */
00334     z[10] = 0.00000000000000000e+000;  /* z[2,1] */
00335     z[18] = 0.00000000000000000e+000;  /* z[2,2] */
00336     z[26] = 0.00000000000000000e+000;  /* z[2,3] */
00337     z[3] = 0.00000000000000000e+000;  /* z[3,0] */
00338     z[11] = 0.00000000000000000e+000;  /* z[3,1] */
00339     z[19] = 0.00000000000000000e+000;  /* z[3,2] */
00340     z[27] = 0.00000000000000000e+000;  /* z[3,3] */
00341 }
00342 static void init_work( lapack_int size, double *work ) {
00343     lapack_int i;
00344     for( i = 0; i < size; i++ ) {
00345         work[i] = 0;
00346     }
00347 }
00348 
00349 /* Auxiliary function: C interface to dsteqr results check */
00350 /* Return value: 0 - test is passed, non-zero - test is failed */
00351 static int compare_dsteqr( double *d, double *d_i, double *e, double *e_i,
00352                            double *z, double *z_i, lapack_int info,
00353                            lapack_int info_i, char compz, lapack_int ldz,
00354                            lapack_int n )
00355 {
00356     lapack_int i;
00357     int failed = 0;
00358     for( i = 0; i < n; i++ ) {
00359         failed += compare_doubles(d[i],d_i[i]);
00360     }
00361     for( i = 0; i < (n-1); i++ ) {
00362         failed += compare_doubles(e[i],e_i[i]);
00363     }
00364     if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
00365         for( i = 0; i < ldz*n; i++ ) {
00366             failed += compare_doubles(z[i],z_i[i]);
00367         }
00368     }
00369     failed += (info == info_i) ? 0 : 1;
00370     if( info != 0 || info_i != 0 ) {
00371         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00372     }
00373 
00374     return failed;
00375 }


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