dhsein_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 * dhsein_1 is the test program for the C interface to LAPACK
00036 * routine dhsein
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_dhsein( char *job, char *eigsrc, char *initv,
00055                                  lapack_int *n, lapack_int *ldh,
00056                                  lapack_int *ldvl, lapack_int *ldvr,
00057                                  lapack_int *mm );
00058 static void init_select( lapack_int size, lapack_int *select );
00059 static void init_h( lapack_int size, double *h );
00060 static void init_wr( lapack_int size, double *wr );
00061 static void init_wi( lapack_int size, double *wi );
00062 static void init_vl( lapack_int size, double *vl );
00063 static void init_vr( lapack_int size, double *vr );
00064 static void init_work( lapack_int size, double *work );
00065 static void init_ifaill( lapack_int size, lapack_int *ifaill );
00066 static void init_ifailr( lapack_int size, lapack_int *ifailr );
00067 static int compare_dhsein( lapack_int *select, lapack_int *select_i, double *wr,
00068                            double *wr_i, double *vl, double *vl_i, double *vr,
00069                            double *vr_i, lapack_int m, lapack_int m_i,
00070                            lapack_int *ifaill, lapack_int *ifaill_i,
00071                            lapack_int *ifailr, lapack_int *ifailr_i,
00072                            lapack_int info, lapack_int info_i, char job,
00073                            lapack_int ldvl, lapack_int ldvr, lapack_int mm,
00074                            lapack_int n );
00075 
00076 int main(void)
00077 {
00078     /* Local scalars */
00079     char job, job_i;
00080     char eigsrc, eigsrc_i;
00081     char initv, initv_i;
00082     lapack_int n, n_i;
00083     lapack_int ldh, ldh_i;
00084     lapack_int ldh_r;
00085     lapack_int ldvl, ldvl_i;
00086     lapack_int ldvl_r;
00087     lapack_int ldvr, ldvr_i;
00088     lapack_int ldvr_r;
00089     lapack_int mm, mm_i;
00090     lapack_int m, m_i;
00091     lapack_int info, info_i;
00092     lapack_int i;
00093     int failed;
00094 
00095     /* Local arrays */
00096     lapack_int *select = NULL, *select_i = NULL;
00097     double *h = NULL, *h_i = NULL;
00098     double *wr = NULL, *wr_i = NULL;
00099     double *wi = NULL, *wi_i = NULL;
00100     double *vl = NULL, *vl_i = NULL;
00101     double *vr = NULL, *vr_i = NULL;
00102     double *work = NULL, *work_i = NULL;
00103     lapack_int *ifaill = NULL, *ifaill_i = NULL;
00104     lapack_int *ifailr = NULL, *ifailr_i = NULL;
00105     lapack_int *select_save = NULL;
00106     double *wr_save = NULL;
00107     double *vl_save = NULL;
00108     double *vr_save = NULL;
00109     lapack_int *ifaill_save = NULL;
00110     lapack_int *ifailr_save = NULL;
00111     double *h_r = NULL;
00112     double *vl_r = NULL;
00113     double *vr_r = NULL;
00114 
00115     /* Iniitialize the scalar parameters */
00116     init_scalars_dhsein( &job, &eigsrc, &initv, &n, &ldh, &ldvl, &ldvr, &mm );
00117     ldh_r = n+2;
00118     ldvl_r = mm+2;
00119     ldvr_r = mm+2;
00120     job_i = job;
00121     eigsrc_i = eigsrc;
00122     initv_i = initv;
00123     n_i = n;
00124     ldh_i = ldh;
00125     ldvl_i = ldvl;
00126     ldvr_i = ldvr;
00127     mm_i = mm;
00128 
00129     /* Allocate memory for the LAPACK routine arrays */
00130     select = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00131     h = (double *)LAPACKE_malloc( ldh*n * sizeof(double) );
00132     wr = (double *)LAPACKE_malloc( n * sizeof(double) );
00133     wi = (double *)LAPACKE_malloc( n * sizeof(double) );
00134     vl = (double *)LAPACKE_malloc( ldvl*mm * sizeof(double) );
00135     vr = (double *)LAPACKE_malloc( ldvr*mm * sizeof(double) );
00136     work = (double *)LAPACKE_malloc( (((n+2)*n)) * sizeof(double) );
00137     ifaill = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00138     ifailr = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00139 
00140     /* Allocate memory for the C interface function arrays */
00141     select_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00142     h_i = (double *)LAPACKE_malloc( ldh*n * sizeof(double) );
00143     wr_i = (double *)LAPACKE_malloc( n * sizeof(double) );
00144     wi_i = (double *)LAPACKE_malloc( n * sizeof(double) );
00145     vl_i = (double *)LAPACKE_malloc( ldvl*mm * sizeof(double) );
00146     vr_i = (double *)LAPACKE_malloc( ldvr*mm * sizeof(double) );
00147     work_i = (double *)LAPACKE_malloc( (((n+2)*n)) * sizeof(double) );
00148     ifaill_i = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00149     ifailr_i = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00150 
00151     /* Allocate memory for the backup arrays */
00152     select_save = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00153     wr_save = (double *)LAPACKE_malloc( n * sizeof(double) );
00154     vl_save = (double *)LAPACKE_malloc( ldvl*mm * sizeof(double) );
00155     vr_save = (double *)LAPACKE_malloc( ldvr*mm * sizeof(double) );
00156     ifaill_save = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00157     ifailr_save = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
00158 
00159     /* Allocate memory for the row-major arrays */
00160     h_r = (double *)LAPACKE_malloc( n*(n+2) * sizeof(double) );
00161     vl_r = (double *)LAPACKE_malloc( n*(mm+2) * sizeof(double) );
00162     vr_r = (double *)LAPACKE_malloc( n*(mm+2) * sizeof(double) );
00163 
00164     /* Initialize input arrays */
00165     init_select( n, select );
00166     init_h( ldh*n, h );
00167     init_wr( n, wr );
00168     init_wi( n, wi );
00169     init_vl( ldvl*mm, vl );
00170     init_vr( ldvr*mm, vr );
00171     init_work( ((n+2)*n), work );
00172     init_ifaill( mm, ifaill );
00173     init_ifailr( mm, ifailr );
00174 
00175     /* Backup the ouptut arrays */
00176     for( i = 0; i < n; i++ ) {
00177         select_save[i] = select[i];
00178     }
00179     for( i = 0; i < n; i++ ) {
00180         wr_save[i] = wr[i];
00181     }
00182     for( i = 0; i < ldvl*mm; i++ ) {
00183         vl_save[i] = vl[i];
00184     }
00185     for( i = 0; i < ldvr*mm; i++ ) {
00186         vr_save[i] = vr[i];
00187     }
00188     for( i = 0; i < mm; i++ ) {
00189         ifaill_save[i] = ifaill[i];
00190     }
00191     for( i = 0; i < mm; i++ ) {
00192         ifailr_save[i] = ifailr[i];
00193     }
00194 
00195     /* Call the LAPACK routine */
00196     dhsein_( &job, &eigsrc, &initv, select, &n, h, &ldh, wr, wi, vl, &ldvl, vr,
00197              &ldvr, &mm, &m, work, ifaill, ifailr, &info );
00198 
00199     /* Initialize input data, call the column-major middle-level
00200      * interface to LAPACK routine and check the results */
00201     for( i = 0; i < n; i++ ) {
00202         select_i[i] = select_save[i];
00203     }
00204     for( i = 0; i < ldh*n; i++ ) {
00205         h_i[i] = h[i];
00206     }
00207     for( i = 0; i < n; i++ ) {
00208         wr_i[i] = wr_save[i];
00209     }
00210     for( i = 0; i < n; i++ ) {
00211         wi_i[i] = wi[i];
00212     }
00213     for( i = 0; i < ldvl*mm; i++ ) {
00214         vl_i[i] = vl_save[i];
00215     }
00216     for( i = 0; i < ldvr*mm; i++ ) {
00217         vr_i[i] = vr_save[i];
00218     }
00219     for( i = 0; i < ((n+2)*n); i++ ) {
00220         work_i[i] = work[i];
00221     }
00222     for( i = 0; i < mm; i++ ) {
00223         ifaill_i[i] = ifaill_save[i];
00224     }
00225     for( i = 0; i < mm; i++ ) {
00226         ifailr_i[i] = ifailr_save[i];
00227     }
00228     info_i = LAPACKE_dhsein_work( LAPACK_COL_MAJOR, job_i, eigsrc_i, initv_i,
00229                                   select_i, n_i, h_i, ldh_i, wr_i, wi_i, vl_i,
00230                                   ldvl_i, vr_i, ldvr_i, mm_i, &m_i, work_i,
00231                                   ifaill_i, ifailr_i );
00232 
00233     failed = compare_dhsein( select, select_i, wr, wr_i, vl, vl_i, vr, vr_i, m,
00234                              m_i, ifaill, ifaill_i, ifailr, ifailr_i, info,
00235                              info_i, job, ldvl, ldvr, mm, n );
00236     if( failed == 0 ) {
00237         printf( "PASSED: column-major middle-level interface to dhsein\n" );
00238     } else {
00239         printf( "FAILED: column-major middle-level interface to dhsein\n" );
00240     }
00241 
00242     /* Initialize input data, call the column-major high-level
00243      * interface to LAPACK routine and check the results */
00244     for( i = 0; i < n; i++ ) {
00245         select_i[i] = select_save[i];
00246     }
00247     for( i = 0; i < ldh*n; i++ ) {
00248         h_i[i] = h[i];
00249     }
00250     for( i = 0; i < n; i++ ) {
00251         wr_i[i] = wr_save[i];
00252     }
00253     for( i = 0; i < n; i++ ) {
00254         wi_i[i] = wi[i];
00255     }
00256     for( i = 0; i < ldvl*mm; i++ ) {
00257         vl_i[i] = vl_save[i];
00258     }
00259     for( i = 0; i < ldvr*mm; i++ ) {
00260         vr_i[i] = vr_save[i];
00261     }
00262     for( i = 0; i < ((n+2)*n); i++ ) {
00263         work_i[i] = work[i];
00264     }
00265     for( i = 0; i < mm; i++ ) {
00266         ifaill_i[i] = ifaill_save[i];
00267     }
00268     for( i = 0; i < mm; i++ ) {
00269         ifailr_i[i] = ifailr_save[i];
00270     }
00271     info_i = LAPACKE_dhsein( LAPACK_COL_MAJOR, job_i, eigsrc_i, initv_i,
00272                              select_i, n_i, h_i, ldh_i, wr_i, wi_i, vl_i,
00273                              ldvl_i, vr_i, ldvr_i, mm_i, &m_i, ifaill_i,
00274                              ifailr_i );
00275 
00276     failed = compare_dhsein( select, select_i, wr, wr_i, vl, vl_i, vr, vr_i, m,
00277                              m_i, ifaill, ifaill_i, ifailr, ifailr_i, info,
00278                              info_i, job, ldvl, ldvr, mm, n );
00279     if( failed == 0 ) {
00280         printf( "PASSED: column-major high-level interface to dhsein\n" );
00281     } else {
00282         printf( "FAILED: column-major high-level interface to dhsein\n" );
00283     }
00284 
00285     /* Initialize input data, call the row-major middle-level
00286      * interface to LAPACK routine and check the results */
00287     for( i = 0; i < n; i++ ) {
00288         select_i[i] = select_save[i];
00289     }
00290     for( i = 0; i < ldh*n; i++ ) {
00291         h_i[i] = h[i];
00292     }
00293     for( i = 0; i < n; i++ ) {
00294         wr_i[i] = wr_save[i];
00295     }
00296     for( i = 0; i < n; i++ ) {
00297         wi_i[i] = wi[i];
00298     }
00299     for( i = 0; i < ldvl*mm; i++ ) {
00300         vl_i[i] = vl_save[i];
00301     }
00302     for( i = 0; i < ldvr*mm; i++ ) {
00303         vr_i[i] = vr_save[i];
00304     }
00305     for( i = 0; i < ((n+2)*n); i++ ) {
00306         work_i[i] = work[i];
00307     }
00308     for( i = 0; i < mm; i++ ) {
00309         ifaill_i[i] = ifaill_save[i];
00310     }
00311     for( i = 0; i < mm; i++ ) {
00312         ifailr_i[i] = ifailr_save[i];
00313     }
00314 
00315     LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, h_i, ldh, h_r, n+2 );
00316     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00317         LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
00318     }
00319     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00320         LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
00321     }
00322     info_i = LAPACKE_dhsein_work( LAPACK_ROW_MAJOR, job_i, eigsrc_i, initv_i,
00323                                   select_i, n_i, h_r, ldh_r, wr_i, wi_i, vl_r,
00324                                   ldvl_r, vr_r, ldvr_r, mm_i, &m_i, work_i,
00325                                   ifaill_i, ifailr_i );
00326 
00327     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00328         LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, mm, vl_r, mm+2, vl_i, ldvl );
00329     }
00330     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00331         LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, mm, vr_r, mm+2, vr_i, ldvr );
00332     }
00333 
00334     failed = compare_dhsein( select, select_i, wr, wr_i, vl, vl_i, vr, vr_i, m,
00335                              m_i, ifaill, ifaill_i, ifailr, ifailr_i, info,
00336                              info_i, job, ldvl, ldvr, mm, n );
00337     if( failed == 0 ) {
00338         printf( "PASSED: row-major middle-level interface to dhsein\n" );
00339     } else {
00340         printf( "FAILED: row-major middle-level interface to dhsein\n" );
00341     }
00342 
00343     /* Initialize input data, call the row-major high-level
00344      * interface to LAPACK routine and check the results */
00345     for( i = 0; i < n; i++ ) {
00346         select_i[i] = select_save[i];
00347     }
00348     for( i = 0; i < ldh*n; i++ ) {
00349         h_i[i] = h[i];
00350     }
00351     for( i = 0; i < n; i++ ) {
00352         wr_i[i] = wr_save[i];
00353     }
00354     for( i = 0; i < n; i++ ) {
00355         wi_i[i] = wi[i];
00356     }
00357     for( i = 0; i < ldvl*mm; i++ ) {
00358         vl_i[i] = vl_save[i];
00359     }
00360     for( i = 0; i < ldvr*mm; i++ ) {
00361         vr_i[i] = vr_save[i];
00362     }
00363     for( i = 0; i < ((n+2)*n); i++ ) {
00364         work_i[i] = work[i];
00365     }
00366     for( i = 0; i < mm; i++ ) {
00367         ifaill_i[i] = ifaill_save[i];
00368     }
00369     for( i = 0; i < mm; i++ ) {
00370         ifailr_i[i] = ifailr_save[i];
00371     }
00372 
00373     /* Init row_major arrays */
00374     LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, h_i, ldh, h_r, n+2 );
00375     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00376         LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
00377     }
00378     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00379         LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
00380     }
00381     info_i = LAPACKE_dhsein( LAPACK_ROW_MAJOR, job_i, eigsrc_i, initv_i,
00382                              select_i, n_i, h_r, ldh_r, wr_i, wi_i, vl_r,
00383                              ldvl_r, vr_r, ldvr_r, mm_i, &m_i, ifaill_i,
00384                              ifailr_i );
00385 
00386     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00387         LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, mm, vl_r, mm+2, vl_i, ldvl );
00388     }
00389     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00390         LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, mm, vr_r, mm+2, vr_i, ldvr );
00391     }
00392 
00393     failed = compare_dhsein( select, select_i, wr, wr_i, vl, vl_i, vr, vr_i, m,
00394                              m_i, ifaill, ifaill_i, ifailr, ifailr_i, info,
00395                              info_i, job, ldvl, ldvr, mm, n );
00396     if( failed == 0 ) {
00397         printf( "PASSED: row-major high-level interface to dhsein\n" );
00398     } else {
00399         printf( "FAILED: row-major high-level interface to dhsein\n" );
00400     }
00401 
00402     /* Release memory */
00403     if( select != NULL ) {
00404         LAPACKE_free( select );
00405     }
00406     if( select_i != NULL ) {
00407         LAPACKE_free( select_i );
00408     }
00409     if( select_save != NULL ) {
00410         LAPACKE_free( select_save );
00411     }
00412     if( h != NULL ) {
00413         LAPACKE_free( h );
00414     }
00415     if( h_i != NULL ) {
00416         LAPACKE_free( h_i );
00417     }
00418     if( h_r != NULL ) {
00419         LAPACKE_free( h_r );
00420     }
00421     if( wr != NULL ) {
00422         LAPACKE_free( wr );
00423     }
00424     if( wr_i != NULL ) {
00425         LAPACKE_free( wr_i );
00426     }
00427     if( wr_save != NULL ) {
00428         LAPACKE_free( wr_save );
00429     }
00430     if( wi != NULL ) {
00431         LAPACKE_free( wi );
00432     }
00433     if( wi_i != NULL ) {
00434         LAPACKE_free( wi_i );
00435     }
00436     if( vl != NULL ) {
00437         LAPACKE_free( vl );
00438     }
00439     if( vl_i != NULL ) {
00440         LAPACKE_free( vl_i );
00441     }
00442     if( vl_r != NULL ) {
00443         LAPACKE_free( vl_r );
00444     }
00445     if( vl_save != NULL ) {
00446         LAPACKE_free( vl_save );
00447     }
00448     if( vr != NULL ) {
00449         LAPACKE_free( vr );
00450     }
00451     if( vr_i != NULL ) {
00452         LAPACKE_free( vr_i );
00453     }
00454     if( vr_r != NULL ) {
00455         LAPACKE_free( vr_r );
00456     }
00457     if( vr_save != NULL ) {
00458         LAPACKE_free( vr_save );
00459     }
00460     if( work != NULL ) {
00461         LAPACKE_free( work );
00462     }
00463     if( work_i != NULL ) {
00464         LAPACKE_free( work_i );
00465     }
00466     if( ifaill != NULL ) {
00467         LAPACKE_free( ifaill );
00468     }
00469     if( ifaill_i != NULL ) {
00470         LAPACKE_free( ifaill_i );
00471     }
00472     if( ifaill_save != NULL ) {
00473         LAPACKE_free( ifaill_save );
00474     }
00475     if( ifailr != NULL ) {
00476         LAPACKE_free( ifailr );
00477     }
00478     if( ifailr_i != NULL ) {
00479         LAPACKE_free( ifailr_i );
00480     }
00481     if( ifailr_save != NULL ) {
00482         LAPACKE_free( ifailr_save );
00483     }
00484 
00485     return 0;
00486 }
00487 
00488 /* Auxiliary function: dhsein scalar parameters initialization */
00489 static void init_scalars_dhsein( char *job, char *eigsrc, char *initv,
00490                                  lapack_int *n, lapack_int *ldh,
00491                                  lapack_int *ldvl, lapack_int *ldvr,
00492                                  lapack_int *mm )
00493 {
00494     *job = 'R';
00495     *eigsrc = 'Q';
00496     *initv = 'N';
00497     *n = 4;
00498     *ldh = 8;
00499     *ldvl = 8;
00500     *ldvr = 8;
00501     *mm = 4;
00502 
00503     return;
00504 }
00505 
00506 /* Auxiliary functions: dhsein array parameters initialization */
00507 static void init_select( lapack_int size, lapack_int *select ) {
00508     lapack_int i;
00509     for( i = 0; i < size; i++ ) {
00510         select[i] = 0;
00511     }
00512     select[0] = 0;
00513     select[1] = -1;
00514     select[2] = -1;
00515     select[3] = -1;
00516 }
00517 static void init_h( lapack_int size, double *h ) {
00518     lapack_int i;
00519     for( i = 0; i < size; i++ ) {
00520         h[i] = 0;
00521     }
00522     h[0] = 3.49999999999999980e-001;  /* h[0,0] */
00523     h[8] = -1.15952429620503390e-001;  /* h[0,1] */
00524     h[16] = -3.88601034323321160e-001;  /* h[0,2] */
00525     h[24] = -2.94184075347302120e-001;  /* h[0,3] */
00526     h[1] = -5.14003891035855980e-001;  /* h[1,0] */
00527     h[9] = 1.22486752460257420e-001;  /* h[1,1] */
00528     h[17] = 1.00359789682150170e-001;  /* h[1,2] */
00529     h[25] = 1.12561879970531830e-001;  /* h[1,3] */
00530     h[2] = -7.28472128292762870e-001;  /* h[2,0] */
00531     h[10] = 6.44263618527061930e-001;  /* h[2,1] */
00532     h[18] = -1.35700171757113630e-001;  /* h[2,2] */
00533     h[26] = -9.76816227049334410e-002;  /* h[2,3] */
00534     h[3] = 4.13904618348160720e-001;  /* h[3,0] */
00535     h[11] = -1.66544579490569860e-001;  /* h[3,1] */
00536     h[19] = 4.26244372207844720e-001;  /* h[3,2] */
00537     h[27] = 1.63213419296856090e-001;  /* h[3,3] */
00538 }
00539 static void init_wr( lapack_int size, double *wr ) {
00540     lapack_int i;
00541     for( i = 0; i < size; i++ ) {
00542         wr[i] = 0;
00543     }
00544     wr[0] = 7.99482122586209880e-001;
00545     wr[1] = -9.94124532950746570e-002;
00546     wr[2] = -9.94124532950746570e-002;
00547     wr[3] = -1.00657215996058770e-001;
00548 }
00549 static void init_wi( lapack_int size, double *wi ) {
00550     lapack_int i;
00551     for( i = 0; i < size; i++ ) {
00552         wi[i] = 0;
00553     }
00554     wi[0] = 0.00000000000000000e+000;
00555     wi[1] = 4.00792471989754480e-001;
00556     wi[2] = -4.00792471989754480e-001;
00557     wi[3] = 0.00000000000000000e+000;
00558 }
00559 static void init_vl( lapack_int size, double *vl ) {
00560     lapack_int i;
00561     for( i = 0; i < size; i++ ) {
00562         vl[i] = 0;
00563     }
00564     vl[0] = 0.00000000000000000e+000;  /* vl[0,0] */
00565     vl[8] = 0.00000000000000000e+000;  /* vl[0,1] */
00566     vl[16] = 0.00000000000000000e+000;  /* vl[0,2] */
00567     vl[24] = 0.00000000000000000e+000;  /* vl[0,3] */
00568     vl[1] = 0.00000000000000000e+000;  /* vl[1,0] */
00569     vl[9] = 0.00000000000000000e+000;  /* vl[1,1] */
00570     vl[17] = 0.00000000000000000e+000;  /* vl[1,2] */
00571     vl[25] = 0.00000000000000000e+000;  /* vl[1,3] */
00572     vl[2] = 0.00000000000000000e+000;  /* vl[2,0] */
00573     vl[10] = 0.00000000000000000e+000;  /* vl[2,1] */
00574     vl[18] = 0.00000000000000000e+000;  /* vl[2,2] */
00575     vl[26] = 0.00000000000000000e+000;  /* vl[2,3] */
00576     vl[3] = 0.00000000000000000e+000;  /* vl[3,0] */
00577     vl[11] = 0.00000000000000000e+000;  /* vl[3,1] */
00578     vl[19] = 0.00000000000000000e+000;  /* vl[3,2] */
00579     vl[27] = 0.00000000000000000e+000;  /* vl[3,3] */
00580 }
00581 static void init_vr( lapack_int size, double *vr ) {
00582     lapack_int i;
00583     for( i = 0; i < size; i++ ) {
00584         vr[i] = 0;
00585     }
00586     vr[0] = 0.00000000000000000e+000;  /* vr[0,0] */
00587     vr[8] = 0.00000000000000000e+000;  /* vr[0,1] */
00588     vr[16] = 0.00000000000000000e+000;  /* vr[0,2] */
00589     vr[24] = 0.00000000000000000e+000;  /* vr[0,3] */
00590     vr[1] = 0.00000000000000000e+000;  /* vr[1,0] */
00591     vr[9] = 0.00000000000000000e+000;  /* vr[1,1] */
00592     vr[17] = 0.00000000000000000e+000;  /* vr[1,2] */
00593     vr[25] = 0.00000000000000000e+000;  /* vr[1,3] */
00594     vr[2] = 0.00000000000000000e+000;  /* vr[2,0] */
00595     vr[10] = 0.00000000000000000e+000;  /* vr[2,1] */
00596     vr[18] = 0.00000000000000000e+000;  /* vr[2,2] */
00597     vr[26] = 0.00000000000000000e+000;  /* vr[2,3] */
00598     vr[3] = 0.00000000000000000e+000;  /* vr[3,0] */
00599     vr[11] = 0.00000000000000000e+000;  /* vr[3,1] */
00600     vr[19] = 0.00000000000000000e+000;  /* vr[3,2] */
00601     vr[27] = 0.00000000000000000e+000;  /* vr[3,3] */
00602 }
00603 static void init_work( lapack_int size, double *work ) {
00604     lapack_int i;
00605     for( i = 0; i < size; i++ ) {
00606         work[i] = 0;
00607     }
00608 }
00609 static void init_ifaill( lapack_int size, lapack_int *ifaill ) {
00610     lapack_int i;
00611     for( i = 0; i < size; i++ ) {
00612         ifaill[i] = 0;
00613     }
00614 }
00615 static void init_ifailr( lapack_int size, lapack_int *ifailr ) {
00616     lapack_int i;
00617     for( i = 0; i < size; i++ ) {
00618         ifailr[i] = 0;
00619     }
00620 }
00621 
00622 /* Auxiliary function: C interface to dhsein results check */
00623 /* Return value: 0 - test is passed, non-zero - test is failed */
00624 static int compare_dhsein( lapack_int *select, lapack_int *select_i, double *wr,
00625                            double *wr_i, double *vl, double *vl_i, double *vr,
00626                            double *vr_i, lapack_int m, lapack_int m_i,
00627                            lapack_int *ifaill, lapack_int *ifaill_i,
00628                            lapack_int *ifailr, lapack_int *ifailr_i,
00629                            lapack_int info, lapack_int info_i, char job,
00630                            lapack_int ldvl, lapack_int ldvr, lapack_int mm,
00631                            lapack_int n )
00632 {
00633     lapack_int i;
00634     int failed = 0;
00635     for( i = 0; i < n; i++ ) {
00636         failed += (select[i] == select_i[i]) ? 0 : 1;
00637     }
00638     for( i = 0; i < n; i++ ) {
00639         failed += compare_doubles(wr[i],wr_i[i]);
00640     }
00641     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00642         for( i = 0; i < ldvl*mm; i++ ) {
00643             failed += compare_doubles(vl[i],vl_i[i]);
00644         }
00645     }
00646     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00647         for( i = 0; i < ldvr*mm; i++ ) {
00648             failed += compare_doubles(vr[i],vr_i[i]);
00649         }
00650     }
00651     failed += (m == m_i) ? 0 : 1;
00652     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
00653         for( i = 0; i < mm; i++ ) {
00654             failed += (ifaill[i] == ifaill_i[i]) ? 0 : 1;
00655         }
00656     }
00657     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
00658         for( i = 0; i < mm; i++ ) {
00659             failed += (ifailr[i] == ifailr_i[i]) ? 0 : 1;
00660         }
00661     }
00662     failed += (info == info_i) ? 0 : 1;
00663     if( info != 0 || info_i != 0 ) {
00664         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00665     }
00666 
00667     return failed;
00668 }


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