ztrsna_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 * ztrsna_1 is the test program for the C interface to LAPACK
00036 * routine ztrsna
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_ztrsna( char *job, char *howmny, lapack_int *n,
00055                                  lapack_int *ldt, lapack_int *ldvl,
00056                                  lapack_int *ldvr, lapack_int *mm,
00057                                  lapack_int *ldwork );
00058 static void init_select( lapack_int size, lapack_int *select );
00059 static void init_t( lapack_int size, lapack_complex_double *t );
00060 static void init_vl( lapack_int size, lapack_complex_double *vl );
00061 static void init_vr( lapack_int size, lapack_complex_double *vr );
00062 static void init_s( lapack_int size, double *s );
00063 static void init_sep( lapack_int size, double *sep );
00064 static void init_work( lapack_int size, lapack_complex_double *work );
00065 static void init_rwork( lapack_int size, double *rwork );
00066 static int compare_ztrsna( double *s, double *s_i, double *sep, double *sep_i,
00067                            lapack_int m, lapack_int m_i, lapack_int info,
00068                            lapack_int info_i, char job, lapack_int mm );
00069 
00070 int main(void)
00071 {
00072     /* Local scalars */
00073     char job, job_i;
00074     char howmny, howmny_i;
00075     lapack_int n, n_i;
00076     lapack_int ldt, ldt_i;
00077     lapack_int ldt_r;
00078     lapack_int ldvl, ldvl_i;
00079     lapack_int ldvl_r;
00080     lapack_int ldvr, ldvr_i;
00081     lapack_int ldvr_r;
00082     lapack_int mm, mm_i;
00083     lapack_int m, m_i;
00084     lapack_int ldwork, ldwork_i;
00085     lapack_int info, info_i;
00086     lapack_int i;
00087     int failed;
00088 
00089     /* Local arrays */
00090     lapack_int *select = NULL, *select_i = NULL;
00091     lapack_complex_double *t = NULL, *t_i = NULL;
00092     lapack_complex_double *vl = NULL, *vl_i = NULL;
00093     lapack_complex_double *vr = NULL, *vr_i = NULL;
00094     double *s = NULL, *s_i = NULL;
00095     double *sep = NULL, *sep_i = NULL;
00096     lapack_complex_double *work = NULL, *work_i = NULL;
00097     double *rwork = NULL, *rwork_i = NULL;
00098     double *s_save = NULL;
00099     double *sep_save = NULL;
00100     lapack_complex_double *t_r = NULL;
00101     lapack_complex_double *vl_r = NULL;
00102     lapack_complex_double *vr_r = NULL;
00103 
00104     /* Iniitialize the scalar parameters */
00105     init_scalars_ztrsna( &job, &howmny, &n, &ldt, &ldvl, &ldvr, &mm, &ldwork );
00106     ldt_r = n+2;
00107     ldvl_r = mm+2;
00108     ldvr_r = mm+2;
00109     job_i = job;
00110     howmny_i = howmny;
00111     n_i = n;
00112     ldt_i = ldt;
00113     ldvl_i = ldvl;
00114     ldvr_i = ldvr;
00115     mm_i = mm;
00116     ldwork_i = ldwork;
00117 
00118     /* Allocate memory for the LAPACK routine arrays */
00119     select = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00120     t = (lapack_complex_double *)
00121         LAPACKE_malloc( ldt*n * sizeof(lapack_complex_double) );
00122     vl = (lapack_complex_double *)
00123         LAPACKE_malloc( ldvl*mm * sizeof(lapack_complex_double) );
00124     vr = (lapack_complex_double *)
00125         LAPACKE_malloc( ldvr*mm * sizeof(lapack_complex_double) );
00126     s = (double *)LAPACKE_malloc( mm * sizeof(double) );
00127     sep = (double *)LAPACKE_malloc( mm * sizeof(double) );
00128     work = (lapack_complex_double *)
00129         LAPACKE_malloc( ldwork*(n+1) * sizeof(lapack_complex_double) );
00130     rwork = (double *)LAPACKE_malloc( n * sizeof(double) );
00131 
00132     /* Allocate memory for the C interface function arrays */
00133     select_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00134     t_i = (lapack_complex_double *)
00135         LAPACKE_malloc( ldt*n * sizeof(lapack_complex_double) );
00136     vl_i = (lapack_complex_double *)
00137         LAPACKE_malloc( ldvl*mm * sizeof(lapack_complex_double) );
00138     vr_i = (lapack_complex_double *)
00139         LAPACKE_malloc( ldvr*mm * sizeof(lapack_complex_double) );
00140     s_i = (double *)LAPACKE_malloc( mm * sizeof(double) );
00141     sep_i = (double *)LAPACKE_malloc( mm * sizeof(double) );
00142     work_i = (lapack_complex_double *)
00143         LAPACKE_malloc( ldwork*(n+1) * sizeof(lapack_complex_double) );
00144     rwork_i = (double *)LAPACKE_malloc( n * sizeof(double) );
00145 
00146     /* Allocate memory for the backup arrays */
00147     s_save = (double *)LAPACKE_malloc( mm * sizeof(double) );
00148     sep_save = (double *)LAPACKE_malloc( mm * sizeof(double) );
00149 
00150     /* Allocate memory for the row-major arrays */
00151     t_r = (lapack_complex_double *)
00152         LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
00153     vl_r = (lapack_complex_double *)
00154         LAPACKE_malloc( n*(mm+2) * sizeof(lapack_complex_double) );
00155     vr_r = (lapack_complex_double *)
00156         LAPACKE_malloc( n*(mm+2) * sizeof(lapack_complex_double) );
00157 
00158     /* Initialize input arrays */
00159     init_select( n, select );
00160     init_t( ldt*n, t );
00161     init_vl( ldvl*mm, vl );
00162     init_vr( ldvr*mm, vr );
00163     init_s( mm, s );
00164     init_sep( mm, sep );
00165     init_work( ldwork*(n+1), work );
00166     init_rwork( n, rwork );
00167 
00168     /* Backup the ouptut arrays */
00169     for( i = 0; i < mm; i++ ) {
00170         s_save[i] = s[i];
00171     }
00172     for( i = 0; i < mm; i++ ) {
00173         sep_save[i] = sep[i];
00174     }
00175 
00176     /* Call the LAPACK routine */
00177     ztrsna_( &job, &howmny, select, &n, t, &ldt, vl, &ldvl, vr, &ldvr, s, sep,
00178              &mm, &m, work, &ldwork, rwork, &info );
00179 
00180     /* Initialize input data, call the column-major middle-level
00181      * interface to LAPACK routine and check the results */
00182     for( i = 0; i < n; i++ ) {
00183         select_i[i] = select[i];
00184     }
00185     for( i = 0; i < ldt*n; i++ ) {
00186         t_i[i] = t[i];
00187     }
00188     for( i = 0; i < ldvl*mm; i++ ) {
00189         vl_i[i] = vl[i];
00190     }
00191     for( i = 0; i < ldvr*mm; i++ ) {
00192         vr_i[i] = vr[i];
00193     }
00194     for( i = 0; i < mm; i++ ) {
00195         s_i[i] = s_save[i];
00196     }
00197     for( i = 0; i < mm; i++ ) {
00198         sep_i[i] = sep_save[i];
00199     }
00200     for( i = 0; i < ldwork*(n+1); i++ ) {
00201         work_i[i] = work[i];
00202     }
00203     for( i = 0; i < n; i++ ) {
00204         rwork_i[i] = rwork[i];
00205     }
00206     info_i = LAPACKE_ztrsna_work( LAPACK_COL_MAJOR, job_i, howmny_i, select_i,
00207                                   n_i, t_i, ldt_i, vl_i, ldvl_i, vr_i, ldvr_i,
00208                                   s_i, sep_i, mm_i, &m_i, work_i, ldwork_i,
00209                                   rwork_i );
00210 
00211     failed = compare_ztrsna( s, s_i, sep, sep_i, m, m_i, info, info_i, job,
00212                              mm );
00213     if( failed == 0 ) {
00214         printf( "PASSED: column-major middle-level interface to ztrsna\n" );
00215     } else {
00216         printf( "FAILED: column-major middle-level interface to ztrsna\n" );
00217     }
00218 
00219     /* Initialize input data, call the column-major high-level
00220      * interface to LAPACK routine and check the results */
00221     for( i = 0; i < n; i++ ) {
00222         select_i[i] = select[i];
00223     }
00224     for( i = 0; i < ldt*n; i++ ) {
00225         t_i[i] = t[i];
00226     }
00227     for( i = 0; i < ldvl*mm; i++ ) {
00228         vl_i[i] = vl[i];
00229     }
00230     for( i = 0; i < ldvr*mm; i++ ) {
00231         vr_i[i] = vr[i];
00232     }
00233     for( i = 0; i < mm; i++ ) {
00234         s_i[i] = s_save[i];
00235     }
00236     for( i = 0; i < mm; i++ ) {
00237         sep_i[i] = sep_save[i];
00238     }
00239     for( i = 0; i < ldwork*(n+1); i++ ) {
00240         work_i[i] = work[i];
00241     }
00242     for( i = 0; i < n; i++ ) {
00243         rwork_i[i] = rwork[i];
00244     }
00245     info_i = LAPACKE_ztrsna( LAPACK_COL_MAJOR, job_i, howmny_i, select_i, n_i,
00246                              t_i, ldt_i, vl_i, ldvl_i, vr_i, ldvr_i, s_i, sep_i,
00247                              mm_i, &m_i );
00248 
00249     failed = compare_ztrsna( s, s_i, sep, sep_i, m, m_i, info, info_i, job,
00250                              mm );
00251     if( failed == 0 ) {
00252         printf( "PASSED: column-major high-level interface to ztrsna\n" );
00253     } else {
00254         printf( "FAILED: column-major high-level interface to ztrsna\n" );
00255     }
00256 
00257     /* Initialize input data, call the row-major middle-level
00258      * interface to LAPACK routine and check the results */
00259     for( i = 0; i < n; i++ ) {
00260         select_i[i] = select[i];
00261     }
00262     for( i = 0; i < ldt*n; i++ ) {
00263         t_i[i] = t[i];
00264     }
00265     for( i = 0; i < ldvl*mm; i++ ) {
00266         vl_i[i] = vl[i];
00267     }
00268     for( i = 0; i < ldvr*mm; i++ ) {
00269         vr_i[i] = vr[i];
00270     }
00271     for( i = 0; i < mm; i++ ) {
00272         s_i[i] = s_save[i];
00273     }
00274     for( i = 0; i < mm; i++ ) {
00275         sep_i[i] = sep_save[i];
00276     }
00277     for( i = 0; i < ldwork*(n+1); i++ ) {
00278         work_i[i] = work[i];
00279     }
00280     for( i = 0; i < n; i++ ) {
00281         rwork_i[i] = rwork[i];
00282     }
00283 
00284     LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
00285     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
00286         LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
00287     }
00288     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
00289         LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
00290     }
00291     info_i = LAPACKE_ztrsna_work( LAPACK_ROW_MAJOR, job_i, howmny_i, select_i,
00292                                   n_i, t_r, ldt_r, vl_r, ldvl_r, vr_r, ldvr_r,
00293                                   s_i, sep_i, mm_i, &m_i, work_i, ldwork_i,
00294                                   rwork_i );
00295 
00296     failed = compare_ztrsna( s, s_i, sep, sep_i, m, m_i, info, info_i, job,
00297                              mm );
00298     if( failed == 0 ) {
00299         printf( "PASSED: row-major middle-level interface to ztrsna\n" );
00300     } else {
00301         printf( "FAILED: row-major middle-level interface to ztrsna\n" );
00302     }
00303 
00304     /* Initialize input data, call the row-major high-level
00305      * interface to LAPACK routine and check the results */
00306     for( i = 0; i < n; i++ ) {
00307         select_i[i] = select[i];
00308     }
00309     for( i = 0; i < ldt*n; i++ ) {
00310         t_i[i] = t[i];
00311     }
00312     for( i = 0; i < ldvl*mm; i++ ) {
00313         vl_i[i] = vl[i];
00314     }
00315     for( i = 0; i < ldvr*mm; i++ ) {
00316         vr_i[i] = vr[i];
00317     }
00318     for( i = 0; i < mm; i++ ) {
00319         s_i[i] = s_save[i];
00320     }
00321     for( i = 0; i < mm; i++ ) {
00322         sep_i[i] = sep_save[i];
00323     }
00324     for( i = 0; i < ldwork*(n+1); i++ ) {
00325         work_i[i] = work[i];
00326     }
00327     for( i = 0; i < n; i++ ) {
00328         rwork_i[i] = rwork[i];
00329     }
00330 
00331     /* Init row_major arrays */
00332     LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
00333     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
00334         LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
00335     }
00336     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
00337         LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
00338     }
00339     info_i = LAPACKE_ztrsna( LAPACK_ROW_MAJOR, job_i, howmny_i, select_i, n_i,
00340                              t_r, ldt_r, vl_r, ldvl_r, vr_r, ldvr_r, s_i, sep_i,
00341                              mm_i, &m_i );
00342 
00343     failed = compare_ztrsna( s, s_i, sep, sep_i, m, m_i, info, info_i, job,
00344                              mm );
00345     if( failed == 0 ) {
00346         printf( "PASSED: row-major high-level interface to ztrsna\n" );
00347     } else {
00348         printf( "FAILED: row-major high-level interface to ztrsna\n" );
00349     }
00350 
00351     /* Release memory */
00352     if( select != NULL ) {
00353         LAPACKE_free( select );
00354     }
00355     if( select_i != NULL ) {
00356         LAPACKE_free( select_i );
00357     }
00358     if( t != NULL ) {
00359         LAPACKE_free( t );
00360     }
00361     if( t_i != NULL ) {
00362         LAPACKE_free( t_i );
00363     }
00364     if( t_r != NULL ) {
00365         LAPACKE_free( t_r );
00366     }
00367     if( vl != NULL ) {
00368         LAPACKE_free( vl );
00369     }
00370     if( vl_i != NULL ) {
00371         LAPACKE_free( vl_i );
00372     }
00373     if( vl_r != NULL ) {
00374         LAPACKE_free( vl_r );
00375     }
00376     if( vr != NULL ) {
00377         LAPACKE_free( vr );
00378     }
00379     if( vr_i != NULL ) {
00380         LAPACKE_free( vr_i );
00381     }
00382     if( vr_r != NULL ) {
00383         LAPACKE_free( vr_r );
00384     }
00385     if( s != NULL ) {
00386         LAPACKE_free( s );
00387     }
00388     if( s_i != NULL ) {
00389         LAPACKE_free( s_i );
00390     }
00391     if( s_save != NULL ) {
00392         LAPACKE_free( s_save );
00393     }
00394     if( sep != NULL ) {
00395         LAPACKE_free( sep );
00396     }
00397     if( sep_i != NULL ) {
00398         LAPACKE_free( sep_i );
00399     }
00400     if( sep_save != NULL ) {
00401         LAPACKE_free( sep_save );
00402     }
00403     if( work != NULL ) {
00404         LAPACKE_free( work );
00405     }
00406     if( work_i != NULL ) {
00407         LAPACKE_free( work_i );
00408     }
00409     if( rwork != NULL ) {
00410         LAPACKE_free( rwork );
00411     }
00412     if( rwork_i != NULL ) {
00413         LAPACKE_free( rwork_i );
00414     }
00415 
00416     return 0;
00417 }
00418 
00419 /* Auxiliary function: ztrsna scalar parameters initialization */
00420 static void init_scalars_ztrsna( char *job, char *howmny, lapack_int *n,
00421                                  lapack_int *ldt, lapack_int *ldvl,
00422                                  lapack_int *ldvr, lapack_int *mm,
00423                                  lapack_int *ldwork )
00424 {
00425     *job = 'B';
00426     *howmny = 'A';
00427     *n = 4;
00428     *ldt = 8;
00429     *ldvl = 8;
00430     *ldvr = 8;
00431     *mm = 4;
00432     *ldwork = 8;
00433 
00434     return;
00435 }
00436 
00437 /* Auxiliary functions: ztrsna array parameters initialization */
00438 static void init_select( lapack_int size, lapack_int *select ) {
00439     lapack_int i;
00440     for( i = 0; i < size; i++ ) {
00441         select[i] = 0;
00442     }
00443     select[0] = 0;
00444     select[1] = 0;
00445     select[2] = 0;
00446     select[3] = 0;
00447 }
00448 static void init_t( lapack_int size, lapack_complex_double *t ) {
00449     lapack_int i;
00450     for( i = 0; i < size; i++ ) {
00451         t[i] = lapack_make_complex_double( 0.0, 0.0 );
00452     }
00453     t[0] = lapack_make_complex_double( -6.00040000000000000e+000,
00454                                        -6.99990000000000020e+000 );
00455     t[8] = lapack_make_complex_double( 3.63700000000000020e-001,
00456                                        -3.65599999999999980e-001 );
00457     t[16] = lapack_make_complex_double( -1.88000000000000000e-001,
00458                                         4.78700000000000010e-001 );
00459     t[24] = lapack_make_complex_double( 8.78499999999999950e-001,
00460                                         -2.53900000000000010e-001 );
00461     t[1] = lapack_make_complex_double( 0.00000000000000000e+000,
00462                                        0.00000000000000000e+000 );
00463     t[9] = lapack_make_complex_double( -5.00000000000000000e+000,
00464                                        2.00599999999999980e+000 );
00465     t[17] = lapack_make_complex_double( -3.07000000000000020e-002,
00466                                         -7.21700000000000010e-001 );
00467     t[25] = lapack_make_complex_double( -2.29000000000000010e-001,
00468                                         1.31300000000000000e-001 );
00469     t[2] = lapack_make_complex_double( 0.00000000000000000e+000,
00470                                        0.00000000000000000e+000 );
00471     t[10] = lapack_make_complex_double( 0.00000000000000000e+000,
00472                                         0.00000000000000000e+000 );
00473     t[18] = lapack_make_complex_double( 7.99819999999999980e+000,
00474                                         -9.96399999999999950e-001 );
00475     t[26] = lapack_make_complex_double( 9.35699999999999980e-001,
00476                                         5.35900000000000040e-001 );
00477     t[3] = lapack_make_complex_double( 0.00000000000000000e+000,
00478                                        0.00000000000000000e+000 );
00479     t[11] = lapack_make_complex_double( 0.00000000000000000e+000,
00480                                         0.00000000000000000e+000 );
00481     t[19] = lapack_make_complex_double( 0.00000000000000000e+000,
00482                                         0.00000000000000000e+000 );
00483     t[27] = lapack_make_complex_double( 3.00230000000000000e+000,
00484                                         -3.99980000000000000e+000 );
00485 }
00486 static void init_vl( lapack_int size, lapack_complex_double *vl ) {
00487     lapack_int i;
00488     for( i = 0; i < size; i++ ) {
00489         vl[i] = lapack_make_complex_double( 0.0, 0.0 );
00490     }
00491     vl[0] = lapack_make_complex_double( 1.00000000000000000e+000,
00492                                         0.00000000000000000e+000 );
00493     vl[8] = lapack_make_complex_double( 0.00000000000000000e+000,
00494                                         0.00000000000000000e+000 );
00495     vl[16] = lapack_make_complex_double( 0.00000000000000000e+000,
00496                                          0.00000000000000000e+000 );
00497     vl[24] = lapack_make_complex_double( 0.00000000000000000e+000,
00498                                          0.00000000000000000e+000 );
00499     vl[1] = lapack_make_complex_double( 3.56694351594852160e-002,
00500                                         -4.43468951391364570e-002 );
00501     vl[9] = lapack_make_complex_double( 1.00000000000000000e+000,
00502                                         0.00000000000000000e+000 );
00503     vl[17] = lapack_make_complex_double( 0.00000000000000000e+000,
00504                                          0.00000000000000000e+000 );
00505     vl[25] = lapack_make_complex_double( 0.00000000000000000e+000,
00506                                          0.00000000000000000e+000 );
00507     vl[2] = lapack_make_complex_double( -2.20737607420687770e-003,
00508                                         3.13134125343339370e-002 );
00509     vl[10] = lapack_make_complex_double( -9.93319711341404500e-003,
00510                                          -5.32286446574668500e-002 );
00511     vl[18] = lapack_make_complex_double( 1.00000000000000000e+000,
00512                                          0.00000000000000000e+000 );
00513     vl[26] = lapack_make_complex_double( 0.00000000000000000e+000,
00514                                          0.00000000000000000e+000 );
00515     vl[3] = lapack_make_complex_double( -7.82438806323640660e-002,
00516                                         -5.82707855845602950e-002 );
00517     vl[11] = lapack_make_complex_double( 3.18749533045133910e-002,
00518                                          -1.95590668724408750e-003 );
00519     vl[19] = lapack_make_complex_double( 1.84940888986473510e-001,
00520                                          3.91350226825490630e-003 );
00521     vl[27] = lapack_make_complex_double( 1.00000000000000000e+000,
00522                                          0.00000000000000000e+000 );
00523 }
00524 static void init_vr( lapack_int size, lapack_complex_double *vr ) {
00525     lapack_int i;
00526     for( i = 0; i < size; i++ ) {
00527         vr[i] = lapack_make_complex_double( 0.0, 0.0 );
00528     }
00529     vr[0] = lapack_make_complex_double( 1.00000000000000000e+000,
00530                                         0.00000000000000000e+000 );
00531     vr[8] = lapack_make_complex_double( -3.56694351594852160e-002,
00532                                         -4.43468951391364570e-002 );
00533     vr[16] = lapack_make_complex_double( -5.07460579179468000e-004,
00534                                          3.27715417727857880e-002 );
00535     vr[24] = lapack_make_complex_double( 7.92597025312869050e-002,
00536                                          -6.28502483030855260e-002 );
00537     vr[1] = lapack_make_complex_double( 0.00000000000000000e+000,
00538                                         0.00000000000000000e+000 );
00539     vr[9] = lapack_make_complex_double( 1.00000000000000000e+000,
00540                                         0.00000000000000000e+000 );
00541     vr[17] = lapack_make_complex_double( 9.93319711341404500e-003,
00542                                          -5.32286446574668500e-002 );
00543     vr[25] = lapack_make_complex_double( -3.35036971875429250e-002,
00544                                          7.92711976468730460e-003 );
00545     vr[2] = lapack_make_complex_double( 0.00000000000000000e+000,
00546                                         0.00000000000000000e+000 );
00547     vr[10] = lapack_make_complex_double( 0.00000000000000000e+000,
00548                                          0.00000000000000000e+000 );
00549     vr[18] = lapack_make_complex_double( 1.00000000000000000e+000,
00550                                          0.00000000000000000e+000 );
00551     vr[26] = lapack_make_complex_double( -1.84940888986473510e-001,
00552                                          3.91350226825490630e-003 );
00553     vr[3] = lapack_make_complex_double( 0.00000000000000000e+000,
00554                                         0.00000000000000000e+000 );
00555     vr[11] = lapack_make_complex_double( 0.00000000000000000e+000,
00556                                          0.00000000000000000e+000 );
00557     vr[19] = lapack_make_complex_double( 0.00000000000000000e+000,
00558                                          0.00000000000000000e+000 );
00559     vr[27] = lapack_make_complex_double( 1.00000000000000000e+000,
00560                                          0.00000000000000000e+000 );
00561 }
00562 static void init_s( lapack_int size, double *s ) {
00563     lapack_int i;
00564     for( i = 0; i < size; i++ ) {
00565         s[i] = 0;
00566     }
00567 }
00568 static void init_sep( lapack_int size, double *sep ) {
00569     lapack_int i;
00570     for( i = 0; i < size; i++ ) {
00571         sep[i] = 0;
00572     }
00573 }
00574 static void init_work( lapack_int size, lapack_complex_double *work ) {
00575     lapack_int i;
00576     for( i = 0; i < size; i++ ) {
00577         work[i] = lapack_make_complex_double( 0.0, 0.0 );
00578     }
00579 }
00580 static void init_rwork( lapack_int size, double *rwork ) {
00581     lapack_int i;
00582     for( i = 0; i < size; i++ ) {
00583         rwork[i] = 0;
00584     }
00585 }
00586 
00587 /* Auxiliary function: C interface to ztrsna results check */
00588 /* Return value: 0 - test is passed, non-zero - test is failed */
00589 static int compare_ztrsna( double *s, double *s_i, double *sep, double *sep_i,
00590                            lapack_int m, lapack_int m_i, lapack_int info,
00591                            lapack_int info_i, char job, lapack_int mm )
00592 {
00593     lapack_int i;
00594     int failed = 0;
00595     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
00596         for( i = 0; i < mm; i++ ) {
00597             failed += compare_doubles(s[i],s_i[i]);
00598         }
00599     }
00600     if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
00601         for( i = 0; i < mm; i++ ) {
00602             failed += compare_doubles(sep[i],sep_i[i]);
00603         }
00604     }
00605     failed += (m == m_i) ? 0 : 1;
00606     failed += (info == info_i) ? 0 : 1;
00607     if( info != 0 || info_i != 0 ) {
00608         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00609     }
00610 
00611     return failed;
00612 }


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