zstein_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 * zstein_1 is the test program for the C interface to LAPACK
00036 * routine zstein
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_zstein( lapack_int *n, lapack_int *m,
00055                                  lapack_int *ldz );
00056 static void init_d( lapack_int size, double *d );
00057 static void init_e( lapack_int size, double *e );
00058 static void init_w( lapack_int size, double *w );
00059 static void init_iblock( lapack_int size, lapack_int *iblock );
00060 static void init_isplit( lapack_int size, lapack_int *isplit );
00061 static void init_z( lapack_int size, lapack_complex_double *z );
00062 static void init_work( lapack_int size, double *work );
00063 static void init_iwork( lapack_int size, lapack_int *iwork );
00064 static void init_ifailv( lapack_int size, lapack_int *ifailv );
00065 static int compare_zstein( lapack_complex_double *z, lapack_complex_double *z_i,
00066                            lapack_int *ifailv, lapack_int *ifailv_i,
00067                            lapack_int info, lapack_int info_i, lapack_int ldz,
00068                            lapack_int m );
00069 
00070 int main(void)
00071 {
00072     /* Local scalars */
00073     lapack_int n, n_i;
00074     lapack_int m, m_i;
00075     lapack_int ldz, ldz_i;
00076     lapack_int ldz_r;
00077     lapack_int info, info_i;
00078     lapack_int i;
00079     int failed;
00080 
00081     /* Local arrays */
00082     double *d = NULL, *d_i = NULL;
00083     double *e = NULL, *e_i = NULL;
00084     double *w = NULL, *w_i = NULL;
00085     lapack_int *iblock = NULL, *iblock_i = NULL;
00086     lapack_int *isplit = NULL, *isplit_i = NULL;
00087     lapack_complex_double *z = NULL, *z_i = NULL;
00088     double *work = NULL, *work_i = NULL;
00089     lapack_int *iwork = NULL, *iwork_i = NULL;
00090     lapack_int *ifailv = NULL, *ifailv_i = NULL;
00091     lapack_complex_double *z_save = NULL;
00092     lapack_int *ifailv_save = NULL;
00093     lapack_complex_double *z_r = NULL;
00094 
00095     /* Iniitialize the scalar parameters */
00096     init_scalars_zstein( &n, &m, &ldz );
00097     ldz_r = m+2;
00098     n_i = n;
00099     m_i = m;
00100     ldz_i = ldz;
00101 
00102     /* Allocate memory for the LAPACK routine arrays */
00103     d = (double *)LAPACKE_malloc( n * sizeof(double) );
00104     e = (double *)LAPACKE_malloc( n * sizeof(double) );
00105     w = (double *)LAPACKE_malloc( n * sizeof(double) );
00106     iblock = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00107     isplit = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00108     z = (lapack_complex_double *)
00109         LAPACKE_malloc( ldz*m * sizeof(lapack_complex_double) );
00110     work = (double *)LAPACKE_malloc( 5*n * sizeof(double) );
00111     iwork = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00112     ifailv = (lapack_int *)LAPACKE_malloc( m * sizeof(lapack_int) );
00113 
00114     /* Allocate memory for the C interface function arrays */
00115     d_i = (double *)LAPACKE_malloc( n * sizeof(double) );
00116     e_i = (double *)LAPACKE_malloc( n * sizeof(double) );
00117     w_i = (double *)LAPACKE_malloc( n * sizeof(double) );
00118     iblock_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00119     isplit_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00120     z_i = (lapack_complex_double *)
00121         LAPACKE_malloc( ldz*m * sizeof(lapack_complex_double) );
00122     work_i = (double *)LAPACKE_malloc( 5*n * sizeof(double) );
00123     iwork_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00124     ifailv_i = (lapack_int *)LAPACKE_malloc( m * sizeof(lapack_int) );
00125 
00126     /* Allocate memory for the backup arrays */
00127     z_save = (lapack_complex_double *)
00128         LAPACKE_malloc( ldz*m * sizeof(lapack_complex_double) );
00129     ifailv_save = (lapack_int *)LAPACKE_malloc( m * sizeof(lapack_int) );
00130 
00131     /* Allocate memory for the row-major arrays */
00132     z_r = (lapack_complex_double *)
00133         LAPACKE_malloc( n*(m+2) * sizeof(lapack_complex_double) );
00134 
00135     /* Initialize input arrays */
00136     init_d( n, d );
00137     init_e( n, e );
00138     init_w( n, w );
00139     init_iblock( n, iblock );
00140     init_isplit( n, isplit );
00141     init_z( ldz*m, z );
00142     init_work( 5*n, work );
00143     init_iwork( n, iwork );
00144     init_ifailv( m, ifailv );
00145 
00146     /* Backup the ouptut arrays */
00147     for( i = 0; i < ldz*m; i++ ) {
00148         z_save[i] = z[i];
00149     }
00150     for( i = 0; i < m; i++ ) {
00151         ifailv_save[i] = ifailv[i];
00152     }
00153 
00154     /* Call the LAPACK routine */
00155     zstein_( &n, d, e, &m, w, iblock, isplit, z, &ldz, work, iwork, ifailv,
00156              &info );
00157 
00158     /* Initialize input data, call the column-major middle-level
00159      * interface to LAPACK routine and check the results */
00160     for( i = 0; i < n; i++ ) {
00161         d_i[i] = d[i];
00162     }
00163     for( i = 0; i < n; i++ ) {
00164         e_i[i] = e[i];
00165     }
00166     for( i = 0; i < n; i++ ) {
00167         w_i[i] = w[i];
00168     }
00169     for( i = 0; i < n; i++ ) {
00170         iblock_i[i] = iblock[i];
00171     }
00172     for( i = 0; i < n; i++ ) {
00173         isplit_i[i] = isplit[i];
00174     }
00175     for( i = 0; i < ldz*m; i++ ) {
00176         z_i[i] = z_save[i];
00177     }
00178     for( i = 0; i < 5*n; i++ ) {
00179         work_i[i] = work[i];
00180     }
00181     for( i = 0; i < n; i++ ) {
00182         iwork_i[i] = iwork[i];
00183     }
00184     for( i = 0; i < m; i++ ) {
00185         ifailv_i[i] = ifailv_save[i];
00186     }
00187     info_i = LAPACKE_zstein_work( LAPACK_COL_MAJOR, n_i, d_i, e_i, m_i, w_i,
00188                                   iblock_i, isplit_i, z_i, ldz_i, work_i,
00189                                   iwork_i, ifailv_i );
00190 
00191     failed = compare_zstein( z, z_i, ifailv, ifailv_i, info, info_i, ldz, m );
00192     if( failed == 0 ) {
00193         printf( "PASSED: column-major middle-level interface to zstein\n" );
00194     } else {
00195         printf( "FAILED: column-major middle-level interface to zstein\n" );
00196     }
00197 
00198     /* Initialize input data, call the column-major high-level
00199      * interface to LAPACK routine and check the results */
00200     for( i = 0; i < n; i++ ) {
00201         d_i[i] = d[i];
00202     }
00203     for( i = 0; i < n; i++ ) {
00204         e_i[i] = e[i];
00205     }
00206     for( i = 0; i < n; i++ ) {
00207         w_i[i] = w[i];
00208     }
00209     for( i = 0; i < n; i++ ) {
00210         iblock_i[i] = iblock[i];
00211     }
00212     for( i = 0; i < n; i++ ) {
00213         isplit_i[i] = isplit[i];
00214     }
00215     for( i = 0; i < ldz*m; i++ ) {
00216         z_i[i] = z_save[i];
00217     }
00218     for( i = 0; i < 5*n; i++ ) {
00219         work_i[i] = work[i];
00220     }
00221     for( i = 0; i < n; i++ ) {
00222         iwork_i[i] = iwork[i];
00223     }
00224     for( i = 0; i < m; i++ ) {
00225         ifailv_i[i] = ifailv_save[i];
00226     }
00227     info_i = LAPACKE_zstein( LAPACK_COL_MAJOR, n_i, d_i, e_i, m_i, w_i,
00228                              iblock_i, isplit_i, z_i, ldz_i, ifailv_i );
00229 
00230     failed = compare_zstein( z, z_i, ifailv, ifailv_i, info, info_i, ldz, m );
00231     if( failed == 0 ) {
00232         printf( "PASSED: column-major high-level interface to zstein\n" );
00233     } else {
00234         printf( "FAILED: column-major high-level interface to zstein\n" );
00235     }
00236 
00237     /* Initialize input data, call the row-major middle-level
00238      * interface to LAPACK routine and check the results */
00239     for( i = 0; i < n; i++ ) {
00240         d_i[i] = d[i];
00241     }
00242     for( i = 0; i < n; i++ ) {
00243         e_i[i] = e[i];
00244     }
00245     for( i = 0; i < n; i++ ) {
00246         w_i[i] = w[i];
00247     }
00248     for( i = 0; i < n; i++ ) {
00249         iblock_i[i] = iblock[i];
00250     }
00251     for( i = 0; i < n; i++ ) {
00252         isplit_i[i] = isplit[i];
00253     }
00254     for( i = 0; i < ldz*m; i++ ) {
00255         z_i[i] = z_save[i];
00256     }
00257     for( i = 0; i < 5*n; i++ ) {
00258         work_i[i] = work[i];
00259     }
00260     for( i = 0; i < n; i++ ) {
00261         iwork_i[i] = iwork[i];
00262     }
00263     for( i = 0; i < m; i++ ) {
00264         ifailv_i[i] = ifailv_save[i];
00265     }
00266 
00267     LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, m, z_i, ldz, z_r, m+2 );
00268     info_i = LAPACKE_zstein_work( LAPACK_ROW_MAJOR, n_i, d_i, e_i, m_i, w_i,
00269                                   iblock_i, isplit_i, z_r, ldz_r, work_i,
00270                                   iwork_i, ifailv_i );
00271 
00272     LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, m, z_r, m+2, z_i, ldz );
00273 
00274     failed = compare_zstein( z, z_i, ifailv, ifailv_i, info, info_i, ldz, m );
00275     if( failed == 0 ) {
00276         printf( "PASSED: row-major middle-level interface to zstein\n" );
00277     } else {
00278         printf( "FAILED: row-major middle-level interface to zstein\n" );
00279     }
00280 
00281     /* Initialize input data, call the row-major high-level
00282      * interface to LAPACK routine and check the results */
00283     for( i = 0; i < n; i++ ) {
00284         d_i[i] = d[i];
00285     }
00286     for( i = 0; i < n; i++ ) {
00287         e_i[i] = e[i];
00288     }
00289     for( i = 0; i < n; i++ ) {
00290         w_i[i] = w[i];
00291     }
00292     for( i = 0; i < n; i++ ) {
00293         iblock_i[i] = iblock[i];
00294     }
00295     for( i = 0; i < n; i++ ) {
00296         isplit_i[i] = isplit[i];
00297     }
00298     for( i = 0; i < ldz*m; i++ ) {
00299         z_i[i] = z_save[i];
00300     }
00301     for( i = 0; i < 5*n; i++ ) {
00302         work_i[i] = work[i];
00303     }
00304     for( i = 0; i < n; i++ ) {
00305         iwork_i[i] = iwork[i];
00306     }
00307     for( i = 0; i < m; i++ ) {
00308         ifailv_i[i] = ifailv_save[i];
00309     }
00310 
00311     /* Init row_major arrays */
00312     LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, m, z_i, ldz, z_r, m+2 );
00313     info_i = LAPACKE_zstein( LAPACK_ROW_MAJOR, n_i, d_i, e_i, m_i, w_i,
00314                              iblock_i, isplit_i, z_r, ldz_r, ifailv_i );
00315 
00316     LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, m, z_r, m+2, z_i, ldz );
00317 
00318     failed = compare_zstein( z, z_i, ifailv, ifailv_i, info, info_i, ldz, m );
00319     if( failed == 0 ) {
00320         printf( "PASSED: row-major high-level interface to zstein\n" );
00321     } else {
00322         printf( "FAILED: row-major high-level interface to zstein\n" );
00323     }
00324 
00325     /* Release memory */
00326     if( d != NULL ) {
00327         LAPACKE_free( d );
00328     }
00329     if( d_i != NULL ) {
00330         LAPACKE_free( d_i );
00331     }
00332     if( e != NULL ) {
00333         LAPACKE_free( e );
00334     }
00335     if( e_i != NULL ) {
00336         LAPACKE_free( e_i );
00337     }
00338     if( w != NULL ) {
00339         LAPACKE_free( w );
00340     }
00341     if( w_i != NULL ) {
00342         LAPACKE_free( w_i );
00343     }
00344     if( iblock != NULL ) {
00345         LAPACKE_free( iblock );
00346     }
00347     if( iblock_i != NULL ) {
00348         LAPACKE_free( iblock_i );
00349     }
00350     if( isplit != NULL ) {
00351         LAPACKE_free( isplit );
00352     }
00353     if( isplit_i != NULL ) {
00354         LAPACKE_free( isplit_i );
00355     }
00356     if( z != NULL ) {
00357         LAPACKE_free( z );
00358     }
00359     if( z_i != NULL ) {
00360         LAPACKE_free( z_i );
00361     }
00362     if( z_r != NULL ) {
00363         LAPACKE_free( z_r );
00364     }
00365     if( z_save != NULL ) {
00366         LAPACKE_free( z_save );
00367     }
00368     if( work != NULL ) {
00369         LAPACKE_free( work );
00370     }
00371     if( work_i != NULL ) {
00372         LAPACKE_free( work_i );
00373     }
00374     if( iwork != NULL ) {
00375         LAPACKE_free( iwork );
00376     }
00377     if( iwork_i != NULL ) {
00378         LAPACKE_free( iwork_i );
00379     }
00380     if( ifailv != NULL ) {
00381         LAPACKE_free( ifailv );
00382     }
00383     if( ifailv_i != NULL ) {
00384         LAPACKE_free( ifailv_i );
00385     }
00386     if( ifailv_save != NULL ) {
00387         LAPACKE_free( ifailv_save );
00388     }
00389 
00390     return 0;
00391 }
00392 
00393 /* Auxiliary function: zstein scalar parameters initialization */
00394 static void init_scalars_zstein( lapack_int *n, lapack_int *m, lapack_int *ldz )
00395 {
00396     *n = 4;
00397     *m = 2;
00398     *ldz = 8;
00399 
00400     return;
00401 }
00402 
00403 /* Auxiliary functions: zstein array parameters initialization */
00404 static void init_d( lapack_int size, double *d ) {
00405     lapack_int i;
00406     for( i = 0; i < size; i++ ) {
00407         d[i] = 0;
00408     }
00409     d[0] = -2.27999999999999980e+000;
00410     d[1] = -1.28456981649329280e-001;
00411     d[2] = -1.66593253752407190e-001;
00412     d[3] = -1.92494976459826360e+000;
00413 }
00414 static void init_e( lapack_int size, double *e ) {
00415     lapack_int i;
00416     for( i = 0; i < size; i++ ) {
00417         e[i] = 0;
00418     }
00419     e[0] = -4.33845594653212970e+000;
00420     e[1] = -2.02259457862261720e+000;
00421     e[2] = -1.80232297833873440e+000;
00422     e[3] = 0.00000000000000000e+000;
00423 }
00424 static void init_w( lapack_int size, double *w ) {
00425     lapack_int i;
00426     for( i = 0; i < size; i++ ) {
00427         w[i] = 0;
00428     }
00429     w[0] = -6.00018545434124210e+000;
00430     w[1] = -3.00303365078195660e+000;
00431     w[2] = 0.00000000000000000e+000;
00432     w[3] = 0.00000000000000000e+000;
00433 }
00434 static void init_iblock( lapack_int size, lapack_int *iblock ) {
00435     lapack_int i;
00436     for( i = 0; i < size; i++ ) {
00437         iblock[i] = 0;
00438     }
00439     iblock[0] = 1;
00440     iblock[1] = 1;
00441     iblock[2] = 0;
00442     iblock[3] = 0;
00443 }
00444 static void init_isplit( lapack_int size, lapack_int *isplit ) {
00445     lapack_int i;
00446     for( i = 0; i < size; i++ ) {
00447         isplit[i] = 0;
00448     }
00449     isplit[0] = 4;
00450     isplit[1] = 0;
00451     isplit[2] = 0;
00452     isplit[3] = 0;
00453 }
00454 static void init_z( lapack_int size, lapack_complex_double *z ) {
00455     lapack_int i;
00456     for( i = 0; i < size; i++ ) {
00457         z[i] = lapack_make_complex_double( 0.0, 0.0 );
00458     }
00459 }
00460 static void init_work( lapack_int size, double *work ) {
00461     lapack_int i;
00462     for( i = 0; i < size; i++ ) {
00463         work[i] = 0;
00464     }
00465 }
00466 static void init_iwork( lapack_int size, lapack_int *iwork ) {
00467     lapack_int i;
00468     for( i = 0; i < size; i++ ) {
00469         iwork[i] = 0;
00470     }
00471 }
00472 static void init_ifailv( lapack_int size, lapack_int *ifailv ) {
00473     lapack_int i;
00474     for( i = 0; i < size; i++ ) {
00475         ifailv[i] = 0;
00476     }
00477 }
00478 
00479 /* Auxiliary function: C interface to zstein results check */
00480 /* Return value: 0 - test is passed, non-zero - test is failed */
00481 static int compare_zstein( lapack_complex_double *z, lapack_complex_double *z_i,
00482                            lapack_int *ifailv, lapack_int *ifailv_i,
00483                            lapack_int info, lapack_int info_i, lapack_int ldz,
00484                            lapack_int m )
00485 {
00486     lapack_int i;
00487     int failed = 0;
00488     for( i = 0; i < ldz*m; i++ ) {
00489         failed += compare_complex_doubles(z[i],z_i[i]);
00490     }
00491     for( i = 0; i < m; i++ ) {
00492         failed += (ifailv[i] == ifailv_i[i]) ? 0 : 1;
00493     }
00494     failed += (info == info_i) ? 0 : 1;
00495     if( info != 0 || info_i != 0 ) {
00496         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00497     }
00498 
00499     return failed;
00500 }


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