zgbbrd_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 * zgbbrd_1 is the test program for the C interface to LAPACK
00036 * routine zgbbrd
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_zgbbrd( char *vect, lapack_int *m, lapack_int *n,
00055                                  lapack_int *ncc, lapack_int *kl,
00056                                  lapack_int *ku, lapack_int *ldab,
00057                                  lapack_int *ldq, lapack_int *ldpt,
00058                                  lapack_int *ldc );
00059 static void init_ab( lapack_int size, lapack_complex_double *ab );
00060 static void init_d( lapack_int size, double *d );
00061 static void init_e( lapack_int size, double *e );
00062 static void init_q( lapack_int size, lapack_complex_double *q );
00063 static void init_pt( lapack_int size, lapack_complex_double *pt );
00064 static void init_c( lapack_int size, lapack_complex_double *c );
00065 static void init_work( lapack_int size, lapack_complex_double *work );
00066 static void init_rwork( lapack_int size, double *rwork );
00067 static int compare_zgbbrd( lapack_complex_double *ab,
00068                            lapack_complex_double *ab_i, double *d, double *d_i,
00069                            double *e, double *e_i, lapack_complex_double *q,
00070                            lapack_complex_double *q_i,
00071                            lapack_complex_double *pt,
00072                            lapack_complex_double *pt_i,
00073                            lapack_complex_double *c, lapack_complex_double *c_i,
00074                            lapack_int info, lapack_int info_i, lapack_int ldab,
00075                            lapack_int ldc, lapack_int ldpt, lapack_int ldq,
00076                            lapack_int m, lapack_int n, lapack_int ncc,
00077                            char vect );
00078 
00079 int main(void)
00080 {
00081     /* Local scalars */
00082     char vect, vect_i;
00083     lapack_int m, m_i;
00084     lapack_int n, n_i;
00085     lapack_int ncc, ncc_i;
00086     lapack_int kl, kl_i;
00087     lapack_int ku, ku_i;
00088     lapack_int ldab, ldab_i;
00089     lapack_int ldab_r;
00090     lapack_int ldq, ldq_i;
00091     lapack_int ldq_r;
00092     lapack_int ldpt, ldpt_i;
00093     lapack_int ldpt_r;
00094     lapack_int ldc, ldc_i;
00095     lapack_int ldc_r;
00096     lapack_int info, info_i;
00097     lapack_int i;
00098     int failed;
00099 
00100     /* Local arrays */
00101     lapack_complex_double *ab = NULL, *ab_i = NULL;
00102     double *d = NULL, *d_i = NULL;
00103     double *e = NULL, *e_i = NULL;
00104     lapack_complex_double *q = NULL, *q_i = NULL;
00105     lapack_complex_double *pt = NULL, *pt_i = NULL;
00106     lapack_complex_double *c = NULL, *c_i = NULL;
00107     lapack_complex_double *work = NULL, *work_i = NULL;
00108     double *rwork = NULL, *rwork_i = NULL;
00109     lapack_complex_double *ab_save = NULL;
00110     double *d_save = NULL;
00111     double *e_save = NULL;
00112     lapack_complex_double *q_save = NULL;
00113     lapack_complex_double *pt_save = NULL;
00114     lapack_complex_double *c_save = NULL;
00115     lapack_complex_double *ab_r = NULL;
00116     lapack_complex_double *q_r = NULL;
00117     lapack_complex_double *pt_r = NULL;
00118     lapack_complex_double *c_r = NULL;
00119 
00120     /* Iniitialize the scalar parameters */
00121     init_scalars_zgbbrd( &vect, &m, &n, &ncc, &kl, &ku, &ldab, &ldq, &ldpt,
00122                          &ldc );
00123     ldab_r = n+2;
00124     ldq_r = m+2;
00125     ldpt_r = n+2;
00126     ldc_r = ncc+2;
00127     vect_i = vect;
00128     m_i = m;
00129     n_i = n;
00130     ncc_i = ncc;
00131     kl_i = kl;
00132     ku_i = ku;
00133     ldab_i = ldab;
00134     ldq_i = ldq;
00135     ldpt_i = ldpt;
00136     ldc_i = ldc;
00137 
00138     /* Allocate memory for the LAPACK routine arrays */
00139     ab = (lapack_complex_double *)
00140         LAPACKE_malloc( ldab*n * sizeof(lapack_complex_double) );
00141     d = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00142     e = (double *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(double) );
00143     q = (lapack_complex_double *)
00144         LAPACKE_malloc( ldq*m * sizeof(lapack_complex_double) );
00145     pt = (lapack_complex_double *)
00146         LAPACKE_malloc( ldpt*n * sizeof(lapack_complex_double) );
00147     c = (lapack_complex_double *)
00148         LAPACKE_malloc( ldc*ncc * sizeof(lapack_complex_double) );
00149     work = (lapack_complex_double *)
00150         LAPACKE_malloc( MAX(m,n) * sizeof(lapack_complex_double) );
00151     rwork = (double *)LAPACKE_malloc( MAX(m,n) * sizeof(double) );
00152 
00153     /* Allocate memory for the C interface function arrays */
00154     ab_i = (lapack_complex_double *)
00155         LAPACKE_malloc( ldab*n * sizeof(lapack_complex_double) );
00156     d_i = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00157     e_i = (double *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(double) );
00158     q_i = (lapack_complex_double *)
00159         LAPACKE_malloc( ldq*m * sizeof(lapack_complex_double) );
00160     pt_i = (lapack_complex_double *)
00161         LAPACKE_malloc( ldpt*n * sizeof(lapack_complex_double) );
00162     c_i = (lapack_complex_double *)
00163         LAPACKE_malloc( ldc*ncc * sizeof(lapack_complex_double) );
00164     work_i = (lapack_complex_double *)
00165         LAPACKE_malloc( MAX(m,n) * sizeof(lapack_complex_double) );
00166     rwork_i = (double *)LAPACKE_malloc( MAX(m,n) * sizeof(double) );
00167 
00168     /* Allocate memory for the backup arrays */
00169     ab_save = (lapack_complex_double *)
00170         LAPACKE_malloc( ldab*n * sizeof(lapack_complex_double) );
00171     d_save = (double *)LAPACKE_malloc( MIN(m,n) * sizeof(double) );
00172     e_save = (double *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(double) );
00173     q_save = (lapack_complex_double *)
00174         LAPACKE_malloc( ldq*m * sizeof(lapack_complex_double) );
00175     pt_save = (lapack_complex_double *)
00176         LAPACKE_malloc( ldpt*n * sizeof(lapack_complex_double) );
00177     c_save = (lapack_complex_double *)
00178         LAPACKE_malloc( ldc*ncc * sizeof(lapack_complex_double) );
00179 
00180     /* Allocate memory for the row-major arrays */
00181     ab_r = (lapack_complex_double *)
00182         LAPACKE_malloc( (kl+ku+1)*(n+2) * sizeof(lapack_complex_double) );
00183     q_r = (lapack_complex_double *)
00184         LAPACKE_malloc( m*(m+2) * sizeof(lapack_complex_double) );
00185     pt_r = (lapack_complex_double *)
00186         LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
00187     c_r = (lapack_complex_double *)
00188         LAPACKE_malloc( m*(ncc+2) * sizeof(lapack_complex_double) );
00189 
00190     /* Initialize input arrays */
00191     init_ab( ldab*n, ab );
00192     init_d( (MIN(m,n)), d );
00193     init_e( (MIN(m,n)-1), e );
00194     init_q( ldq*m, q );
00195     init_pt( ldpt*n, pt );
00196     init_c( ldc*ncc, c );
00197     init_work( (MAX(m,n)), work );
00198     init_rwork( (MAX(m,n)), rwork );
00199 
00200     /* Backup the ouptut arrays */
00201     for( i = 0; i < ldab*n; i++ ) {
00202         ab_save[i] = ab[i];
00203     }
00204     for( i = 0; i < (MIN(m,n)); i++ ) {
00205         d_save[i] = d[i];
00206     }
00207     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00208         e_save[i] = e[i];
00209     }
00210     for( i = 0; i < ldq*m; i++ ) {
00211         q_save[i] = q[i];
00212     }
00213     for( i = 0; i < ldpt*n; i++ ) {
00214         pt_save[i] = pt[i];
00215     }
00216     for( i = 0; i < ldc*ncc; i++ ) {
00217         c_save[i] = c[i];
00218     }
00219 
00220     /* Call the LAPACK routine */
00221     zgbbrd_( &vect, &m, &n, &ncc, &kl, &ku, ab, &ldab, d, e, q, &ldq, pt, &ldpt,
00222              c, &ldc, work, rwork, &info );
00223 
00224     /* Initialize input data, call the column-major middle-level
00225      * interface to LAPACK routine and check the results */
00226     for( i = 0; i < ldab*n; i++ ) {
00227         ab_i[i] = ab_save[i];
00228     }
00229     for( i = 0; i < (MIN(m,n)); i++ ) {
00230         d_i[i] = d_save[i];
00231     }
00232     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00233         e_i[i] = e_save[i];
00234     }
00235     for( i = 0; i < ldq*m; i++ ) {
00236         q_i[i] = q_save[i];
00237     }
00238     for( i = 0; i < ldpt*n; i++ ) {
00239         pt_i[i] = pt_save[i];
00240     }
00241     for( i = 0; i < ldc*ncc; i++ ) {
00242         c_i[i] = c_save[i];
00243     }
00244     for( i = 0; i < (MAX(m,n)); i++ ) {
00245         work_i[i] = work[i];
00246     }
00247     for( i = 0; i < (MAX(m,n)); i++ ) {
00248         rwork_i[i] = rwork[i];
00249     }
00250     info_i = LAPACKE_zgbbrd_work( LAPACK_COL_MAJOR, vect_i, m_i, n_i, ncc_i,
00251                                   kl_i, ku_i, ab_i, ldab_i, d_i, e_i, q_i,
00252                                   ldq_i, pt_i, ldpt_i, c_i, ldc_i, work_i,
00253                                   rwork_i );
00254 
00255     failed = compare_zgbbrd( ab, ab_i, d, d_i, e, e_i, q, q_i, pt, pt_i, c, c_i,
00256                              info, info_i, ldab, ldc, ldpt, ldq, m, n, ncc,
00257                              vect );
00258     if( failed == 0 ) {
00259         printf( "PASSED: column-major middle-level interface to zgbbrd\n" );
00260     } else {
00261         printf( "FAILED: column-major middle-level interface to zgbbrd\n" );
00262     }
00263 
00264     /* Initialize input data, call the column-major high-level
00265      * interface to LAPACK routine and check the results */
00266     for( i = 0; i < ldab*n; i++ ) {
00267         ab_i[i] = ab_save[i];
00268     }
00269     for( i = 0; i < (MIN(m,n)); i++ ) {
00270         d_i[i] = d_save[i];
00271     }
00272     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00273         e_i[i] = e_save[i];
00274     }
00275     for( i = 0; i < ldq*m; i++ ) {
00276         q_i[i] = q_save[i];
00277     }
00278     for( i = 0; i < ldpt*n; i++ ) {
00279         pt_i[i] = pt_save[i];
00280     }
00281     for( i = 0; i < ldc*ncc; i++ ) {
00282         c_i[i] = c_save[i];
00283     }
00284     for( i = 0; i < (MAX(m,n)); i++ ) {
00285         work_i[i] = work[i];
00286     }
00287     for( i = 0; i < (MAX(m,n)); i++ ) {
00288         rwork_i[i] = rwork[i];
00289     }
00290     info_i = LAPACKE_zgbbrd( LAPACK_COL_MAJOR, vect_i, m_i, n_i, ncc_i, kl_i,
00291                              ku_i, ab_i, ldab_i, d_i, e_i, q_i, ldq_i, pt_i,
00292                              ldpt_i, c_i, ldc_i );
00293 
00294     failed = compare_zgbbrd( ab, ab_i, d, d_i, e, e_i, q, q_i, pt, pt_i, c, c_i,
00295                              info, info_i, ldab, ldc, ldpt, ldq, m, n, ncc,
00296                              vect );
00297     if( failed == 0 ) {
00298         printf( "PASSED: column-major high-level interface to zgbbrd\n" );
00299     } else {
00300         printf( "FAILED: column-major high-level interface to zgbbrd\n" );
00301     }
00302 
00303     /* Initialize input data, call the row-major middle-level
00304      * interface to LAPACK routine and check the results */
00305     for( i = 0; i < ldab*n; i++ ) {
00306         ab_i[i] = ab_save[i];
00307     }
00308     for( i = 0; i < (MIN(m,n)); i++ ) {
00309         d_i[i] = d_save[i];
00310     }
00311     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00312         e_i[i] = e_save[i];
00313     }
00314     for( i = 0; i < ldq*m; i++ ) {
00315         q_i[i] = q_save[i];
00316     }
00317     for( i = 0; i < ldpt*n; i++ ) {
00318         pt_i[i] = pt_save[i];
00319     }
00320     for( i = 0; i < ldc*ncc; i++ ) {
00321         c_i[i] = c_save[i];
00322     }
00323     for( i = 0; i < (MAX(m,n)); i++ ) {
00324         work_i[i] = work[i];
00325     }
00326     for( i = 0; i < (MAX(m,n)); i++ ) {
00327         rwork_i[i] = rwork[i];
00328     }
00329 
00330     LAPACKE_zge_trans( LAPACK_COL_MAJOR, kl+ku+1, n, ab_i, ldab, ab_r, n+2 );
00331     if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
00332         LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, q_i, ldq, q_r, m+2 );
00333     }
00334     if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
00335         LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, pt_i, ldpt, pt_r, n+2 );
00336     }
00337     if( ncc != 0 ) {
00338         LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, ncc, c_i, ldc, c_r, ncc+2 );
00339     }
00340     info_i = LAPACKE_zgbbrd_work( LAPACK_ROW_MAJOR, vect_i, m_i, n_i, ncc_i,
00341                                   kl_i, ku_i, ab_r, ldab_r, d_i, e_i, q_r,
00342                                   ldq_r, pt_r, ldpt_r, c_r, ldc_r, work_i,
00343                                   rwork_i );
00344 
00345     LAPACKE_zge_trans( LAPACK_ROW_MAJOR, kl+ku+1, n, ab_r, n+2, ab_i, ldab );
00346     if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
00347         LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, m, q_r, m+2, q_i, ldq );
00348     }
00349     if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
00350         LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, pt_r, n+2, pt_i, ldpt );
00351     }
00352     if( ncc != 0 ) {
00353         LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, ncc, c_r, ncc+2, c_i, ldc );
00354     }
00355 
00356     failed = compare_zgbbrd( ab, ab_i, d, d_i, e, e_i, q, q_i, pt, pt_i, c, c_i,
00357                              info, info_i, ldab, ldc, ldpt, ldq, m, n, ncc,
00358                              vect );
00359     if( failed == 0 ) {
00360         printf( "PASSED: row-major middle-level interface to zgbbrd\n" );
00361     } else {
00362         printf( "FAILED: row-major middle-level interface to zgbbrd\n" );
00363     }
00364 
00365     /* Initialize input data, call the row-major high-level
00366      * interface to LAPACK routine and check the results */
00367     for( i = 0; i < ldab*n; i++ ) {
00368         ab_i[i] = ab_save[i];
00369     }
00370     for( i = 0; i < (MIN(m,n)); i++ ) {
00371         d_i[i] = d_save[i];
00372     }
00373     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00374         e_i[i] = e_save[i];
00375     }
00376     for( i = 0; i < ldq*m; i++ ) {
00377         q_i[i] = q_save[i];
00378     }
00379     for( i = 0; i < ldpt*n; i++ ) {
00380         pt_i[i] = pt_save[i];
00381     }
00382     for( i = 0; i < ldc*ncc; i++ ) {
00383         c_i[i] = c_save[i];
00384     }
00385     for( i = 0; i < (MAX(m,n)); i++ ) {
00386         work_i[i] = work[i];
00387     }
00388     for( i = 0; i < (MAX(m,n)); i++ ) {
00389         rwork_i[i] = rwork[i];
00390     }
00391 
00392     /* Init row_major arrays */
00393     LAPACKE_zge_trans( LAPACK_COL_MAJOR, kl+ku+1, n, ab_i, ldab, ab_r, n+2 );
00394     if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
00395         LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, q_i, ldq, q_r, m+2 );
00396     }
00397     if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
00398         LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, pt_i, ldpt, pt_r, n+2 );
00399     }
00400     if( ncc != 0 ) {
00401         LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, ncc, c_i, ldc, c_r, ncc+2 );
00402     }
00403     info_i = LAPACKE_zgbbrd( LAPACK_ROW_MAJOR, vect_i, m_i, n_i, ncc_i, kl_i,
00404                              ku_i, ab_r, ldab_r, d_i, e_i, q_r, ldq_r, pt_r,
00405                              ldpt_r, c_r, ldc_r );
00406 
00407     LAPACKE_zge_trans( LAPACK_ROW_MAJOR, kl+ku+1, n, ab_r, n+2, ab_i, ldab );
00408     if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
00409         LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, m, q_r, m+2, q_i, ldq );
00410     }
00411     if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
00412         LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, pt_r, n+2, pt_i, ldpt );
00413     }
00414     if( ncc != 0 ) {
00415         LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, ncc, c_r, ncc+2, c_i, ldc );
00416     }
00417 
00418     failed = compare_zgbbrd( ab, ab_i, d, d_i, e, e_i, q, q_i, pt, pt_i, c, c_i,
00419                              info, info_i, ldab, ldc, ldpt, ldq, m, n, ncc,
00420                              vect );
00421     if( failed == 0 ) {
00422         printf( "PASSED: row-major high-level interface to zgbbrd\n" );
00423     } else {
00424         printf( "FAILED: row-major high-level interface to zgbbrd\n" );
00425     }
00426 
00427     /* Release memory */
00428     if( ab != NULL ) {
00429         LAPACKE_free( ab );
00430     }
00431     if( ab_i != NULL ) {
00432         LAPACKE_free( ab_i );
00433     }
00434     if( ab_r != NULL ) {
00435         LAPACKE_free( ab_r );
00436     }
00437     if( ab_save != NULL ) {
00438         LAPACKE_free( ab_save );
00439     }
00440     if( d != NULL ) {
00441         LAPACKE_free( d );
00442     }
00443     if( d_i != NULL ) {
00444         LAPACKE_free( d_i );
00445     }
00446     if( d_save != NULL ) {
00447         LAPACKE_free( d_save );
00448     }
00449     if( e != NULL ) {
00450         LAPACKE_free( e );
00451     }
00452     if( e_i != NULL ) {
00453         LAPACKE_free( e_i );
00454     }
00455     if( e_save != NULL ) {
00456         LAPACKE_free( e_save );
00457     }
00458     if( q != NULL ) {
00459         LAPACKE_free( q );
00460     }
00461     if( q_i != NULL ) {
00462         LAPACKE_free( q_i );
00463     }
00464     if( q_r != NULL ) {
00465         LAPACKE_free( q_r );
00466     }
00467     if( q_save != NULL ) {
00468         LAPACKE_free( q_save );
00469     }
00470     if( pt != NULL ) {
00471         LAPACKE_free( pt );
00472     }
00473     if( pt_i != NULL ) {
00474         LAPACKE_free( pt_i );
00475     }
00476     if( pt_r != NULL ) {
00477         LAPACKE_free( pt_r );
00478     }
00479     if( pt_save != NULL ) {
00480         LAPACKE_free( pt_save );
00481     }
00482     if( c != NULL ) {
00483         LAPACKE_free( c );
00484     }
00485     if( c_i != NULL ) {
00486         LAPACKE_free( c_i );
00487     }
00488     if( c_r != NULL ) {
00489         LAPACKE_free( c_r );
00490     }
00491     if( c_save != NULL ) {
00492         LAPACKE_free( c_save );
00493     }
00494     if( work != NULL ) {
00495         LAPACKE_free( work );
00496     }
00497     if( work_i != NULL ) {
00498         LAPACKE_free( work_i );
00499     }
00500     if( rwork != NULL ) {
00501         LAPACKE_free( rwork );
00502     }
00503     if( rwork_i != NULL ) {
00504         LAPACKE_free( rwork_i );
00505     }
00506 
00507     return 0;
00508 }
00509 
00510 /* Auxiliary function: zgbbrd scalar parameters initialization */
00511 static void init_scalars_zgbbrd( char *vect, lapack_int *m, lapack_int *n,
00512                                  lapack_int *ncc, lapack_int *kl,
00513                                  lapack_int *ku, lapack_int *ldab,
00514                                  lapack_int *ldq, lapack_int *ldpt,
00515                                  lapack_int *ldc )
00516 {
00517     *vect = 'N';
00518     *m = 6;
00519     *n = 4;
00520     *ncc = 0;
00521     *kl = 2;
00522     *ku = 1;
00523     *ldab = 17;
00524     *ldq = 8;
00525     *ldpt = 8;
00526     *ldc = 8;
00527 
00528     return;
00529 }
00530 
00531 /* Auxiliary functions: zgbbrd array parameters initialization */
00532 static void init_ab( lapack_int size, lapack_complex_double *ab ) {
00533     lapack_int i;
00534     for( i = 0; i < size; i++ ) {
00535         ab[i] = lapack_make_complex_double( 0.0, 0.0 );
00536     }
00537     ab[0] = lapack_make_complex_double( 0.00000000000000000e+000,
00538                                         0.00000000000000000e+000 );
00539     ab[17] = lapack_make_complex_double( -2.99999999999999990e-002,
00540                                          9.59999999999999960e-001 );
00541     ab[34] = lapack_make_complex_double( -6.60000000000000030e-001,
00542                                          4.19999999999999980e-001 );
00543     ab[51] = lapack_make_complex_double( -1.11000000000000010e+000,
00544                                          5.99999999999999980e-001 );
00545     ab[1] = lapack_make_complex_double( 9.59999999999999960e-001,
00546                                         -8.10000000000000050e-001 );
00547     ab[18] = lapack_make_complex_double( -1.20000000000000000e+000,
00548                                          1.90000000000000000e-001 );
00549     ab[35] = lapack_make_complex_double( 6.30000000000000000e-001,
00550                                          -1.70000000000000010e-001 );
00551     ab[52] = lapack_make_complex_double( 2.20000000000000000e-001,
00552                                          -2.00000000000000010e-001 );
00553     ab[2] = lapack_make_complex_double( -9.79999999999999980e-001,
00554                                         1.98000000000000000e+000 );
00555     ab[19] = lapack_make_complex_double( 1.01000000000000000e+000,
00556                                          2.00000000000000000e-002 );
00557     ab[36] = lapack_make_complex_double( -9.79999999999999980e-001,
00558                                          -3.59999999999999990e-001 );
00559     ab[53] = lapack_make_complex_double( 1.47000000000000000e+000,
00560                                          1.59000000000000010e+000 );
00561     ab[3] = lapack_make_complex_double( 6.20000000000000000e-001,
00562                                         -4.60000000000000020e-001 );
00563     ab[20] = lapack_make_complex_double( 1.90000000000000000e-001,
00564                                          -5.40000000000000040e-001 );
00565     ab[37] = lapack_make_complex_double( -1.70000000000000010e-001,
00566                                          -4.60000000000000020e-001 );
00567     ab[54] = lapack_make_complex_double( 2.60000000000000010e-001,
00568                                          2.60000000000000010e-001 );
00569 }
00570 static void init_d( lapack_int size, double *d ) {
00571     lapack_int i;
00572     for( i = 0; i < size; i++ ) {
00573         d[i] = 0;
00574     }
00575 }
00576 static void init_e( lapack_int size, double *e ) {
00577     lapack_int i;
00578     for( i = 0; i < size; i++ ) {
00579         e[i] = 0;
00580     }
00581 }
00582 static void init_q( lapack_int size, lapack_complex_double *q ) {
00583     lapack_int i;
00584     for( i = 0; i < size; i++ ) {
00585         q[i] = lapack_make_complex_double( 0.0, 0.0 );
00586     }
00587 }
00588 static void init_pt( lapack_int size, lapack_complex_double *pt ) {
00589     lapack_int i;
00590     for( i = 0; i < size; i++ ) {
00591         pt[i] = lapack_make_complex_double( 0.0, 0.0 );
00592     }
00593 }
00594 static void init_c( lapack_int size, lapack_complex_double *c ) {
00595     lapack_int i;
00596     for( i = 0; i < size; i++ ) {
00597         c[i] = lapack_make_complex_double( 0.0, 0.0 );
00598     }
00599 }
00600 static void init_work( lapack_int size, lapack_complex_double *work ) {
00601     lapack_int i;
00602     for( i = 0; i < size; i++ ) {
00603         work[i] = lapack_make_complex_double( 0.0, 0.0 );
00604     }
00605 }
00606 static void init_rwork( lapack_int size, double *rwork ) {
00607     lapack_int i;
00608     for( i = 0; i < size; i++ ) {
00609         rwork[i] = 0;
00610     }
00611 }
00612 
00613 /* Auxiliary function: C interface to zgbbrd results check */
00614 /* Return value: 0 - test is passed, non-zero - test is failed */
00615 static int compare_zgbbrd( lapack_complex_double *ab,
00616                            lapack_complex_double *ab_i, double *d, double *d_i,
00617                            double *e, double *e_i, lapack_complex_double *q,
00618                            lapack_complex_double *q_i,
00619                            lapack_complex_double *pt,
00620                            lapack_complex_double *pt_i,
00621                            lapack_complex_double *c, lapack_complex_double *c_i,
00622                            lapack_int info, lapack_int info_i, lapack_int ldab,
00623                            lapack_int ldc, lapack_int ldpt, lapack_int ldq,
00624                            lapack_int m, lapack_int n, lapack_int ncc,
00625                            char vect )
00626 {
00627     lapack_int i;
00628     int failed = 0;
00629     for( i = 0; i < ldab*n; i++ ) {
00630         failed += compare_complex_doubles(ab[i],ab_i[i]);
00631     }
00632     for( i = 0; i < (MIN(m,n)); i++ ) {
00633         failed += compare_doubles(d[i],d_i[i]);
00634     }
00635     for( i = 0; i < (MIN(m,n)-1); i++ ) {
00636         failed += compare_doubles(e[i],e_i[i]);
00637     }
00638     if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
00639         for( i = 0; i < ldq*m; i++ ) {
00640             failed += compare_complex_doubles(q[i],q_i[i]);
00641         }
00642     }
00643     if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
00644         for( i = 0; i < ldpt*n; i++ ) {
00645             failed += compare_complex_doubles(pt[i],pt_i[i]);
00646         }
00647     }
00648     if( ncc != 0 ) {
00649         for( i = 0; i < ldc*ncc; i++ ) {
00650             failed += compare_complex_doubles(c[i],c_i[i]);
00651         }
00652     }
00653     failed += (info == info_i) ? 0 : 1;
00654     if( info != 0 || info_i != 0 ) {
00655         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00656     }
00657 
00658     return failed;
00659 }


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