zhetrd_3.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 * zhetrd_3 is the test program for the C interface to LAPACK
00036 * routine zhetrd
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_zhetrd( char *uplo, lapack_int *n, lapack_int *lda,
00055                                  lapack_int *lwork );
00056 static void init_a( lapack_int size, lapack_complex_double *a );
00057 static void init_d( lapack_int size, double *d );
00058 static void init_e( lapack_int size, double *e );
00059 static void init_tau( lapack_int size, lapack_complex_double *tau );
00060 static void init_work( lapack_int size, lapack_complex_double *work );
00061 static int compare_zhetrd( lapack_complex_double *a, lapack_complex_double *a_i,
00062                            double *d, double *d_i, double *e, double *e_i,
00063                            lapack_complex_double *tau,
00064                            lapack_complex_double *tau_i, lapack_int info,
00065                            lapack_int info_i, lapack_int lda, lapack_int n );
00066 
00067 int main(void)
00068 {
00069     /* Local scalars */
00070     char uplo, uplo_i;
00071     lapack_int n, n_i;
00072     lapack_int lda, lda_i;
00073     lapack_int lda_r;
00074     lapack_int lwork, lwork_i;
00075     lapack_int info, info_i;
00076     lapack_int i;
00077     int failed;
00078 
00079     /* Local arrays */
00080     lapack_complex_double *a = NULL, *a_i = NULL;
00081     double *d = NULL, *d_i = NULL;
00082     double *e = NULL, *e_i = NULL;
00083     lapack_complex_double *tau = NULL, *tau_i = NULL;
00084     lapack_complex_double *work = NULL, *work_i = NULL;
00085     lapack_complex_double *a_save = NULL;
00086     double *d_save = NULL;
00087     double *e_save = NULL;
00088     lapack_complex_double *tau_save = NULL;
00089     lapack_complex_double *a_r = NULL;
00090 
00091     /* Iniitialize the scalar parameters */
00092     init_scalars_zhetrd( &uplo, &n, &lda, &lwork );
00093     lda_r = n+2;
00094     uplo_i = uplo;
00095     n_i = n;
00096     lda_i = lda;
00097     lwork_i = lwork;
00098 
00099     /* Allocate memory for the LAPACK routine arrays */
00100     a = (lapack_complex_double *)
00101         LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
00102     d = (double *)LAPACKE_malloc( n * sizeof(double) );
00103     e = (double *)LAPACKE_malloc( (n-1) * sizeof(double) );
00104     tau = (lapack_complex_double *)
00105         LAPACKE_malloc( (n-1) * sizeof(lapack_complex_double) );
00106     work = (lapack_complex_double *)
00107         LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
00108 
00109     /* Allocate memory for the C interface function arrays */
00110     a_i = (lapack_complex_double *)
00111         LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
00112     d_i = (double *)LAPACKE_malloc( n * sizeof(double) );
00113     e_i = (double *)LAPACKE_malloc( (n-1) * sizeof(double) );
00114     tau_i = (lapack_complex_double *)
00115         LAPACKE_malloc( (n-1) * sizeof(lapack_complex_double) );
00116     work_i = (lapack_complex_double *)
00117         LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
00118 
00119     /* Allocate memory for the backup arrays */
00120     a_save = (lapack_complex_double *)
00121         LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
00122     d_save = (double *)LAPACKE_malloc( n * sizeof(double) );
00123     e_save = (double *)LAPACKE_malloc( (n-1) * sizeof(double) );
00124     tau_save = (lapack_complex_double *)
00125         LAPACKE_malloc( (n-1) * sizeof(lapack_complex_double) );
00126 
00127     /* Allocate memory for the row-major arrays */
00128     a_r = (lapack_complex_double *)
00129         LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
00130 
00131     /* Initialize input arrays */
00132     init_a( lda*n, a );
00133     init_d( n, d );
00134     init_e( (n-1), e );
00135     init_tau( (n-1), tau );
00136     init_work( lwork, work );
00137 
00138     /* Backup the ouptut arrays */
00139     for( i = 0; i < lda*n; i++ ) {
00140         a_save[i] = a[i];
00141     }
00142     for( i = 0; i < n; i++ ) {
00143         d_save[i] = d[i];
00144     }
00145     for( i = 0; i < (n-1); i++ ) {
00146         e_save[i] = e[i];
00147     }
00148     for( i = 0; i < (n-1); i++ ) {
00149         tau_save[i] = tau[i];
00150     }
00151 
00152     /* Call the LAPACK routine */
00153     zhetrd_( &uplo, &n, a, &lda, d, e, tau, work, &lwork, &info );
00154 
00155     /* Initialize input data, call the column-major middle-level
00156      * interface to LAPACK routine and check the results */
00157     for( i = 0; i < lda*n; i++ ) {
00158         a_i[i] = a_save[i];
00159     }
00160     for( i = 0; i < n; i++ ) {
00161         d_i[i] = d_save[i];
00162     }
00163     for( i = 0; i < (n-1); i++ ) {
00164         e_i[i] = e_save[i];
00165     }
00166     for( i = 0; i < (n-1); i++ ) {
00167         tau_i[i] = tau_save[i];
00168     }
00169     for( i = 0; i < lwork; i++ ) {
00170         work_i[i] = work[i];
00171     }
00172     info_i = LAPACKE_zhetrd_work( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i,
00173                                   d_i, e_i, tau_i, work_i, lwork_i );
00174 
00175     failed = compare_zhetrd( a, a_i, d, d_i, e, e_i, tau, tau_i, info, info_i,
00176                              lda, n );
00177     if( failed == 0 ) {
00178         printf( "PASSED: column-major middle-level interface to zhetrd\n" );
00179     } else {
00180         printf( "FAILED: column-major middle-level interface to zhetrd\n" );
00181     }
00182 
00183     /* Initialize input data, call the column-major high-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         d_i[i] = d_save[i];
00190     }
00191     for( i = 0; i < (n-1); i++ ) {
00192         e_i[i] = e_save[i];
00193     }
00194     for( i = 0; i < (n-1); i++ ) {
00195         tau_i[i] = tau_save[i];
00196     }
00197     for( i = 0; i < lwork; i++ ) {
00198         work_i[i] = work[i];
00199     }
00200     info_i = LAPACKE_zhetrd( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i, d_i,
00201                              e_i, tau_i );
00202 
00203     failed = compare_zhetrd( a, a_i, d, d_i, e, e_i, tau, tau_i, info, info_i,
00204                              lda, n );
00205     if( failed == 0 ) {
00206         printf( "PASSED: column-major high-level interface to zhetrd\n" );
00207     } else {
00208         printf( "FAILED: column-major high-level interface to zhetrd\n" );
00209     }
00210 
00211     /* Initialize input data, call the row-major middle-level
00212      * interface to LAPACK routine and check the results */
00213     for( i = 0; i < lda*n; i++ ) {
00214         a_i[i] = a_save[i];
00215     }
00216     for( i = 0; i < n; i++ ) {
00217         d_i[i] = d_save[i];
00218     }
00219     for( i = 0; i < (n-1); i++ ) {
00220         e_i[i] = e_save[i];
00221     }
00222     for( i = 0; i < (n-1); i++ ) {
00223         tau_i[i] = tau_save[i];
00224     }
00225     for( i = 0; i < lwork; i++ ) {
00226         work_i[i] = work[i];
00227     }
00228 
00229     LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
00230     info_i = LAPACKE_zhetrd_work( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r,
00231                                   d_i, e_i, tau_i, work_i, lwork_i );
00232 
00233     LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
00234 
00235     failed = compare_zhetrd( a, a_i, d, d_i, e, e_i, tau, tau_i, info, info_i,
00236                              lda, n );
00237     if( failed == 0 ) {
00238         printf( "PASSED: row-major middle-level interface to zhetrd\n" );
00239     } else {
00240         printf( "FAILED: row-major middle-level interface to zhetrd\n" );
00241     }
00242 
00243     /* Initialize input data, call the row-major high-level
00244      * interface to LAPACK routine and check the results */
00245     for( i = 0; i < lda*n; i++ ) {
00246         a_i[i] = a_save[i];
00247     }
00248     for( i = 0; i < n; i++ ) {
00249         d_i[i] = d_save[i];
00250     }
00251     for( i = 0; i < (n-1); i++ ) {
00252         e_i[i] = e_save[i];
00253     }
00254     for( i = 0; i < (n-1); i++ ) {
00255         tau_i[i] = tau_save[i];
00256     }
00257     for( i = 0; i < lwork; i++ ) {
00258         work_i[i] = work[i];
00259     }
00260 
00261     /* Init row_major arrays */
00262     LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
00263     info_i = LAPACKE_zhetrd( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r, d_i,
00264                              e_i, tau_i );
00265 
00266     LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
00267 
00268     failed = compare_zhetrd( a, a_i, d, d_i, e, e_i, tau, tau_i, info, info_i,
00269                              lda, n );
00270     if( failed == 0 ) {
00271         printf( "PASSED: row-major high-level interface to zhetrd\n" );
00272     } else {
00273         printf( "FAILED: row-major high-level interface to zhetrd\n" );
00274     }
00275 
00276     /* Release memory */
00277     if( a != NULL ) {
00278         LAPACKE_free( a );
00279     }
00280     if( a_i != NULL ) {
00281         LAPACKE_free( a_i );
00282     }
00283     if( a_r != NULL ) {
00284         LAPACKE_free( a_r );
00285     }
00286     if( a_save != NULL ) {
00287         LAPACKE_free( a_save );
00288     }
00289     if( d != NULL ) {
00290         LAPACKE_free( d );
00291     }
00292     if( d_i != NULL ) {
00293         LAPACKE_free( d_i );
00294     }
00295     if( d_save != NULL ) {
00296         LAPACKE_free( d_save );
00297     }
00298     if( e != NULL ) {
00299         LAPACKE_free( e );
00300     }
00301     if( e_i != NULL ) {
00302         LAPACKE_free( e_i );
00303     }
00304     if( e_save != NULL ) {
00305         LAPACKE_free( e_save );
00306     }
00307     if( tau != NULL ) {
00308         LAPACKE_free( tau );
00309     }
00310     if( tau_i != NULL ) {
00311         LAPACKE_free( tau_i );
00312     }
00313     if( tau_save != NULL ) {
00314         LAPACKE_free( tau_save );
00315     }
00316     if( work != NULL ) {
00317         LAPACKE_free( work );
00318     }
00319     if( work_i != NULL ) {
00320         LAPACKE_free( work_i );
00321     }
00322 
00323     return 0;
00324 }
00325 
00326 /* Auxiliary function: zhetrd scalar parameters initialization */
00327 static void init_scalars_zhetrd( char *uplo, lapack_int *n, lapack_int *lda,
00328                                  lapack_int *lwork )
00329 {
00330     *uplo = 'L';
00331     *n = 4;
00332     *lda = 8;
00333     *lwork = 512;
00334 
00335     return;
00336 }
00337 
00338 /* Auxiliary functions: zhetrd array parameters initialization */
00339 static void init_a( lapack_int size, lapack_complex_double *a ) {
00340     lapack_int i;
00341     for( i = 0; i < size; i++ ) {
00342         a[i] = lapack_make_complex_double( 0.0, 0.0 );
00343     }
00344     a[0] = lapack_make_complex_double( 6.01999999999999960e+000,
00345                                        0.00000000000000000e+000 );
00346     a[8] = lapack_make_complex_double( 0.00000000000000000e+000,
00347                                        0.00000000000000000e+000 );
00348     a[16] = lapack_make_complex_double( 0.00000000000000000e+000,
00349                                         0.00000000000000000e+000 );
00350     a[24] = lapack_make_complex_double( 0.00000000000000000e+000,
00351                                         0.00000000000000000e+000 );
00352     a[1] = lapack_make_complex_double( -4.50000000000000010e-001,
00353                                        -2.50000000000000000e-001 );
00354     a[9] = lapack_make_complex_double( 2.91000000000000010e+000,
00355                                        0.00000000000000000e+000 );
00356     a[17] = lapack_make_complex_double( 0.00000000000000000e+000,
00357                                         0.00000000000000000e+000 );
00358     a[25] = lapack_make_complex_double( 0.00000000000000000e+000,
00359                                         0.00000000000000000e+000 );
00360     a[2] = lapack_make_complex_double( -1.30000000000000000e+000,
00361                                        -1.74000000000000000e+000 );
00362     a[10] = lapack_make_complex_double( 5.00000000000000030e-002,
00363                                         -1.56000000000000010e+000 );
00364     a[18] = lapack_make_complex_double( 3.29000000000000000e+000,
00365                                         0.00000000000000000e+000 );
00366     a[26] = lapack_make_complex_double( 0.00000000000000000e+000,
00367                                         0.00000000000000000e+000 );
00368     a[3] = lapack_make_complex_double( 1.45000000000000000e+000,
00369                                        6.60000000000000030e-001 );
00370     a[11] = lapack_make_complex_double( -1.04000000000000000e+000,
00371                                         -1.27000000000000000e+000 );
00372     a[19] = lapack_make_complex_double( 1.40000000000000010e-001,
00373                                         -1.70000000000000000e+000 );
00374     a[27] = lapack_make_complex_double( 4.17999999999999970e+000,
00375                                         0.00000000000000000e+000 );
00376 }
00377 static void init_d( lapack_int size, double *d ) {
00378     lapack_int i;
00379     for( i = 0; i < size; i++ ) {
00380         d[i] = 0;
00381     }
00382 }
00383 static void init_e( lapack_int size, double *e ) {
00384     lapack_int i;
00385     for( i = 0; i < size; i++ ) {
00386         e[i] = 0;
00387     }
00388 }
00389 static void init_tau( lapack_int size, lapack_complex_double *tau ) {
00390     lapack_int i;
00391     for( i = 0; i < size; i++ ) {
00392         tau[i] = lapack_make_complex_double( 0.0, 0.0 );
00393     }
00394 }
00395 static void init_work( lapack_int size, lapack_complex_double *work ) {
00396     lapack_int i;
00397     for( i = 0; i < size; i++ ) {
00398         work[i] = lapack_make_complex_double( 0.0, 0.0 );
00399     }
00400 }
00401 
00402 /* Auxiliary function: C interface to zhetrd results check */
00403 /* Return value: 0 - test is passed, non-zero - test is failed */
00404 static int compare_zhetrd( lapack_complex_double *a, lapack_complex_double *a_i,
00405                            double *d, double *d_i, double *e, double *e_i,
00406                            lapack_complex_double *tau,
00407                            lapack_complex_double *tau_i, lapack_int info,
00408                            lapack_int info_i, lapack_int lda, lapack_int n )
00409 {
00410     lapack_int i;
00411     int failed = 0;
00412     for( i = 0; i < lda*n; i++ ) {
00413         failed += compare_complex_doubles(a[i],a_i[i]);
00414     }
00415     for( i = 0; i < n; i++ ) {
00416         failed += compare_doubles(d[i],d_i[i]);
00417     }
00418     for( i = 0; i < (n-1); i++ ) {
00419         failed += compare_doubles(e[i],e_i[i]);
00420     }
00421     for( i = 0; i < (n-1); i++ ) {
00422         failed += compare_complex_doubles(tau[i],tau_i[i]);
00423     }
00424     failed += (info == info_i) ? 0 : 1;
00425     if( info != 0 || info_i != 0 ) {
00426         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00427     }
00428 
00429     return failed;
00430 }


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